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