diff options
author | dkf <dkf@noemail.net> | 2005-07-17 21:17:30 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2005-07-17 21:17:30 (GMT) |
commit | 1e182def1fc1c70e8744170a0e0268da14e2d866 (patch) | |
tree | 9183a28f85e9bde31e4db45664f5fdf9fde7e792 /generic/tclLoad.c | |
parent | cefe1517ba6e266087f24f82916abe70ac2c33ac (diff) | |
download | tcl-1e182def1fc1c70e8744170a0e0268da14e2d866.zip tcl-1e182def1fc1c70e8744170a0e0268da14e2d866.tar.gz tcl-1e182def1fc1c70e8744170a0e0268da14e2d866.tar.bz2 |
Getting more systematic about style
FossilOrigin-Name: 7591df07d6708876cd588c42190751e37f827e21
Diffstat (limited to 'generic/tclLoad.c')
-rw-r--r-- | generic/tclLoad.c | 439 |
1 files changed, 220 insertions, 219 deletions
diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 3ce5200..72c33d4 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -1,36 +1,35 @@ -/* +/* * tclLoad.c -- * - * This file provides the generic portion (those that are the same - * on all platforms) of Tcl's dynamic loading facilities. + * This file provides the generic portion (those that are the same on all + * platforms) of Tcl's dynamic loading facilities. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoad.c,v 1.13 2004/03/09 12:59:05 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoad.c,v 1.14 2005/07/17 21:17:43 dkf Exp $ */ #include "tclInt.h" /* - * The following structure describes a package that has been loaded - * either dynamically (with the "load" command) or statically (as - * indicated by a call to TclGetLoadedPackages). All such packages - * are linked together into a single list for the process. Packages - * are never unloaded, until the application exits, when - * TclFinalizeLoad is called, and these structures are freed. + * The following structure describes a package that has been loaded either + * dynamically (with the "load" command) or statically (as indicated by a call + * to TclGetLoadedPackages). All such packages are linked together into a + * single list for the process. Packages are never unloaded, until the + * application exits, when TclFinalizeLoad is called, and these structures are + * freed. */ typedef struct LoadedPackage { - char *fileName; /* Name of the file from which the - * package was loaded. An empty string - * means the package is loaded statically. - * Malloc-ed. */ + char *fileName; /* Name of the file from which the package was + * loaded. An empty string means the package + * is loaded statically. Malloc-ed. */ char *packageName; /* Name of package prefix for the package, * properly capitalized (first letter UC, - * others LC), no "_", as in "Net". + * others LC), no "_", as in "Net". * Malloc-ed. */ Tcl_LoadHandle loadHandle; /* Token for the loaded file which should be * passed to (*unLoadProcPtr)() when the file @@ -44,21 +43,20 @@ typedef struct LoadedPackage { /* Initialization procedure to call to * incorporate this package into a safe * interpreter (one that will execute - * untrusted scripts). NULL means the - * package can't be used in unsafe - * interpreters. */ + * untrusted scripts). NULL means the package + * can't be used in unsafe interpreters. */ Tcl_PackageUnloadProc *unloadProc; - /* Finalisation procedure to unload a package - * from a trusted interpreter. NULL means - * that the package cannot be unloaded. */ + /* Finalisation procedure to unload a package + * from a trusted interpreter. NULL means that + * the package cannot be unloaded. */ Tcl_PackageUnloadProc *safeUnloadProc; - /* Finalisation procedure to unload a package - * from a safe interpreter. NULL means - * that the package cannot be unloaded. */ - int interpRefCount; /* How many times the package has been loaded - in trusted interpreters. */ - int safeInterpRefCount; /* How many times the package has been loaded - in safe interpreters. */ + /* Finalisation procedure to unload a package + * from a safe interpreter. NULL means that + * the package cannot be unloaded. */ + int interpRefCount; /* How many times the package has been loaded + * in trusted interpreters. */ + int safeInterpRefCount; /* How many times the package has been loaded + * in safe interpreters. */ Tcl_FSUnloadFileProc *unLoadProcPtr; /* Procedure to use to unload this package. * If NULL, then we do not attempt to unload @@ -66,8 +64,8 @@ typedef struct LoadedPackage { * this field is irrelevant. */ struct LoadedPackage *nextPtr; /* Next in list of all packages loaded into - * this application process. NULL means - * end of list. */ + * this application process. NULL means end of + * list. */ } LoadedPackage; /* @@ -83,19 +81,19 @@ static LoadedPackage *firstPackagePtr = NULL; TCL_DECLARE_MUTEX(packageMutex) /* - * The following structure represents a particular package that has - * been incorporated into a particular interpreter (by calling its - * initialization procedure). There is a list of these structures for - * each interpreter, with an AssocData value (key "load") for the - * interpreter that points to the first package (if any). + * The following structure represents a particular package that has been + * incorporated into a particular interpreter (by calling its initialization + * procedure). There is a list of these structures for each interpreter, with + * an AssocData value (key "load") for the interpreter that points to the + * first package (if any). */ typedef struct InterpPackage { LoadedPackage *pkgPtr; /* Points to detailed information about * package. */ struct InterpPackage *nextPtr; - /* Next package in this interpreter, or - * NULL for end of list. */ + /* Next package in this interpreter, or NULL + * for end of list. */ } InterpPackage; /* @@ -110,8 +108,8 @@ static void LoadCleanupProc _ANSI_ARGS_((ClientData clientData, * * Tcl_LoadObjCmd -- * - * This procedure is invoked to process the "load" Tcl command. - * See the user documentation for details on what it does. + * This procedure is invoked to process the "load" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -131,11 +129,11 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) { Tcl_Interp *target; LoadedPackage *pkgPtr, *defaultPtr; - Tcl_DString pkgName, tmp, initName, safeInitName, - unloadName, safeUnloadName; + Tcl_DString pkgName, tmp, initName, safeInitName; + Tcl_DString unloadName, safeUnloadName; Tcl_PackageInitProc *initProc, *safeInitProc, *unloadProc, *safeUnloadProc; InterpPackage *ipFirstPtr, *ipPtr; - int code, namesMatch, filesMatch; + int code, namesMatch, filesMatch, offset; CONST char *symbols[4]; Tcl_PackageInitProc **procPtrs[4]; ClientData clientData; @@ -143,17 +141,16 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) Tcl_LoadHandle loadHandle; Tcl_FSUnloadFileProc *unLoadProcPtr = NULL; Tcl_UniChar ch; - int offset; if ((objc < 2) || (objc > 4)) { - Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?"); + Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } fullFileName = Tcl_GetString(objv[1]); - + Tcl_DStringInit(&pkgName); Tcl_DStringInit(&initName); Tcl_DStringInit(&safeInitName); @@ -182,8 +179,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) target = interp; if (objc == 4) { - char *slaveIntName; - slaveIntName = Tcl_GetString(objv[3]); + char *slaveIntName = Tcl_GetString(objv[3]); + target = Tcl_GetSlave(interp, slaveIntName); if (target == NULL) { code = TCL_ERROR; @@ -193,13 +190,14 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) /* * Scan through the packages that are currently loaded to see if the - * package we want is already loaded. We'll use a loaded package if - * it meets any of the following conditions: + * package we want is already loaded. We'll use a loaded package if it + * meets any of the following conditions: * - Its name and file match the once we're looking for. * - Its file matches, and we weren't given a name. - * - Its name matches, the file name was specified as empty, and there - * is only no statically loaded package with the same name. + * - Its name matches, the file name was specified as empty, and there is + * only no statically loaded package with the same name. */ + Tcl_MutexLock(&packageMutex); defaultPtr = NULL; @@ -231,8 +229,7 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) } if (filesMatch && !namesMatch && (fullFileName[0] != 0)) { /* - * Can't have two different packages loaded from the same - * file. + * Can't have two different packages loaded from the same file. */ Tcl_AppendResult(interp, "file \"", fullFileName, @@ -250,8 +247,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) /* * Scan through the list of packages already loaded in the target - * interpreter. If the package we want is already loaded there, - * then there's nothing for us to do. + * interpreter. If the package we want is already loaded there, then + * there's nothing for us to do. */ if (pkgPtr != NULL) { @@ -267,8 +264,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) if (pkgPtr == NULL) { /* - * The desired file isn't currently loaded, so load it. It's an - * error if the desired package is a static one. + * The desired file isn't currently loaded, so load it. It's an error + * if the desired package is a static one. */ if (fullFileName[0] == 0) { @@ -286,9 +283,11 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) Tcl_DStringAppend(&pkgName, packageName, -1); } else { int retc; + /* * Threading note - this call used to be protected by a mutex. */ + retc = TclGuessPackageName(fullFileName, &pkgName); if (!retc) { Tcl_Obj *splitPtr; @@ -297,11 +296,11 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) char *pkgGuess; /* - * The platform-specific code couldn't figure out the - * module name. Make a guess by taking the last element - * of the file name, stripping off any leading "lib", - * and then using all of the alphabetic and underline - * characters that follow that. + * The platform-specific code couldn't figure out the module + * name. Make a guess by taking the last element of the file + * name, stripping off any leading "lib", and then using all + * of the alphabetic and underline characters that follow + * that. */ splitPtr = Tcl_FSSplitPath(objv[1], &pElements); @@ -337,45 +336,47 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) * character is in caps (or title case) but the others are all * lower-case. */ - + Tcl_DStringSetLength(&pkgName, Tcl_UtfToTitle(Tcl_DStringValue(&pkgName))); /* - * Compute the names of the two initialization procedures, - * based on the package name. + * Compute the names of the two initialization procedures, based on + * the package name. */ - + Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1); Tcl_DStringAppend(&initName, "_Init", 5); Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1); Tcl_DStringAppend(&safeInitName, "_SafeInit", 9); - Tcl_DStringAppend(&unloadName, Tcl_DStringValue(&pkgName), -1); + Tcl_DStringAppend(&unloadName, Tcl_DStringValue(&pkgName), -1); Tcl_DStringAppend(&unloadName, "_Unload", 7); - Tcl_DStringAppend(&safeUnloadName, Tcl_DStringValue(&pkgName), -1); + Tcl_DStringAppend(&safeUnloadName, Tcl_DStringValue(&pkgName), -1); Tcl_DStringAppend(&safeUnloadName, "_SafeUnload", 11); /* - * Call platform-specific code to load the package and find the - * two initialization procedures. + * Call platform-specific code to load the package and find the two + * initialization procedures. */ - symbols[0] = Tcl_DStringValue(&initName); - symbols[1] = Tcl_DStringValue(&safeInitName); - symbols[2] = Tcl_DStringValue(&unloadName); - symbols[3] = Tcl_DStringValue(&safeUnloadName); - procPtrs[0] = &initProc; - procPtrs[1] = &safeInitProc; - procPtrs[2] = &unloadProc; - procPtrs[3] = &safeUnloadProc; + symbols[0] = Tcl_DStringValue(&initName); + symbols[1] = Tcl_DStringValue(&safeInitName); + symbols[2] = Tcl_DStringValue(&unloadName); + symbols[3] = Tcl_DStringValue(&safeUnloadName); + procPtrs[0] = &initProc; + procPtrs[1] = &safeInitProc; + procPtrs[2] = &unloadProc; + procPtrs[3] = &safeUnloadProc; + Tcl_MutexLock(&packageMutex); code = TclLoadFile(interp, objv[1], 4, symbols, procPtrs, &loadHandle, &clientData, &unLoadProcPtr); Tcl_MutexUnlock(&packageMutex); - loadHandle = (Tcl_LoadHandle) clientData; + loadHandle = (Tcl_LoadHandle) clientData; if (code != TCL_OK) { goto done; } + if (*procPtrs[0] /* initProc */ == NULL) { Tcl_AppendResult(interp, "couldn't find procedure ", Tcl_DStringValue(&initName), (char *) NULL); @@ -401,10 +402,11 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) pkgPtr->unLoadProcPtr = unLoadProcPtr; pkgPtr->initProc = *procPtrs[0]; pkgPtr->safeInitProc = *procPtrs[1]; - pkgPtr->unloadProc = (Tcl_PackageUnloadProc*) *procPtrs[2]; - pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc*) *procPtrs[3]; - pkgPtr->interpRefCount = 0; - pkgPtr->safeInterpRefCount = 0; + pkgPtr->unloadProc = (Tcl_PackageUnloadProc*) *procPtrs[2]; + pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc*) *procPtrs[3]; + pkgPtr->interpRefCount = 0; + pkgPtr->safeInterpRefCount = 0; + Tcl_MutexLock(&packageMutex); pkgPtr->nextPtr = firstPackagePtr; firstPackagePtr = pkgPtr; @@ -412,9 +414,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) } /* - * Invoke the package's initialization procedure (either the - * normal one or the safe one, depending on whether or not the - * interpreter is safe). + * Invoke the package's initialization procedure (either the normal one or + * the safe one, depending on whether or not the interpreter is safe). */ if (Tcl_IsSafe(target)) { @@ -422,9 +423,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) code = (*pkgPtr->safeInitProc)(target); } else { Tcl_AppendResult(interp, - "can't use package in a safe interpreter: ", - "no ", pkgPtr->packageName, "_SafeInit procedure", - (char *) NULL); + "can't use package in a safe interpreter: no ", + pkgPtr->packageName, "_SafeInit procedure", (char *) NULL); code = TCL_ERROR; goto done; } @@ -433,21 +433,23 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) } /* - * Record the fact that the package has been loaded in the - * target interpreter. + * Record the fact that the package has been loaded in the target + * interpreter. */ if (code == TCL_OK) { - /* - * Update the proper reference count. - */ - Tcl_MutexLock(&packageMutex); - if (Tcl_IsSafe(target)) { - ++pkgPtr->safeInterpRefCount; - } else { - ++pkgPtr->interpRefCount; - } - Tcl_MutexUnlock(&packageMutex); + /* + * Update the proper reference count. + */ + + Tcl_MutexLock(&packageMutex); + if (Tcl_IsSafe(target)) { + ++pkgPtr->safeInterpRefCount; + } else { + ++pkgPtr->interpRefCount; + } + Tcl_MutexUnlock(&packageMutex); + /* * Refetch ipFirstPtr: loading the package may have introduced * additional static packages at the head of the linked list! @@ -464,7 +466,7 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) TclTransferResult(target, code, interp); } - done: + done: Tcl_DStringFree(&pkgName); Tcl_DStringFree(&initName); Tcl_DStringFree(&safeInitName); @@ -479,8 +481,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) * * Tcl_UnloadObjCmd -- * - * This procedure is invoked to process the "unload" Tcl command. - * See the user documentation for details on what it does. + * This procedure is invoked to process the "unload" Tcl command. See + * the user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -499,22 +501,13 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tcl_Interp *target; /* Which interpreter to unload from. */ - LoadedPackage *pkgPtr; - LoadedPackage *defaultPtr; - Tcl_DString pkgName; - Tcl_DString tmp; + LoadedPackage *pkgPtr, *defaultPtr; + Tcl_DString pkgName, tmp; Tcl_PackageUnloadProc *unloadProc; - InterpPackage *ipFirstPtr; - InterpPackage *ipPtr; - int i; - int index; - int code; - int complain = 1; - int keepLibrary = 0; - int trustedRefCount = -1; - int safeRefCount = -1; - char *fullFileName = ""; - char *packageName; + InterpPackage *ipFirstPtr, *ipPtr; + int i, index, code, complain = 1, keepLibrary = 0; + int trustedRefCount = -1, safeRefCount = -1; + char *fullFileName = "", *packageName; static CONST char *options[] = { "-nocomplain", "-keeplibrary", "--", NULL }; @@ -528,15 +521,15 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) fullFileName = Tcl_GetString(objv[i]); if (fullFileName[0] == '-') { /* - * It looks like the command contains an option so signal - * an error + * It looks like the command contains an option so signal an + * error */ return TCL_ERROR; } else { /* - * This clearly isn't an option; assume it's the - * filename. We must clear the error. + * This clearly isn't an option; assume it's the filename. We + * must clear the error. */ Tcl_ResetResult(interp); @@ -555,7 +548,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) goto endOfForLoop; } } - endOfForLoop: + endOfForLoop: if ((objc-i < 1) || (objc-i > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? fileName ?packageName? ?interp?"); @@ -564,7 +557,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) { return TCL_ERROR; } - + fullFileName = Tcl_GetString(objv[i]); Tcl_DStringInit(&pkgName); Tcl_DStringInit(&tmp); @@ -600,12 +593,12 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) /* * Scan through the packages that are currently loaded to see if the - * package we want is already loaded. We'll use a loaded package if - * it meets any of the following conditions: + * package we want is already loaded. We'll use a loaded package if it + * meets any of the following conditions: * - Its name and file match the once we're looking for. * - Its file matches, and we weren't given a name. - * - Its name matches, the file name was specified as empty, and there - * is only no statically loaded package with the same name. + * - Its name matches, the file name was specified as empty, and there is + * only no statically loaded package with the same name. */ Tcl_MutexLock(&packageMutex); @@ -657,8 +650,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) } if (pkgPtr == NULL) { /* - * The DLL pointed by the provided filename has never been - * loaded. + * The DLL pointed by the provided filename has never been loaded. */ Tcl_AppendResult(interp, "file \"", fullFileName, @@ -669,8 +661,8 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) /* * Scan through the list of packages already loaded in the target - * interpreter. If the package we want is already loaded there, - * then we should proceed with unloading. + * interpreter. If the package we want is already loaded there, then we + * should proceed with unloading. */ code = TCL_ERROR; @@ -688,6 +680,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) /* * The package has not been loaded in this interpreter. */ + Tcl_AppendResult(interp, "file \"", fullFileName, "\" has never been loaded in this interpreter", (char *) NULL); code = TCL_ERROR; @@ -695,10 +688,9 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) } /* - * Ensure that the DLL can be unloaded. If it is a trusted - * interpreter, pkgPtr->unloadProc must not be NULL for the DLL to - * be unloadable. If the interpreter is a safe one, - * pkgPtr->safeUnloadProc must be non-NULL. + * Ensure that the DLL can be unloaded. If it is a trusted interpreter, + * pkgPtr->unloadProc must not be NULL for the DLL to be unloadable. If + * the interpreter is a safe one, pkgPtr->safeUnloadProc must be non-NULL. */ if (Tcl_IsSafe(target)) { @@ -723,13 +715,12 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) /* * We are ready to unload the package. First, evaluate the unload - * procedure. If this fails, we cannot proceed with unload. Also, - * we must specify the proper flag to pass to the unload callback. - * TCL_UNLOAD_DETACH_FROM_INTERPRETER is defined when the callback - * should only remove itself from the interpreter; the library - * will be unloaded in a future call of unload. In case the - * library will be unloaded just after the callback returns, - * TCL_UNLOAD_DETACH_FROM_PROCESS is passed. + * procedure. If this fails, we cannot proceed with unload. Also, we must + * specify the proper flag to pass to the unload callback. + * TCL_UNLOAD_DETACH_FROM_INTERPRETER is defined when the callback should + * only remove itself from the interpreter; the library will be unloaded + * in a future call of unload. In case the library will be unloaded just + * after the callback returns, TCL_UNLOAD_DETACH_FROM_PROCESS is passed. */ code = TCL_UNLOAD_DETACH_FROM_INTERPRETER; @@ -756,24 +747,28 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) } /* - * The unload procedure executed fine. Examine the reference - * count to see if we unload the DLL. + * The unload procedure executed fine. Examine the reference count to see + * if we unload the DLL. */ Tcl_MutexLock(&packageMutex); if (Tcl_IsSafe(target)) { --pkgPtr->safeInterpRefCount; + /* - * Do not let counter get negative + * Do not let counter get negative. */ + if (pkgPtr->safeInterpRefCount < 0) { pkgPtr->safeInterpRefCount = 0; } } else { --pkgPtr->interpRefCount; + /* - * Do not let counter get negative + * Do not let counter get negative. */ + if (pkgPtr->interpRefCount < 0) { pkgPtr->interpRefCount = 0; } @@ -791,10 +786,10 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) #if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__) /* - * Some Unix dlls are poorly behaved - registering things like - * atexit calls that can't be unregistered. If you unload - * such dlls, you get a core on exit because it wants to call - * a function in the dll after it's been unloaded. + * Some Unix dlls are poorly behaved - registering things like atexit + * calls that can't be unregistered. If you unload such dlls, you get + * a core on exit because it wants to call a function in the dll after + * it's been unloaded. */ if (pkgPtr->fileName[0] != '\0') { @@ -822,8 +817,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) } /* - * Remove this library from the interpreter's library - * cache. + * Remove this library from the interpreter's library cache. */ ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, @@ -863,7 +857,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) #endif } - done: + done: Tcl_DStringFree(&pkgName); Tcl_DStringFree(&tmp); if (!complain && code!=TCL_OK) { @@ -873,8 +867,8 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) if (code == TCL_OK) { #if 0 /* - * Result of [unload] was not documented in TIP#100, so force - * to be the empty string by commenting this out. DKF. + * Result of [unload] was not documented in TIP#100, so force to be + * the empty string by commenting this out. DKF. */ Tcl_Obj *resultObjPtr, *objPtr[2]; @@ -908,37 +902,37 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv) * * Tcl_StaticPackage -- * - * This procedure is invoked to indicate that a particular - * package has been linked statically with an application. + * This procedure is invoked to indicate that a particular package has + * been linked statically with an application. * * Results: * None. * * Side effects: - * Once this procedure completes, the package becomes loadable - * via the "load" command with an empty file name. + * Once this procedure completes, the package becomes loadable via the + * "load" command with an empty file name. * *---------------------------------------------------------------------- */ void Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc) - Tcl_Interp *interp; /* If not NULL, it means that the - * package has already been loaded - * into the given interpreter by - * calling the appropriate init proc. */ - CONST char *pkgName; /* Name of package (must be properly - * capitalized: first letter upper - * case, others lower case). */ - Tcl_PackageInitProc *initProc; /* Procedure to call to incorporate - * this package into a trusted - * interpreter. */ - Tcl_PackageInitProc *safeInitProc; /* Procedure to call to incorporate - * this package into a safe interpreter - * (one that will execute untrusted - * scripts). NULL means the package - * can't be used in safe - * interpreters. */ + Tcl_Interp *interp; /* If not NULL, it means that the package has + * already been loaded into the given + * interpreter by calling the appropriate init + * proc. */ + CONST char *pkgName; /* Name of package (must be properly + * capitalized: first letter upper case, + * others lower case). */ + Tcl_PackageInitProc *initProc; + /* Procedure to call to incorporate this + * package into a trusted interpreter. */ + Tcl_PackageInitProc *safeInitProc; + /* Procedure to call to incorporate this + * package into a safe interpreter (one that + * will execute untrusted scripts). NULL means + * the package can't be used in safe + * interpreters. */ { LoadedPackage *pkgPtr; InterpPackage *ipPtr, *ipFirstPtr; @@ -959,8 +953,8 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc) Tcl_MutexUnlock(&packageMutex); /* - * If the package is not yet recorded as being loaded statically, - * add it to the list now. + * If the package is not yet recorded as being loaded statically, add it + * to the list now. */ if ( pkgPtr == NULL ) { @@ -982,8 +976,8 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc) if (interp != NULL) { /* - * If we're loading the package into an interpreter, - * determine whether it's already loaded. + * If we're loading the package into an interpreter, determine whether + * it's already loaded. */ ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp, "tclLoad", @@ -995,8 +989,8 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc) } /* - * Package isn't loade in the current interp yet. Mark it as - * now being loaded. + * Package isn't loade in the current interp yet. Mark it as now being + * loaded. */ ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage)); @@ -1012,17 +1006,15 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc) * * TclGetLoadedPackages -- * - * This procedure returns information about all of the files - * that are loaded (either in a particular intepreter, or - * for all interpreters). + * This procedure returns information about all of the files that are + * loaded (either in a particular intepreter, or for all interpreters). * * Results: - * The return value is a standard Tcl completion code. If - * successful, a list of lists is placed in the interp's result. - * Each sublist corresponds to one loaded file; its first - * element is the name of the file (or an empty string for - * something that's statically loaded) and the second element - * is the name of the package in that file. + * The return value is a standard Tcl completion code. If successful, a + * list of lists is placed in the interp's result. Each sublist + * corresponds to one loaded file; its first element is the name of the + * file (or an empty string for something that's statically loaded) and + * the second element is the name of the package in that file. * * Side effects: * None. @@ -1032,10 +1024,10 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc) int TclGetLoadedPackages(interp, targetName) - Tcl_Interp *interp; /* Interpreter in which to return - * information or error message. */ - char *targetName; /* Name of target interpreter or NULL. - * If NULL, return info about all interps; + Tcl_Interp *interp; /* Interpreter in which to return information + * or error message. */ + char *targetName; /* Name of target interpreter or NULL. If + * NULL, return info about all interps; * otherwise, just return info about this * interpreter. */ { @@ -1045,7 +1037,7 @@ TclGetLoadedPackages(interp, targetName) char *prefix; if (targetName == NULL) { - /* + /* * Return information about all of the available packages. */ @@ -1064,8 +1056,8 @@ TclGetLoadedPackages(interp, targetName) } /* - * Return information about only the packages that are loaded in - * a given interpreter. + * Return information about only the packages that are loaded in a given + * interpreter. */ target = Tcl_GetSlave(interp, targetName); @@ -1091,16 +1083,16 @@ TclGetLoadedPackages(interp, targetName) * * LoadCleanupProc -- * - * This procedure is called to delete all of the InterpPackage - * structures for an interpreter when the interpreter is deleted. - * It gets invoked via the Tcl AssocData mechanism. + * This procedure is called to delete all of the InterpPackage structures + * for an interpreter when the interpreter is deleted. It gets invoked + * via the Tcl AssocData mechanism. * * Results: * None. * * Side effects: - * Storage for all of the InterpPackage procedures for interp - * get deleted. + * Storage for all of the InterpPackage procedures for interp get + * deleted. * *---------------------------------------------------------------------- */ @@ -1126,8 +1118,8 @@ LoadCleanupProc(clientData, interp) * * TclFinalizeLoad -- * - * This procedure is invoked just before the application exits. - * It frees all of the LoadedPackage structures. + * This procedure is invoked just before the application exits. It frees + * all of the LoadedPackage structures. * * Results: * None. @@ -1144,33 +1136,42 @@ TclFinalizeLoad() LoadedPackage *pkgPtr; /* - * No synchronization here because there should just be - * one thread alive at this point. Logically, - * packageMutex should be grabbed at this point, but - * the Mutexes get finalized before the call to this routine. - * The only subsystem left alive at this point is the - * memory allocator. + * No synchronization here because there should just be one thread alive + * at this point. Logically, packageMutex should be grabbed at this point, + * but the Mutexes get finalized before the call to this routine. The + * only subsystem left alive at this point is the memory allocator. */ while (firstPackagePtr != NULL) { pkgPtr = firstPackagePtr; firstPackagePtr = pkgPtr->nextPtr; + #if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__) /* - * Some Unix dlls are poorly behaved - registering things like - * atexit calls that can't be unregistered. If you unload - * such dlls, you get a core on exit because it wants to - * call a function in the dll after it's been unloaded. + * Some Unix dlls are poorly behaved - registering things like atexit + * calls that can't be unregistered. If you unload such dlls, you get + * a core on exit because it wants to call a function in the dll after + * it's been unloaded. */ + if (pkgPtr->fileName[0] != '\0') { Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr; if (unLoadProcPtr != NULL) { - (*unLoadProcPtr)(pkgPtr->loadHandle); + (*unLoadProcPtr)(pkgPtr->loadHandle); } } #endif + ckfree(pkgPtr->fileName); ckfree(pkgPtr->packageName); ckfree((char *) pkgPtr); } } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |