tclLoadShl.cGo to the documentation of this file.00001 /* 00002 * tclLoadShl.c -- 00003 * 00004 * This procedure provides a version of the TclLoadFile that works with 00005 * the "shl_load" and "shl_findsym" library procedures for dynamic 00006 * loading (e.g. for HP machines). 00007 * 00008 * Copyright (c) 1995-1997 Sun Microsystems, Inc. 00009 * 00010 * See the file "license.terms" for information on usage and redistribution of 00011 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 00012 * 00013 * RCS: @(#) $Id: tclLoadShl.c,v 1.16 2005/11/11 23:46:34 dkf Exp $ 00014 */ 00015 00016 #include <dl.h> 00017 00018 /* 00019 * On some HP machines, dl.h defines EXTERN; remove that definition. 00020 */ 00021 00022 #ifdef EXTERN 00023 # undef EXTERN 00024 #endif 00025 00026 #include "tclInt.h" 00027 00028 /* 00029 *---------------------------------------------------------------------- 00030 * 00031 * TclpDlopen -- 00032 * 00033 * Dynamically loads a binary code file into memory and returns a handle 00034 * to the new code. 00035 * 00036 * Results: 00037 * A standard Tcl completion code. If an error occurs, an error message 00038 * is left in the interp's result. 00039 * 00040 * Side effects: 00041 * New code suddenly appears in memory. 00042 * 00043 *---------------------------------------------------------------------- 00044 */ 00045 00046 int 00047 TclpDlopen( 00048 Tcl_Interp *interp, /* Used for error reporting. */ 00049 Tcl_Obj *pathPtr, /* Name of the file containing the desired 00050 * code (UTF-8). */ 00051 Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded 00052 * file which will be passed back to 00053 * (*unloadProcPtr)() to unload the file. */ 00054 Tcl_FSUnloadFileProc **unloadProcPtr) 00055 /* Filled with address of Tcl_FSUnloadFileProc 00056 * function which should be used for this 00057 * file. */ 00058 { 00059 shl_t handle; 00060 CONST char *native; 00061 char *fileName = Tcl_GetString(pathPtr); 00062 00063 /* 00064 * The flags below used to be BIND_IMMEDIATE; they were changed at the 00065 * suggestion of Wolfgang Kechel (wolfgang@prs.de): "This enables 00066 * verbosity for missing symbols when loading a shared lib and allows to 00067 * load libtk8.0.sl into tclsh8.0 without problems. In general, this 00068 * delays resolving symbols until they are actually needed. Shared libs 00069 * do no longer need all libraries linked in when they are build." 00070 */ 00071 00072 /* 00073 * First try the full path the user gave us. This is particularly 00074 * important if the cwd is inside a vfs, and we are trying to load using a 00075 * relative path. 00076 */ 00077 00078 native = Tcl_FSGetNativePath(pathPtr); 00079 handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE, 0L); 00080 00081 if (handle == NULL) { 00082 /* 00083 * Let the OS loader examine the binary search path for whatever 00084 * string the user gave us which hopefully refers to a file on the 00085 * binary path. 00086 */ 00087 00088 Tcl_DString ds; 00089 00090 native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); 00091 handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L); 00092 Tcl_DStringFree(&ds); 00093 } 00094 00095 if (handle == NULL) { 00096 Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ", 00097 Tcl_PosixError(interp), (char *) NULL); 00098 return TCL_ERROR; 00099 } 00100 *loadHandle = (Tcl_LoadHandle) handle; 00101 *unloadProcPtr = &TclpUnloadFile; 00102 return TCL_OK; 00103 } 00104 00105 /* 00106 *---------------------------------------------------------------------- 00107 * 00108 * TclpFindSymbol -- 00109 * 00110 * Looks up a symbol, by name, through a handle associated with a 00111 * previously loaded piece of code (shared library). 00112 * 00113 * Results: 00114 * Returns a pointer to the function associated with 'symbol' if it is 00115 * found. Otherwise returns NULL and may leave an error message in the 00116 * interp's result. 00117 * 00118 *---------------------------------------------------------------------- 00119 */ 00120 00121 Tcl_PackageInitProc * 00122 TclpFindSymbol( 00123 Tcl_Interp *interp, 00124 Tcl_LoadHandle loadHandle, 00125 CONST char *symbol) 00126 { 00127 Tcl_DString newName; 00128 Tcl_PackageInitProc *proc = NULL; 00129 shl_t handle = (shl_t)loadHandle; 00130 00131 /* 00132 * Some versions of the HP system software still use "_" at the beginning 00133 * of exported symbols while others don't; try both forms of each name. 00134 */ 00135 00136 if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE, 00137 (void *) &proc) != 0) { 00138 Tcl_DStringInit(&newName); 00139 Tcl_DStringAppend(&newName, "_", 1); 00140 Tcl_DStringAppend(&newName, symbol, -1); 00141 if (shl_findsym(&handle, Tcl_DStringValue(&newName), 00142 (short) TYPE_PROCEDURE, (void *) &proc) != 0) { 00143 proc = NULL; 00144 } 00145 Tcl_DStringFree(&newName); 00146 } 00147 return proc; 00148 } 00149 00150 /* 00151 *---------------------------------------------------------------------- 00152 * 00153 * TclpUnloadFile -- 00154 * 00155 * Unloads a dynamically loaded binary code file from memory. Code 00156 * pointers in the formerly loaded file are no longer valid after calling 00157 * this function. 00158 * 00159 * Results: 00160 * None. 00161 * 00162 * Side effects: 00163 * Code removed from memory. 00164 * 00165 *---------------------------------------------------------------------- 00166 */ 00167 00168 void 00169 TclpUnloadFile( 00170 Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to 00171 * TclpDlopen(). The loadHandle is a token 00172 * that represents the loaded file. */ 00173 { 00174 shl_t handle; 00175 00176 handle = (shl_t) loadHandle; 00177 shl_unload(handle); 00178 } 00179 00180 /* 00181 *---------------------------------------------------------------------- 00182 * 00183 * TclGuessPackageName -- 00184 * 00185 * If the "load" command is invoked without providing a package name, 00186 * this procedure is invoked to try to figure it out. 00187 * 00188 * Results: 00189 * Always returns 0 to indicate that we couldn't figure out a package 00190 * name; generic code will then try to guess the package from the file 00191 * name. A return value of 1 would have meant that we figured out the 00192 * package name and put it in bufPtr. 00193 * 00194 * Side effects: 00195 * None. 00196 * 00197 *---------------------------------------------------------------------- 00198 */ 00199 00200 int 00201 TclGuessPackageName( 00202 CONST char *fileName, /* Name of file containing package (already 00203 * translated to local form if needed). */ 00204 Tcl_DString *bufPtr) /* Initialized empty dstring. Append package 00205 * name to this if possible. */ 00206 { 00207 return 0; 00208 } 00209 00210 /* 00211 * Local Variables: 00212 * mode: c 00213 * c-basic-offset: 4 00214 * fill-column: 78 00215 * End: 00216 */
Generated on Wed Mar 12 12:18:25 2008 by 1.5.1 |