sl@0: /* sl@0: * tclLoad.c -- sl@0: * sl@0: * This file provides the generic portion (those that are the same sl@0: * on all platforms) of Tcl's dynamic loading facilities. sl@0: * sl@0: * Copyright (c) 1995-1997 Sun Microsystems, Inc. sl@0: * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved. sl@0: * sl@0: * See the file "license.terms" for information on usage and redistribution sl@0: * of this file, and for a DISCLAIMER OF ALL WARRANTIES. sl@0: * sl@0: * RCS: @(#) $Id: tclLoad.c,v 1.9 2003/02/01 23:37:29 kennykb Exp $ sl@0: */ sl@0: sl@0: #include "tclInt.h" sl@0: sl@0: /* sl@0: * The following structure describes a package that has been loaded sl@0: * either dynamically (with the "load" command) or statically (as sl@0: * indicated by a call to TclGetLoadedPackages). All such packages sl@0: * are linked together into a single list for the process. Packages sl@0: * are never unloaded, until the application exits, when sl@0: * TclFinalizeLoad is called, and these structures are freed. sl@0: */ sl@0: sl@0: typedef struct LoadedPackage { sl@0: char *fileName; /* Name of the file from which the sl@0: * package was loaded. An empty string sl@0: * means the package is loaded statically. sl@0: * Malloc-ed. */ sl@0: char *packageName; /* Name of package prefix for the package, sl@0: * properly capitalized (first letter UC, sl@0: * others LC), no "_", as in "Net". sl@0: * Malloc-ed. */ sl@0: Tcl_LoadHandle loadHandle; /* Token for the loaded file which should be sl@0: * passed to (*unLoadProcPtr)() when the file sl@0: * is no longer needed. If fileName is NULL, sl@0: * then this field is irrelevant. */ sl@0: Tcl_PackageInitProc *initProc; sl@0: /* Initialization procedure to call to sl@0: * incorporate this package into a trusted sl@0: * interpreter. */ sl@0: Tcl_PackageInitProc *safeInitProc; sl@0: /* Initialization procedure to call to sl@0: * incorporate this package into a safe sl@0: * interpreter (one that will execute sl@0: * untrusted scripts). NULL means the sl@0: * package can't be used in unsafe sl@0: * interpreters. */ sl@0: Tcl_FSUnloadFileProc *unLoadProcPtr; sl@0: /* Procedure to use to unload this package. sl@0: * If NULL, then we do not attempt to unload sl@0: * the package. If fileName is NULL, then sl@0: * this field is irrelevant. */ sl@0: struct LoadedPackage *nextPtr; sl@0: /* Next in list of all packages loaded into sl@0: * this application process. NULL means sl@0: * end of list. */ sl@0: } LoadedPackage; sl@0: sl@0: /* sl@0: * TCL_THREADS sl@0: * There is a global list of packages that is anchored at firstPackagePtr. sl@0: * Access to this list is governed by a mutex. sl@0: */ sl@0: sl@0: static LoadedPackage *firstPackagePtr = NULL; sl@0: /* First in list of all packages loaded into sl@0: * this process. */ sl@0: sl@0: TCL_DECLARE_MUTEX(packageMutex) sl@0: sl@0: /* sl@0: * The following structure represents a particular package that has sl@0: * been incorporated into a particular interpreter (by calling its sl@0: * initialization procedure). There is a list of these structures for sl@0: * each interpreter, with an AssocData value (key "load") for the sl@0: * interpreter that points to the first package (if any). sl@0: */ sl@0: sl@0: typedef struct InterpPackage { sl@0: LoadedPackage *pkgPtr; /* Points to detailed information about sl@0: * package. */ sl@0: struct InterpPackage *nextPtr; sl@0: /* Next package in this interpreter, or sl@0: * NULL for end of list. */ sl@0: } InterpPackage; sl@0: sl@0: /* sl@0: * Prototypes for procedures that are private to this file: sl@0: */ sl@0: sl@0: static void LoadCleanupProc _ANSI_ARGS_((ClientData clientData, sl@0: Tcl_Interp *interp)); sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_LoadObjCmd -- sl@0: * sl@0: * This procedure is invoked to process the "load" Tcl command. sl@0: * See the user documentation for details on what it does. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * See the user documentation. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: Tcl_LoadObjCmd(dummy, interp, objc, objv) sl@0: ClientData dummy; /* Not used. */ sl@0: Tcl_Interp *interp; /* Current interpreter. */ sl@0: int objc; /* Number of arguments. */ sl@0: Tcl_Obj *CONST objv[]; /* Argument objects. */ sl@0: { sl@0: Tcl_Interp *target; sl@0: LoadedPackage *pkgPtr, *defaultPtr; sl@0: Tcl_DString pkgName, tmp, initName, safeInitName; sl@0: Tcl_PackageInitProc *initProc, *safeInitProc; sl@0: InterpPackage *ipFirstPtr, *ipPtr; sl@0: int code, namesMatch, filesMatch; sl@0: char *p, *fullFileName, *packageName; sl@0: Tcl_LoadHandle loadHandle; sl@0: Tcl_FSUnloadFileProc *unLoadProcPtr = NULL; sl@0: Tcl_UniChar ch; sl@0: int offset; sl@0: sl@0: if ((objc < 2) || (objc > 4)) { sl@0: Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?"); sl@0: return TCL_ERROR; sl@0: } sl@0: if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { sl@0: return TCL_ERROR; sl@0: } sl@0: fullFileName = Tcl_GetString(objv[1]); sl@0: sl@0: Tcl_DStringInit(&pkgName); sl@0: Tcl_DStringInit(&initName); sl@0: Tcl_DStringInit(&safeInitName); sl@0: Tcl_DStringInit(&tmp); sl@0: sl@0: packageName = NULL; sl@0: if (objc >= 3) { sl@0: packageName = Tcl_GetString(objv[2]); sl@0: if (packageName[0] == '\0') { sl@0: packageName = NULL; sl@0: } sl@0: } sl@0: if ((fullFileName[0] == 0) && (packageName == NULL)) { sl@0: Tcl_SetResult(interp, sl@0: "must specify either file name or package name", sl@0: TCL_STATIC); sl@0: code = TCL_ERROR; sl@0: goto done; sl@0: } sl@0: sl@0: /* sl@0: * Figure out which interpreter we're going to load the package into. sl@0: */ sl@0: sl@0: target = interp; sl@0: if (objc == 4) { sl@0: char *slaveIntName; sl@0: slaveIntName = Tcl_GetString(objv[3]); sl@0: target = Tcl_GetSlave(interp, slaveIntName); sl@0: if (target == NULL) { sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Scan through the packages that are currently loaded to see if the sl@0: * package we want is already loaded. We'll use a loaded package if sl@0: * it meets any of the following conditions: sl@0: * - Its name and file match the once we're looking for. sl@0: * - Its file matches, and we weren't given a name. sl@0: * - Its name matches, the file name was specified as empty, and there sl@0: * is only no statically loaded package with the same name. sl@0: */ sl@0: Tcl_MutexLock(&packageMutex); sl@0: sl@0: defaultPtr = NULL; sl@0: for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { sl@0: if (packageName == NULL) { sl@0: namesMatch = 0; sl@0: } else { sl@0: Tcl_DStringSetLength(&pkgName, 0); sl@0: Tcl_DStringAppend(&pkgName, packageName, -1); sl@0: Tcl_DStringSetLength(&tmp, 0); sl@0: Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); sl@0: Tcl_UtfToLower(Tcl_DStringValue(&pkgName)); sl@0: Tcl_UtfToLower(Tcl_DStringValue(&tmp)); sl@0: if (strcmp(Tcl_DStringValue(&tmp), sl@0: Tcl_DStringValue(&pkgName)) == 0) { sl@0: namesMatch = 1; sl@0: } else { sl@0: namesMatch = 0; sl@0: } sl@0: } sl@0: Tcl_DStringSetLength(&pkgName, 0); sl@0: sl@0: filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); sl@0: if (filesMatch && (namesMatch || (packageName == NULL))) { sl@0: break; sl@0: } sl@0: if (namesMatch && (fullFileName[0] == 0)) { sl@0: defaultPtr = pkgPtr; sl@0: } sl@0: if (filesMatch && !namesMatch && (fullFileName[0] != 0)) { sl@0: /* sl@0: * Can't have two different packages loaded from the same sl@0: * file. sl@0: */ sl@0: sl@0: Tcl_AppendResult(interp, "file \"", fullFileName, sl@0: "\" is already loaded for package \"", sl@0: pkgPtr->packageName, "\"", (char *) NULL); sl@0: code = TCL_ERROR; sl@0: Tcl_MutexUnlock(&packageMutex); sl@0: goto done; sl@0: } sl@0: } sl@0: Tcl_MutexUnlock(&packageMutex); sl@0: if (pkgPtr == NULL) { sl@0: pkgPtr = defaultPtr; sl@0: } sl@0: sl@0: /* sl@0: * Scan through the list of packages already loaded in the target sl@0: * interpreter. If the package we want is already loaded there, sl@0: * then there's nothing for us to to. sl@0: */ sl@0: sl@0: if (pkgPtr != NULL) { sl@0: ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", sl@0: (Tcl_InterpDeleteProc **) NULL); sl@0: for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { sl@0: if (ipPtr->pkgPtr == pkgPtr) { sl@0: code = TCL_OK; sl@0: goto done; sl@0: } sl@0: } sl@0: } sl@0: sl@0: if (pkgPtr == NULL) { sl@0: /* sl@0: * The desired file isn't currently loaded, so load it. It's an sl@0: * error if the desired package is a static one. sl@0: */ sl@0: sl@0: if (fullFileName[0] == 0) { sl@0: Tcl_AppendResult(interp, "package \"", packageName, sl@0: "\" isn't loaded statically", (char *) NULL); sl@0: code = TCL_ERROR; sl@0: goto done; sl@0: } sl@0: sl@0: /* sl@0: * Figure out the module name if it wasn't provided explicitly. sl@0: */ sl@0: sl@0: if (packageName != NULL) { sl@0: Tcl_DStringAppend(&pkgName, packageName, -1); sl@0: } else { sl@0: int retc; sl@0: /* sl@0: * Threading note - this call used to be protected by a mutex. sl@0: */ sl@0: retc = TclGuessPackageName(fullFileName, &pkgName); sl@0: if (!retc) { sl@0: Tcl_Obj *splitPtr; sl@0: Tcl_Obj *pkgGuessPtr; sl@0: int pElements; sl@0: char *pkgGuess; sl@0: sl@0: /* sl@0: * The platform-specific code couldn't figure out the sl@0: * module name. Make a guess by taking the last element sl@0: * of the file name, stripping off any leading "lib", sl@0: * and then using all of the alphabetic and underline sl@0: * characters that follow that. sl@0: */ sl@0: sl@0: splitPtr = Tcl_FSSplitPath(objv[1], &pElements); sl@0: Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr); sl@0: pkgGuess = Tcl_GetString(pkgGuessPtr); sl@0: if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i') sl@0: && (pkgGuess[2] == 'b')) { sl@0: pkgGuess += 3; sl@0: } sl@0: for (p = pkgGuess; *p != 0; p += offset) { sl@0: offset = Tcl_UtfToUniChar(p, &ch); sl@0: if ((ch > 0x100) sl@0: || !(isalpha(UCHAR(ch)) /* INTL: ISO only */ sl@0: || (UCHAR(ch) == '_'))) { sl@0: break; sl@0: } sl@0: } sl@0: if (p == pkgGuess) { sl@0: Tcl_DecrRefCount(splitPtr); sl@0: Tcl_AppendResult(interp, sl@0: "couldn't figure out package name for ", sl@0: fullFileName, (char *) NULL); sl@0: code = TCL_ERROR; sl@0: goto done; sl@0: } sl@0: Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess)); sl@0: Tcl_DecrRefCount(splitPtr); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Fix the capitalization in the package name so that the first sl@0: * character is in caps (or title case) but the others are all sl@0: * lower-case. sl@0: */ sl@0: sl@0: Tcl_DStringSetLength(&pkgName, sl@0: Tcl_UtfToTitle(Tcl_DStringValue(&pkgName))); sl@0: sl@0: /* sl@0: * Compute the names of the two initialization procedures, sl@0: * based on the package name. sl@0: */ sl@0: sl@0: Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1); sl@0: Tcl_DStringAppend(&initName, "_Init", 5); sl@0: Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1); sl@0: Tcl_DStringAppend(&safeInitName, "_SafeInit", 9); sl@0: sl@0: /* sl@0: * Call platform-specific code to load the package and find the sl@0: * two initialization procedures. sl@0: */ sl@0: sl@0: Tcl_MutexLock(&packageMutex); sl@0: code = Tcl_FSLoadFile(interp, objv[1], Tcl_DStringValue(&initName), sl@0: Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc, sl@0: &loadHandle,&unLoadProcPtr); sl@0: Tcl_MutexUnlock(&packageMutex); sl@0: if (code != TCL_OK) { sl@0: goto done; sl@0: } sl@0: if (initProc == NULL) { sl@0: Tcl_AppendResult(interp, "couldn't find procedure ", sl@0: Tcl_DStringValue(&initName), (char *) NULL); sl@0: if (unLoadProcPtr != NULL) { sl@0: (*unLoadProcPtr)(loadHandle); sl@0: } sl@0: code = TCL_ERROR; sl@0: goto done; sl@0: } sl@0: sl@0: /* sl@0: * Create a new record to describe this package. sl@0: */ sl@0: sl@0: pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage)); sl@0: pkgPtr->fileName = (char *) ckalloc((unsigned) sl@0: (strlen(fullFileName) + 1)); sl@0: strcpy(pkgPtr->fileName, fullFileName); sl@0: pkgPtr->packageName = (char *) ckalloc((unsigned) sl@0: (Tcl_DStringLength(&pkgName) + 1)); sl@0: strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName)); sl@0: pkgPtr->loadHandle = loadHandle; sl@0: pkgPtr->unLoadProcPtr = unLoadProcPtr; sl@0: pkgPtr->initProc = initProc; sl@0: pkgPtr->safeInitProc = safeInitProc; sl@0: Tcl_MutexLock(&packageMutex); sl@0: pkgPtr->nextPtr = firstPackagePtr; sl@0: firstPackagePtr = pkgPtr; sl@0: Tcl_MutexUnlock(&packageMutex); sl@0: } sl@0: sl@0: /* sl@0: * Invoke the package's initialization procedure (either the sl@0: * normal one or the safe one, depending on whether or not the sl@0: * interpreter is safe). sl@0: */ sl@0: sl@0: if (Tcl_IsSafe(target)) { sl@0: if (pkgPtr->safeInitProc != NULL) { sl@0: code = (*pkgPtr->safeInitProc)(target); sl@0: } else { sl@0: Tcl_AppendResult(interp, sl@0: "can't use package in a safe interpreter: ", sl@0: "no ", pkgPtr->packageName, "_SafeInit procedure", sl@0: (char *) NULL); sl@0: code = TCL_ERROR; sl@0: goto done; sl@0: } sl@0: } else { sl@0: code = (*pkgPtr->initProc)(target); sl@0: } sl@0: sl@0: /* sl@0: * Record the fact that the package has been loaded in the sl@0: * target interpreter. sl@0: */ sl@0: sl@0: if (code == TCL_OK) { sl@0: /* sl@0: * Refetch ipFirstPtr: loading the package may have introduced sl@0: * additional static packages at the head of the linked list! sl@0: */ sl@0: sl@0: ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", sl@0: (Tcl_InterpDeleteProc **) NULL); sl@0: ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage)); sl@0: ipPtr->pkgPtr = pkgPtr; sl@0: ipPtr->nextPtr = ipFirstPtr; sl@0: Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, sl@0: (ClientData) ipPtr); sl@0: } else { sl@0: TclTransferResult(target, code, interp); sl@0: } sl@0: sl@0: done: sl@0: Tcl_DStringFree(&pkgName); sl@0: Tcl_DStringFree(&initName); sl@0: Tcl_DStringFree(&safeInitName); sl@0: Tcl_DStringFree(&tmp); sl@0: return code; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_StaticPackage -- sl@0: * sl@0: * This procedure is invoked to indicate that a particular sl@0: * package has been linked statically with an application. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Once this procedure completes, the package becomes loadable sl@0: * via the "load" command with an empty file name. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc) sl@0: Tcl_Interp *interp; /* If not NULL, it means that the sl@0: * package has already been loaded sl@0: * into the given interpreter by sl@0: * calling the appropriate init proc. */ sl@0: CONST char *pkgName; /* Name of package (must be properly sl@0: * capitalized: first letter upper sl@0: * case, others lower case). */ sl@0: Tcl_PackageInitProc *initProc; /* Procedure to call to incorporate sl@0: * this package into a trusted sl@0: * interpreter. */ sl@0: Tcl_PackageInitProc *safeInitProc; /* Procedure to call to incorporate sl@0: * this package into a safe interpreter sl@0: * (one that will execute untrusted sl@0: * scripts). NULL means the package sl@0: * can't be used in safe sl@0: * interpreters. */ sl@0: { sl@0: LoadedPackage *pkgPtr; sl@0: InterpPackage *ipPtr, *ipFirstPtr; sl@0: sl@0: /* sl@0: * Check to see if someone else has already reported this package as sl@0: * statically loaded in the process. sl@0: */ sl@0: sl@0: Tcl_MutexLock(&packageMutex); sl@0: for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { sl@0: if ((pkgPtr->initProc == initProc) sl@0: && (pkgPtr->safeInitProc == safeInitProc) sl@0: && (strcmp(pkgPtr->packageName, pkgName) == 0)) { sl@0: break; sl@0: } sl@0: } sl@0: Tcl_MutexUnlock(&packageMutex); sl@0: sl@0: /* sl@0: * If the package is not yet recorded as being loaded statically, sl@0: * add it to the list now. sl@0: */ sl@0: sl@0: if ( pkgPtr == NULL ) { sl@0: pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage)); sl@0: pkgPtr->fileName = (char *) ckalloc((unsigned) 1); sl@0: pkgPtr->fileName[0] = 0; sl@0: pkgPtr->packageName = (char *) ckalloc((unsigned) sl@0: (strlen(pkgName) + 1)); sl@0: strcpy(pkgPtr->packageName, pkgName); sl@0: pkgPtr->loadHandle = NULL; sl@0: pkgPtr->initProc = initProc; sl@0: pkgPtr->safeInitProc = safeInitProc; sl@0: Tcl_MutexLock(&packageMutex); sl@0: pkgPtr->nextPtr = firstPackagePtr; sl@0: firstPackagePtr = pkgPtr; sl@0: Tcl_MutexUnlock(&packageMutex); sl@0: } sl@0: sl@0: if (interp != NULL) { sl@0: sl@0: /* sl@0: * If we're loading the package into an interpreter, sl@0: * determine whether it's already loaded. sl@0: */ sl@0: sl@0: ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp, "tclLoad", sl@0: (Tcl_InterpDeleteProc **) NULL); sl@0: for ( ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr ) { sl@0: if ( ipPtr->pkgPtr == pkgPtr ) { sl@0: return; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Package isn't loade in the current interp yet. Mark it as sl@0: * now being loaded. sl@0: */ sl@0: sl@0: ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage)); sl@0: ipPtr->pkgPtr = pkgPtr; sl@0: ipPtr->nextPtr = ipFirstPtr; sl@0: Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, sl@0: (ClientData) ipPtr); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclGetLoadedPackages -- sl@0: * sl@0: * This procedure returns information about all of the files sl@0: * that are loaded (either in a particular intepreter, or sl@0: * for all interpreters). sl@0: * sl@0: * Results: sl@0: * The return value is a standard Tcl completion code. If sl@0: * successful, a list of lists is placed in the interp's result. sl@0: * Each sublist corresponds to one loaded file; its first sl@0: * element is the name of the file (or an empty string for sl@0: * something that's statically loaded) and the second element sl@0: * is the name of the package in that file. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclGetLoadedPackages(interp, targetName) sl@0: Tcl_Interp *interp; /* Interpreter in which to return sl@0: * information or error message. */ sl@0: char *targetName; /* Name of target interpreter or NULL. sl@0: * If NULL, return info about all interps; sl@0: * otherwise, just return info about this sl@0: * interpreter. */ sl@0: { sl@0: Tcl_Interp *target; sl@0: LoadedPackage *pkgPtr; sl@0: InterpPackage *ipPtr; sl@0: char *prefix; sl@0: sl@0: if (targetName == NULL) { sl@0: /* sl@0: * Return information about all of the available packages. sl@0: */ sl@0: sl@0: prefix = "{"; sl@0: Tcl_MutexLock(&packageMutex); sl@0: for (pkgPtr = firstPackagePtr; pkgPtr != NULL; sl@0: pkgPtr = pkgPtr->nextPtr) { sl@0: Tcl_AppendResult(interp, prefix, (char *) NULL); sl@0: Tcl_AppendElement(interp, pkgPtr->fileName); sl@0: Tcl_AppendElement(interp, pkgPtr->packageName); sl@0: Tcl_AppendResult(interp, "}", (char *) NULL); sl@0: prefix = " {"; sl@0: } sl@0: Tcl_MutexUnlock(&packageMutex); sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: * Return information about only the packages that are loaded in sl@0: * a given interpreter. sl@0: */ sl@0: sl@0: target = Tcl_GetSlave(interp, targetName); sl@0: if (target == NULL) { sl@0: return TCL_ERROR; sl@0: } sl@0: ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", sl@0: (Tcl_InterpDeleteProc **) NULL); sl@0: prefix = "{"; sl@0: for ( ; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { sl@0: pkgPtr = ipPtr->pkgPtr; sl@0: Tcl_AppendResult(interp, prefix, (char *) NULL); sl@0: Tcl_AppendElement(interp, pkgPtr->fileName); sl@0: Tcl_AppendElement(interp, pkgPtr->packageName); sl@0: Tcl_AppendResult(interp, "}", (char *) NULL); sl@0: prefix = " {"; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * LoadCleanupProc -- sl@0: * sl@0: * This procedure is called to delete all of the InterpPackage sl@0: * structures for an interpreter when the interpreter is deleted. sl@0: * It gets invoked via the Tcl AssocData mechanism. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Storage for all of the InterpPackage procedures for interp sl@0: * get deleted. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static void sl@0: LoadCleanupProc(clientData, interp) sl@0: ClientData clientData; /* Pointer to first InterpPackage structure sl@0: * for interp. */ sl@0: Tcl_Interp *interp; /* Interpreter that is being deleted. */ sl@0: { sl@0: InterpPackage *ipPtr, *nextPtr; sl@0: sl@0: ipPtr = (InterpPackage *) clientData; sl@0: while (ipPtr != NULL) { sl@0: nextPtr = ipPtr->nextPtr; sl@0: ckfree((char *) ipPtr); sl@0: ipPtr = nextPtr; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclFinalizeLoad -- sl@0: * sl@0: * This procedure is invoked just before the application exits. sl@0: * It frees all of the LoadedPackage structures. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Memory is freed. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: void sl@0: TclFinalizeLoad() sl@0: { sl@0: LoadedPackage *pkgPtr; sl@0: sl@0: /* sl@0: * No synchronization here because there should just be sl@0: * one thread alive at this point. Logically, sl@0: * packageMutex should be grabbed at this point, but sl@0: * the Mutexes get finalized before the call to this routine. sl@0: * The only subsystem left alive at this point is the sl@0: * memory allocator. sl@0: */ sl@0: sl@0: while (firstPackagePtr != NULL) { sl@0: pkgPtr = firstPackagePtr; sl@0: firstPackagePtr = pkgPtr->nextPtr; sl@0: #if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__) sl@0: /* sl@0: * Some Unix dlls are poorly behaved - registering things like sl@0: * atexit calls that can't be unregistered. If you unload sl@0: * such dlls, you get a core on exit because it wants to sl@0: * call a function in the dll after it's been unloaded. sl@0: */ sl@0: if (pkgPtr->fileName[0] != '\0') { sl@0: Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr; sl@0: if (unLoadProcPtr != NULL) { sl@0: (*unLoadProcPtr)(pkgPtr->loadHandle); sl@0: } sl@0: } sl@0: #endif sl@0: ckfree(pkgPtr->fileName); sl@0: ckfree(pkgPtr->packageName); sl@0: ckfree((char *) pkgPtr); sl@0: } sl@0: }