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