The R Project SVN – R – Diff – /branches/R-exp-API/src/gnuwin32/dynload.c

 /*
- *  R : A Computer Langage for Statistical Data Analysis
+ *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 1995  Robert Gentleman and Ross Ihaka
+ *  Copyright (C) 1995-1996 Robert Gentleman and Ross Ihaka
- *  Copyright (C) 1997  The R Core Team
+ *  Copyright (C) 1997-1999 The R Development Core Team
+ *
  *  This program is free software; you can redistribute it and/or modify
  *  it under the terms of the GNU General Public License as published by
  *  the Free Software Foundation; either version 2 of the License, or
  *  (at your option) any later version.
+ *
+ *
  *  2. The dlopen interface is not available.
+ *
  *  In this case we use the table "CFunTabEntry" to locate functions
- *  in the executable.  We do this by straight linear search through
+ *  in the executable.	We do this by straight linear search through
- *  the table.  Note that the content of the table is created at
+ *  the table.	Note that the content of the table is created at
  *  system build time from the list in ../appl/ROUTINES.
  */
 #ifdef HAVE_CONFIG_H
 #include <Rconfig.h>
 typedef int (*DL_FUNC) ();
 typedef struct {
     char *name;
     DL_FUNC func;
-}     CFunTabEntry;
+} CFunTabEntry;
 #include "FFDecl.h"
-#include "FFDecl.h"
-        /* This provides a table of built-in C and Fortran functions */
+/* This provides a table of built-in C and Fortran functions.
-        /* We include this table, even when we have dlopen and friends */
+   We include this table, even when we have dlopen and friends.
-        /* This is so that the functions are actually loaded at link time */
+   This is so that the functions are actually loaded at link time. */
 static CFunTabEntry CFunTab[] =
+{
 #include "FFTab.h"
     {NULL, NULL}
 #define MAX_NUM_DLLS    30
 static int CountDLL = 0;
 static struct {
-    char  path[MAX_PATH + 1];
+    char  *path;
+    char  *name;
     HINSTANCE dlh;
+}
 LoadedDLL[MAX_NUM_DLLS];
-        /* Remove the specified DLL from the current DLL list */
+	/* Remove the specified DLL from the current DLL list */
-        /* Returns 1 if the DLL was found and removed from */
+	/* Returns 1 if the DLL was found and removed from */
-        /* the list and returns 0 otherwise. */
+	/* the list and returns 0 otherwise. */
 static int DeleteDLL(char *path)
+{
     int   i, loc;
 	    goto found;
+	}
+    }
     return 0;
 found:
+    free(LoadedDLL[i].name);
+    free(LoadedDLL[i].path);
     FreeLibrary(LoadedDLL[i].dlh);
     for (i = loc + 1; i < CountDLL; i++) {
-	strcpy(LoadedDLL[i - 1].path, LoadedDLL[i].path);
+	LoadedDLL[i - 1].path = LoadedDLL[i].path;
+	LoadedDLL[i - 1].name = LoadedDLL[i].name;
 	LoadedDLL[i - 1].dlh = LoadedDLL[i].dlh;
+    }
     CountDLL--;
     return 1;
+}
         /* All the other entries are "moved down" by one. */
         /* Returns 1 if the library was successfully added */
         /* and returns 0 if there library table is full or */
         /* or if LoadLibrary fails for some reason. */
+/*
+  The arguments asLocal and now are unused in this version.
+  They are here for consistency with the UNIX code.
+ */
-static int AddDLL(char *path)
+static int AddDLL(char *path, int asLocal, int now)
+{
     HINSTANCE tdlh;
+    char *dpath, *name, DLLname[MAX_PATH], *p, *st;
+    /* int i; */
+    DeleteDLL(path);
     if (CountDLL == MAX_NUM_DLLS) {
 	strcpy(DLLerror, "Maximal number of DLLs reached...");
 	return 0;
+    }
     tdlh = LoadLibrary(path);
     if (tdlh == NULL) {
 	strcpy(DLLerror, "LoadLibrary failure");
 	return 0;
+    }
+    dpath = malloc(strlen(path)+1);
+    if(dpath == NULL) {
+	strcpy(DLLerror,"Couldn't allocate space for 'path'");
+	FreeLibrary(tdlh);
+	return 0;
+    }
+    strcpy(dpath, path);
+    strcpy(DLLname, path);
+    for(p = DLLname; *p != '\0'; p++) if(*p == '\\') *p = '/';
+    p = strrchr(path, '/');
+    if(!p) p = DLLname; else p++;
+    st = strchr(p, '.');
+    if(st) *st = '\0';
+    name = malloc(strlen(p)+1);
+    if(name == NULL) {
+	strcpy(DLLerror,"Couldn't allocate space for 'name'");
+	FreeLibrary(tdlh);
+	free(dpath);
+	return 0;
+    }
+    strcpy(name, p);
-    strcpy(LoadedDLL[CountDLL].path, path);
+    LoadedDLL[CountDLL].path = dpath;
+    LoadedDLL[CountDLL].name = name;
     LoadedDLL[CountDLL].dlh = tdlh;
     CountDLL++;
     return 1;
+}
         /* R_FindSymbol checks whether one of the libraries */
         /* that have been loaded contains the symbol name and */
         /* returns a pointer to that symbol upon success. */
-DL_FUNC R_FindSymbol(char const *name)
+DL_FUNC R_FindSymbol(char const *name, char const *pkg)
+{
-    char  buf[MAXIDSIZE + 1];
     DL_FUNC fcnptr;
-    int   i, j;
+    int   i, j, all=(strlen(pkg) == 0), doit;
     static int NumStatic = 0;
     int   mid, high, low, cmp;
-#ifdef HAVE_NO_SYMBOL_UNDERSCORE
-    sprintf(buf, "%s", name);
+    /* Rprintf("name = %s pkg = %s\n", name, pkg); */
-#else
-    sprintf(buf, "_%s", name);
-#endif
-    sprintf(buf, "%s", name);
     for (i = CountDLL - 1; i >= 0; i--) {
+	doit = all;
-	fcnptr = (DL_FUNC) GetProcAddress(LoadedDLL[i].dlh, buf);
+	if(!doit && !strcmp(pkg, LoadedDLL[i].name)) doit = 2;
-	if (fcnptr != NULL)
+	if(doit) {
+	    /* Rprintf("name = %s\n", LoadedDLL[i].name); */
+	    fcnptr = (DL_FUNC) GetProcAddress(LoadedDLL[i].dlh, name);
-	    return fcnptr;
+	    if (fcnptr != (DL_FUNC)0) return fcnptr;
+	}
+	if(doit > 1) return (DL_FUNC)0;/* Only look in the first-matching DLL*/
+    }
-    if (!NumStatic) {
+    if (!NumStatic && (all || !strcmp(pkg, "base"))) {
 	char *tname;
 	DL_FUNC tfunc;
 	NumStatic = (sizeof(CFunTab) / sizeof(CFunTabEntry)) - 1;
 	for (i = 0; i < NumStatic; i++)
 	strcpy(buf, path);
+}
         /* do_dynload implements the R-Interface for the */
         /* loading of shared libraries */
+/* This looks very close the version in unix.
+   Is the only reason it is not shared due to
+    a) 2*PATH_MAX v's PATH_MAX for sizeof(buf)
+    b) static routines in this file.
+*/
 SEXP do_dynload(SEXP call, SEXP op, SEXP args, SEXP env)
+{
     char  buf[MAX_PATH];
     checkArity(op, args);
     if (!isString(CAR(args)) || length(CAR(args)) != 1)
 	errorcall(call, "character argument expected");
     GetFullDLLPath(call, buf, CHAR(STRING(CAR(args))[0]));
     DeleteDLL(buf);
-    if (!AddDLL(buf))
+    if (!AddDLL(buf,LOGICAL(CADR(args))[0],LOGICAL(CADDR(args))[0]))
-	errorcall(call, "unable to load shared library \"%s\":\n  %s",
+	errorcall(call, "unable to load shared library \"%s\":\n  %s\n",
 		  buf, DLLerror);
     return R_NilValue;
+}
 SEXP do_dynunload(SEXP call, SEXP op, SEXP args, SEXP env)

The R Project SVN R

(root)/branches/R-exp-API/src/gnuwin32/dynload.c @ 63243 – Rev 5731 → 6098