The R Project SVN R

Rev

Rev 80546 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 80546 Rev 83796
Line 1... Line 1...
1 
/*
 1 
/*
2 
 *  R : A Computer Language for Statistical Data Analysis
 2 
 *  R : A Computer Language for Statistical Data Analysis
3 
 *  Copyright (C) 1995-1996 Robert Gentleman and Ross Ihaka
 3 
 *  Copyright (C) 1995-1996 Robert Gentleman and Ross Ihaka
4 
 *  Copyright (C) 1997-2021 The R Core Team
 4 
 *  Copyright (C) 1997-2023 The R Core Team
5 
 *
 5 
 *
6 
 *  This program is free software; you can redistribute it and/or modify
 6 
 *  This program is free software; you can redistribute it and/or modify
7 
 *  it under the terms of the GNU General Public License as published by
 7 
 *  it under the terms of the GNU General Public License as published by
8 
 *  the Free Software Foundation; either version 2 of the License, or
 8 
 *  the Free Software Foundation; either version 2 of the License, or
9 
 *  (at your option) any later version.
 9 
 *  (at your option) any later version.
Line 27... Line 27...
27 
 
 27 
 
28 
#include <string.h>
 28 
#include <string.h>
29 
#include <stdlib.h>
 29 
#include <stdlib.h>
30 
#include <Defn.h>
 30 
#include <Defn.h>
31 
#include <Rmath.h>
 31 
#include <Rmath.h>
32 
#include <direct.h>
 - 
 
33 
#define WIN32_LEAN_AND_MEAN 1
 32 
#define WIN32_LEAN_AND_MEAN 1
- 
 
 33 
 
- 
 
 34 
#ifndef _WIN32_WINNT
34 
/* Eventually #define _WIN32_WINNT 0x0502 for SetDllDirectoryA */
 35 
# define _WIN32_WINNT 0x0502 /* for SetDllDirectory */
- 
 
 36 
#endif
- 
 
 37 
#include <direct.h>
35 
#include <windows.h>
 38 
#include <windows.h>
36 
 
 39 
 
37 
/* SetDllDirectory is supported under XP SP1 and later.
 - 
 
38 
   If called with a non-NULL argument it sets the argument to be
 40 
/* If called with a non-NULL argument it sets the argument to be
39 
   the second item on the DLL search path (after the application
 41 
   the second item on the DLL search path (after the application
40 
   launch directory).  This is removed if called with NULL.
 42 
   launch directory).  This is removed if called with NULL.
41 
 
 - 
 
42 
   Prior to XP SP1 the second item was the current directory, but this
 - 
 
43 
   has (by default, 'safe DLL search mode') been moved below the
 - 
 
44 
   Windows dirs.  Using SetDllDirectory removes it altogether.
 - 
 
45 
 
 - 
 
46 
   We fudge this via the current directory in earlier systems.
 - 
 
47 
 */
 43 
 */
48 
typedef BOOL (WINAPI *PSDD)(LPCTSTR);
 - 
 
49 
 
 44 
 
50 
int setDLLSearchPath(const char *path)
 45 
int setDLLSearchPath(const char *path)
51 
{
 46 
{
52 
    int res = 0; /* failure */
 - 
 
53 
    PSDD p = (PSDD) -1;
 - 
 
54 
    static char wd[MAX_PATH] = "";  /* stored real current directory */
 - 
 
55 
 
 - 
 
56 
    // XP SP1 and later.
 - 
 
57 
    if(p == (PSDD) -1)
 - 
 
58 
	p = (PSDD) GetProcAddress(GetModuleHandle(TEXT("kernel32.dll")),
 - 
 
59 
				  "SetDllDirectoryA");
 - 
 
60 
    if(p) {
 - 
 
61 
	res = p(path);
 - 
 
62 
    } else { /* Windows 2000 */
 - 
 
63 
	if(path) {
 - 
 
64 
	    GetCurrentDirectory(MAX_PATH, wd);
 - 
 
65 
	    SetCurrentDirectory(path);
 47 
    return SetDllDirectory(path);
66 
	} else if (wd[0]) {
 - 
 
67 
	    SetCurrentDirectory(wd);
 - 
 
68 
	    wd[0] = '\0';
 - 
 
69 
	}
 - 
 
70 
    }
 - 
 
71 
    return res;
 - 
 
72 
}
 48 
}
73 
 
 49 
 
74 
#include <R_ext/Rdynload.h>
 50 
#include <R_ext/Rdynload.h>
75 
#include <Rdynpriv.h>
 51 
#include <Rdynpriv.h>
76 
 
 52 
 
Line 89... Line 65...
89 
static HINSTANCE R_loadLibrary(const char *path, int asLocal, int now,
 65 
static HINSTANCE R_loadLibrary(const char *path, int asLocal, int now,
90 
			       const char *search);
 66 
			       const char *search);
91 
static DL_FUNC getRoutine(DllInfo *info, char const *name);
 67 
static DL_FUNC getRoutine(DllInfo *info, char const *name);
92 
 
 68 
 
93 
static void R_getDLLError(char *buf, int len);
 69 
static void R_getDLLError(char *buf, int len);
- 
 
 70 
static size_t
94 
static void GetFullDLLPath(SEXP call, char *buf, const char *path);
 71 
GetFullDLLPath(SEXP call, char *buf, size_t bufsize, const char *path);
95 
 
 72 
 
96 
static void closeLibrary(HINSTANCE handle)
 73 
static void closeLibrary(HINSTANCE handle)
97 
{
 74 
{
98 
    FreeLibrary(handle);
 75 
    FreeLibrary(handle);
99 
}
 76 
}
Line 174... Line 151...
174 
    /* It seems that Win 7 returns error messages with CRLF terminators */
 151 
    /* It seems that Win 7 returns error messages with CRLF terminators */
175 
    for (p = lpMsgBuf; *p; p++) if (*p != '\r') *q++ = *p;
 152 
    for (p = lpMsgBuf; *p; p++) if (*p != '\r') *q++ = *p;
176 
    LocalFree(lpMsgBuf);
 153 
    LocalFree(lpMsgBuf);
177 
}
 154 
}
178 
 
 155 
 
- 
 
 156 
/* Retuns the number of bytes (excluding the terminator) needed in buf.
- 
 
 157 
   When bufsize is at least that + 1, buf contains the result
- 
 
 158 
   with terminator. */
- 
 
 159 
static size_t
179 
static void GetFullDLLPath(SEXP call, char *buf, const char *path)
 160 
GetFullDLLPath(SEXP call, char *buf, size_t bufsize, const char *path)
180 
{
 161 
{
181 
    char *p;
 162 
    /* NOTE: Unix version also expands ~ */
182 
 
 163 
 
- 
 
 164 
    size_t needed = strlen(path);
183 
    if ((path[0] != '/') && (path[0] != '\\') && (path[1] != ':')) {
 165 
    if ((path[0] != '/') && (path[0] != '\\') && (path[1] != ':')) {
184 
	if (!getcwd(buf, MAX_PATH))
 166 
	needed ++; /* for separator */
- 
 
 167 
	DWORD res = GetCurrentDirectory(bufsize, buf);
- 
 
 168 
	if (!res)
185 
	    errorcall(call, _("cannot get working directory"));
 169 
	    errorcall(call, _("cannot get working directory"));
- 
 
 170 
	needed += res;
- 
 
 171 
	if (res >= bufsize)
- 
 
 172 
	    return needed - 1; /* res here includes terminator */
- 
 
 173 
 
- 
 
 174 
	if (bufsize >= needed + 1) {
186 
	strcat(buf, "\\");
 175 
	    strcat(buf, "/");
187 
	strcat(buf, path);
 176 
	    strcat(buf, path);
- 
 
 177 
	    /* fix slashes to allow inconsistent usage later */
- 
 
 178 
	    fixPath(buf);
- 
 
 179 
	}
188 
    } else
 180 
    } else {
- 
 
 181 
	if (bufsize >= needed + 1) {
189 
	strcpy(buf, path);
 182 
	    strcpy(buf, path);
190 
    /* fix slashes to allow inconsistent usage later */
 183 
	    /* fix slashes to allow inconsistent usage later */
191 
    for (p = buf; *p; p++) if (*p == '\\') *p = '/';
 184 
	    fixPath(buf);
- 
 
 185 
	}
- 
 
 186 
    }
- 
 
 187 
    return needed;
192 
}
 188 
}
- 
 
 189