tclLoadNext.c

Go to the documentation of this file.
00001 /*
00002  * tclLoadNext.c --
00003  *
00004  *      This procedure provides a version of the TclLoadFile that works with
00005  *      NeXTs rld_* dynamic loading. This file provided by Pedja Bogdanovich.
00006  *
00007  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
00008  *
00009  * See the file "license.terms" for information on usage and redistribution of
00010  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
00011  *
00012  * RCS: @(#) $Id: tclLoadNext.c,v 1.13 2005/11/11 23:46:34 dkf Exp $
00013  */
00014 
00015 #include "tclInt.h"
00016 #include <mach-o/rld.h>
00017 #include <streams/streams.h>
00018 
00019 /*
00020  *----------------------------------------------------------------------
00021  *
00022  * TclpDlopen --
00023  *
00024  *      Dynamically loads a binary code file into memory and returns a handle
00025  *      to the new code.
00026  *
00027  * Results:
00028  *      A standard Tcl completion code.  If an error occurs, an error message
00029  *      is left in the interp's result.
00030  *
00031  * Side effects:
00032  *      New code suddenly appears in memory.
00033  *
00034  *----------------------------------------------------------------------
00035  */
00036 
00037 int
00038 TclpDlopen(
00039     Tcl_Interp *interp,         /* Used for error reporting. */
00040     Tcl_Obj *pathPtr,           /* Name of the file containing the desired
00041                                  * code (UTF-8). */
00042     Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
00043                                  * file which will be passed back to
00044                                  * (*unloadProcPtr)() to unload the file. */
00045     Tcl_FSUnloadFileProc **unloadProcPtr)
00046                                 /* Filled with address of Tcl_FSUnloadFileProc
00047                                  * function which should be used for this
00048                                  * file. */
00049 {
00050     struct mach_header *header;
00051     char *fileName;
00052     char *files[2];
00053     CONST char *native;
00054     int result = 1;
00055 
00056     NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE);
00057 
00058     fileName = Tcl_GetString(pathPtr);
00059 
00060     /*
00061      * First try the full path the user gave us. This is particularly
00062      * important if the cwd is inside a vfs, and we are trying to load using a
00063      * relative path.
00064      */
00065 
00066     native = Tcl_FSGetNativePath(pathPtr);
00067     files = {native,NULL};
00068 
00069     result = rld_load(errorStream, &header, files, NULL);
00070 
00071     if (!result) {
00072         /*
00073          * Let the OS loader examine the binary search path for whatever
00074          * string the user gave us which hopefully refers to a file on the
00075          * binary path
00076          */
00077 
00078         Tcl_DString ds;
00079 
00080         native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
00081         files = {native,NULL};
00082         result = rld_load(errorStream, &header, files, NULL);
00083         Tcl_DStringFree(&ds);
00084     }
00085 
00086     if (!result) {
00087         char *data;
00088         int len, maxlen;
00089 
00090         NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
00091         Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ",
00092                 data, NULL);
00093         NXCloseMemory(errorStream, NX_FREEBUFFER);
00094         return TCL_ERROR;
00095     }
00096     NXCloseMemory(errorStream, NX_FREEBUFFER);
00097 
00098     *loadHandle = (Tcl_LoadHandle)1; /* A dummy non-NULL value */
00099     *unloadProcPtr = &TclpUnloadFile;
00100 
00101     return TCL_OK;
00102 }
00103 
00104 /*
00105  *----------------------------------------------------------------------
00106  *
00107  * TclpFindSymbol --
00108  *
00109  *      Looks up a symbol, by name, through a handle associated with a
00110  *      previously loaded piece of code (shared library).
00111  *
00112  * Results:
00113  *      Returns a pointer to the function associated with 'symbol' if it is
00114  *      found. Otherwise returns NULL and may leave an error message in the
00115  *      interp's result.
00116  *
00117  *----------------------------------------------------------------------
00118  */
00119 
00120 Tcl_PackageInitProc *
00121 TclpFindSymbol(
00122     Tcl_Interp *interp,
00123     Tcl_LoadHandle loadHandle,
00124     CONST char *symbol)
00125 {
00126     Tcl_PackageInitProc *proc = NULL;
00127     if (symbol) {
00128         char sym[strlen(symbol) + 2];
00129 
00130         sym[0] = '_';
00131         sym[1] = 0;
00132         strcat(sym, symbol);
00133         rld_lookup(NULL, sym, (unsigned long *)&proc);
00134     }
00135     return proc;
00136 }
00137 
00138 /*
00139  *----------------------------------------------------------------------
00140  *
00141  * TclpUnloadFile --
00142  *
00143  *      Unloads a dynamically loaded binary code file from memory. Code
00144  *      pointers in the formerly loaded file are no longer valid after calling
00145  *      this function.
00146  *
00147  * Results:
00148  *      None.
00149  *
00150  * Side effects:
00151  *      Does nothing.  Can anything be done?
00152  *
00153  *----------------------------------------------------------------------
00154  */
00155 
00156 void
00157 TclpUnloadFile(
00158     Tcl_LoadHandle loadHandle)  /* loadHandle returned by a previous call to
00159                                  * TclpDlopen(). The loadHandle is a token
00160                                  * that represents the loaded file. */
00161 {
00162 }
00163 
00164 /*
00165  *----------------------------------------------------------------------
00166  *
00167  * TclGuessPackageName --
00168  *
00169  *      If the "load" command is invoked without providing a package name,
00170  *      this procedure is invoked to try to figure it out.
00171  *
00172  * Results:
00173  *      Always returns 0 to indicate that we couldn't figure out a package
00174  *      name; generic code will then try to guess the package from the file
00175  *      name. A return value of 1 would have meant that we figured out the
00176  *      package name and put it in bufPtr.
00177  *
00178  * Side effects:
00179  *      None.
00180  *
00181  *----------------------------------------------------------------------
00182  */
00183 
00184 int
00185 TclGuessPackageName(
00186     CONST char *fileName,       /* Name of file containing package (already
00187                                  * translated to local form if needed). */
00188     Tcl_DString *bufPtr)        /* Initialized empty dstring. Append package
00189                                  * name to this if possible. */
00190 {
00191     return 0;
00192 }
00193 
00194 /*
00195  * Local Variables:
00196  * mode: c
00197  * c-basic-offset: 4
00198  * fill-column: 78
00199  * End:
00200  */



Generated on Wed Mar 12 12:18:25 2008 by  doxygen 1.5.1