The R Project SVN R

Rev

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

Rev 6098 Rev 6195
Line 163... Line 163...
163 
    }
 163 
    }
164 
 
 164 
 
165 
    dpath = malloc(strlen(path)+1);
 165 
    dpath = malloc(strlen(path)+1);
166 
    if(dpath == NULL) {
 166 
    if(dpath == NULL) {
167 
	strcpy(DLLerror,"Couldn't allocate space for 'path'");
 167 
	strcpy(DLLerror,"Couldn't allocate space for 'path'");
168 
	FreeLibrary(tdlh);
168 
	FreeLibrary(tdlh);
169 
	return 0;
 169 
	return 0;
170 
    }
 170 
    }
171 
    strcpy(dpath, path);
 171 
    strcpy(dpath, path);
172 
 
 172 
 
173 
    strcpy(DLLname, path);
 173 
    strcpy(DLLname, path);
174 
    for(p = DLLname; *p != '\0'; p++) if(*p == '\\') *p = '/';
 174 
    for(p = DLLname; *p != '\0'; p++) if(*p == '\\') *p = '/';
175 
    p = strrchr(path, '/');
175 
    p = strrchr(path, '/');
176 
    if(!p) p = DLLname; else p++;
 176 
    if(!p) p = DLLname; else p++;
177 
    st = strchr(p, '.');
 177 
    st = strchr(p, '.');
178 
    if(st) *st = '\0';
 178 
    if(st) *st = '\0';
179 
    name = malloc(strlen(p)+1);
 179 
    name = malloc(strlen(p)+1);
180 
    if(name == NULL) {
 180 
    if(name == NULL) {
Line 207... Line 207...
207 
    /* Rprintf("name = %s pkg = %s\n", name, pkg); */
 207 
    /* Rprintf("name = %s pkg = %s\n", name, pkg); */
208 
 
 208 
 
209 
    for (i = CountDLL - 1; i >= 0; i--) {
 209 
    for (i = CountDLL - 1; i >= 0; i--) {
210 
	doit = all;
 210 
	doit = all;
211 
	if(!doit && !strcmp(pkg, LoadedDLL[i].name)) doit = 2;
 211 
	if(!doit && !strcmp(pkg, LoadedDLL[i].name)) doit = 2;
212 
	if(doit) {
212 
	if(doit) {
213 
	    /* Rprintf("name = %s\n", LoadedDLL[i].name); */
 213 
	    /* Rprintf("name = %s\n", LoadedDLL[i].name); */
214 
	    fcnptr = (DL_FUNC) GetProcAddress(LoadedDLL[i].dlh, name);
 214 
	    fcnptr = (DL_FUNC) GetProcAddress(LoadedDLL[i].dlh, name);
215 
	    if (fcnptr != (DL_FUNC)0) return fcnptr;
 215 
	    if (fcnptr != (DL_FUNC)0) return fcnptr;
216 
	}
 216 
	}
217 
	if(doit > 1) return (DL_FUNC)0;/* Only look in the first-matching DLL*/
 217 
	if(doit > 1) return (DL_FUNC)0;/* Only look in the first-matching DLL*/
Line 266... Line 266...
266 
}
 266 
}
267 
 
 267 
 
268 
        /* do_dynload implements the R-Interface for the */
 268 
        /* do_dynload implements the R-Interface for the */
269 
        /* loading of shared libraries */
 269 
        /* loading of shared libraries */
270 
/* This looks very close the version in unix.
 270 
/* This looks very close the version in unix.
271 
   Is the only reason it is not shared due to
271 
   Is the only reason it is not shared due to
272 
    a) 2*PATH_MAX v's PATH_MAX for sizeof(buf)
 272 
    a) 2*PATH_MAX v's PATH_MAX for sizeof(buf)
273 
    b) static routines in this file.
 273 
    b) static routines in this file.
274 
*/
 274 
*/
275 
SEXP do_dynload(SEXP call, SEXP op, SEXP args, SEXP env)
 275 
SEXP do_dynload(SEXP call, SEXP op, SEXP args, SEXP env)
276 
{
 276 
{
Line 280... Line 280...
280 
    if (!isString(CAR(args)) || length(CAR(args)) != 1)
 280 
    if (!isString(CAR(args)) || length(CAR(args)) != 1)
281 
	errorcall(call, "character argument expected");
 281 
	errorcall(call, "character argument expected");
282 
    GetFullDLLPath(call, buf, CHAR(STRING(CAR(args))[0]));
 282 
    GetFullDLLPath(call, buf, CHAR(STRING(CAR(args))[0]));
283 
    DeleteDLL(buf);
 283 
    DeleteDLL(buf);
284 
    if (!AddDLL(buf,LOGICAL(CADR(args))[0],LOGICAL(CADDR(args))[0]))
 284 
    if (!AddDLL(buf,LOGICAL(CADR(args))[0],LOGICAL(CADDR(args))[0]))
285 
	errorcall(call, "unable to load shared library \"%s\":\n  %s\n",
 285 
	errorcall(call, "unable to load shared library \"%s\":\n  %s",
286 
		  buf, DLLerror);
 286 
		  buf, DLLerror);
287 
    return R_NilValue;
 287 
    return R_NilValue;
288 
}
 288 
}
289 
 
 289 
 
290 
SEXP do_dynunload(SEXP call, SEXP op, SEXP args, SEXP env)
 290 
SEXP do_dynunload(SEXP call, SEXP op, SEXP args, SEXP env)