diff options
Diffstat (limited to 'generic/tclLoad.c')
-rw-r--r-- | generic/tclLoad.c | 200 |
1 files changed, 83 insertions, 117 deletions
diff --git a/generic/tclLoad.c b/generic/tclLoad.c index e64d0e0..371a437 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -55,11 +55,6 @@ typedef struct LoadedPackage { * in trusted interpreters. */ int safeInterpRefCount; /* How many times the package has been loaded * in safe interpreters. */ - Tcl_FSUnloadFileProc *unLoadProcPtr; - /* Function to use to unload this package. If - * NULL, then we do not attempt to unload the - * package. If fileName is NULL, then this - * field is irrelevant. */ struct LoadedPackage *nextPtr; /* Next in list of all packages loaded into * this application process. NULL means end of @@ -129,16 +124,14 @@ Tcl_LoadObjCmd( LoadedPackage *pkgPtr, *defaultPtr; Tcl_DString pkgName, tmp, initName, safeInitName; Tcl_DString unloadName, safeUnloadName; - Tcl_PackageInitProc *initProc, *safeInitProc, *unloadProc, *safeUnloadProc; InterpPackage *ipFirstPtr, *ipPtr; int code, namesMatch, filesMatch, offset; - const char *symbols[4]; - Tcl_PackageInitProc **procPtrs[4]; - ClientData clientData; - char *p, *fullFileName, *packageName; + const char *symbols[2]; + Tcl_PackageInitProc *initProc; + const char *p, *fullFileName, *packageName; Tcl_LoadHandle loadHandle; - Tcl_FSUnloadFileProc *unLoadProcPtr = NULL; Tcl_UniChar ch; + unsigned len; if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?"); @@ -177,7 +170,7 @@ Tcl_LoadObjCmd( target = interp; if (objc == 4) { - char *slaveIntName = Tcl_GetString(objv[3]); + const char *slaveIntName = Tcl_GetString(objv[3]); target = Tcl_GetSlave(interp, slaveIntName); if (target == NULL) { @@ -250,8 +243,7 @@ Tcl_LoadObjCmd( */ if (pkgPtr != NULL) { - ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, - "tclLoad", NULL); + ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { if (ipPtr->pkgPtr == pkgPtr) { code = TCL_OK; @@ -288,10 +280,9 @@ Tcl_LoadObjCmd( retc = TclGuessPackageName(fullFileName, &pkgName); if (!retc) { - Tcl_Obj *splitPtr; - Tcl_Obj *pkgGuessPtr; + Tcl_Obj *splitPtr, *pkgGuessPtr; int pElements; - char *pkgGuess; + const char *pkgGuess; /* * The platform-specific code couldn't figure out the module @@ -358,50 +349,38 @@ Tcl_LoadObjCmd( */ 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[1] = NULL; Tcl_MutexLock(&packageMutex); - code = TclLoadFile(interp, objv[1], 4, symbols, procPtrs, - &loadHandle, &clientData, &unLoadProcPtr); + code = Tcl_LoadFile(interp, objv[1], symbols, 0, &initProc, + &loadHandle); Tcl_MutexUnlock(&packageMutex); - 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), NULL); - if (unLoadProcPtr != NULL) { - (*unLoadProcPtr)(loadHandle); - } - code = TCL_ERROR; - goto done; - } - /* * Create a new record to describe this package. */ - pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage)); - pkgPtr->fileName = (char *) ckalloc((unsigned) - (strlen(fullFileName) + 1)); - strcpy(pkgPtr->fileName, fullFileName); - pkgPtr->packageName = (char *) ckalloc((unsigned) - (Tcl_DStringLength(&pkgName) + 1)); - strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName)); + pkgPtr = ckalloc(sizeof(LoadedPackage)); + len = strlen(fullFileName) + 1; + pkgPtr->fileName = ckalloc(len); + memcpy(pkgPtr->fileName, fullFileName, len); + len = (unsigned) Tcl_DStringLength(&pkgName) + 1; + pkgPtr->packageName = ckalloc(len); + memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len); pkgPtr->loadHandle = loadHandle; - pkgPtr->unLoadProcPtr = unLoadProcPtr; - pkgPtr->initProc = *procPtrs[0]; - pkgPtr->safeInitProc = *procPtrs[1]; - pkgPtr->unloadProc = (Tcl_PackageUnloadProc*) *procPtrs[2]; - pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc*) *procPtrs[3]; + pkgPtr->initProc = initProc; + pkgPtr->safeInitProc = (Tcl_PackageInitProc *) + Tcl_FindSymbol(interp, loadHandle, + Tcl_DStringValue(&safeInitName)); + pkgPtr->unloadProc = (Tcl_PackageUnloadProc *) + Tcl_FindSymbol(interp, loadHandle, + Tcl_DStringValue(&unloadName)); + pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc *) + Tcl_FindSymbol(interp, loadHandle, + Tcl_DStringValue(&safeUnloadName)); pkgPtr->interpRefCount = 0; pkgPtr->safeInterpRefCount = 0; @@ -409,6 +388,13 @@ Tcl_LoadObjCmd( pkgPtr->nextPtr = firstPackagePtr; firstPackagePtr = pkgPtr; Tcl_MutexUnlock(&packageMutex); + + /* + * The Tcl_FindSymbol calls may have left a spurious error message in + * the interpreter result. + */ + + Tcl_ResetResult(interp); } /* @@ -417,17 +403,16 @@ Tcl_LoadObjCmd( */ if (Tcl_IsSafe(target)) { - if (pkgPtr->safeInitProc != NULL) { - code = (*pkgPtr->safeInitProc)(target); - } else { + if (pkgPtr->safeInitProc == NULL) { Tcl_AppendResult(interp, "can't use package in a safe interpreter: no ", pkgPtr->packageName, "_SafeInit procedure", NULL); code = TCL_ERROR; goto done; } + code = pkgPtr->safeInitProc(target); } else { - code = (*pkgPtr->initProc)(target); + code = pkgPtr->initProc(target); } /* @@ -442,9 +427,9 @@ Tcl_LoadObjCmd( Tcl_MutexLock(&packageMutex); if (Tcl_IsSafe(target)) { - ++pkgPtr->safeInterpRefCount; + pkgPtr->safeInterpRefCount++; } else { - ++pkgPtr->interpRefCount; + pkgPtr->interpRefCount++; } Tcl_MutexUnlock(&packageMutex); @@ -453,15 +438,13 @@ Tcl_LoadObjCmd( * additional static packages at the head of the linked list! */ - ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, - "tclLoad", NULL); - ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage)); + ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); + ipPtr = ckalloc(sizeof(InterpPackage)); ipPtr->pkgPtr = pkgPtr; ipPtr->nextPtr = ipFirstPtr; - Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, - (ClientData) ipPtr); + Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr); } else { - TclTransferResult(target, code, interp); + Tcl_TransferResult(target, code, interp); } done: @@ -506,8 +489,8 @@ Tcl_UnloadObjCmd( int i, index, code, complain = 1, keepLibrary = 0; int trustedRefCount = -1, safeRefCount = -1; const char *fullFileName = ""; - char *packageName; - static const char *options[] = { + const char *packageName; + static const char *const options[] = { "-nocomplain", "-keeplibrary", "--", NULL }; enum options { @@ -550,7 +533,7 @@ Tcl_UnloadObjCmd( endOfForLoop: if ((objc-i < 1) || (objc-i > 3)) { Tcl_WrongNumArgs(interp, 1, objv, - "?switches? fileName ?packageName? ?interp?"); + "?-switch ...? fileName ?packageName? ?interp?"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) { @@ -582,8 +565,8 @@ Tcl_UnloadObjCmd( target = interp; if (objc - i == 3) { - char *slaveIntName; - slaveIntName = Tcl_GetString(objv[i+2]); + const char *slaveIntName = Tcl_GetString(objv[i + 2]); + target = Tcl_GetSlave(interp, slaveIntName); if (target == NULL) { return TCL_ERROR; @@ -665,8 +648,7 @@ Tcl_UnloadObjCmd( code = TCL_ERROR; if (pkgPtr != NULL) { - ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, - "tclLoad", NULL); + ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { if (ipPtr->pkgPtr == pkgPtr) { code = TCL_OK; @@ -727,18 +709,18 @@ Tcl_UnloadObjCmd( Tcl_MutexUnlock(&packageMutex); if (Tcl_IsSafe(target)) { - --safeRefCount; + safeRefCount--; } else { - --trustedRefCount; + trustedRefCount--; } if (safeRefCount <= 0 && trustedRefCount <= 0) { code = TCL_UNLOAD_DETACH_FROM_PROCESS; } } - code = (*unloadProc)(target, code); + code = unloadProc(target, code); if (code != TCL_OK) { - TclTransferResult(target, code, interp); + Tcl_TransferResult(target, code, interp); goto done; } @@ -749,7 +731,7 @@ Tcl_UnloadObjCmd( Tcl_MutexLock(&packageMutex); if (Tcl_IsSafe(target)) { - --pkgPtr->safeInterpRefCount; + pkgPtr->safeInterpRefCount--; /* * Do not let counter get negative. @@ -759,7 +741,7 @@ Tcl_UnloadObjCmd( pkgPtr->safeInterpRefCount = 0; } } else { - --pkgPtr->interpRefCount; + pkgPtr->interpRefCount--; /* * Do not let counter get negative. @@ -789,14 +771,9 @@ Tcl_UnloadObjCmd( */ if (pkgPtr->fileName[0] != '\0') { - Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr; - if (unLoadProcPtr != NULL) { Tcl_MutexLock(&packageMutex); - if ((pkgPtr->unloadProc != NULL) || (unLoadProcPtr == TclFSUnloadTempFile)) { - (*unLoadProcPtr)(pkgPtr->loadHandle); - } - + if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) { /* * Remove this library from the loaded library cache. */ @@ -818,8 +795,7 @@ Tcl_UnloadObjCmd( * Remove this library from the interpreter's library cache. */ - ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, - "tclLoad", NULL); + ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); ipPtr = ipFirstPtr; if (ipPtr->pkgPtr == defaultPtr) { ipFirstPtr = ipFirstPtr->nextPtr; @@ -835,16 +811,13 @@ Tcl_UnloadObjCmd( } } Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, - (ClientData) ipFirstPtr); + ipFirstPtr); ckfree(defaultPtr->fileName); ckfree(defaultPtr->packageName); - ckfree((char *) defaultPtr); - ckfree((char *) ipPtr); + ckfree(defaultPtr); + ckfree(ipPtr); Tcl_MutexUnlock(&packageMutex); } else { - Tcl_AppendResult(interp, "file \"", fullFileName, - "\" cannot be unloaded: filesystem does not support unloading", - NULL); code = TCL_ERROR; } } @@ -875,8 +848,8 @@ Tcl_UnloadObjCmd( * Our result is the two reference counts. */ - objPtr[0] = Tcl_NewIntObj(trustedRefCount); - objPtr[1] = Tcl_NewIntObj(safeRefCount); + TclNewIntObj(objPtr[0], trustedRefCount); + TclNewIntObj(objPtr[1], safeRefCount); if (objPtr[0] == NULL || objPtr[1] == NULL) { if (objPtr[0]) { Tcl_DecrRefCount(objPtr[0]); @@ -885,7 +858,7 @@ Tcl_UnloadObjCmd( Tcl_DecrRefCount(objPtr[1]); } } else { - resultObjPtr = Tcl_NewListObj(2, objPtr); + TclNewListObj(resultObjPtr, 2, objPtr); if (resultObjPtr != NULL) { Tcl_SetObjResult(interp, resultObjPtr); } @@ -955,12 +928,11 @@ Tcl_StaticPackage( * to the list now. */ - if ( pkgPtr == NULL ) { - pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage)); - pkgPtr->fileName = (char *) ckalloc((unsigned) 1); + if (pkgPtr == NULL) { + pkgPtr = ckalloc(sizeof(LoadedPackage)); + pkgPtr->fileName = ckalloc(1); pkgPtr->fileName[0] = 0; - pkgPtr->packageName = (char *) - ckalloc((unsigned) (strlen(pkgName) + 1)); + pkgPtr->packageName = ckalloc(strlen(pkgName) + 1); strcpy(pkgPtr->packageName, pkgName); pkgPtr->loadHandle = NULL; pkgPtr->initProc = initProc; @@ -978,10 +950,9 @@ Tcl_StaticPackage( * it's already loaded. */ - ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp, - "tclLoad", NULL); - for ( ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr ) { - if ( ipPtr->pkgPtr == pkgPtr ) { + ipFirstPtr = Tcl_GetAssocData(interp, "tclLoad", NULL); + for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { + if (ipPtr->pkgPtr == pkgPtr) { return; } } @@ -991,11 +962,10 @@ Tcl_StaticPackage( * loaded. */ - ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage)); + ipPtr = ckalloc(sizeof(InterpPackage)); ipPtr->pkgPtr = pkgPtr; ipPtr->nextPtr = ipFirstPtr; - Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, - (ClientData) ipPtr); + Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr); } } @@ -1024,11 +994,12 @@ int TclGetLoadedPackages( Tcl_Interp *interp, /* Interpreter in which to return information * or error message. */ - char *targetName) /* Name of target interpreter or NULL. If + const char *targetName) /* Name of target interpreter or NULL. If * NULL, return info about all interps; * otherwise, just return info about this * interpreter. */ { + /* TODO: Use Tcl_Obj APIs to generate this info for cleanliness. */ Tcl_Interp *target; LoadedPackage *pkgPtr; InterpPackage *ipPtr; @@ -1062,9 +1033,9 @@ TclGetLoadedPackages( if (target == NULL) { return TCL_ERROR; } - ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", NULL); + ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL); prefix = "{"; - for ( ; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { + for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { pkgPtr = ipPtr->pkgPtr; Tcl_AppendResult(interp, prefix, NULL); Tcl_AppendElement(interp, pkgPtr->fileName); @@ -1101,10 +1072,10 @@ LoadCleanupProc( { InterpPackage *ipPtr, *nextPtr; - ipPtr = (InterpPackage *) clientData; + ipPtr = clientData; while (ipPtr != NULL) { nextPtr = ipPtr->nextPtr; - ckfree((char *) ipPtr); + ckfree(ipPtr); ipPtr = nextPtr; } } @@ -1134,8 +1105,8 @@ TclFinalizeLoad(void) /* * 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. + * 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) { @@ -1151,18 +1122,13 @@ TclFinalizeLoad(void) */ if (pkgPtr->fileName[0] != '\0') { - Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr; - if ((unLoadProcPtr != NULL) - && ((pkgPtr->unloadProc != NULL) - || (unLoadProcPtr == TclFSUnloadTempFile))) { - (*unLoadProcPtr)(pkgPtr->loadHandle); - } + Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle); } #endif ckfree(pkgPtr->fileName); ckfree(pkgPtr->packageName); - ckfree((char *) pkgPtr); + ckfree(pkgPtr); } } |