tcl/unix/tclLoadOSF.c

   1 /*
   2  * tclLoadOSF.c --
   3  *
   4  *      This procedure provides a version of the TclLoadFile that works
   5  *      under OSF/1 1.0/1.1/1.2 and related systems, utilizing the old OSF/1
   6  *      /sbin/loader and /usr/include/loader.h.  OSF/1 versions from 1.3 and
   7  *      on use ELF, rtld, and dlopen()[/usr/include/ldfcn.h].
   8  *
   9  *      This is useful for:
  10  *              OSF/1 1.0, 1.1, 1.2 (from OSF)
  11  *                      includes: MK4 and AD1 (from OSF RI)
  12  *              OSF/1 1.3 (from OSF) using ROSE
  13  *              HP OSF/1 1.0 ("Acorn") using COFF
  14  *
  15  *      This is likely to be useful for:
  16  *              Paragon OSF/1 (from Intel)
  17  *              HI-OSF/1 (from Hitachi)
  18  *
  19  *      This is NOT to be used on:
  20  *              Digitial Alpha OSF/1 systems
  21  *              OSF/1 1.3 or later (from OSF) using ELF
  22  *                      includes: MK6, MK7, AD2, AD3 (from OSF RI)
  23  *
  24  *      This approach to things was utter @&^#; thankfully,
  25  *      OSF/1 eventually supported dlopen().
  26  *
  27  *      John Robert LoVerso <loverso@freebsd.osf.org>
  28  *
  29  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  30  *
  31  * See the file "license.terms" for information on usage and redistribution
  32  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  33  *
  34  * RCS: @(#) $Id$
  35  */
  36
  37 #include "tclInt.h"
  38 #include <sys/types.h>
  39 #include <loader.h>
  40 \f
  41 /*
  42  *----------------------------------------------------------------------
  43  *
  44  * TclpDlopen --
  45  *
  46  *      Dynamically loads a binary code file into memory and returns
  47  *      a handle to the new code.
  48  *
  49  * Results:
  50  *      A standard Tcl completion code.  If an error occurs, an error
  51  *      message is left in the interp's result.
  52  *
  53  * Side effects:
  54  *      New code suddenly appears in memory.
  55  *
  56  *----------------------------------------------------------------------
  57  */
  58
  59 int
  60 TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
  61     Tcl_Interp *interp;         /* Used for error reporting. */
  62     Tcl_Obj *pathPtr;           /* Name of the file containing the desired
  63                                  * code (UTF-8). */
  64     Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded
  65                                  * file which will be passed back to
  66                                  * (*unloadProcPtr)() to unload the file. */
  67     Tcl_FSUnloadFileProc **unloadProcPtr;
  68                                 /* Filled with address of Tcl_FSUnloadFileProc
  69                                  * function which should be used for
  70                                  * this file. */
  71 {
  72     ldr_module_t lm;
  73     char *pkg;
  74     char *fileName = Tcl_GetString(pathPtr);
  75     CONST char *native;
  76
  77     /*
  78      * First try the full path the user gave us.  This is particularly
  79      * important if the cwd is inside a vfs, and we are trying to load
  80      * using a relative path.
  81      */
  82     native = Tcl_FSGetNativePath(pathPtr);
  83     lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS);
  84
  85     if (lm == LDR_NULL_MODULE) {
  86         /*
  87          * Let the OS loader examine the binary search path for
  88          * whatever string the user gave us which hopefully refers
  89          * to a file on the binary path
  90          */
  91         Tcl_DString ds;
  92         native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
  93         lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS);
  94         Tcl_DStringFree(&ds);
  95     }
  96
  97     if (lm == LDR_NULL_MODULE) {
  98         Tcl_AppendResult(interp, "couldn't load file \"", fileName,
  99             "\": ", Tcl_PosixError (interp), (char *) NULL);
 100         return TCL_ERROR;
 101     }
 102
 103     *clientDataPtr = NULL;
 104
 105     /*
 106      * My convention is to use a [OSF loader] package name the same as shlib,
 107      * since the idiots never implemented ldr_lookup() and it is otherwise
 108      * impossible to get a package name given a module.
 109      *
 110      * I build loadable modules with a makefile rule like
 111      *          ld ... -export $@: -o $@ $(OBJS)
 112      */
 113     if ((pkg = strrchr(fileName, '/')) == NULL) {
 114         pkg = fileName;
 115     } else {
 116         pkg++;
 117     }
 118     *loadHandle = pkg;
 119     *unloadProcPtr = &TclpUnloadFile;
 120     return TCL_OK;
 121 }
 122 \f
 123 /*
 124  *----------------------------------------------------------------------
 125  *
 126  * TclpFindSymbol --
 127  *
 128  *      Looks up a symbol, by name, through a handle associated with
 129  *      a previously loaded piece of code (shared library).
 130  *
 131  * Results:
 132  *      Returns a pointer to the function associated with 'symbol' if
 133  *      it is found.  Otherwise returns NULL and may leave an error
 134  *      message in the interp's result.
 135  *
 136  *----------------------------------------------------------------------
 137  */
 138 Tcl_PackageInitProc*
 139 TclpFindSymbol(interp, loadHandle, symbol)
 140     Tcl_Interp *interp;
 141     Tcl_LoadHandle loadHandle;
 142     CONST char *symbol;
 143 {
 144     return ldr_lookup_package((char *)loadHandle, symbol);
 145 }
 146 \f
 147 /*
 148  *----------------------------------------------------------------------
 149  *
 150  * TclpUnloadFile --
 151  *
 152  *      Unloads a dynamically loaded binary code file from memory.
 153  *      Code pointers in the formerly loaded file are no longer valid
 154  *      after calling this function.
 155  *
 156  * Results:
 157  *      None.
 158  *
 159  * Side effects:
 160  *      Does nothing.  Can anything be done?
 161  *
 162  *----------------------------------------------------------------------
 163  */
 164
 165 void
 166 TclpUnloadFile(loadHandle)
 167     Tcl_LoadHandle loadHandle;  /* loadHandle returned by a previous call
 168                                  * to TclpDlopen().  The loadHandle is
 169                                  * a token that represents the loaded
 170                                  * file. */
 171 {
 172 }
 173 \f
 174 /*
 175  *----------------------------------------------------------------------
 176  *
 177  * TclGuessPackageName --
 178  *
 179  *      If the "load" command is invoked without providing a package
 180  *      name, this procedure is invoked to try to figure it out.
 181  *
 182  * Results:
 183  *      Always returns 0 to indicate that we couldn't figure out a
 184  *      package name;  generic code will then try to guess the package
 185  *      from the file name.  A return value of 1 would have meant that
 186  *      we figured out the package name and put it in bufPtr.
 187  *
 188  * Side effects:
 189  *      None.
 190  *
 191  *----------------------------------------------------------------------
 192  */
 193
 194 int
 195 TclGuessPackageName(fileName, bufPtr)
 196     CONST char *fileName;       /* Name of file containing package (already
 197                                  * translated to local form if needed). */
 198     Tcl_DString *bufPtr;        /* Initialized empty dstring.  Append
 199                                  * package name to this if possible. */
 200 {
 201     return 0;
 202 }