tcl/unix/tclLoadDl2.c

   1 /*
   2  * tclLoadDl2.c --
   3  *
   4  *      This procedure provides a version of the TclLoadFile that
   5  *      works with the "dlopen" and "dlsym" library procedures for
   6  *      dynamic loading.  It is identical to tclLoadDl.c except that
   7  *      it adds a "_" character to symbol names before looking them
   8  *      up.
   9  *
  10  * Copyright (c) 1995 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  * SCCS: @(#) tclLoadDl2.c 1.3 96/02/15 11:58:45
  16  */
  17
  18 #include "tcl.h"
  19 #include "dlfcn.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  * TclLoadFile --
  34  *
  35  *      Dynamically loads a binary code file into memory and returns
  36  *      the addresses of two procedures within that file, if they
  37  *      are defined.
  38  *
  39  * Results:
  40  *      A standard Tcl completion code.  If an error occurs, an error
  41  *      message is left in interp->result.  *proc1Ptr and *proc2Ptr
  42  *      are filled in with the addresses of the symbols given by
  43  *      *sym1 and *sym2, or NULL if those symbols can't be found.
  44  *
  45  * Side effects:
  46  *      New code suddenly appears in memory.
  47  *
  48  *----------------------------------------------------------------------
  49  */
  50
  51 int
  52 TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
  53     Tcl_Interp *interp;         /* Used for error reporting. */
  54     char *fileName;             /* Name of the file containing the desired
  55                                  * code. */
  56     char *sym1, *sym2;          /* Names of two procedures to look up in
  57                                  * the file's symbol table. */
  58     Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
  59                                 /* Where to return the addresses corresponding
  60                                  * to sym1 and sym2. */
  61 {
  62     VOID *handle;
  63     Tcl_DString newName;
  64
  65     handle = dlopen(fileName, RTLD_NOW);
  66     if (handle == NULL) {
  67         Tcl_AppendResult(interp, "couldn't load file \"", fileName,
  68                 "\": ", dlerror(), (char *) NULL);
  69         return TCL_ERROR;
  70     }
  71     Tcl_DStringInit(&newName);
  72     Tcl_DStringAppend(&newName, "_", 1);
  73     Tcl_DStringAppend(&newName, sym1, -1);
  74     *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle,
  75             Tcl_DStringValue(&newName));
  76     Tcl_DStringSetLength(&newName, 0);
  77     Tcl_DStringAppend(&newName, "_", 1);
  78     Tcl_DStringAppend(&newName, sym2, -1);
  79     *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle,
  80             Tcl_DStringValue(&newName));
  81     Tcl_DStringFree(&newName);
  82     return TCL_OK;
  83 }
  84 \f
  85 /*
  86  *----------------------------------------------------------------------
  87  *
  88  * TclGuessPackageName --
  89  *
  90  *      If the "load" command is invoked without providing a package
  91  *      name, this procedure is invoked to try to figure it out.
  92  *
  93  * Results:
  94  *      Always returns 0 to indicate that we couldn't figure out a
  95  *      package name;  generic code will then try to guess the package
  96  *      from the file name.  A return value of 1 would have meant that
  97  *      we figured out the package name and put it in bufPtr.
  98  *
  99  * Side effects:
 100  *      None.
 101  *
 102  *----------------------------------------------------------------------
 103  */
 104
 105 int
 106 TclGuessPackageName(fileName, bufPtr)
 107     char *fileName;             /* Name of file containing package (already
 108                                  * translated to local form if needed). */
 109     Tcl_DString *bufPtr;        /* Initialized empty dstring.  Append
 110                                  * package name to this if possible. */
 111 {
 112     return 0;
 113 }