tclLoadOSF.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:6k
源码类别:

通讯编程

开发平台:

Visual 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: tclLoadOSF.c,v 1.11 2002/10/10 12:25:53 vincentdarley Exp $
  35.  */
  36. #include "tclInt.h"
  37. #include <sys/types.h>
  38. #include <loader.h>
  39. /*
  40.  *----------------------------------------------------------------------
  41.  *
  42.  * TclpDlopen --
  43.  *
  44.  * Dynamically loads a binary code file into memory and returns
  45.  * a handle to the new code.
  46.  *
  47.  * Results:
  48.  * A standard Tcl completion code.  If an error occurs, an error
  49.  * message is left in the interp's result.
  50.  *
  51.  * Side effects:
  52.  * New code suddenly appears in memory.
  53.  *
  54.  *----------------------------------------------------------------------
  55.  */
  56. int
  57. TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
  58.     Tcl_Interp *interp; /* Used for error reporting. */
  59.     Tcl_Obj *pathPtr; /* Name of the file containing the desired
  60.  * code (UTF-8). */
  61.     Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded
  62.  * file which will be passed back to 
  63.  * (*unloadProcPtr)() to unload the file. */
  64.     Tcl_FSUnloadFileProc **unloadProcPtr;
  65. /* Filled with address of Tcl_FSUnloadFileProc
  66.  * function which should be used for
  67.  * this file. */
  68. {
  69.     ldr_module_t lm;
  70.     char *pkg;
  71.     char *fileName = Tcl_GetString(pathPtr);
  72.     CONST char *native;
  73.     /* 
  74.      * First try the full path the user gave us.  This is particularly
  75.      * important if the cwd is inside a vfs, and we are trying to load
  76.      * using a relative path.
  77.      */
  78.     native = Tcl_FSGetNativePath(pathPtr);
  79.     lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS);
  80.     if (lm == LDR_NULL_MODULE) {
  81. /* 
  82.  * Let the OS loader examine the binary search path for
  83.  * whatever string the user gave us which hopefully refers
  84.  * to a file on the binary path
  85.  */
  86. Tcl_DString ds;
  87. native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
  88. lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS);
  89. Tcl_DStringFree(&ds);
  90.     }
  91.     
  92.     if (lm == LDR_NULL_MODULE) {
  93. Tcl_AppendResult(interp, "couldn't load file "", fileName,
  94.     "": ", Tcl_PosixError (interp), (char *) NULL);
  95. return TCL_ERROR;
  96.     }
  97.     *clientDataPtr = NULL;
  98.     
  99.     /*
  100.      * My convention is to use a [OSF loader] package name the same as shlib,
  101.      * since the idiots never implemented ldr_lookup() and it is otherwise
  102.      * impossible to get a package name given a module.
  103.      *
  104.      * I build loadable modules with a makefile rule like 
  105.      * ld ... -export $@: -o $@ $(OBJS)
  106.      */
  107.     if ((pkg = strrchr(fileName, '/')) == NULL) {
  108.         pkg = fileName;
  109.     } else {
  110. pkg++;
  111.     }
  112.     *loadHandle = pkg;
  113.     *unloadProcPtr = &TclpUnloadFile;
  114.     return TCL_OK;
  115. }
  116. /*
  117.  *----------------------------------------------------------------------
  118.  *
  119.  * TclpFindSymbol --
  120.  *
  121.  * Looks up a symbol, by name, through a handle associated with
  122.  * a previously loaded piece of code (shared library).
  123.  *
  124.  * Results:
  125.  * Returns a pointer to the function associated with 'symbol' if
  126.  * it is found.  Otherwise returns NULL and may leave an error
  127.  * message in the interp's result.
  128.  *
  129.  *----------------------------------------------------------------------
  130.  */
  131. Tcl_PackageInitProc*
  132. TclpFindSymbol(interp, loadHandle, symbol) 
  133.     Tcl_Interp *interp;
  134.     Tcl_LoadHandle loadHandle;
  135.     CONST char *symbol;
  136. {
  137.     return ldr_lookup_package((char *)loadHandle, symbol);
  138. }
  139. /*
  140.  *----------------------------------------------------------------------
  141.  *
  142.  * TclpUnloadFile --
  143.  *
  144.  * Unloads a dynamically loaded binary code file from memory.
  145.  * Code pointers in the formerly loaded file are no longer valid
  146.  * after calling this function.
  147.  *
  148.  * Results:
  149.  * None.
  150.  *
  151.  * Side effects:
  152.  * Does nothing.  Can anything be done?
  153.  *
  154.  *----------------------------------------------------------------------
  155.  */
  156. void
  157. TclpUnloadFile(loadHandle)
  158.     Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
  159.  * to TclpDlopen().  The loadHandle is 
  160.  * a token that represents the loaded 
  161.  * file. */
  162. {
  163. }
  164. /*
  165.  *----------------------------------------------------------------------
  166.  *
  167.  * TclGuessPackageName --
  168.  *
  169.  * If the "load" command is invoked without providing a package
  170.  * name, this procedure is invoked to try to figure it out.
  171.  *
  172.  * Results:
  173.  * Always returns 0 to indicate that we couldn't figure out a
  174.  * package name;  generic code will then try to guess the package
  175.  * from the file name.  A return value of 1 would have meant that
  176.  * we figured out the package name and put it in bufPtr.
  177.  *
  178.  * Side effects:
  179.  * None.
  180.  *
  181.  *----------------------------------------------------------------------
  182.  */
  183. int
  184. TclGuessPackageName(fileName, bufPtr)
  185.     CONST char *fileName; /* Name of file containing package (already
  186.  * translated to local form if needed). */
  187.     Tcl_DString *bufPtr; /* Initialized empty dstring.  Append
  188.  * package name to this if possible. */
  189. {
  190.     return 0;
  191. }