1/* 2 * tclLoadShl.c -- 3 * 4 * This procedure provides a version of the TclLoadFile that works with 5 * the "shl_load" and "shl_findsym" library procedures for dynamic 6 * loading (e.g. for HP machines). 7 * 8 * Copyright (c) 1995-1997 Sun Microsystems, Inc. 9 * 10 * See the file "license.terms" for information on usage and redistribution of 11 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 * 13 * RCS: @(#) $Id: tclLoadShl.c,v 1.16 2005/11/11 23:46:34 dkf Exp $ 14 */ 15 16#include <dl.h> 17 18/* 19 * On some HP machines, dl.h defines EXTERN; remove that definition. 20 */ 21 22#ifdef EXTERN 23# undef EXTERN 24#endif 25 26#include "tclInt.h" 27 28/* 29 *---------------------------------------------------------------------- 30 * 31 * TclpDlopen -- 32 * 33 * Dynamically loads a binary code file into memory and returns a handle 34 * to the new code. 35 * 36 * Results: 37 * A standard Tcl completion code. If an error occurs, an error message 38 * is left in the interp's result. 39 * 40 * Side effects: 41 * New code suddenly appears in memory. 42 * 43 *---------------------------------------------------------------------- 44 */ 45 46int 47TclpDlopen( 48 Tcl_Interp *interp, /* Used for error reporting. */ 49 Tcl_Obj *pathPtr, /* Name of the file containing the desired 50 * code (UTF-8). */ 51 Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded 52 * file which will be passed back to 53 * (*unloadProcPtr)() to unload the file. */ 54 Tcl_FSUnloadFileProc **unloadProcPtr) 55 /* Filled with address of Tcl_FSUnloadFileProc 56 * function which should be used for this 57 * file. */ 58{ 59 shl_t handle; 60 CONST char *native; 61 char *fileName = Tcl_GetString(pathPtr); 62 63 /* 64 * The flags below used to be BIND_IMMEDIATE; they were changed at the 65 * suggestion of Wolfgang Kechel (wolfgang@prs.de): "This enables 66 * verbosity for missing symbols when loading a shared lib and allows to 67 * load libtk8.0.sl into tclsh8.0 without problems. In general, this 68 * delays resolving symbols until they are actually needed. Shared libs 69 * do no longer need all libraries linked in when they are build." 70 */ 71 72 /* 73 * First try the full path the user gave us. This is particularly 74 * important if the cwd is inside a vfs, and we are trying to load using a 75 * relative path. 76 */ 77 78 native = Tcl_FSGetNativePath(pathPtr); 79 handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE, 0L); 80 81 if (handle == NULL) { 82 /* 83 * Let the OS loader examine the binary search path for whatever 84 * string the user gave us which hopefully refers to a file on the 85 * binary path. 86 */ 87 88 Tcl_DString ds; 89 90 native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); 91 handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L); 92 Tcl_DStringFree(&ds); 93 } 94 95 if (handle == NULL) { 96 Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ", 97 Tcl_PosixError(interp), (char *) NULL); 98 return TCL_ERROR; 99 } 100 *loadHandle = (Tcl_LoadHandle) handle; 101 *unloadProcPtr = &TclpUnloadFile; 102 return TCL_OK; 103} 104 105/* 106 *---------------------------------------------------------------------- 107 * 108 * TclpFindSymbol -- 109 * 110 * Looks up a symbol, by name, through a handle associated with a 111 * previously loaded piece of code (shared library). 112 * 113 * Results: 114 * Returns a pointer to the function associated with 'symbol' if it is 115 * found. Otherwise returns NULL and may leave an error message in the 116 * interp's result. 117 * 118 *---------------------------------------------------------------------- 119 */ 120 121Tcl_PackageInitProc * 122TclpFindSymbol( 123 Tcl_Interp *interp, 124 Tcl_LoadHandle loadHandle, 125 CONST char *symbol) 126{ 127 Tcl_DString newName; 128 Tcl_PackageInitProc *proc = NULL; 129 shl_t handle = (shl_t)loadHandle; 130 131 /* 132 * Some versions of the HP system software still use "_" at the beginning 133 * of exported symbols while others don't; try both forms of each name. 134 */ 135 136 if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE, 137 (void *) &proc) != 0) { 138 Tcl_DStringInit(&newName); 139 Tcl_DStringAppend(&newName, "_", 1); 140 Tcl_DStringAppend(&newName, symbol, -1); 141 if (shl_findsym(&handle, Tcl_DStringValue(&newName), 142 (short) TYPE_PROCEDURE, (void *) &proc) != 0) { 143 proc = NULL; 144 } 145 Tcl_DStringFree(&newName); 146 } 147 return proc; 148} 149 150/* 151 *---------------------------------------------------------------------- 152 * 153 * TclpUnloadFile -- 154 * 155 * Unloads a dynamically loaded binary code file from memory. Code 156 * pointers in the formerly loaded file are no longer valid after calling 157 * this function. 158 * 159 * Results: 160 * None. 161 * 162 * Side effects: 163 * Code removed from memory. 164 * 165 *---------------------------------------------------------------------- 166 */ 167 168void 169TclpUnloadFile( 170 Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to 171 * TclpDlopen(). The loadHandle is a token 172 * that represents the loaded file. */ 173{ 174 shl_t handle; 175 176 handle = (shl_t) loadHandle; 177 shl_unload(handle); 178} 179 180/* 181 *---------------------------------------------------------------------- 182 * 183 * TclGuessPackageName -- 184 * 185 * If the "load" command is invoked without providing a package name, 186 * this procedure is invoked to try to figure it out. 187 * 188 * Results: 189 * Always returns 0 to indicate that we couldn't figure out a package 190 * name; generic code will then try to guess the package from the file 191 * name. A return value of 1 would have meant that we figured out the 192 * package name and put it in bufPtr. 193 * 194 * Side effects: 195 * None. 196 * 197 *---------------------------------------------------------------------- 198 */ 199 200int 201TclGuessPackageName( 202 CONST char *fileName, /* Name of file containing package (already 203 * translated to local form if needed). */ 204 Tcl_DString *bufPtr) /* Initialized empty dstring. Append package 205 * name to this if possible. */ 206{ 207 return 0; 208} 209 210/* 211 * Local Variables: 212 * mode: c 213 * c-basic-offset: 4 214 * fill-column: 78 215 * End: 216 */ 217