1/* 2 * tclLoadDl.c -- 3 * 4 * This procedure provides a version of the TclLoadFile that works with 5 * the "dlopen" and "dlsym" library procedures for dynamic loading. 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: tclLoadDl.c,v 1.16 2006/06/13 22:10:19 dkf Exp $ 13 */ 14 15#include "tclInt.h" 16#ifdef NO_DLFCN_H 17# include "../compat/dlfcn.h" 18#else 19# include <dlfcn.h> 20#endif 21 22/* 23 * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined and this 24 * argument to dlopen must always be 1. The RTLD_GLOBAL flag is needed on some 25 * systems (e.g. SCO and UnixWare) but doesn't exist on others; if it doesn't 26 * exist, set it to 0 so it has no effect. 27 */ 28 29#ifndef RTLD_NOW 30# define RTLD_NOW 1 31#endif 32 33#ifndef RTLD_GLOBAL 34# define RTLD_GLOBAL 0 35#endif 36 37/* 38 *--------------------------------------------------------------------------- 39 * 40 * TclpDlopen -- 41 * 42 * Dynamically loads a binary code file into memory and returns a handle 43 * to the new code. 44 * 45 * Results: 46 * A standard Tcl completion code. If an error occurs, an error message 47 * is left in the interp's result. 48 * 49 * Side effects: 50 * New code suddenly appears in memory. 51 * 52 *--------------------------------------------------------------------------- 53 */ 54 55int 56TclpDlopen( 57 Tcl_Interp *interp, /* Used for error reporting. */ 58 Tcl_Obj *pathPtr, /* Name of the file containing the desired 59 * code (UTF-8). */ 60 Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded 61 * file which will be passed back to 62 * (*unloadProcPtr)() to unload the file. */ 63 Tcl_FSUnloadFileProc **unloadProcPtr) 64 /* Filled with address of Tcl_FSUnloadFileProc 65 * function which should be used for this 66 * file. */ 67{ 68 void *handle; 69 CONST char *native; 70 71 /* 72 * First try the full path the user gave us. This is particularly 73 * important if the cwd is inside a vfs, and we are trying to load using a 74 * relative path. 75 */ 76 77 native = Tcl_FSGetNativePath(pathPtr); 78 handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL); 79 if (handle == NULL) { 80 /* 81 * Let the OS loader examine the binary search path for whatever 82 * string the user gave us which hopefully refers to a file on the 83 * binary path. 84 */ 85 86 Tcl_DString ds; 87 char *fileName = Tcl_GetString(pathPtr); 88 89 native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); 90 handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL); 91 Tcl_DStringFree(&ds); 92 } 93 94 if (handle == NULL) { 95 /* 96 * Write the string to a variable first to work around a compiler bug 97 * in the Sun Forte 6 compiler. [Bug 1503729] 98 */ 99 100 const char *errorStr = dlerror(); 101 102 Tcl_AppendResult(interp, "couldn't load file \"", 103 Tcl_GetString(pathPtr), "\": ", errorStr, NULL); 104 return TCL_ERROR; 105 } 106 107 *unloadProcPtr = &TclpUnloadFile; 108 *loadHandle = (Tcl_LoadHandle) handle; 109 return TCL_OK; 110} 111 112/* 113 *---------------------------------------------------------------------- 114 * 115 * TclpFindSymbol -- 116 * 117 * Looks up a symbol, by name, through a handle associated with a 118 * previously loaded piece of code (shared library). 119 * 120 * Results: 121 * Returns a pointer to the function associated with 'symbol' if it is 122 * found. Otherwise returns NULL and may leave an error message in the 123 * interp's result. 124 * 125 *---------------------------------------------------------------------- 126 */ 127 128Tcl_PackageInitProc * 129TclpFindSymbol( 130 Tcl_Interp *interp, /* Place to put error messages. */ 131 Tcl_LoadHandle loadHandle, /* Value from TcpDlopen(). */ 132 CONST char *symbol) /* Symbol to look up. */ 133{ 134 CONST char *native; 135 Tcl_DString newName, ds; 136 VOID *handle = (VOID*)loadHandle; 137 Tcl_PackageInitProc *proc; 138 139 /* 140 * Some platforms still add an underscore to the beginning of symbol 141 * names. If we can't find a name without an underscore, try again with 142 * the underscore. 143 */ 144 145 native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds); 146 proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */ 147 native); 148 if (proc == NULL) { 149 Tcl_DStringInit(&newName); 150 Tcl_DStringAppend(&newName, "_", 1); 151 native = Tcl_DStringAppend(&newName, native, -1); 152 proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */ 153 native); 154 Tcl_DStringFree(&newName); 155 } 156 Tcl_DStringFree(&ds); 157 158 return proc; 159} 160 161/* 162 *---------------------------------------------------------------------- 163 * 164 * TclpUnloadFile -- 165 * 166 * Unloads a dynamically loaded binary code file from memory. Code 167 * pointers in the formerly loaded file are no longer valid after calling 168 * this function. 169 * 170 * Results: 171 * None. 172 * 173 * Side effects: 174 * Code removed from memory. 175 * 176 *---------------------------------------------------------------------- 177 */ 178 179void 180TclpUnloadFile( 181 Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to 182 * TclpDlopen(). The loadHandle is a token 183 * that represents the loaded file. */ 184{ 185 void *handle; 186 187 handle = (void *) loadHandle; 188 dlclose(handle); 189} 190 191/* 192 *---------------------------------------------------------------------- 193 * 194 * TclGuessPackageName -- 195 * 196 * If the "load" command is invoked without providing a package name, 197 * this procedure is invoked to try to figure it out. 198 * 199 * Results: 200 * Always returns 0 to indicate that we couldn't figure out a package 201 * name; generic code will then try to guess the package from the file 202 * name. A return value of 1 would have meant that we figured out the 203 * package name and put it in bufPtr. 204 * 205 * Side effects: 206 * None. 207 * 208 *---------------------------------------------------------------------- 209 */ 210 211int 212TclGuessPackageName( 213 CONST char *fileName, /* Name of file containing package (already 214 * translated to local form if needed). */ 215 Tcl_DString *bufPtr) /* Initialized empty dstring. Append package 216 * name to this if possible. */ 217{ 218 return 0; 219} 220 221/* 222 * Local Variables: 223 * mode: c 224 * c-basic-offset: 4 225 * fill-column: 78 226 * End: 227 */ 228