home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / unix / tclLoadDld.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  3.6 KB  |  126 lines  |  [TEXT/CWIE]
  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 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: @(#) tclLoadDld.c 1.5 97/05/14 13:24:22
  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.  
  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.     static int firstTime = 1;
  63.     int returnCode;
  64.  
  65.     /*
  66.      *  The dld package needs to know the pathname to the tcl binary.
  67.      *  If that's not know, return an error.
  68.      */
  69.  
  70.     if (firstTime) {
  71.     if (tclExecutableName == NULL) {
  72.         Tcl_SetResult(interp,
  73.             "don't know name of application binary file, so can't initialize dynamic loader",
  74.             TCL_STATIC);
  75.         return TCL_ERROR;
  76.     }
  77.     returnCode = dld_init(tclExecutableName);
  78.     if (returnCode != 0) {
  79.         Tcl_AppendResult(interp,
  80.             "initialization failed for dynamic loader: ",
  81.             dld_strerror(returnCode), (char *) NULL);
  82.         return TCL_ERROR;
  83.     }
  84.     firstTime = 0;
  85.     }
  86.  
  87.     if ((returnCode = dld_link(fileName)) != 0) {
  88.     Tcl_AppendResult(interp, "couldn't load file \"", fileName,
  89.         "\": ", dld_strerror(returnCode), (char *) NULL);
  90.     return TCL_ERROR;
  91.     }
  92.     *proc1Ptr = (Tcl_PackageInitProc *) dld_get_func(sym1);
  93.     *proc2Ptr = (Tcl_PackageInitProc *) dld_get_func(sym2);
  94.     return TCL_OK;
  95. }
  96.  
  97. /*
  98.  *----------------------------------------------------------------------
  99.  *
  100.  * TclGuessPackageName --
  101.  *
  102.  *    If the "load" command is invoked without providing a package
  103.  *    name, this procedure is invoked to try to figure it out.
  104.  *
  105.  * Results:
  106.  *    Always returns 0 to indicate that we couldn't figure out a
  107.  *    package name;  generic code will then try to guess the package
  108.  *    from the file name.  A return value of 1 would have meant that
  109.  *    we figured out the package name and put it in bufPtr.
  110.  *
  111.  * Side effects:
  112.  *    None.
  113.  *
  114.  *----------------------------------------------------------------------
  115.  */
  116.  
  117. int
  118. TclGuessPackageName(fileName, bufPtr)
  119.     char *fileName;        /* Name of file containing package (already
  120.                  * translated to local form if needed). */
  121.     Tcl_DString *bufPtr;    /* Initialized empty dstring.  Append
  122.                  * package name to this if possible. */
  123. {
  124.     return 0;
  125. }
  126.