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  * TclpLoadFile --
  45  *
  46  *      Dynamically loads a binary code file into memory and returns
  47  *      the addresses of two procedures within that file, if they
  48  *      are defined.
  49  *
  50  * Results:
  51  *      A standard Tcl completion code.  If an error occurs, an error
  52  *      message is left in the interp's result.  *proc1Ptr and *proc2Ptr
  53  *      are filled in with the addresses of the symbols given by
  54  *      *sym1 and *sym2, or NULL if those symbols can't be found.
  55  *
  56  * Side effects:
  57  *      New code suddenly appears in memory.
  58  *
  59  *----------------------------------------------------------------------
  60  */
  61
  62 int
  63 TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
  64     Tcl_Interp *interp;         /* Used for error reporting. */
  65     char *fileName;             /* Name of the file containing the desired
  66                                  * code. */
  67     char *sym1, *sym2;          /* Names of two procedures to look up in
  68                                  * the file's symbol table. */
  69     Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
  70                                 /* Where to return the addresses corresponding
  71                                  * to sym1 and sym2. */
  72     ClientData *clientDataPtr;  /* Filled with token for dynamically loaded
  73                                  * file which will be passed back to
  74                                  * TclpUnloadFile() to unload the file. */
  75 {
  76     ldr_module_t lm;
  77     char *pkg;
  78
  79     lm = (Tcl_PackageInitProc *) load(fileName, LDR_NOFLAGS);
  80     if (lm == LDR_NULL_MODULE) {
  81         Tcl_AppendResult(interp, "couldn't load file \"", fileName,
  82             "\": ", Tcl_PosixError (interp), (char *) NULL);
  83         return TCL_ERROR;
  84     }
  85
  86     *clientDataPtr = NULL;
  87
  88     /*
  89      * My convention is to use a [OSF loader] package name the same as shlib,
  90      * since the idiots never implemented ldr_lookup() and it is otherwise
  91      * impossible to get a package name given a module.
  92      *
  93      * I build loadable modules with a makefile rule like
  94      *          ld ... -export $@: -o $@ $(OBJS)
  95      */
  96     if ((pkg = strrchr(fileName, '/')) == NULL)
  97         pkg = fileName;
  98     else
  99         pkg++;
 100     *proc1Ptr = ldr_lookup_package(pkg, sym1);
 101     *proc2Ptr = ldr_lookup_package(pkg, sym2);
 102     return TCL_OK;
 103 }
 104 \f
 105 /*
 106  *----------------------------------------------------------------------
 107  *
 108  * TclpUnloadFile --
 109  *
 110  *      Unloads a dynamically loaded binary code file from memory.
 111  *      Code pointers in the formerly loaded file are no longer valid
 112  *      after calling this function.
 113  *
 114  * Results:
 115  *      None.
 116  *
 117  * Side effects:
 118  *      Does nothing.  Can anything be done?
 119  *
 120  *----------------------------------------------------------------------
 121  */
 122
 123 void
 124 TclpUnloadFile(clientData)
 125     ClientData clientData;      /* ClientData returned by a previous call
 126                                  * to TclpLoadFile().  The clientData is
 127                                  * a token that represents the loaded
 128                                  * file. */
 129 {
 130 }
 131 \f
 132 /*
 133  *----------------------------------------------------------------------
 134  *
 135  * TclGuessPackageName --
 136  *
 137  *      If the "load" command is invoked without providing a package
 138  *      name, this procedure is invoked to try to figure it out.
 139  *
 140  * Results:
 141  *      Always returns 0 to indicate that we couldn't figure out a
 142  *      package name;  generic code will then try to guess the package
 143  *      from the file name.  A return value of 1 would have meant that
 144  *      we figured out the package name and put it in bufPtr.
 145  *
 146  * Side effects:
 147  *      None.
 148  *
 149  *----------------------------------------------------------------------
 150  */
 151
 152 int
 153 TclGuessPackageName(fileName, bufPtr)
 154     char *fileName;             /* Name of file containing package (already
 155                                  * translated to local form if needed). */
 156     Tcl_DString *bufPtr;        /* Initialized empty dstring.  Append
 157                                  * package name to this if possible. */
 158 {
 159     return 0;
 160 }
 161