tcl/unix/tclLoadDld.c

   1 /*
   2  * tclLoadDld.c --
   3  *
   4  *      This procedure provides a version of the TclLoadFile that
   5  *      works with the "dld_link" and "dld_get_func" library procedures
   6  *      for dynamic loading.  It has been tested on Linux 1.1.95 and
   7  *      dld-3.2.7.  This file probably isn't needed anymore, since it
   8  *      makes more sense to use "dl_open" etc.
   9  *
  10  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  11  *
  12  * See the file "license.terms" for information on usage and redistribution
  13  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14  *
  15  * RCS: @(#) $Id$
  16  */
  17
  18 #include "tclInt.h"
  19 #include "dld.h"
  20
  21 /*
  22  * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined
  23  * and this argument to dlopen must always be 1.
  24  */
  25
  26 #ifndef RTLD_NOW
  27 #   define RTLD_NOW 1
  28 #endif
  29 \f
  30 /*
  31  *----------------------------------------------------------------------
  32  *
  33  * TclpDlopen --
  34  *
  35  *      Dynamically loads a binary code file into memory and returns
  36  *      a handle to the new code.
  37  *
  38  * Results:
  39  *      A standard Tcl completion code.  If an error occurs, an error
  40  *      message is left in the interp's result.
  41  *
  42  * Side effects:
  43  *      New code suddenly appears in memory.
  44  *
  45  *----------------------------------------------------------------------
  46  */
  47
  48 int
  49 TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
  50     Tcl_Interp *interp;         /* Used for error reporting. */
  51     Tcl_Obj *pathPtr;           /* Name of the file containing the desired
  52                                  * code (UTF-8). */
  53     Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded
  54                                  * file which will be passed back to
  55                                  * (*unloadProcPtr)() to unload the file. */
  56     Tcl_FSUnloadFileProc **unloadProcPtr;
  57                                 /* Filled with address of Tcl_FSUnloadFileProc
  58                                  * function which should be used for
  59                                  * this file. */
  60 {
  61     static int firstTime = 1;
  62     int returnCode;
  63     char *fileName;
  64     CONST char *native;
  65
  66     /*
  67      *  The dld package needs to know the pathname to the tcl binary.
  68      *  If that's not known, return an error.
  69      */
  70
  71     if (firstTime) {
  72         if (tclExecutableName == NULL) {
  73             Tcl_SetResult(interp,
  74                     "don't know name of application binary file, so can't initialize dynamic loader",
  75                     TCL_STATIC);
  76             return TCL_ERROR;
  77         }
  78         returnCode = dld_init(tclExecutableName);
  79         if (returnCode != 0) {
  80             Tcl_AppendResult(interp,
  81                     "initialization failed for dynamic loader: ",
  82                     dld_strerror(returnCode), (char *) NULL);
  83             return TCL_ERROR;
  84         }
  85         firstTime = 0;
  86     }
  87
  88     fileName = Tcl_GetString(pathPtr);
  89
  90     /*
  91      * First try the full path the user gave us.  This is particularly
  92      * important if the cwd is inside a vfs, and we are trying to load
  93      * using a relative path.
  94      */
  95     native = Tcl_FSGetNativePath(pathPtr);
  96     returnCode = dld_link(native);
  97
  98     if (returnCode != 0) {
  99         Tcl_DString ds;
 100         native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
 101         returnCode = dld_link(native);
 102         Tcl_DStringFree(&ds);
 103     }
 104
 105     if (returnCode != 0) {
 106         Tcl_AppendResult(interp, "couldn't load file \"",
 107                          fileName, "\": ",
 108                          dld_strerror(returnCode), (char *) NULL);
 109         return TCL_ERROR;
 110     }
 111     *loadHandle = (Tcl_LoadHandle) strcpy(
 112             (char *) ckalloc((unsigned) (strlen(fileName) + 1)), fileName);
 113     *unloadProcPtr = &TclpUnloadFile;
 114     return TCL_OK;
 115 }
 116 \f
 117 /*
 118  *----------------------------------------------------------------------
 119  *
 120  * TclpFindSymbol --
 121  *
 122  *      Looks up a symbol, by name, through a handle associated with
 123  *      a previously loaded piece of code (shared library).
 124  *
 125  * Results:
 126  *      Returns a pointer to the function associated with 'symbol' if
 127  *      it is found.  Otherwise returns NULL and may leave an error
 128  *      message in the interp's result.
 129  *
 130  *----------------------------------------------------------------------
 131  */
 132 Tcl_PackageInitProc*
 133 TclpFindSymbol(interp, loadHandle, symbol)
 134     Tcl_Interp *interp;
 135     Tcl_LoadHandle loadHandle;
 136     CONST char *symbol;
 137 {
 138     return (Tcl_PackageInitProc *) dld_get_func(symbol);
 139 }
 140 \f
 141 /*
 142  *----------------------------------------------------------------------
 143  *
 144  * TclpUnloadFile --
 145  *
 146  *      Unloads a dynamically loaded binary code file from memory.
 147  *      Code pointers in the formerly loaded file are no longer valid
 148  *      after calling this function.
 149  *
 150  * Results:
 151  *      None.
 152  *
 153  * Side effects:
 154  *      Code removed from memory.
 155  *
 156  *----------------------------------------------------------------------
 157  */
 158
 159 void
 160 TclpUnloadFile(loadHandle)
 161     Tcl_LoadHandle loadHandle;  /* loadHandle returned by a previous call
 162                                  * to TclpDlopen().  The loadHandle is
 163                                  * a token that represents the loaded
 164                                  * file. */
 165 {
 166     char *fileName;
 167
 168     handle = (char *) loadHandle;
 169     dld_unlink_by_file(handle, 0);
 170     ckfree(handle);
 171 }
 172 \f
 173 /*
 174  *----------------------------------------------------------------------
 175  *
 176  * TclGuessPackageName --
 177  *
 178  *      If the "load" command is invoked without providing a package
 179  *      name, this procedure is invoked to try to figure it out.
 180  *
 181  * Results:
 182  *      Always returns 0 to indicate that we couldn't figure out a
 183  *      package name;  generic code will then try to guess the package
 184  *      from the file name.  A return value of 1 would have meant that
 185  *      we figured out the package name and put it in bufPtr.
 186  *
 187  * Side effects:
 188  *      None.
 189  *
 190  *----------------------------------------------------------------------
 191  */
 192
 193 int
 194 TclGuessPackageName(fileName, bufPtr)
 195     CONST char *fileName;       /* Name of file containing package (already
 196                                  * translated to local form if needed). */
 197     Tcl_DString *bufPtr;        /* Initialized empty dstring.  Append
 198                                  * package name to this if possible. */
 199 {
 200     return 0;
 201 }