tcl/unix/tclLoadDyld.c

   1 /*
   2  * tclLoadDyld.c --
   3  *
   4  *     This procedure provides a version of the TclLoadFile that
   5  *     works with Apple's dyld dynamic loading.  This file
   6  *     provided by Wilfredo Sanchez (wsanchez@apple.com).
   7  *     This works on Mac OS X.
   8  *
   9  * Copyright (c) 1995 Apple Computer, Inc.
  10  *
  11  * See the file "license.terms" for information on usage and redistribution
  12  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13  *
  14  * RCS: @(#) $Id$
  15  */
  16
  17 #include "tclInt.h"
  18 #include "tclPort.h"
  19 #include <mach-o/dyld.h>
  20
  21 typedef struct Tcl_DyldModuleHandle {
  22     struct Tcl_DyldModuleHandle *nextModuleHandle;
  23     NSModule module;
  24 } Tcl_DyldModuleHandle;
  25
  26 typedef struct Tcl_DyldLoadHandle {
  27     const struct mach_header *dyld_lib;
  28     Tcl_DyldModuleHandle *firstModuleHandle;
  29 } Tcl_DyldLoadHandle;
  30
  31 /*
  32  *----------------------------------------------------------------------
  33  *
  34  * TclpDlopen --
  35  *
  36  *      Dynamically loads a binary code file into memory and returns
  37  *      a handle to the new code.
  38  *
  39  * Results:
  40  *     A standard Tcl completion code.  If an error occurs, an error
  41  *     message is left in the interpreter's result.
  42  *
  43  * Side effects:
  44  *     New code suddenly appears in memory.
  45  *
  46  *----------------------------------------------------------------------
  47  */
  48
  49 int
  50 TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
  51     Tcl_Interp *interp;         /* Used for error reporting. */
  52     Tcl_Obj *pathPtr;           /* Name of the file containing the desired
  53                                  * code (UTF-8). */
  54     Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded
  55                                  * file which will be passed back to
  56                                  * (*unloadProcPtr)() to unload the file. */
  57     Tcl_FSUnloadFileProc **unloadProcPtr;
  58                                 /* Filled with address of Tcl_FSUnloadFileProc
  59                                  * function which should be used for
  60                                  * this file. */
  61 {
  62     Tcl_DyldLoadHandle *dyldLoadHandle;
  63     const struct mach_header *dyld_lib;
  64     CONST char *native;
  65
  66     /*
  67      * First try the full path the user gave us.  This is particularly
  68      * important if the cwd is inside a vfs, and we are trying to load
  69      * using a relative path.
  70      */
  71     native = Tcl_FSGetNativePath(pathPtr);
  72     dyld_lib = NSAddImage(native,
  73                           NSADDIMAGE_OPTION_WITH_SEARCHING |
  74                           NSADDIMAGE_OPTION_RETURN_ON_ERROR);
  75
  76     if (!dyld_lib) {
  77         /*
  78          * Let the OS loader examine the binary search path for
  79          * whatever string the user gave us which hopefully refers
  80          * to a file on the binary path
  81          */
  82         Tcl_DString ds;
  83         char *fileName = Tcl_GetString(pathPtr);
  84         native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
  85         dyld_lib = NSAddImage(native,
  86                               NSADDIMAGE_OPTION_WITH_SEARCHING |
  87                               NSADDIMAGE_OPTION_RETURN_ON_ERROR);
  88         Tcl_DStringFree(&ds);
  89     }
  90
  91     if (!dyld_lib) {
  92         NSLinkEditErrors editError;
  93         char *name, *msg;
  94         NSLinkEditError(&editError, &errno, &name, &msg);
  95         Tcl_AppendResult(interp, msg, (char *) NULL);
  96         return TCL_ERROR;
  97     }
  98
  99     dyldLoadHandle = (Tcl_DyldLoadHandle *) ckalloc(sizeof(Tcl_DyldLoadHandle));
 100     if (!dyldLoadHandle) return TCL_ERROR;
 101     dyldLoadHandle->dyld_lib = dyld_lib;
 102     dyldLoadHandle->firstModuleHandle = NULL;
 103     *loadHandle = (Tcl_LoadHandle) dyldLoadHandle;
 104     *unloadProcPtr = &TclpUnloadFile;
 105     return TCL_OK;
 106 }
 107 \f
 108 /*
 109  *----------------------------------------------------------------------
 110  *
 111  * TclpFindSymbol --
 112  *
 113  *      Looks up a symbol, by name, through a handle associated with
 114  *      a previously loaded piece of code (shared library).
 115  *
 116  * Results:
 117  *      Returns a pointer to the function associated with 'symbol' if
 118  *      it is found.  Otherwise returns NULL and may leave an error
 119  *      message in the interp's result.
 120  *
 121  *----------------------------------------------------------------------
 122  */
 123 Tcl_PackageInitProc*
 124 TclpFindSymbol(interp, loadHandle, symbol)
 125     Tcl_Interp *interp;
 126     Tcl_LoadHandle loadHandle;
 127     CONST char *symbol;
 128 {
 129     NSSymbol nsSymbol;
 130     CONST char *native;
 131     Tcl_DString newName, ds;
 132     Tcl_PackageInitProc* proc = NULL;
 133     Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle;
 134     /*
 135      * dyld adds an underscore to the beginning of symbol names.
 136      */
 137
 138     native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
 139     Tcl_DStringInit(&newName);
 140     Tcl_DStringAppend(&newName, "_", 1);
 141     native = Tcl_DStringAppend(&newName, native, -1);
 142     nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyld_lib, native,
 143         NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW |
 144         NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR);
 145     if(nsSymbol) {
 146         Tcl_DyldModuleHandle *dyldModuleHandle;
 147         proc = NSAddressOfSymbol(nsSymbol);
 148         dyldModuleHandle = (Tcl_DyldModuleHandle *) ckalloc(sizeof(Tcl_DyldModuleHandle));
 149         if (dyldModuleHandle) {
 150             dyldModuleHandle->module = NSModuleForSymbol(nsSymbol);
 151             dyldModuleHandle->nextModuleHandle = dyldLoadHandle->firstModuleHandle;
 152             dyldLoadHandle->firstModuleHandle = dyldModuleHandle;
 153         }
 154     }
 155     Tcl_DStringFree(&newName);
 156     Tcl_DStringFree(&ds);
 157
 158     return proc;
 159 }
 160
 161 /*
 162  *----------------------------------------------------------------------
 163  *
 164  * TclpUnloadFile --
 165  *
 166  *     Unloads a dynamically loaded binary code file from memory.
 167  *     Code pointers in the formerly loaded file are no longer valid
 168  *     after calling this function.
 169  *
 170  * Results:
 171  *     None.
 172  *
 173  * Side effects:
 174  *     Code dissapears from memory.
 175  *     Note that this is a no-op on older (OpenStep) versions of dyld.
 176  *
 177  *----------------------------------------------------------------------
 178  */
 179
 180 void
 181 TclpUnloadFile(loadHandle)
 182     Tcl_LoadHandle loadHandle;  /* loadHandle returned by a previous call
 183                                  * to TclpDlopen().  The loadHandle is
 184                                  * a token that represents the loaded
 185                                  * file. */
 186 {
 187     Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle;
 188     Tcl_DyldModuleHandle *dyldModuleHandle = dyldLoadHandle->firstModuleHandle;
 189     void *ptr;
 190
 191     while (dyldModuleHandle) {
 192         NSUnLinkModule(dyldModuleHandle->module, NSUNLINKMODULE_OPTION_NONE);
 193         ptr = dyldModuleHandle;
 194         dyldModuleHandle = dyldModuleHandle->nextModuleHandle;
 195         ckfree(ptr);
 196     }
 197     ckfree(dyldLoadHandle);
 198 }
 199
 200 /*
 201  *----------------------------------------------------------------------
 202  *
 203  * TclGuessPackageName --
 204  *
 205  *     If the "load" command is invoked without providing a package
 206  *     name, this procedure is invoked to try to figure it out.
 207  *
 208  * Results:
 209  *     Always returns 0 to indicate that we couldn't figure out a
 210  *     package name;  generic code will then try to guess the package
 211  *     from the file name.  A return value of 1 would have meant that
 212  *     we figured out the package name and put it in bufPtr.
 213  *
 214  * Side effects:
 215  *     None.
 216  *
 217  *----------------------------------------------------------------------
 218  */
 219
 220 int
 221 TclGuessPackageName(fileName, bufPtr)
 222     CONST char *fileName;      /* Name of file containing package (already
 223                                 * translated to local form if needed). */
 224     Tcl_DString *bufPtr;       /* Initialized empty dstring.  Append
 225                                 * package name to this if possible. */
 226 {
 227     return 0;
 228 }