1/* 2 * tclLoadShl.c -- 3 * 4 * This procedure provides a version of the TclLoadFile that works 5 * with the "shl_load" and "shl_findsym" library procedures for 6 * dynamic 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 11 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 * 13 * RCS: @(#) $Id: tclLoadShl.c,v 1.13.2.1 2005/10/05 04:23:56 hobbs 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 34 * a handle to the new code. 35 * 36 * Results: 37 * A standard Tcl completion code. If an error occurs, an error 38 * message is left in the interp's result. 39 * 40 * Side effects: 41 * New code suddenly appears in memory. 42 * 43 *---------------------------------------------------------------------- 44 */ 45 46int 47TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) 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 57 * this 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 65 * the suggestion of Wolfgang Kechel (wolfgang@prs.de): "This 66 * enables verbosity for missing symbols when loading a shared lib 67 * and allows to load libtk8.0.sl into tclsh8.0 without problems. 68 * In general, this delays resolving symbols until they are actually 69 * needed. Shared libs do no longer need all libraries linked in 70 * when they are build." 71 */ 72 73 74 /* 75 * First try the full path the user gave us. This is particularly 76 * important if the cwd is inside a vfs, and we are trying to load 77 * using a relative path. 78 */ 79 native = Tcl_FSGetNativePath(pathPtr); 80 handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE, 0L); 81 82 if (handle == NULL) { 83 /* 84 * Let the OS loader examine the binary search path for 85 * whatever string the user gave us which hopefully refers 86 * to a file on the binary path 87 */ 88 Tcl_DString ds; 89 native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); 90 handle = shl_load(native, 91 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 111 * a previously loaded piece of code (shared library). 112 * 113 * Results: 114 * Returns a pointer to the function associated with 'symbol' if 115 * it is found. Otherwise returns NULL and may leave an error 116 * message in the interp's result. 117 * 118 *---------------------------------------------------------------------- 119 */ 120Tcl_PackageInitProc* 121TclpFindSymbol(interp, loadHandle, symbol) 122 Tcl_Interp *interp; 123 Tcl_LoadHandle loadHandle; 124 CONST char *symbol; 125{ 126 Tcl_DString newName; 127 Tcl_PackageInitProc *proc=NULL; 128 shl_t handle = (shl_t)loadHandle; 129 /* 130 * Some versions of the HP system software still use "_" at the 131 * beginning of exported symbols while others don't; try both 132 * forms of each name. 133 */ 134 135 if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE, (void *) &proc) 136 != 0) { 137 Tcl_DStringInit(&newName); 138 Tcl_DStringAppend(&newName, "_", 1); 139 Tcl_DStringAppend(&newName, symbol, -1); 140 if (shl_findsym(&handle, Tcl_DStringValue(&newName), 141 (short) TYPE_PROCEDURE, (void *) &proc) != 0) { 142 proc = NULL; 143 } 144 Tcl_DStringFree(&newName); 145 } 146 return proc; 147} 148 149/* 150 *---------------------------------------------------------------------- 151 * 152 * TclpUnloadFile -- 153 * 154 * Unloads a dynamically loaded binary code file from memory. 155 * Code pointers in the formerly loaded file are no longer valid 156 * after calling this function. 157 * 158 * Results: 159 * None. 160 * 161 * Side effects: 162 * Code removed from memory. 163 * 164 *---------------------------------------------------------------------- 165 */ 166 167void 168TclpUnloadFile(loadHandle) 169 Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call 170 * to TclpDlopen(). The loadHandle is 171 * a token that represents the loaded 172 * 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 186 * name, 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 190 * package name; generic code will then try to guess the package 191 * from the file name. A return value of 1 would have meant that 192 * we figured out the package name and put it in bufPtr. 193 * 194 * Side effects: 195 * None. 196 * 197 *---------------------------------------------------------------------- 198 */ 199 200int 201TclGuessPackageName(fileName, bufPtr) 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 205 * package name to this if possible. */ 206{ 207 return 0; 208} 209