The R Project SVN R

Rev

Rev 42300 | Rev 44177 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 42300 Rev 43904
Line 29... Line 29...
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>
 32 
#include <direct.h>
33 
#define WIN32_LEAN_AND_MEAN 1
 33 
#define WIN32_LEAN_AND_MEAN 1
- 
 
 34 
/* Eventually #define _WIN32_WINNT 0x0502 for SetDllDirectoryA */
34 
#include <windows.h>
 35 
#include <windows.h>
35 
 
 36 
 
- 
 
 37 
/* SetDllDirectory is supported under XP SP1 and later.
- 
 
 38 
   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
- 
 
 40 
   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 
 */
- 
 
 48 
typedef BOOL (WINAPI *PSDD)(LPCTSTR);
- 
 
 49 
 
- 
 
 50 
int setDLLSearchPath(const char *path)
- 
 
 51 
{
- 
 
 52 
    int res = 0; /* failure */
- 
 
 53 
    PSDD p = (PSDD) -1;
- 
 
 54 
    static char wd[MAX_PATH] = "";  /* stored real current directory */
- 
 
 55
- 
 
 56 
    if(p == (PSDD) -1)
- 
 
 57 
	p = (PSDD) GetProcAddress(GetModuleHandle(TEXT("kernel32.dll")),
- 
 
 58 
				  "SetDllDirectoryA");
- 
 
 59 
    if(p) {
- 
 
 60 
	res = p(path);
- 
 
 61 
    } else { /* Windows 2000 */
- 
 
 62 
	if(path) {
- 
 
 63 
	    GetCurrentDirectory(MAX_PATH, wd);
- 
 
 64 
	} else if (wd[0]) {
- 
 
 65 
	    SetCurrentDirectory(wd);
- 
 
 66 
	    wd[0] = '\0';
- 
 
 67 
	}
- 
 
 68 
    }
- 
 
 69 
    return res;
- 
 
 70 
}
- 
 
 71 
 
36 
#include <R_ext/Rdynload.h>
 72 
#include <R_ext/Rdynload.h>
37 
#include <Rdynpriv.h>
 73 
#include <Rdynpriv.h>
38 
 
 74 
 
39 
 
 75 
 
40 
        /* Inserts the specified DLL at the head of the DLL list */
 76 
        /* Inserts the specified DLL at the head of the DLL list */
Line 46... Line 82...
46 
{
 82 
{
47 
    char *p;
 83 
    char *p;
48 
    for(p = path; *p != '\0'; p++) if(*p == '\\') *p = '/';
 84 
    for(p = path; *p != '\0'; p++) if(*p == '\\') *p = '/';
49 
}
 85 
}
50 
 
 86 
 
51 
static HINSTANCE R_loadLibrary(const char *path, int asLocal, int now);
 87 
static HINSTANCE R_loadLibrary(const char *path, int asLocal, int now,
- 
 
 88 
			       const char *search);
52 
static DL_FUNC getRoutine(DllInfo *info, char const *name);
 89 
static DL_FUNC getRoutine(DllInfo *info, char const *name);
53 
static void R_deleteCachedSymbols(DllInfo *dll);
 90 
static void R_deleteCachedSymbols(DllInfo *dll);
54 
 
 91 
 
55 
static void R_getDLLError(char *buf, int len);
 92 
static void R_getDLLError(char *buf, int len);
56 
static void GetFullDLLPath(SEXP call, char *buf, const char *path);
 93 
static void GetFullDLLPath(SEXP call, char *buf, const char *path);
Line 96... Line 133...
96 
#define	_MCW_IC		0x00040000	/* Infinity */
 133 
#define	_MCW_IC		0x00040000	/* Infinity */
97 
#define	_MCW_RC		0x00000300	/* Rounding */
 134 
#define	_MCW_RC		0x00000300	/* Rounding */
98 
#define	_MCW_PC		0x00030000	/* Precision */
 135 
#define	_MCW_PC		0x00030000	/* Precision */
99 
#endif
 136 
#endif
100 
 
 137 
 
101 
HINSTANCE R_loadLibrary(const char *path, int asLocal, int now)
 138 
HINSTANCE R_loadLibrary(const char *path, int asLocal, int now,
- 
 
 139 
			const char *search)
102 
{
 140 
{
103 
    HINSTANCE tdlh;
 141 
    HINSTANCE tdlh;
104 
    unsigned int dllcw, rcw;
 142 
    unsigned int dllcw, rcw;
- 
 
 143 
    int useSearch = search && search[0];
105 
 
 144 
 
106 
    rcw = _controlfp(0,0) & ~_MCW_IC;  /* Infinity control is ignored */
 145 
    rcw = _controlfp(0,0) & ~_MCW_IC;  /* Infinity control is ignored */
107 
    _clearfp();
 146 
    _clearfp();
- 
 
 147 
    if(useSearch) setDLLSearchPath(search);
108 
    tdlh = LoadLibrary(path);
 148 
    tdlh = LoadLibrary(path);
- 
 
 149 
    if(useSearch) setDLLSearchPath(NULL);
109 
    dllcw = _controlfp(0,0) & ~_MCW_IC;
 150 
    dllcw = _controlfp(0,0) & ~_MCW_IC;
110 
    if (dllcw != rcw) {
 151 
    if (dllcw != rcw) {
111 
		_controlfp(rcw, _MCW_EM | _MCW_IC | _MCW_RC | _MCW_PC);
 152 
	_controlfp(rcw, _MCW_EM | _MCW_IC | _MCW_RC | _MCW_PC);
112 
		if (LOGICAL(GetOption(install("warn.FPU"), R_BaseEnv))[0])
 153 
	if (LOGICAL(GetOption(install("warn.FPU"), R_BaseEnv))[0])
113 
			warning(_("DLL attempted to change FPU control word from %x to %x"),
 154 
	    warning(_("DLL attempted to change FPU control word from %x to %x"),
114 
					rcw,dllcw);
 155 
		    rcw,dllcw);
115 
	}
 156 
    }
116 
    return(tdlh);
 157 
    return(tdlh);
117 
}
 158 
}
118 
 
 159 
 
119 
static DL_FUNC getRoutine(DllInfo *info, char const *name)
 160 
static DL_FUNC getRoutine(DllInfo *info, char const *name)
120 
{
 161 
{
Line 154... Line 195...
154 
    } else
 195 
    } else
155 
	strcpy(buf, path);
 196 
	strcpy(buf, path);
156 
    /* fix slashes to allow inconsistent usage later */
 197 
    /* fix slashes to allow inconsistent usage later */
157 
    for (p = buf; *p; p++) if (*p == '\\') *p = '/';
 198 
    for (p = buf; *p; p++) if (*p == '\\') *p = '/';
158 
}
 199 
}
- 
 
 200