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

通讯编程

开发平台:

Visual C++

  1. /* 
  2.  * tclLoadNext.c --
  3.  *
  4.  * This procedure provides a version of the TclLoadFile that
  5.  * works with NeXTs rld_* dynamic loading.  This file provided
  6.  * by Pedja Bogdanovich.
  7.  *
  8.  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * RCS: @(#) $Id: tclLoadNext.c,v 1.11 2002/10/10 12:25:53 vincentdarley Exp $
  14.  */
  15. #include "tclInt.h"
  16. #include <mach-o/rld.h>
  17. #include <streams/streams.h>
  18. /*
  19.  *----------------------------------------------------------------------
  20.  *
  21.  * TclpDlopen --
  22.  *
  23.  * Dynamically loads a binary code file into memory and returns
  24.  * a handle to the new code.
  25.  *
  26.  * Results:
  27.  * A standard Tcl completion code.  If an error occurs, an error
  28.  * message is left in the interp's result.
  29.  *
  30.  * Side effects:
  31.  * New code suddenly appears in memory.
  32.  *
  33.  *----------------------------------------------------------------------
  34.  */
  35. int
  36. TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
  37.     Tcl_Interp *interp; /* Used for error reporting. */
  38.     Tcl_Obj *pathPtr; /* Name of the file containing the desired
  39.  * code (UTF-8). */
  40.     Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded
  41.  * file which will be passed back to 
  42.  * (*unloadProcPtr)() to unload the file. */
  43.     Tcl_FSUnloadFileProc **unloadProcPtr;
  44. /* Filled with address of Tcl_FSUnloadFileProc
  45.  * function which should be used for
  46.  * this file. */
  47. {
  48.     struct mach_header *header;
  49.     char *fileName;
  50.     char *files[2];
  51.     CONST char *native;
  52.     int result = 1;
  53.     
  54.     NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE);
  55.     
  56.     fileName = Tcl_GetString(pathPtr);
  57.     /* 
  58.      * First try the full path the user gave us.  This is particularly
  59.      * important if the cwd is inside a vfs, and we are trying to load
  60.      * using a relative path.
  61.      */
  62.     native = Tcl_FSGetNativePath(pathPtr);
  63.     files = {native,NULL};
  64.     result = rld_load(errorStream, &header, files, NULL);
  65.     
  66.     if (!result) {
  67. /* 
  68.  * Let the OS loader examine the binary search path for
  69.  * whatever string the user gave us which hopefully refers
  70.  * to a file on the binary path
  71.  */
  72. Tcl_DString ds;
  73. native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
  74. files = {native,NULL};
  75. result = rld_load(errorStream, &header, files, NULL);
  76. Tcl_DStringFree(&ds);
  77.     }
  78.     
  79.     if (!result) {
  80. char *data;
  81. int len, maxlen;
  82. NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
  83. Tcl_AppendResult(interp, "couldn't load file "",
  84.  fileName, "": ", data, NULL);
  85. NXCloseMemory(errorStream, NX_FREEBUFFER);
  86. return TCL_ERROR;
  87.     }
  88.     NXCloseMemory(errorStream, NX_FREEBUFFER);
  89.     
  90.     *loadHandle = (Tcl_LoadHandle)1; /* A dummy non-NULL value */
  91.     *unloadProcPtr = &TclpUnloadFile;
  92.     
  93.     return TCL_OK;
  94. }
  95. /*
  96.  *----------------------------------------------------------------------
  97.  *
  98.  * TclpFindSymbol --
  99.  *
  100.  * Looks up a symbol, by name, through a handle associated with
  101.  * a previously loaded piece of code (shared library).
  102.  *
  103.  * Results:
  104.  * Returns a pointer to the function associated with 'symbol' if
  105.  * it is found.  Otherwise returns NULL and may leave an error
  106.  * message in the interp's result.
  107.  *
  108.  *----------------------------------------------------------------------
  109.  */
  110. Tcl_PackageInitProc*
  111. TclpFindSymbol(interp, loadHandle, symbol) 
  112.     Tcl_Interp *interp;
  113.     Tcl_LoadHandle loadHandle;
  114.     CONST char *symbol;
  115. {
  116.     Tcl_PackageInitProc *proc=NULL;
  117.     if(symbol) {
  118. char sym[strlen(symbol)+2];
  119. sym[0]='_'; sym[1]=0; strcat(sym,symbol);
  120. rld_lookup(NULL,sym,(unsigned long *)&proc);
  121.     }
  122.     return proc;
  123. }
  124. /*
  125.  *----------------------------------------------------------------------
  126.  *
  127.  * TclpUnloadFile --
  128.  *
  129.  * Unloads a dynamically loaded binary code file from memory.
  130.  * Code pointers in the formerly loaded file are no longer valid
  131.  * after calling this function.
  132.  *
  133.  * Results:
  134.  * None.
  135.  *
  136.  * Side effects:
  137.  * Does nothing.  Can anything be done?
  138.  *
  139.  *----------------------------------------------------------------------
  140.  */
  141. void
  142. TclpUnloadFile(loadHandle)
  143.     Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
  144.  * to TclpDlopen().  The loadHandle is 
  145.  * a token that represents the loaded 
  146.  * file. */
  147. {
  148. }
  149. /*
  150.  *----------------------------------------------------------------------
  151.  *
  152.  * TclGuessPackageName --
  153.  *
  154.  * If the "load" command is invoked without providing a package
  155.  * name, this procedure is invoked to try to figure it out.
  156.  *
  157.  * Results:
  158.  * Always returns 0 to indicate that we couldn't figure out a
  159.  * package name;  generic code will then try to guess the package
  160.  * from the file name.  A return value of 1 would have meant that
  161.  * we figured out the package name and put it in bufPtr.
  162.  *
  163.  * Side effects:
  164.  * None.
  165.  *
  166.  *----------------------------------------------------------------------
  167.  */
  168. int
  169. TclGuessPackageName(fileName, bufPtr)
  170.     CONST char *fileName; /* Name of file containing package (already
  171.  * translated to local form if needed). */
  172.     Tcl_DString *bufPtr; /* Initialized empty dstring.  Append
  173.  * package name to this if possible. */
  174. {
  175.     return 0;
  176. }