The R Project SVN R

Rev

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

Rev 11499 Rev 14077
Line 64... Line 64...
64 
#include <Defn.h>
 64 
#include <Defn.h>
65 
#include <Rmath.h>
 65 
#include <Rmath.h>
66 
#include <direct.h>
 66 
#include <direct.h>
67 
#include <windows.h>
 67 
#include <windows.h>
68 
 
 68 
 
69 
/* DL_FUNC is in Defn.h */
 69 
#include "R_ext/Rdynload.h"
70 
typedef struct {
 70 
#include "R_ext/Rdynpriv.h"
71 
    char *name;
 - 
 
72 
    DL_FUNC func;
 - 
 
73 
} CFunTabEntry;
 - 
 
74 
 
 71 
 
75 
#include "FFDecl.h"
 72 
#include "FFDecl.h"
76 
 
 73 
 
77 
/* This provides a table of built-in C and Fortran functions.
 74 
/* This provides a table of built-in C and Fortran functions.
78 
   We include this table, even when we have dlopen and friends.
 75 
   We include this table, even when we have dlopen and friends.
Line 82... Line 79...
82 
{
 79 
{
83 
#include "FFTab.h"
 80 
#include "FFTab.h"
84 
    {NULL, NULL}
 81 
    {NULL, NULL}
85 
};
 82 
};
86 
 
 83 
 
87 
#define CACHE_DLL_SYM
 - 
 
88 
#ifdef CACHE_DLL_SYM
 - 
 
89 
/* keep a record of symbols that have been found */
 - 
 
90 
static struct {
 - 
 
91 
    char pkg[21];
 - 
 
92 
    char name[21];
 - 
 
93 
    DL_FUNC func;
 - 
 
94 
}  CPFun[100];
 - 
 
95 
static int nCPFun = 0;
 - 
 
96 
#endif
 - 
 
97 
 
 84 
 
98 
 
 85 
 
- 
 
 86 
        /* Inserts the specified DLL at the head of the DLL list */
- 
 
 87 
        /* Returns 1 if the library was successfully added */
- 
 
 88 
        /* and returns 0 if the library table is full or */
- 
 
 89 
        /* or if LoadLibrary fails for some reason. */
- 
 
 90 
 
99 
void InitFunctionHashing()
 91 
static void fixPath(char *path)
100 
{
 92 
{
- 
 
 93 
  char *p;
- 
 
 94 
    for(p = path; *p != '\0'; p++) if(*p == '\\') *p = '/';
101 
}
 95 
}
102 
 
 96 
 
- 
 
 97 
static HINSTANCE R_loadLibrary(const char *path, int asLocal, int now);
- 
 
 98 
static DL_FUNC getRoutine(DllInfo *info, char const *name);
- 
 
 99 
static void R_deleteCachedSymbols(DllInfo *dll);
103 
 
 100 
 
104 
#define MAX_NUM_DLLS	100
 - 
 
105 
 
 - 
 
106 
static int CountDLL = 0;
 101 
static DL_FUNC getBaseSymbol(const char *name);
107 
 
 102 
 
108 
static struct {
 103 
static void R_getDLLError(char *buf, int len);
109 
    char  *path;
 104 
static void GetFullDLLPath(SEXP call, char *buf, char *path);
110 
    char  *name;
 - 
 
111 
    HINSTANCE dlh;
 - 
 
112 
} LoadedDLL[MAX_NUM_DLLS];
 - 
 
113 
 
 105 
 
114 
	/* Remove the specified DLL from the current DLL list */
 - 
 
115 
	/* Returns 1 if the DLL was found and removed from */
 106 
static void closeLibrary(HINSTANCE handle)
- 
 
 107 
{
116 
	/* the list and returns 0 otherwise. */
 108 
  FreeLibrary(handle);
- 
 
 109 
}
117 
 
 110 
 
118 
static int DeleteDLL(char *path)
 111 
void InitFunctionHashing()
119 
{
 112 
{
- 
 
 113 
    R_osDynSymbol->loadLibrary = R_loadLibrary;
120 
    int   i, loc;
 114 
    R_osDynSymbol->dlsym = getRoutine;
- 
 
 115 
    R_osDynSymbol->closeLibrary = closeLibrary;
- 
 
 116 
    R_osDynSymbol->getError = R_getDLLError;
- 
 
 117 
    R_osDynSymbol->getBaseSymbol = getBaseSymbol;
121 
 
 118 
 
122 
    for (i = 0; i < CountDLL; i++) {
 119 
    R_osDynSymbol->deleteCachedSymbols = R_deleteCachedSymbols;
123 
	if (!strcmp(path, LoadedDLL[i].path)) {
 120 
    R_osDynSymbol->lookupCachedSymbol = Rf_lookupCachedSymbol;
- 
 
 121 
 
124 
	    loc = i;
 122 
    R_osDynSymbol->CFunTab = CFunTab;
- 
 
 123 
 
125 
	    goto found;
 124 
    R_osDynSymbol->fixPath = fixPath;
- 
 
 125 
    R_osDynSymbol->getFullDLLPath = GetFullDLLPath;
126 
	}
 126 
}
127 
    }
 127 
 
128 
    return 0;
 128 
static void R_deleteCachedSymbols(DllInfo *dll)
129 
found:
 129 
{
130 
#ifdef CACHE_DLL_SYM
 130 
  int i;
131 
    for(i = nCPFun - 1; i >= 0; i--)
 131 
    for(i = nCPFun - 1; i >= 0; i--)
132 
	if(!strcmp(CPFun[i].pkg, LoadedDLL[loc].name)) {
 132 
	if(!strcmp(CPFun[i].pkg, dll->name)) {
133 
	    if(i < nCPFun - 1) {
 133 
	    if(i < nCPFun - 1) {
134 
		strcpy(CPFun[i].name, CPFun[--nCPFun].name);
 134 
		strcpy(CPFun[i].name, CPFun[--nCPFun].name);
135 
		strcpy(CPFun[i].pkg, CPFun[nCPFun].pkg);
 135 
		strcpy(CPFun[i].pkg, CPFun[nCPFun].pkg);
136 
		CPFun[i].func = CPFun[nCPFun].func;
 136 
		CPFun[i].func = CPFun[nCPFun].func;
137 
	    } else nCPFun--;
 137 
	    } else nCPFun--;
138 
	}
 138 
	}
139 
#endif
 - 
 
140 
    free(LoadedDLL[loc].name);
 - 
 
141 
    free(LoadedDLL[loc].path);
 - 
 
142 
    FreeLibrary(LoadedDLL[loc].dlh);
 - 
 
143 
    for (i = loc + 1; i < CountDLL; i++) {
 - 
 
144 
	LoadedDLL[i - 1].path = LoadedDLL[i].path;
 - 
 
145 
	LoadedDLL[i - 1].name = LoadedDLL[i].name;
 - 
 
146 
	LoadedDLL[i - 1].dlh = LoadedDLL[i].dlh;
 - 
 
147 
    }
 - 
 
148 
    CountDLL--;
 - 
 
149 
    return 1;
 - 
 
150 
}
 139 
}
151 
 
 140 
 
- 
 
 141 
HINSTANCE R_loadLibrary(const char *path, int asLocal, int now)
- 
 
 142 
{
152 
#define DLLerrBUFSIZE 4000
 143 
  HINSTANCE tdlh;
153 
static char DLLerror[DLLerrBUFSIZE] = "";
 144 
    tdlh = LoadLibrary(path);
154 
 
 145 
 
155 
        /* Inserts the specified DLL at the head of the DLL list */
 - 
 
156 
        /* Returns 1 if the library was successfully added */
 - 
 
157 
        /* and returns 0 if the library table is full or */
 146 
 return(tdlh);
158 
        /* or if LoadLibrary fails for some reason. */
 - 
 
- 
 
 147 
}
159 
 
 148 
 
160 
/*
 - 
 
161 
  The arguments asLocal and now are unused in this version.
 - 
 
162 
  They are here for consistency with the UNIX code.
 - 
 
163 
 */
 - 
 
164 
static int AddDLL(char *path, int asLocal, int now)
 149 
static DL_FUNC getRoutine(DllInfo *info, char const *name)
165 
{
 150 
{
166 
    HINSTANCE tdlh;
 151 
 DL_FUNC f;
167 
    char *dpath, *name, DLLname[MAX_PATH], *p, *st;
 152 
  f = (DL_FUNC) GetProcAddress(info->handle, name);
- 
 
 153 
  return(f);
- 
 
 154 
}
168 
 
 155 
 
169 
    DeleteDLL(path);
 - 
 
170 
    if (CountDLL == MAX_NUM_DLLS) {
 156 
static void R_getDLLError(char *buf, int len)
171 
	strcpy(DLLerror, "Maximal number of DLLs reached...");
 - 
 
172 
	return 0;
 - 
 
173 
    }
 157 
{
174 
    tdlh = LoadLibrary(path);
 - 
 
175 
    if (tdlh == NULL) {
 - 
 
176 
	LPVOID lpMsgBuf;
 158 
    LPVOID lpMsgBuf;
177 
	FormatMessage(
159 
	FormatMessage(
178 
	    FORMAT_MESSAGE_ALLOCATE_BUFFER |
160 
	    FORMAT_MESSAGE_ALLOCATE_BUFFER |
179 
	    FORMAT_MESSAGE_FROM_SYSTEM |
161 
	    FORMAT_MESSAGE_FROM_SYSTEM |
180 
	    FORMAT_MESSAGE_IGNORE_INSERTS,
 162 
	    FORMAT_MESSAGE_IGNORE_INSERTS,
181 
	    NULL,
 163 
	    NULL,
Line 183... Line 165...
183 
	    MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
 165 
	    MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
184 
	    (LPTSTR) &lpMsgBuf,
 166 
	    (LPTSTR) &lpMsgBuf,
185 
	    0,
 167 
	    0,
186 
	    NULL
168 
	    NULL
187 
	    );
 169 
	    );
188 
	strcpy(DLLerror, "LoadLibrary failure:  ");
 170 
	strcpy(buf, "LoadLibrary failure:  ");
189 
	strcat(DLLerror, lpMsgBuf);
 171 
	strcat(buf, lpMsgBuf);
190 
	LocalFree(lpMsgBuf);
 172 
	LocalFree(lpMsgBuf);
191 
	return 0;
 - 
 
192 
    }
 - 
 
193 
 
 - 
 
194 
    dpath = malloc(strlen(path)+1);
 - 
 
195 
    if(dpath == NULL) {
 - 
 
196 
	strcpy(DLLerror, "Couldn't allocate space for 'path'");
 - 
 
197 
	FreeLibrary(tdlh);
 - 
 
198 
	return 0;
 - 
 
199 
    }
 - 
 
200 
    strcpy(dpath, path);
 - 
 
201 
 
 - 
 
202 
    strcpy(DLLname, path);
 - 
 
203 
    for(p = DLLname; *p != '\0'; p++) if(*p == '\\') *p = '/';
 - 
 
204 
    p = strrchr(path, '/');
 - 
 
205 
    if(!p) p = DLLname; else p++;
 - 
 
206 
    st = strchr(p, '.');
 - 
 
207 
    if(st) *st = '\0';
 - 
 
208 
    name = malloc(strlen(p)+1);
 - 
 
209 
    if(name == NULL) {
 - 
 
210 
	strcpy(DLLerror,"Couldn't allocate space for 'name'");
 - 
 
211 
	FreeLibrary(tdlh);
 - 
 
212 
	free(dpath);
 - 
 
213 
	return 0;
 - 
 
214 
    }
 - 
 
215 
    strcpy(name, p);
 - 
 
216 
 
 - 
 
217 
    LoadedDLL[CountDLL].path = dpath;
 - 
 
218 
    LoadedDLL[CountDLL].name = name;
 - 
 
219 
    LoadedDLL[CountDLL].dlh = tdlh;
 - 
 
220 
    CountDLL++;
 - 
 
221 
 
 - 
 
222 
    return 1;
 - 
 
223 
}
 173 
}
224 
 
 174 
 
225 
 
 175 
 
226 
        /* R_FindSymbol checks whether one of the libraries */
 - 
 
227 
        /* that have been loaded contains the symbol name and */
 - 
 
228 
        /* returns a pointer to that symbol upon success. */
 - 
 
229 
 
 - 
 
230 
DL_FUNC R_FindSymbol(char const *name, char const *pkg)
 176 
static DL_FUNC getBaseSymbol(const char *name)
231 
{
 177 
{
232 
    DL_FUNC fcnptr;
 - 
 
233 
    int   i, j, all=(strlen(pkg) == 0), doit;
 - 
 
234 
    static int NumStatic = 0;
 178 
  static int NumStatic = 0;
235 
    int   mid, high, low, cmp;
 179 
  int   mid, high, low, cmp;
236 
 
 - 
 
237 
#ifdef CACHE_DLL_SYM
 - 
 
238 
    for (i = 0; i < nCPFun; i++)
 - 
 
239 
	if (!strcmp(name, CPFun[i].name) &&
- 
 
240 
	    (all || !strcmp(pkg, CPFun[i].pkg)))
 - 
 
241 
	    return CPFun[i].func;
 - 
 
242 
#endif
 - 
 
243 
 
 - 
 
244 
    for (i = CountDLL - 1; i >= 0; i--) {
 - 
 
245 
	doit = all;
 - 
 
246 
	if(!doit && !strcmp(pkg, LoadedDLL[i].name)) doit = 2;
 - 
 
247 
	if(doit) {
 180 
  if (!NumStatic) {
248 
	    fcnptr = (DL_FUNC) GetProcAddress(LoadedDLL[i].dlh, name);
 - 
 
249 
	    if (fcnptr != (DL_FUNC) NULL) {
 - 
 
250 
#ifdef CACHE_DLL_SYM
 - 
 
251 
		if(strlen(pkg) <= 20 && strlen(name) <= 20 && nCPFun < 100) {
 - 
 
252 
		    strcpy(CPFun[nCPFun].pkg, LoadedDLL[i].name);
 - 
 
253 
		    strcpy(CPFun[nCPFun].name, name);
 - 
 
254 
		    CPFun[nCPFun++].func = fcnptr;
 - 
 
255 
		}
 - 
 
256 
#endif
 - 
 
257 
		return fcnptr;
 181 
        int i,j;
258 
	    }
 - 
 
259 
	}
 - 
 
260 
	if(doit > 1) return (DL_FUNC) NULL;/* Only look in the first-matching DLL*/
 - 
 
261 
    }
 - 
 
262 
    if (!NumStatic && (all || !strcmp(pkg, "base"))) {
 - 
 
263 
	char *tname;
 182 
	char *tname;
264 
	DL_FUNC tfunc;
 183 
	DL_FUNC tfunc;
265 
 
 184 
 
266 
	NumStatic = (sizeof(CFunTab) / sizeof(CFunTabEntry)) - 1;
 185 
	NumStatic = (sizeof(CFunTab) / sizeof(CFunTabEntry)) - 1;
267 
	for (i = 0; i < NumStatic; i++)
 186 
	for (i = 0; i < NumStatic; i++)
Line 291... Line 210...
291 
    }
 210 
    }
292 
    if (high < low)
 211 
    if (high < low)
293 
	return (DL_FUNC) NULL;
 212 
	return (DL_FUNC) NULL;
294 
    else
 213 
    else
295 
	return CFunTab[mid].func;
 214 
	return CFunTab[mid].func;
296 
    return (DL_FUNC) NULL;
 - 
 
297 
}
 215 
}
298 
 
 216 
 
299 
 
 - 
 
300 
static void GetFullDLLPath(SEXP call, char *buf, char *path)
 217 
static void GetFullDLLPath(SEXP call, char *buf, char *path)
301 
{
 218 
{
302 
    char *p;
 219 
    char *p;
303 
 
 220 
 
304 
    if ((path[0] != '/') && (path[0] != '\\') && (path[1] != ':')) {
 221 
    if ((path[0] != '/') && (path[0] != '\\') && (path[1] != ':')) {
Line 310... Line 227...
310 
	strcpy(buf, path);
 227 
	strcpy(buf, path);
311 
    /* fix slashes to allow inconsistent usage later */
 228 
    /* fix slashes to allow inconsistent usage later */
312 
    for (p = buf; *p; p++) if (*p == '\\') *p = '/';
 229 
    for (p = buf; *p; p++) if (*p == '\\') *p = '/';
313 
}
 230 
}
314 
 
 231 
 
315 
        /* do_dynload implements the R-Interface for the */
 - 
 
316 
        /* loading of shared libraries */
 - 
 
317 
 
 - 
 
318 
SEXP do_dynload(SEXP call, SEXP op, SEXP args, SEXP env)
 - 
 
319 
{
 - 
 
320 
    char  buf[MAX_PATH];
 - 
 
321 
 
 - 
 
322 
    checkArity(op, args);
 - 
 
323 
    if (!isString(CAR(args)) || length(CAR(args)) != 1)
 - 
 
324 
	errorcall(call, "character argument expected");
 - 
 
325 
    GetFullDLLPath(call, buf, CHAR(STRING_ELT(CAR(args), 0)));
 - 
 
326 
    DeleteDLL(buf);
 - 
 
327 
    if (!AddDLL(buf,LOGICAL(CADR(args))[0],LOGICAL(CADDR(args))[0]))
 - 
 
328 
	errorcall(call, "unable to load shared library \"%s\":\n  %s",
 - 
 
329 
		  buf, DLLerror);
 - 
 
330 
    return R_NilValue;
 - 
 
331 
}
 - 
 
332 
 
 - 
 
333 
SEXP do_dynunload(SEXP call, SEXP op, SEXP args, SEXP env)
 - 
 
334 
{
 - 
 
335 
    char  buf[MAX_PATH];
 - 
 
336 
 
 - 
 
337 
    checkArity(op, args);
 - 
 
338 
    if (!isString(CAR(args)) || length(CAR(args)) != 1)
 - 
 
339 
	errorcall(call, "character argument expected");
 - 
 
340 
    GetFullDLLPath(call, buf, CHAR(STRING_ELT(CAR(args), 0)));
 - 
 
341 
    if (!DeleteDLL(buf))
 - 
 
342 
	errorcall(call, "dynamic library \"%s\" was not loaded", buf);
 - 
 
343 
    return R_NilValue;
 - 
 
344 
}
 -