1/* 2 * tclLoadOSF.c -- 3 * 4 * This procedure provides a version of the TclLoadFile that works 5 * under OSF/1 1.0/1.1/1.2 and related systems, utilizing the old OSF/1 6 * /sbin/loader and /usr/include/loader.h. OSF/1 versions from 1.3 and 7 * on use ELF, rtld, and dlopen()[/usr/include/ldfcn.h]. 8 * 9 * This is useful for: 10 * OSF/1 1.0, 1.1, 1.2 (from OSF) 11 * includes: MK4 and AD1 (from OSF RI) 12 * OSF/1 1.3 (from OSF) using ROSE 13 * HP OSF/1 1.0 ("Acorn") using COFF 14 * 15 * This is likely to be useful for: 16 * Paragon OSF/1 (from Intel) 17 * HI-OSF/1 (from Hitachi) 18 * 19 * This is NOT to be used on: 20 * Digitial Alpha OSF/1 systems 21 * OSF/1 1.3 or later (from OSF) using ELF 22 * includes: MK6, MK7, AD2, AD3 (from OSF RI) 23 * 24 * This approach to things was utter @&^#; thankfully, 25 * OSF/1 eventually supported dlopen(). 26 * 27 * John Robert LoVerso <loverso@freebsd.osf.org> 28 * 29 * Copyright (c) 1995-1997 Sun Microsystems, Inc. 30 * 31 * See the file "license.terms" for information on usage and redistribution 32 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 33 * 34 * RCS: @(#) $Id: tclLoadOSF.c,v 1.11 2002/10/10 12:25:53 vincentdarley Exp $ 35 */ 36 37#include "tclInt.h" 38#include <sys/types.h> 39#include <loader.h> 40 41/* 42 *---------------------------------------------------------------------- 43 * 44 * TclpDlopen -- 45 * 46 * Dynamically loads a binary code file into memory and returns 47 * a handle to the new code. 48 * 49 * Results: 50 * A standard Tcl completion code. If an error occurs, an error 51 * message is left in the interp's result. 52 * 53 * Side effects: 54 * New code suddenly appears in memory. 55 * 56 *---------------------------------------------------------------------- 57 */ 58 59int 60TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) 61 Tcl_Interp *interp; /* Used for error reporting. */ 62 Tcl_Obj *pathPtr; /* Name of the file containing the desired 63 * code (UTF-8). */ 64 Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded 65 * file which will be passed back to 66 * (*unloadProcPtr)() to unload the file. */ 67 Tcl_FSUnloadFileProc **unloadProcPtr; 68 /* Filled with address of Tcl_FSUnloadFileProc 69 * function which should be used for 70 * this file. */ 71{ 72 ldr_module_t lm; 73 char *pkg; 74 char *fileName = Tcl_GetString(pathPtr); 75 CONST char *native; 76 77 /* 78 * First try the full path the user gave us. This is particularly 79 * important if the cwd is inside a vfs, and we are trying to load 80 * using a relative path. 81 */ 82 native = Tcl_FSGetNativePath(pathPtr); 83 lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS); 84 85 if (lm == LDR_NULL_MODULE) { 86 /* 87 * Let the OS loader examine the binary search path for 88 * whatever string the user gave us which hopefully refers 89 * to a file on the binary path 90 */ 91 Tcl_DString ds; 92 native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); 93 lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS); 94 Tcl_DStringFree(&ds); 95 } 96 97 if (lm == LDR_NULL_MODULE) { 98 Tcl_AppendResult(interp, "couldn't load file \"", fileName, 99 "\": ", Tcl_PosixError (interp), (char *) NULL); 100 return TCL_ERROR; 101 } 102 103 *clientDataPtr = NULL; 104 105 /* 106 * My convention is to use a [OSF loader] package name the same as shlib, 107 * since the idiots never implemented ldr_lookup() and it is otherwise 108 * impossible to get a package name given a module. 109 * 110 * I build loadable modules with a makefile rule like 111 * ld ... -export $@: -o $@ $(OBJS) 112 */ 113 if ((pkg = strrchr(fileName, '/')) == NULL) { 114 pkg = fileName; 115 } else { 116 pkg++; 117 } 118 *loadHandle = pkg; 119 *unloadProcPtr = &TclpUnloadFile; 120 return TCL_OK; 121} 122 123/* 124 *---------------------------------------------------------------------- 125 * 126 * TclpFindSymbol -- 127 * 128 * Looks up a symbol, by name, through a handle associated with 129 * a previously loaded piece of code (shared library). 130 * 131 * Results: 132 * Returns a pointer to the function associated with 'symbol' if 133 * it is found. Otherwise returns NULL and may leave an error 134 * message in the interp's result. 135 * 136 *---------------------------------------------------------------------- 137 */ 138Tcl_PackageInitProc* 139TclpFindSymbol(interp, loadHandle, symbol) 140 Tcl_Interp *interp; 141 Tcl_LoadHandle loadHandle; 142 CONST char *symbol; 143{ 144 return ldr_lookup_package((char *)loadHandle, symbol); 145} 146 147/* 148 *---------------------------------------------------------------------- 149 * 150 * TclpUnloadFile -- 151 * 152 * Unloads a dynamically loaded binary code file from memory. 153 * Code pointers in the formerly loaded file are no longer valid 154 * after calling this function. 155 * 156 * Results: 157 * None. 158 * 159 * Side effects: 160 * Does nothing. Can anything be done? 161 * 162 *---------------------------------------------------------------------- 163 */ 164 165void 166TclpUnloadFile(loadHandle) 167 Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call 168 * to TclpDlopen(). The loadHandle is 169 * a token that represents the loaded 170 * file. */ 171{ 172} 173 174/* 175 *---------------------------------------------------------------------- 176 * 177 * TclGuessPackageName -- 178 * 179 * If the "load" command is invoked without providing a package 180 * name, this procedure is invoked to try to figure it out. 181 * 182 * Results: 183 * Always returns 0 to indicate that we couldn't figure out a 184 * package name; generic code will then try to guess the package 185 * from the file name. A return value of 1 would have meant that 186 * we figured out the package name and put it in bufPtr. 187 * 188 * Side effects: 189 * None. 190 * 191 *---------------------------------------------------------------------- 192 */ 193 194int 195TclGuessPackageName(fileName, bufPtr) 196 CONST char *fileName; /* Name of file containing package (already 197 * translated to local form if needed). */ 198 Tcl_DString *bufPtr; /* Initialized empty dstring. Append 199 * package name to this if possible. */ 200{ 201 return 0; 202} 203