1 |
/*$Header$ */ |
/* $Header$ */ |
2 |
/* |
/* |
3 |
* tclLoad.c -- |
* tclLoad.c -- |
4 |
* |
* |
5 |
* This file provides the generic portion (those that are the same |
* This file provides the generic portion (those that are the same |
6 |
* on all platforms) of Tcl's dynamic loading facilities. |
* on all platforms) of Tcl's dynamic loading facilities. |
7 |
* |
* |
8 |
* Copyright (c) 1995-1997 Sun Microsystems, Inc. |
* Copyright (c) 1995-1997 Sun Microsystems, Inc. |
9 |
* |
* |
10 |
* See the file "license.terms" for information on usage and redistribution |
* See the file "license.terms" for information on usage and redistribution |
11 |
* of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
* of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
12 |
* |
* |
13 |
* RCS: @(#) $Id: tclload.c,v 1.1.1.1 2001/06/13 04:42:55 dtashley Exp $ |
* RCS: @(#) $Id: tclload.c,v 1.1.1.1 2001/06/13 04:42:55 dtashley Exp $ |
14 |
*/ |
*/ |
15 |
|
|
16 |
#include "tclInt.h" |
#include "tclInt.h" |
17 |
|
|
18 |
/* |
/* |
19 |
* The following structure describes a package that has been loaded |
* The following structure describes a package that has been loaded |
20 |
* either dynamically (with the "load" command) or statically (as |
* either dynamically (with the "load" command) or statically (as |
21 |
* indicated by a call to TclGetLoadedPackages). All such packages |
* indicated by a call to TclGetLoadedPackages). All such packages |
22 |
* are linked together into a single list for the process. Packages |
* are linked together into a single list for the process. Packages |
23 |
* are never unloaded, so these structures are never freed. |
* are never unloaded, so these structures are never freed. |
24 |
*/ |
*/ |
25 |
|
|
26 |
typedef struct LoadedPackage { |
typedef struct LoadedPackage { |
27 |
char *fileName; /* Name of the file from which the |
char *fileName; /* Name of the file from which the |
28 |
* package was loaded. An empty string |
* package was loaded. An empty string |
29 |
* means the package is loaded statically. |
* means the package is loaded statically. |
30 |
* Malloc-ed. */ |
* Malloc-ed. */ |
31 |
char *packageName; /* Name of package prefix for the package, |
char *packageName; /* Name of package prefix for the package, |
32 |
* properly capitalized (first letter UC, |
* properly capitalized (first letter UC, |
33 |
* others LC), no "_", as in "Net". |
* others LC), no "_", as in "Net". |
34 |
* Malloc-ed. */ |
* Malloc-ed. */ |
35 |
ClientData clientData; /* Token for the loaded file which should be |
ClientData clientData; /* Token for the loaded file which should be |
36 |
* passed to TclpUnloadFile() when the file |
* passed to TclpUnloadFile() when the file |
37 |
* is no longer needed. If fileName is NULL, |
* is no longer needed. If fileName is NULL, |
38 |
* then this field is irrelevant. */ |
* then this field is irrelevant. */ |
39 |
Tcl_PackageInitProc *initProc; |
Tcl_PackageInitProc *initProc; |
40 |
/* Initialization procedure to call to |
/* Initialization procedure to call to |
41 |
* incorporate this package into a trusted |
* incorporate this package into a trusted |
42 |
* interpreter. */ |
* interpreter. */ |
43 |
Tcl_PackageInitProc *safeInitProc; |
Tcl_PackageInitProc *safeInitProc; |
44 |
/* Initialization procedure to call to |
/* Initialization procedure to call to |
45 |
* incorporate this package into a safe |
* incorporate this package into a safe |
46 |
* interpreter (one that will execute |
* interpreter (one that will execute |
47 |
* untrusted scripts). NULL means the |
* untrusted scripts). NULL means the |
48 |
* package can't be used in unsafe |
* package can't be used in unsafe |
49 |
* interpreters. */ |
* interpreters. */ |
50 |
struct LoadedPackage *nextPtr; |
struct LoadedPackage *nextPtr; |
51 |
/* Next in list of all packages loaded into |
/* Next in list of all packages loaded into |
52 |
* this application process. NULL means |
* this application process. NULL means |
53 |
* end of list. */ |
* end of list. */ |
54 |
} LoadedPackage; |
} LoadedPackage; |
55 |
|
|
56 |
/* |
/* |
57 |
* TCL_THREADS |
* TCL_THREADS |
58 |
* There is a global list of packages that is anchored at firstPackagePtr. |
* There is a global list of packages that is anchored at firstPackagePtr. |
59 |
* Access to this list is governed by a mutex. |
* Access to this list is governed by a mutex. |
60 |
*/ |
*/ |
61 |
|
|
62 |
static LoadedPackage *firstPackagePtr = NULL; |
static LoadedPackage *firstPackagePtr = NULL; |
63 |
/* First in list of all packages loaded into |
/* First in list of all packages loaded into |
64 |
* this process. */ |
* this process. */ |
65 |
|
|
66 |
TCL_DECLARE_MUTEX(packageMutex) |
TCL_DECLARE_MUTEX(packageMutex) |
67 |
|
|
68 |
/* |
/* |
69 |
* The following structure represents a particular package that has |
* The following structure represents a particular package that has |
70 |
* been incorporated into a particular interpreter (by calling its |
* been incorporated into a particular interpreter (by calling its |
71 |
* initialization procedure). There is a list of these structures for |
* initialization procedure). There is a list of these structures for |
72 |
* each interpreter, with an AssocData value (key "load") for the |
* each interpreter, with an AssocData value (key "load") for the |
73 |
* interpreter that points to the first package (if any). |
* interpreter that points to the first package (if any). |
74 |
*/ |
*/ |
75 |
|
|
76 |
typedef struct InterpPackage { |
typedef struct InterpPackage { |
77 |
LoadedPackage *pkgPtr; /* Points to detailed information about |
LoadedPackage *pkgPtr; /* Points to detailed information about |
78 |
* package. */ |
* package. */ |
79 |
struct InterpPackage *nextPtr; |
struct InterpPackage *nextPtr; |
80 |
/* Next package in this interpreter, or |
/* Next package in this interpreter, or |
81 |
* NULL for end of list. */ |
* NULL for end of list. */ |
82 |
} InterpPackage; |
} InterpPackage; |
83 |
|
|
84 |
/* |
/* |
85 |
* Prototypes for procedures that are private to this file: |
* Prototypes for procedures that are private to this file: |
86 |
*/ |
*/ |
87 |
|
|
88 |
static void LoadCleanupProc _ANSI_ARGS_((ClientData clientData, |
static void LoadCleanupProc _ANSI_ARGS_((ClientData clientData, |
89 |
Tcl_Interp *interp)); |
Tcl_Interp *interp)); |
90 |
|
|
91 |
/* |
/* |
92 |
*---------------------------------------------------------------------- |
*---------------------------------------------------------------------- |
93 |
* |
* |
94 |
* Tcl_LoadObjCmd -- |
* Tcl_LoadObjCmd -- |
95 |
* |
* |
96 |
* This procedure is invoked to process the "load" Tcl command. |
* This procedure is invoked to process the "load" Tcl command. |
97 |
* See the user documentation for details on what it does. |
* See the user documentation for details on what it does. |
98 |
* |
* |
99 |
* Results: |
* Results: |
100 |
* A standard Tcl result. |
* A standard Tcl result. |
101 |
* |
* |
102 |
* Side effects: |
* Side effects: |
103 |
* See the user documentation. |
* See the user documentation. |
104 |
* |
* |
105 |
*---------------------------------------------------------------------- |
*---------------------------------------------------------------------- |
106 |
*/ |
*/ |
107 |
|
|
108 |
int |
int |
109 |
Tcl_LoadObjCmd(dummy, interp, objc, objv) |
Tcl_LoadObjCmd(dummy, interp, objc, objv) |
110 |
ClientData dummy; /* Not used. */ |
ClientData dummy; /* Not used. */ |
111 |
Tcl_Interp *interp; /* Current interpreter. */ |
Tcl_Interp *interp; /* Current interpreter. */ |
112 |
int objc; /* Number of arguments. */ |
int objc; /* Number of arguments. */ |
113 |
Tcl_Obj *CONST objv[]; /* Argument objects. */ |
Tcl_Obj *CONST objv[]; /* Argument objects. */ |
114 |
{ |
{ |
115 |
Tcl_Interp *target; |
Tcl_Interp *target; |
116 |
LoadedPackage *pkgPtr, *defaultPtr; |
LoadedPackage *pkgPtr, *defaultPtr; |
117 |
Tcl_DString pkgName, tmp, initName, safeInitName, fileName; |
Tcl_DString pkgName, tmp, initName, safeInitName, fileName; |
118 |
Tcl_PackageInitProc *initProc, *safeInitProc; |
Tcl_PackageInitProc *initProc, *safeInitProc; |
119 |
InterpPackage *ipFirstPtr, *ipPtr; |
InterpPackage *ipFirstPtr, *ipPtr; |
120 |
int code, namesMatch, filesMatch; |
int code, namesMatch, filesMatch; |
121 |
char *p, *tempString, *fullFileName, *packageName; |
char *p, *tempString, *fullFileName, *packageName; |
122 |
ClientData clientData; |
ClientData clientData; |
123 |
Tcl_UniChar ch; |
Tcl_UniChar ch; |
124 |
int offset; |
int offset; |
125 |
|
|
126 |
if ((objc < 2) || (objc > 4)) { |
if ((objc < 2) || (objc > 4)) { |
127 |
Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?"); |
Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?"); |
128 |
return TCL_ERROR; |
return TCL_ERROR; |
129 |
} |
} |
130 |
tempString = Tcl_GetString(objv[1]); |
tempString = Tcl_GetString(objv[1]); |
131 |
fullFileName = Tcl_TranslateFileName(interp, tempString, &fileName); |
fullFileName = Tcl_TranslateFileName(interp, tempString, &fileName); |
132 |
if (fullFileName == NULL) { |
if (fullFileName == NULL) { |
133 |
return TCL_ERROR; |
return TCL_ERROR; |
134 |
} |
} |
135 |
Tcl_DStringInit(&pkgName); |
Tcl_DStringInit(&pkgName); |
136 |
Tcl_DStringInit(&initName); |
Tcl_DStringInit(&initName); |
137 |
Tcl_DStringInit(&safeInitName); |
Tcl_DStringInit(&safeInitName); |
138 |
Tcl_DStringInit(&tmp); |
Tcl_DStringInit(&tmp); |
139 |
|
|
140 |
packageName = NULL; |
packageName = NULL; |
141 |
if (objc >= 3) { |
if (objc >= 3) { |
142 |
packageName = Tcl_GetString(objv[2]); |
packageName = Tcl_GetString(objv[2]); |
143 |
if (packageName[0] == '\0') { |
if (packageName[0] == '\0') { |
144 |
packageName = NULL; |
packageName = NULL; |
145 |
} |
} |
146 |
} |
} |
147 |
if ((fullFileName[0] == 0) && (packageName == NULL)) { |
if ((fullFileName[0] == 0) && (packageName == NULL)) { |
148 |
Tcl_SetResult(interp, |
Tcl_SetResult(interp, |
149 |
"must specify either file name or package name", |
"must specify either file name or package name", |
150 |
TCL_STATIC); |
TCL_STATIC); |
151 |
code = TCL_ERROR; |
code = TCL_ERROR; |
152 |
goto done; |
goto done; |
153 |
} |
} |
154 |
|
|
155 |
/* |
/* |
156 |
* Figure out which interpreter we're going to load the package into. |
* Figure out which interpreter we're going to load the package into. |
157 |
*/ |
*/ |
158 |
|
|
159 |
target = interp; |
target = interp; |
160 |
if (objc == 4) { |
if (objc == 4) { |
161 |
char *slaveIntName; |
char *slaveIntName; |
162 |
slaveIntName = Tcl_GetString(objv[3]); |
slaveIntName = Tcl_GetString(objv[3]); |
163 |
target = Tcl_GetSlave(interp, slaveIntName); |
target = Tcl_GetSlave(interp, slaveIntName); |
164 |
if (target == NULL) { |
if (target == NULL) { |
165 |
return TCL_ERROR; |
return TCL_ERROR; |
166 |
} |
} |
167 |
} |
} |
168 |
|
|
169 |
/* |
/* |
170 |
* Scan through the packages that are currently loaded to see if the |
* Scan through the packages that are currently loaded to see if the |
171 |
* package we want is already loaded. We'll use a loaded package if |
* package we want is already loaded. We'll use a loaded package if |
172 |
* it meets any of the following conditions: |
* it meets any of the following conditions: |
173 |
* - Its name and file match the once we're looking for. |
* - Its name and file match the once we're looking for. |
174 |
* - Its file matches, and we weren't given a name. |
* - Its file matches, and we weren't given a name. |
175 |
* - Its name matches, the file name was specified as empty, and there |
* - Its name matches, the file name was specified as empty, and there |
176 |
* is only no statically loaded package with the same name. |
* is only no statically loaded package with the same name. |
177 |
*/ |
*/ |
178 |
Tcl_MutexLock(&packageMutex); |
Tcl_MutexLock(&packageMutex); |
179 |
|
|
180 |
defaultPtr = NULL; |
defaultPtr = NULL; |
181 |
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { |
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { |
182 |
if (packageName == NULL) { |
if (packageName == NULL) { |
183 |
namesMatch = 0; |
namesMatch = 0; |
184 |
} else { |
} else { |
185 |
Tcl_DStringSetLength(&pkgName, 0); |
Tcl_DStringSetLength(&pkgName, 0); |
186 |
Tcl_DStringAppend(&pkgName, packageName, -1); |
Tcl_DStringAppend(&pkgName, packageName, -1); |
187 |
Tcl_DStringSetLength(&tmp, 0); |
Tcl_DStringSetLength(&tmp, 0); |
188 |
Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); |
Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); |
189 |
Tcl_UtfToLower(Tcl_DStringValue(&pkgName)); |
Tcl_UtfToLower(Tcl_DStringValue(&pkgName)); |
190 |
Tcl_UtfToLower(Tcl_DStringValue(&tmp)); |
Tcl_UtfToLower(Tcl_DStringValue(&tmp)); |
191 |
if (strcmp(Tcl_DStringValue(&tmp), |
if (strcmp(Tcl_DStringValue(&tmp), |
192 |
Tcl_DStringValue(&pkgName)) == 0) { |
Tcl_DStringValue(&pkgName)) == 0) { |
193 |
namesMatch = 1; |
namesMatch = 1; |
194 |
} else { |
} else { |
195 |
namesMatch = 0; |
namesMatch = 0; |
196 |
} |
} |
197 |
} |
} |
198 |
Tcl_DStringSetLength(&pkgName, 0); |
Tcl_DStringSetLength(&pkgName, 0); |
199 |
|
|
200 |
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); |
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); |
201 |
if (filesMatch && (namesMatch || (packageName == NULL))) { |
if (filesMatch && (namesMatch || (packageName == NULL))) { |
202 |
break; |
break; |
203 |
} |
} |
204 |
if (namesMatch && (fullFileName[0] == 0)) { |
if (namesMatch && (fullFileName[0] == 0)) { |
205 |
defaultPtr = pkgPtr; |
defaultPtr = pkgPtr; |
206 |
} |
} |
207 |
if (filesMatch && !namesMatch && (fullFileName[0] != 0)) { |
if (filesMatch && !namesMatch && (fullFileName[0] != 0)) { |
208 |
/* |
/* |
209 |
* Can't have two different packages loaded from the same |
* Can't have two different packages loaded from the same |
210 |
* file. |
* file. |
211 |
*/ |
*/ |
212 |
|
|
213 |
Tcl_AppendResult(interp, "file \"", fullFileName, |
Tcl_AppendResult(interp, "file \"", fullFileName, |
214 |
"\" is already loaded for package \"", |
"\" is already loaded for package \"", |
215 |
pkgPtr->packageName, "\"", (char *) NULL); |
pkgPtr->packageName, "\"", (char *) NULL); |
216 |
code = TCL_ERROR; |
code = TCL_ERROR; |
217 |
Tcl_MutexUnlock(&packageMutex); |
Tcl_MutexUnlock(&packageMutex); |
218 |
goto done; |
goto done; |
219 |
} |
} |
220 |
} |
} |
221 |
Tcl_MutexUnlock(&packageMutex); |
Tcl_MutexUnlock(&packageMutex); |
222 |
if (pkgPtr == NULL) { |
if (pkgPtr == NULL) { |
223 |
pkgPtr = defaultPtr; |
pkgPtr = defaultPtr; |
224 |
} |
} |
225 |
|
|
226 |
/* |
/* |
227 |
* Scan through the list of packages already loaded in the target |
* Scan through the list of packages already loaded in the target |
228 |
* interpreter. If the package we want is already loaded there, |
* interpreter. If the package we want is already loaded there, |
229 |
* then there's nothing for us to to. |
* then there's nothing for us to to. |
230 |
*/ |
*/ |
231 |
|
|
232 |
if (pkgPtr != NULL) { |
if (pkgPtr != NULL) { |
233 |
ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", |
ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", |
234 |
(Tcl_InterpDeleteProc **) NULL); |
(Tcl_InterpDeleteProc **) NULL); |
235 |
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { |
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { |
236 |
if (ipPtr->pkgPtr == pkgPtr) { |
if (ipPtr->pkgPtr == pkgPtr) { |
237 |
code = TCL_OK; |
code = TCL_OK; |
238 |
goto done; |
goto done; |
239 |
} |
} |
240 |
} |
} |
241 |
} |
} |
242 |
|
|
243 |
if (pkgPtr == NULL) { |
if (pkgPtr == NULL) { |
244 |
/* |
/* |
245 |
* The desired file isn't currently loaded, so load it. It's an |
* The desired file isn't currently loaded, so load it. It's an |
246 |
* error if the desired package is a static one. |
* error if the desired package is a static one. |
247 |
*/ |
*/ |
248 |
|
|
249 |
if (fullFileName[0] == 0) { |
if (fullFileName[0] == 0) { |
250 |
Tcl_AppendResult(interp, "package \"", packageName, |
Tcl_AppendResult(interp, "package \"", packageName, |
251 |
"\" isn't loaded statically", (char *) NULL); |
"\" isn't loaded statically", (char *) NULL); |
252 |
code = TCL_ERROR; |
code = TCL_ERROR; |
253 |
goto done; |
goto done; |
254 |
} |
} |
255 |
|
|
256 |
/* |
/* |
257 |
* Figure out the module name if it wasn't provided explicitly. |
* Figure out the module name if it wasn't provided explicitly. |
258 |
*/ |
*/ |
259 |
|
|
260 |
if (packageName != NULL) { |
if (packageName != NULL) { |
261 |
Tcl_DStringAppend(&pkgName, packageName, -1); |
Tcl_DStringAppend(&pkgName, packageName, -1); |
262 |
} else { |
} else { |
263 |
int retc; |
int retc; |
264 |
/* |
/* |
265 |
* Threading note - this call used to be protected by a mutex. |
* Threading note - this call used to be protected by a mutex. |
266 |
*/ |
*/ |
267 |
retc = TclGuessPackageName(fullFileName, &pkgName); |
retc = TclGuessPackageName(fullFileName, &pkgName); |
268 |
if (!retc) { |
if (!retc) { |
269 |
int pargc; |
int pargc; |
270 |
char **pargv, *pkgGuess; |
char **pargv, *pkgGuess; |
271 |
|
|
272 |
/* |
/* |
273 |
* The platform-specific code couldn't figure out the |
* The platform-specific code couldn't figure out the |
274 |
* module name. Make a guess by taking the last element |
* module name. Make a guess by taking the last element |
275 |
* of the file name, stripping off any leading "lib", |
* of the file name, stripping off any leading "lib", |
276 |
* and then using all of the alphabetic and underline |
* and then using all of the alphabetic and underline |
277 |
* characters that follow that. |
* characters that follow that. |
278 |
*/ |
*/ |
279 |
|
|
280 |
Tcl_SplitPath(fullFileName, &pargc, &pargv); |
Tcl_SplitPath(fullFileName, &pargc, &pargv); |
281 |
pkgGuess = pargv[pargc-1]; |
pkgGuess = pargv[pargc-1]; |
282 |
if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i') |
if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i') |
283 |
&& (pkgGuess[2] == 'b')) { |
&& (pkgGuess[2] == 'b')) { |
284 |
pkgGuess += 3; |
pkgGuess += 3; |
285 |
} |
} |
286 |
for (p = pkgGuess; *p != 0; p += offset) { |
for (p = pkgGuess; *p != 0; p += offset) { |
287 |
offset = Tcl_UtfToUniChar(p, &ch); |
offset = Tcl_UtfToUniChar(p, &ch); |
288 |
if ((ch > 0x100) |
if ((ch > 0x100) |
289 |
|| !(isalpha(UCHAR(ch)) /* INTL: ISO only */ |
|| !(isalpha(UCHAR(ch)) /* INTL: ISO only */ |
290 |
|| (UCHAR(ch) == '_'))) { |
|| (UCHAR(ch) == '_'))) { |
291 |
break; |
break; |
292 |
} |
} |
293 |
} |
} |
294 |
if (p == pkgGuess) { |
if (p == pkgGuess) { |
295 |
ckfree((char *)pargv); |
ckfree((char *)pargv); |
296 |
Tcl_AppendResult(interp, |
Tcl_AppendResult(interp, |
297 |
"couldn't figure out package name for ", |
"couldn't figure out package name for ", |
298 |
fullFileName, (char *) NULL); |
fullFileName, (char *) NULL); |
299 |
code = TCL_ERROR; |
code = TCL_ERROR; |
300 |
goto done; |
goto done; |
301 |
} |
} |
302 |
Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess)); |
Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess)); |
303 |
ckfree((char *)pargv); |
ckfree((char *)pargv); |
304 |
} |
} |
305 |
} |
} |
306 |
|
|
307 |
/* |
/* |
308 |
* Fix the capitalization in the package name so that the first |
* Fix the capitalization in the package name so that the first |
309 |
* character is in caps (or title case) but the others are all |
* character is in caps (or title case) but the others are all |
310 |
* lower-case. |
* lower-case. |
311 |
*/ |
*/ |
312 |
|
|
313 |
Tcl_DStringSetLength(&pkgName, |
Tcl_DStringSetLength(&pkgName, |
314 |
Tcl_UtfToTitle(Tcl_DStringValue(&pkgName))); |
Tcl_UtfToTitle(Tcl_DStringValue(&pkgName))); |
315 |
|
|
316 |
/* |
/* |
317 |
* Compute the names of the two initialization procedures, |
* Compute the names of the two initialization procedures, |
318 |
* based on the package name. |
* based on the package name. |
319 |
*/ |
*/ |
320 |
|
|
321 |
Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1); |
Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1); |
322 |
Tcl_DStringAppend(&initName, "_Init", 5); |
Tcl_DStringAppend(&initName, "_Init", 5); |
323 |
Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1); |
Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1); |
324 |
Tcl_DStringAppend(&safeInitName, "_SafeInit", 9); |
Tcl_DStringAppend(&safeInitName, "_SafeInit", 9); |
325 |
|
|
326 |
/* |
/* |
327 |
* Call platform-specific code to load the package and find the |
* Call platform-specific code to load the package and find the |
328 |
* two initialization procedures. |
* two initialization procedures. |
329 |
*/ |
*/ |
330 |
|
|
331 |
Tcl_MutexLock(&packageMutex); |
Tcl_MutexLock(&packageMutex); |
332 |
code = TclpLoadFile(interp, fullFileName, Tcl_DStringValue(&initName), |
code = TclpLoadFile(interp, fullFileName, Tcl_DStringValue(&initName), |
333 |
Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc, |
Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc, |
334 |
&clientData); |
&clientData); |
335 |
Tcl_MutexUnlock(&packageMutex); |
Tcl_MutexUnlock(&packageMutex); |
336 |
if (code != TCL_OK) { |
if (code != TCL_OK) { |
337 |
goto done; |
goto done; |
338 |
} |
} |
339 |
if (initProc == NULL) { |
if (initProc == NULL) { |
340 |
Tcl_AppendResult(interp, "couldn't find procedure ", |
Tcl_AppendResult(interp, "couldn't find procedure ", |
341 |
Tcl_DStringValue(&initName), (char *) NULL); |
Tcl_DStringValue(&initName), (char *) NULL); |
342 |
TclpUnloadFile(clientData); |
TclpUnloadFile(clientData); |
343 |
code = TCL_ERROR; |
code = TCL_ERROR; |
344 |
goto done; |
goto done; |
345 |
} |
} |
346 |
|
|
347 |
/* |
/* |
348 |
* Create a new record to describe this package. |
* Create a new record to describe this package. |
349 |
*/ |
*/ |
350 |
|
|
351 |
pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage)); |
pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage)); |
352 |
pkgPtr->fileName = (char *) ckalloc((unsigned) |
pkgPtr->fileName = (char *) ckalloc((unsigned) |
353 |
(strlen(fullFileName) + 1)); |
(strlen(fullFileName) + 1)); |
354 |
strcpy(pkgPtr->fileName, fullFileName); |
strcpy(pkgPtr->fileName, fullFileName); |
355 |
pkgPtr->packageName = (char *) ckalloc((unsigned) |
pkgPtr->packageName = (char *) ckalloc((unsigned) |
356 |
(Tcl_DStringLength(&pkgName) + 1)); |
(Tcl_DStringLength(&pkgName) + 1)); |
357 |
strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName)); |
strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName)); |
358 |
pkgPtr->clientData = clientData; |
pkgPtr->clientData = clientData; |
359 |
pkgPtr->initProc = initProc; |
pkgPtr->initProc = initProc; |
360 |
pkgPtr->safeInitProc = safeInitProc; |
pkgPtr->safeInitProc = safeInitProc; |
361 |
Tcl_MutexLock(&packageMutex); |
Tcl_MutexLock(&packageMutex); |
362 |
pkgPtr->nextPtr = firstPackagePtr; |
pkgPtr->nextPtr = firstPackagePtr; |
363 |
firstPackagePtr = pkgPtr; |
firstPackagePtr = pkgPtr; |
364 |
Tcl_MutexUnlock(&packageMutex); |
Tcl_MutexUnlock(&packageMutex); |
365 |
} |
} |
366 |
|
|
367 |
/* |
/* |
368 |
* Invoke the package's initialization procedure (either the |
* Invoke the package's initialization procedure (either the |
369 |
* normal one or the safe one, depending on whether or not the |
* normal one or the safe one, depending on whether or not the |
370 |
* interpreter is safe). |
* interpreter is safe). |
371 |
*/ |
*/ |
372 |
|
|
373 |
if (Tcl_IsSafe(target)) { |
if (Tcl_IsSafe(target)) { |
374 |
if (pkgPtr->safeInitProc != NULL) { |
if (pkgPtr->safeInitProc != NULL) { |
375 |
code = (*pkgPtr->safeInitProc)(target); |
code = (*pkgPtr->safeInitProc)(target); |
376 |
} else { |
} else { |
377 |
Tcl_AppendResult(interp, |
Tcl_AppendResult(interp, |
378 |
"can't use package in a safe interpreter: ", |
"can't use package in a safe interpreter: ", |
379 |
"no ", pkgPtr->packageName, "_SafeInit procedure", |
"no ", pkgPtr->packageName, "_SafeInit procedure", |
380 |
(char *) NULL); |
(char *) NULL); |
381 |
code = TCL_ERROR; |
code = TCL_ERROR; |
382 |
goto done; |
goto done; |
383 |
} |
} |
384 |
} else { |
} else { |
385 |
code = (*pkgPtr->initProc)(target); |
code = (*pkgPtr->initProc)(target); |
386 |
} |
} |
387 |
|
|
388 |
/* |
/* |
389 |
* Record the fact that the package has been loaded in the |
* Record the fact that the package has been loaded in the |
390 |
* target interpreter. |
* target interpreter. |
391 |
*/ |
*/ |
392 |
|
|
393 |
if (code == TCL_OK) { |
if (code == TCL_OK) { |
394 |
/* |
/* |
395 |
* Refetch ipFirstPtr: loading the package may have introduced |
* Refetch ipFirstPtr: loading the package may have introduced |
396 |
* additional static packages at the head of the linked list! |
* additional static packages at the head of the linked list! |
397 |
*/ |
*/ |
398 |
|
|
399 |
ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", |
ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", |
400 |
(Tcl_InterpDeleteProc **) NULL); |
(Tcl_InterpDeleteProc **) NULL); |
401 |
ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage)); |
ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage)); |
402 |
ipPtr->pkgPtr = pkgPtr; |
ipPtr->pkgPtr = pkgPtr; |
403 |
ipPtr->nextPtr = ipFirstPtr; |
ipPtr->nextPtr = ipFirstPtr; |
404 |
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, |
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, |
405 |
(ClientData) ipPtr); |
(ClientData) ipPtr); |
406 |
} else { |
} else { |
407 |
TclTransferResult(target, code, interp); |
TclTransferResult(target, code, interp); |
408 |
} |
} |
409 |
|
|
410 |
done: |
done: |
411 |
Tcl_DStringFree(&pkgName); |
Tcl_DStringFree(&pkgName); |
412 |
Tcl_DStringFree(&initName); |
Tcl_DStringFree(&initName); |
413 |
Tcl_DStringFree(&safeInitName); |
Tcl_DStringFree(&safeInitName); |
414 |
Tcl_DStringFree(&fileName); |
Tcl_DStringFree(&fileName); |
415 |
Tcl_DStringFree(&tmp); |
Tcl_DStringFree(&tmp); |
416 |
return code; |
return code; |
417 |
} |
} |
418 |
|
|
419 |
/* |
/* |
420 |
*---------------------------------------------------------------------- |
*---------------------------------------------------------------------- |
421 |
* |
* |
422 |
* Tcl_StaticPackage -- |
* Tcl_StaticPackage -- |
423 |
* |
* |
424 |
* This procedure is invoked to indicate that a particular |
* This procedure is invoked to indicate that a particular |
425 |
* package has been linked statically with an application. |
* package has been linked statically with an application. |
426 |
* |
* |
427 |
* Results: |
* Results: |
428 |
* None. |
* None. |
429 |
* |
* |
430 |
* Side effects: |
* Side effects: |
431 |
* Once this procedure completes, the package becomes loadable |
* Once this procedure completes, the package becomes loadable |
432 |
* via the "load" command with an empty file name. |
* via the "load" command with an empty file name. |
433 |
* |
* |
434 |
*---------------------------------------------------------------------- |
*---------------------------------------------------------------------- |
435 |
*/ |
*/ |
436 |
|
|
437 |
void |
void |
438 |
Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc) |
Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc) |
439 |
Tcl_Interp *interp; /* If not NULL, it means that the |
Tcl_Interp *interp; /* If not NULL, it means that the |
440 |
* package has already been loaded |
* package has already been loaded |
441 |
* into the given interpreter by |
* into the given interpreter by |
442 |
* calling the appropriate init proc. */ |
* calling the appropriate init proc. */ |
443 |
char *pkgName; /* Name of package (must be properly |
char *pkgName; /* Name of package (must be properly |
444 |
* capitalized: first letter upper |
* capitalized: first letter upper |
445 |
* case, others lower case). */ |
* case, others lower case). */ |
446 |
Tcl_PackageInitProc *initProc; /* Procedure to call to incorporate |
Tcl_PackageInitProc *initProc; /* Procedure to call to incorporate |
447 |
* this package into a trusted |
* this package into a trusted |
448 |
* interpreter. */ |
* interpreter. */ |
449 |
Tcl_PackageInitProc *safeInitProc; /* Procedure to call to incorporate |
Tcl_PackageInitProc *safeInitProc; /* Procedure to call to incorporate |
450 |
* this package into a safe interpreter |
* this package into a safe interpreter |
451 |
* (one that will execute untrusted |
* (one that will execute untrusted |
452 |
* scripts). NULL means the package |
* scripts). NULL means the package |
453 |
* can't be used in safe |
* can't be used in safe |
454 |
* interpreters. */ |
* interpreters. */ |
455 |
{ |
{ |
456 |
LoadedPackage *pkgPtr; |
LoadedPackage *pkgPtr; |
457 |
InterpPackage *ipPtr, *ipFirstPtr; |
InterpPackage *ipPtr, *ipFirstPtr; |
458 |
|
|
459 |
/* |
/* |
460 |
* Check to see if someone else has already reported this package as |
* Check to see if someone else has already reported this package as |
461 |
* statically loaded. If this call is redundant then just return. |
* statically loaded. If this call is redundant then just return. |
462 |
*/ |
*/ |
463 |
|
|
464 |
Tcl_MutexLock(&packageMutex); |
Tcl_MutexLock(&packageMutex); |
465 |
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { |
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { |
466 |
if ((pkgPtr->initProc == initProc) |
if ((pkgPtr->initProc == initProc) |
467 |
&& (pkgPtr->safeInitProc == safeInitProc) |
&& (pkgPtr->safeInitProc == safeInitProc) |
468 |
&& (strcmp(pkgPtr->packageName, pkgName) == 0)) { |
&& (strcmp(pkgPtr->packageName, pkgName) == 0)) { |
469 |
Tcl_MutexUnlock(&packageMutex); |
Tcl_MutexUnlock(&packageMutex); |
470 |
return; |
return; |
471 |
} |
} |
472 |
} |
} |
473 |
|
|
474 |
Tcl_MutexUnlock(&packageMutex); |
Tcl_MutexUnlock(&packageMutex); |
475 |
|
|
476 |
pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage)); |
pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage)); |
477 |
pkgPtr->fileName = (char *) ckalloc((unsigned) 1); |
pkgPtr->fileName = (char *) ckalloc((unsigned) 1); |
478 |
pkgPtr->fileName[0] = 0; |
pkgPtr->fileName[0] = 0; |
479 |
pkgPtr->packageName = (char *) ckalloc((unsigned) |
pkgPtr->packageName = (char *) ckalloc((unsigned) |
480 |
(strlen(pkgName) + 1)); |
(strlen(pkgName) + 1)); |
481 |
strcpy(pkgPtr->packageName, pkgName); |
strcpy(pkgPtr->packageName, pkgName); |
482 |
pkgPtr->clientData = NULL; |
pkgPtr->clientData = NULL; |
483 |
pkgPtr->initProc = initProc; |
pkgPtr->initProc = initProc; |
484 |
pkgPtr->safeInitProc = safeInitProc; |
pkgPtr->safeInitProc = safeInitProc; |
485 |
Tcl_MutexLock(&packageMutex); |
Tcl_MutexLock(&packageMutex); |
486 |
pkgPtr->nextPtr = firstPackagePtr; |
pkgPtr->nextPtr = firstPackagePtr; |
487 |
firstPackagePtr = pkgPtr; |
firstPackagePtr = pkgPtr; |
488 |
Tcl_MutexUnlock(&packageMutex); |
Tcl_MutexUnlock(&packageMutex); |
489 |
|
|
490 |
if (interp != NULL) { |
if (interp != NULL) { |
491 |
ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp, "tclLoad", |
ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp, "tclLoad", |
492 |
(Tcl_InterpDeleteProc **) NULL); |
(Tcl_InterpDeleteProc **) NULL); |
493 |
ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage)); |
ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage)); |
494 |
ipPtr->pkgPtr = pkgPtr; |
ipPtr->pkgPtr = pkgPtr; |
495 |
ipPtr->nextPtr = ipFirstPtr; |
ipPtr->nextPtr = ipFirstPtr; |
496 |
Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, |
Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, |
497 |
(ClientData) ipPtr); |
(ClientData) ipPtr); |
498 |
} |
} |
499 |
} |
} |
500 |
|
|
501 |
/* |
/* |
502 |
*---------------------------------------------------------------------- |
*---------------------------------------------------------------------- |
503 |
* |
* |
504 |
* TclGetLoadedPackages -- |
* TclGetLoadedPackages -- |
505 |
* |
* |
506 |
* This procedure returns information about all of the files |
* This procedure returns information about all of the files |
507 |
* that are loaded (either in a particular intepreter, or |
* that are loaded (either in a particular intepreter, or |
508 |
* for all interpreters). |
* for all interpreters). |
509 |
* |
* |
510 |
* Results: |
* Results: |
511 |
* The return value is a standard Tcl completion code. If |
* The return value is a standard Tcl completion code. If |
512 |
* successful, a list of lists is placed in the interp's result. |
* successful, a list of lists is placed in the interp's result. |
513 |
* Each sublist corresponds to one loaded file; its first |
* Each sublist corresponds to one loaded file; its first |
514 |
* element is the name of the file (or an empty string for |
* element is the name of the file (or an empty string for |
515 |
* something that's statically loaded) and the second element |
* something that's statically loaded) and the second element |
516 |
* is the name of the package in that file. |
* is the name of the package in that file. |
517 |
* |
* |
518 |
* Side effects: |
* Side effects: |
519 |
* None. |
* None. |
520 |
* |
* |
521 |
*---------------------------------------------------------------------- |
*---------------------------------------------------------------------- |
522 |
*/ |
*/ |
523 |
|
|
524 |
int |
int |
525 |
TclGetLoadedPackages(interp, targetName) |
TclGetLoadedPackages(interp, targetName) |
526 |
Tcl_Interp *interp; /* Interpreter in which to return |
Tcl_Interp *interp; /* Interpreter in which to return |
527 |
* information or error message. */ |
* information or error message. */ |
528 |
char *targetName; /* Name of target interpreter or NULL. |
char *targetName; /* Name of target interpreter or NULL. |
529 |
* If NULL, return info about all interps; |
* If NULL, return info about all interps; |
530 |
* otherwise, just return info about this |
* otherwise, just return info about this |
531 |
* interpreter. */ |
* interpreter. */ |
532 |
{ |
{ |
533 |
Tcl_Interp *target; |
Tcl_Interp *target; |
534 |
LoadedPackage *pkgPtr; |
LoadedPackage *pkgPtr; |
535 |
InterpPackage *ipPtr; |
InterpPackage *ipPtr; |
536 |
char *prefix; |
char *prefix; |
537 |
|
|
538 |
if (targetName == NULL) { |
if (targetName == NULL) { |
539 |
/* |
/* |
540 |
* Return information about all of the available packages. |
* Return information about all of the available packages. |
541 |
*/ |
*/ |
542 |
|
|
543 |
prefix = "{"; |
prefix = "{"; |
544 |
Tcl_MutexLock(&packageMutex); |
Tcl_MutexLock(&packageMutex); |
545 |
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; |
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; |
546 |
pkgPtr = pkgPtr->nextPtr) { |
pkgPtr = pkgPtr->nextPtr) { |
547 |
Tcl_AppendResult(interp, prefix, (char *) NULL); |
Tcl_AppendResult(interp, prefix, (char *) NULL); |
548 |
Tcl_AppendElement(interp, pkgPtr->fileName); |
Tcl_AppendElement(interp, pkgPtr->fileName); |
549 |
Tcl_AppendElement(interp, pkgPtr->packageName); |
Tcl_AppendElement(interp, pkgPtr->packageName); |
550 |
Tcl_AppendResult(interp, "}", (char *) NULL); |
Tcl_AppendResult(interp, "}", (char *) NULL); |
551 |
prefix = " {"; |
prefix = " {"; |
552 |
} |
} |
553 |
Tcl_MutexUnlock(&packageMutex); |
Tcl_MutexUnlock(&packageMutex); |
554 |
return TCL_OK; |
return TCL_OK; |
555 |
} |
} |
556 |
|
|
557 |
/* |
/* |
558 |
* Return information about only the packages that are loaded in |
* Return information about only the packages that are loaded in |
559 |
* a given interpreter. |
* a given interpreter. |
560 |
*/ |
*/ |
561 |
|
|
562 |
target = Tcl_GetSlave(interp, targetName); |
target = Tcl_GetSlave(interp, targetName); |
563 |
if (target == NULL) { |
if (target == NULL) { |
564 |
return TCL_ERROR; |
return TCL_ERROR; |
565 |
} |
} |
566 |
ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", |
ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", |
567 |
(Tcl_InterpDeleteProc **) NULL); |
(Tcl_InterpDeleteProc **) NULL); |
568 |
prefix = "{"; |
prefix = "{"; |
569 |
for ( ; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { |
for ( ; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { |
570 |
pkgPtr = ipPtr->pkgPtr; |
pkgPtr = ipPtr->pkgPtr; |
571 |
Tcl_AppendResult(interp, prefix, (char *) NULL); |
Tcl_AppendResult(interp, prefix, (char *) NULL); |
572 |
Tcl_AppendElement(interp, pkgPtr->fileName); |
Tcl_AppendElement(interp, pkgPtr->fileName); |
573 |
Tcl_AppendElement(interp, pkgPtr->packageName); |
Tcl_AppendElement(interp, pkgPtr->packageName); |
574 |
Tcl_AppendResult(interp, "}", (char *) NULL); |
Tcl_AppendResult(interp, "}", (char *) NULL); |
575 |
prefix = " {"; |
prefix = " {"; |
576 |
} |
} |
577 |
return TCL_OK; |
return TCL_OK; |
578 |
} |
} |
579 |
|
|
580 |
/* |
/* |
581 |
*---------------------------------------------------------------------- |
*---------------------------------------------------------------------- |
582 |
* |
* |
583 |
* LoadCleanupProc -- |
* LoadCleanupProc -- |
584 |
* |
* |
585 |
* This procedure is called to delete all of the InterpPackage |
* This procedure is called to delete all of the InterpPackage |
586 |
* structures for an interpreter when the interpreter is deleted. |
* structures for an interpreter when the interpreter is deleted. |
587 |
* It gets invoked via the Tcl AssocData mechanism. |
* It gets invoked via the Tcl AssocData mechanism. |
588 |
* |
* |
589 |
* Results: |
* Results: |
590 |
* None. |
* None. |
591 |
* |
* |
592 |
* Side effects: |
* Side effects: |
593 |
* Storage for all of the InterpPackage procedures for interp |
* Storage for all of the InterpPackage procedures for interp |
594 |
* get deleted. |
* get deleted. |
595 |
* |
* |
596 |
*---------------------------------------------------------------------- |
*---------------------------------------------------------------------- |
597 |
*/ |
*/ |
598 |
|
|
599 |
static void |
static void |
600 |
LoadCleanupProc(clientData, interp) |
LoadCleanupProc(clientData, interp) |
601 |
ClientData clientData; /* Pointer to first InterpPackage structure |
ClientData clientData; /* Pointer to first InterpPackage structure |
602 |
* for interp. */ |
* for interp. */ |
603 |
Tcl_Interp *interp; /* Interpreter that is being deleted. */ |
Tcl_Interp *interp; /* Interpreter that is being deleted. */ |
604 |
{ |
{ |
605 |
InterpPackage *ipPtr, *nextPtr; |
InterpPackage *ipPtr, *nextPtr; |
606 |
|
|
607 |
ipPtr = (InterpPackage *) clientData; |
ipPtr = (InterpPackage *) clientData; |
608 |
while (ipPtr != NULL) { |
while (ipPtr != NULL) { |
609 |
nextPtr = ipPtr->nextPtr; |
nextPtr = ipPtr->nextPtr; |
610 |
ckfree((char *) ipPtr); |
ckfree((char *) ipPtr); |
611 |
ipPtr = nextPtr; |
ipPtr = nextPtr; |
612 |
} |
} |
613 |
} |
} |
614 |
|
|
615 |
/* |
/* |
616 |
*---------------------------------------------------------------------- |
*---------------------------------------------------------------------- |
617 |
* |
* |
618 |
* TclFinalizeLoad -- |
* TclFinalizeLoad -- |
619 |
* |
* |
620 |
* This procedure is invoked just before the application exits. |
* This procedure is invoked just before the application exits. |
621 |
* It frees all of the LoadedPackage structures. |
* It frees all of the LoadedPackage structures. |
622 |
* |
* |
623 |
* Results: |
* Results: |
624 |
* None. |
* None. |
625 |
* |
* |
626 |
* Side effects: |
* Side effects: |
627 |
* Memory is freed. |
* Memory is freed. |
628 |
* |
* |
629 |
*---------------------------------------------------------------------- |
*---------------------------------------------------------------------- |
630 |
*/ |
*/ |
631 |
|
|
632 |
void |
void |
633 |
TclFinalizeLoad() |
TclFinalizeLoad() |
634 |
{ |
{ |
635 |
LoadedPackage *pkgPtr; |
LoadedPackage *pkgPtr; |
636 |
|
|
637 |
/* |
/* |
638 |
* No synchronization here because there should just be |
* No synchronization here because there should just be |
639 |
* one thread alive at this point. Logically, |
* one thread alive at this point. Logically, |
640 |
* packageMutex should be grabbed at this point, but |
* packageMutex should be grabbed at this point, but |
641 |
* the Mutexes get finalized before the call to this routine. |
* the Mutexes get finalized before the call to this routine. |
642 |
* The only subsystem left alive at this point is the |
* The only subsystem left alive at this point is the |
643 |
* memory allocator. |
* memory allocator. |
644 |
*/ |
*/ |
645 |
|
|
646 |
while (firstPackagePtr != NULL) { |
while (firstPackagePtr != NULL) { |
647 |
pkgPtr = firstPackagePtr; |
pkgPtr = firstPackagePtr; |
648 |
firstPackagePtr = pkgPtr->nextPtr; |
firstPackagePtr = pkgPtr->nextPtr; |
649 |
#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__) |
#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__) |
650 |
/* |
/* |
651 |
* Some Unix dlls are poorly behaved - registering things like |
* Some Unix dlls are poorly behaved - registering things like |
652 |
* atexit calls that can't be unregistered. If you unload |
* atexit calls that can't be unregistered. If you unload |
653 |
* such dlls, you get a core on exit because it wants to |
* such dlls, you get a core on exit because it wants to |
654 |
* call a function in the dll after it's been unloaded. |
* call a function in the dll after it's been unloaded. |
655 |
*/ |
*/ |
656 |
if (pkgPtr->fileName[0] != '\0') { |
if (pkgPtr->fileName[0] != '\0') { |
657 |
TclpUnloadFile(pkgPtr->clientData); |
TclpUnloadFile(pkgPtr->clientData); |
658 |
} |
} |
659 |
#endif |
#endif |
660 |
ckfree(pkgPtr->fileName); |
ckfree(pkgPtr->fileName); |
661 |
ckfree(pkgPtr->packageName); |
ckfree(pkgPtr->packageName); |
662 |
ckfree((char *) pkgPtr); |
ckfree((char *) pkgPtr); |
663 |
} |
} |
664 |
} |
} |
665 |
|
|
666 |
/* End of tclload.c */ |
/* End of tclload.c */ |