Updated to tcl 8.4.1

[pf3gnuchains/sourceware.git] / tcl / unix / tclLoadOSF.c

diff --git a/tcl/unix/tclLoadOSF.c b/tcl/unix/tclLoadOSF.c
index f4bc755..0484f43 100644 (file)
--- a/tcl/unix/tclLoadOSF.c
+++ b/tcl/unix/tclLoadOSF.c
@@ -41,17 +41,14 @@
 /*
  *----------------------------------------------------------------------
  *
- * TclpLoadFile --
+ * TclpDlopen --
  *
  *     Dynamically loads a binary code file into memory and returns
- *     the addresses of two procedures within that file, if they
- *     are defined.
+ *     a handle to the new code.
  *
  * Results:
  *     A standard Tcl completion code.  If an error occurs, an error
- *     message is left in the interp's result.  *proc1Ptr and *proc2Ptr
- *     are filled in with the addresses of the symbols given by
- *     *sym1 and *sym2, or NULL if those symbols can't be found.
+ *     message is left in the interp's result.
  *
  * Side effects:
  *     New code suddenly appears in memory.
@@ -60,23 +57,43 @@
  */
 
 int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
     Tcl_Interp *interp;                /* Used for error reporting. */
-    char *fileName;            /* Name of the file containing the desired
-                                * code. */
-    char *sym1, *sym2;         /* Names of two procedures to look up in
-                                * the file's symbol table. */
-    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
-                               /* Where to return the addresses corresponding
-                                * to sym1 and sym2. */
-    ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+    Tcl_Obj *pathPtr;          /* Name of the file containing the desired
+                                * code (UTF-8). */
+    Tcl_LoadHandle *loadHandle;        /* Filled with token for dynamically loaded
                                 * file which will be passed back to 
-                                * TclpUnloadFile() to unload the file. */
+                                * (*unloadProcPtr)() to unload the file. */
+    Tcl_FSUnloadFileProc **unloadProcPtr;      
+                               /* Filled with address of Tcl_FSUnloadFileProc
+                                * function which should be used for
+                                * this file. */
 {
     ldr_module_t lm;
     char *pkg;
+    char *fileName = Tcl_GetString(pathPtr);
+    CONST char *native;
 
-    lm = (Tcl_PackageInitProc *) load(fileName, LDR_NOFLAGS);
+    /* 
+     * First try the full path the user gave us.  This is particularly
+     * important if the cwd is inside a vfs, and we are trying to load
+     * using a relative path.
+     */
+    native = Tcl_FSGetNativePath(pathPtr);
+    lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS);
+
+    if (lm == LDR_NULL_MODULE) {
+       /* 
+        * Let the OS loader examine the binary search path for
+        * whatever string the user gave us which hopefully refers
+        * to a file on the binary path
+        */
+       Tcl_DString ds;
+       native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+       lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS);
+       Tcl_DStringFree(&ds);
+    }
+    
     if (lm == LDR_NULL_MODULE) {
        Tcl_AppendResult(interp, "couldn't load file \"", fileName,
            "\": ", Tcl_PosixError (interp), (char *) NULL);
@@ -93,18 +110,43 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
      * I build loadable modules with a makefile rule like 
      *         ld ... -export $@: -o $@ $(OBJS)
      */
-    if ((pkg = strrchr(fileName, '/')) == NULL)
-       pkg = fileName;
-    else
+    if ((pkg = strrchr(fileName, '/')) == NULL) {
+        pkg = fileName;
+    } else {
        pkg++;
-    *proc1Ptr = ldr_lookup_package(pkg, sym1);
-    *proc2Ptr = ldr_lookup_package(pkg, sym2);
+    }
+    *loadHandle = pkg;
+    *unloadProcPtr = &TclpUnloadFile;
     return TCL_OK;
 }
 \f
 /*
  *----------------------------------------------------------------------
  *
+ * TclpFindSymbol --
+ *
+ *     Looks up a symbol, by name, through a handle associated with
+ *     a previously loaded piece of code (shared library).
+ *
+ * Results:
+ *     Returns a pointer to the function associated with 'symbol' if
+ *     it is found.  Otherwise returns NULL and may leave an error
+ *     message in the interp's result.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_PackageInitProc*
+TclpFindSymbol(interp, loadHandle, symbol) 
+    Tcl_Interp *interp;
+    Tcl_LoadHandle loadHandle;
+    CONST char *symbol;
+{
+    return ldr_lookup_package((char *)loadHandle, symbol);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
  * TclpUnloadFile --
  *
  *     Unloads a dynamically loaded binary code file from memory.
@@ -121,9 +163,9 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
  */
 
 void
-TclpUnloadFile(clientData)
-    ClientData clientData;     /* ClientData returned by a previous call
-                                * to TclpLoadFile().  The clientData is 
+TclpUnloadFile(loadHandle)
+    Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
+                                * to TclpDlopen().  The loadHandle is 
                                 * a token that represents the loaded 
                                 * file. */
 {
@@ -151,11 +193,10 @@ TclpUnloadFile(clientData)
 
 int
 TclGuessPackageName(fileName, bufPtr)
-    char *fileName;            /* Name of file containing package (already
+    CONST char *fileName;      /* Name of file containing package (already
                                 * translated to local form if needed). */
     Tcl_DString *bufPtr;       /* Initialized empty dstring.  Append
                                 * package name to this if possible. */
 {
     return 0;
 }
-