1/* 2 * tclLoadDld.c -- 3 * 4 * This procedure provides a version of the TclLoadFile that 5 * works with the "dld_link" and "dld_get_func" library procedures 6 * for dynamic loading. It has been tested on Linux 1.1.95 and 7 * dld-3.2.7. This file probably isn't needed anymore, since it 8 * makes more sense to use "dl_open" etc. 9 * 10 * Copyright (c) 1995-1997 Sun Microsystems, Inc. 11 * 12 * See the file "license.terms" for information on usage and redistribution 13 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 14 * 15 * RCS: @(#) $Id: tclLoadDld.c,v 1.12 2002/10/10 12:25:53 vincentdarley Exp $ 16 */ 17 18#include "tclInt.h" 19#include "dld.h" 20 21/* 22 * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined 23 * and this argument to dlopen must always be 1. 24 */ 25 26#ifndef RTLD_NOW 27# define RTLD_NOW 1 28#endif 29 30/* 31 *---------------------------------------------------------------------- 32 * 33 * TclpDlopen -- 34 * 35 * Dynamically loads a binary code file into memory and returns 36 * a handle to the new code. 37 * 38 * Results: 39 * A standard Tcl completion code. If an error occurs, an error 40 * message is left in the interp's result. 41 * 42 * Side effects: 43 * New code suddenly appears in memory. 44 * 45 *---------------------------------------------------------------------- 46 */ 47 48int 49TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) 50 Tcl_Interp *interp; /* Used for error reporting. */ 51 Tcl_Obj *pathPtr; /* Name of the file containing the desired 52 * code (UTF-8). */ 53 Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded 54 * file which will be passed back to 55 * (*unloadProcPtr)() to unload the file. */ 56 Tcl_FSUnloadFileProc **unloadProcPtr; 57 /* Filled with address of Tcl_FSUnloadFileProc 58 * function which should be used for 59 * this file. */ 60{ 61 static int firstTime = 1; 62 int returnCode; 63 char *fileName; 64 CONST char *native; 65 66 /* 67 * The dld package needs to know the pathname to the tcl binary. 68 * If that's not known, return an error. 69 */ 70 71 if (firstTime) { 72 if (tclExecutableName == NULL) { 73 Tcl_SetResult(interp, 74 "don't know name of application binary file, so can't initialize dynamic loader", 75 TCL_STATIC); 76 return TCL_ERROR; 77 } 78 returnCode = dld_init(tclExecutableName); 79 if (returnCode != 0) { 80 Tcl_AppendResult(interp, 81 "initialization failed for dynamic loader: ", 82 dld_strerror(returnCode), (char *) NULL); 83 return TCL_ERROR; 84 } 85 firstTime = 0; 86 } 87 88 fileName = Tcl_GetString(pathPtr); 89 90 /* 91 * First try the full path the user gave us. This is particularly 92 * important if the cwd is inside a vfs, and we are trying to load 93 * using a relative path. 94 */ 95 native = Tcl_FSGetNativePath(pathPtr); 96 returnCode = dld_link(native); 97 98 if (returnCode != 0) { 99 Tcl_DString ds; 100 native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); 101 returnCode = dld_link(native); 102 Tcl_DStringFree(&ds); 103 } 104 105 if (returnCode != 0) { 106 Tcl_AppendResult(interp, "couldn't load file \"", 107 fileName, "\": ", 108 dld_strerror(returnCode), (char *) NULL); 109 return TCL_ERROR; 110 } 111 *loadHandle = (Tcl_LoadHandle) strcpy( 112 (char *) ckalloc((unsigned) (strlen(fileName) + 1)), fileName); 113 *unloadProcPtr = &TclpUnloadFile; 114 return TCL_OK; 115} 116 117/* 118 *---------------------------------------------------------------------- 119 * 120 * TclpFindSymbol -- 121 * 122 * Looks up a symbol, by name, through a handle associated with 123 * a previously loaded piece of code (shared library). 124 * 125 * Results: 126 * Returns a pointer to the function associated with 'symbol' if 127 * it is found. Otherwise returns NULL and may leave an error 128 * message in the interp's result. 129 * 130 *---------------------------------------------------------------------- 131 */ 132Tcl_PackageInitProc* 133TclpFindSymbol(interp, loadHandle, symbol) 134 Tcl_Interp *interp; 135 Tcl_LoadHandle loadHandle; 136 CONST char *symbol; 137{ 138 return (Tcl_PackageInitProc *) dld_get_func(symbol); 139} 140 141/* 142 *---------------------------------------------------------------------- 143 * 144 * TclpUnloadFile -- 145 * 146 * Unloads a dynamically loaded binary code file from memory. 147 * Code pointers in the formerly loaded file are no longer valid 148 * after calling this function. 149 * 150 * Results: 151 * None. 152 * 153 * Side effects: 154 * Code removed from memory. 155 * 156 *---------------------------------------------------------------------- 157 */ 158 159void 160TclpUnloadFile(loadHandle) 161 Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call 162 * to TclpDlopen(). The loadHandle is 163 * a token that represents the loaded 164 * file. */ 165{ 166 char *fileName; 167 168 handle = (char *) loadHandle; 169 dld_unlink_by_file(handle, 0); 170 ckfree(handle); 171} 172 173/* 174 *---------------------------------------------------------------------- 175 * 176 * TclGuessPackageName -- 177 * 178 * If the "load" command is invoked without providing a package 179 * name, this procedure is invoked to try to figure it out. 180 * 181 * Results: 182 * Always returns 0 to indicate that we couldn't figure out a 183 * package name; generic code will then try to guess the package 184 * from the file name. A return value of 1 would have meant that 185 * we figured out the package name and put it in bufPtr. 186 * 187 * Side effects: 188 * None. 189 * 190 *---------------------------------------------------------------------- 191 */ 192 193int 194TclGuessPackageName(fileName, bufPtr) 195 CONST char *fileName; /* Name of file containing package (already 196 * translated to local form if needed). */ 197 Tcl_DString *bufPtr; /* Initialized empty dstring. Append 198 * package name to this if possible. */ 199{ 200 return 0; 201} 202