diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tcl.decls | 16 | ||||
| -rw-r--r-- | generic/tclDecls.h | 36 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 310 | ||||
| -rw-r--r-- | generic/tclInt.h | 31 | ||||
| -rw-r--r-- | generic/tclLoad.c | 71 | ||||
| -rw-r--r-- | generic/tclLoadNone.c | 57 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 5 |
7 files changed, 336 insertions, 190 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index e9843a8..0e59216 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.172 2010/01/29 16:17:20 nijtmans Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.173 2010/04/02 21:21:04 kennykb Exp $ library tcl @@ -2305,6 +2305,20 @@ declare 626 generic { int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) } +# TIP #357 (Export TclLoadFile and TclpFindSymbol) kbk +declare 627 generic { + int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, + const char *symv[], int flags, void* procPtrs, + Tcl_LoadHandle* handlePtr) +} +declare 628 generic { + void* Tcl_FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle handle, + const char* symbol) +} +declare 629 generic { + int Tcl_FSUnloadFile(Tcl_Interp* interp, Tcl_LoadHandle handlePtr) +} + # ----- BASELINE -- FOR -- 8.6.0 ----- # ############################################################################## diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 2508da9..8c2db65 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDecls.h,v 1.174 2010/02/05 10:03:23 nijtmans Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.175 2010/04/02 21:21:05 kennykb Exp $ */ #ifndef _TCLDECLS @@ -3684,6 +3684,25 @@ EXTERN int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, EXTERN int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); #endif +#ifndef Tcl_LoadFile_TCL_DECLARED +#define Tcl_LoadFile_TCL_DECLARED +/* 627 */ +EXTERN int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, + const char *symv[], int flags, void*procPtrs, + Tcl_LoadHandle*handlePtr); +#endif +#ifndef Tcl_FindSymbol_TCL_DECLARED +#define Tcl_FindSymbol_TCL_DECLARED +/* 628 */ +EXTERN void* Tcl_FindSymbol(Tcl_Interp*interp, + Tcl_LoadHandle handle, const char*symbol); +#endif +#ifndef Tcl_FSUnloadFile_TCL_DECLARED +#define Tcl_FSUnloadFile_TCL_DECLARED +/* 629 */ +EXTERN int Tcl_FSUnloadFile(Tcl_Interp*interp, + Tcl_LoadHandle handlePtr); +#endif typedef struct TclStubHooks { const struct TclPlatStubs *tclPlatStubs; @@ -4346,6 +4365,9 @@ typedef struct TclStubs { int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */ int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */ int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */ + int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *symv[], int flags, void*procPtrs, Tcl_LoadHandle*handlePtr); /* 627 */ + void* (*tcl_FindSymbol) (Tcl_Interp*interp, Tcl_LoadHandle handle, const char*symbol); /* 628 */ + int (*tcl_FSUnloadFile) (Tcl_Interp*interp, Tcl_LoadHandle handlePtr); /* 629 */ } TclStubs; #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) @@ -6884,6 +6906,18 @@ extern const TclStubs *tclStubsPtr; #define Tcl_NRSubstObj \ (tclStubsPtr->tcl_NRSubstObj) /* 626 */ #endif +#ifndef Tcl_LoadFile +#define Tcl_LoadFile \ + (tclStubsPtr->tcl_LoadFile) /* 627 */ +#endif +#ifndef Tcl_FindSymbol +#define Tcl_FindSymbol \ + (tclStubsPtr->tcl_FindSymbol) /* 628 */ +#endif +#ifndef Tcl_FSUnloadFile +#define Tcl_FSUnloadFile \ + (tclStubsPtr->tcl_FSUnloadFile) /* 629 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index a838df6..c1e9430 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.170 2010/03/11 13:35:24 nijtmans Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.171 2010/04/02 21:21:06 kennykb Exp $ */ #include "tclInt.h" @@ -42,6 +42,10 @@ static void FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData); #ifdef TCL_THREADS static void FsRecacheFilesystemList(void); #endif +static void* DivertFindSymbol(Tcl_Interp* interp, + Tcl_LoadHandle loadHandle, + const char* symbol); +static void DivertUnloadFile(Tcl_LoadHandle loadHandle); /* * These form part of the native filesystem support. They are needed here @@ -2967,9 +2971,8 @@ Tcl_FSLoadFile( * function which should be used for this * file. */ { - const char *symbols[2]; - Tcl_PackageInitProc **procPtrs[2]; - ClientData clientData; + const char *symbols[3]; + void *procPtrs[2]; int res; /* @@ -2978,35 +2981,27 @@ Tcl_FSLoadFile( symbols[0] = sym1; symbols[1] = sym2; - procPtrs[0] = proc1Ptr; - procPtrs[1] = proc2Ptr; + symbols[2] = NULL; /* * Perform the load. */ - res = TclLoadFile(interp, pathPtr, 2, symbols, procPtrs, handlePtr, - &clientData, unloadProcPtr); - - /* - * Due to an unfortunate mis-design in Tcl 8.4 fs, when loading a shared - * library, we don't keep the loadHandle (for TclpFindSymbol) and the - * clientData (for the unloadProc) separately. In fact we effectively - * throw away the loadHandle and only use the clientData. It just so - * happens, for the native filesystem only, that these two are identical. - * - * This also means that the signatures Tcl_FSUnloadFileProc and - * Tcl_FSLoadFileProc are both misleading. - */ + res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr); + if (res == TCL_OK) { + *proc1Ptr = (Tcl_PackageInitProc*) procPtrs[0]; + *proc2Ptr = (Tcl_PackageInitProc*) procPtrs[1]; + } else { + *proc1Ptr = *proc2Ptr = NULL; + } - *handlePtr = clientData; return res; } /* *---------------------------------------------------------------------- * - * TclLoadFile -- + * Tcl_LoadFile -- * * Dynamically loads a binary code file into memory and returns the * addresses of a number of given functions within that file, if they are @@ -3020,54 +3015,42 @@ Tcl_FSLoadFile( * filesystems (and has other problems documented in the load man-page), * so it is advised that full paths are always used. * - * This function is currently private to Tcl. It may be exported in the - * future and its interface fixed (but we should clean up the - * loadHandle/clientData confusion at that time -- see the above comments - * in Tcl_FSLoadFile for details). For a public function, see - * Tcl_FSLoadFile. - * * Results: * A standard Tcl completion code. If an error occurs, an error message * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. This may later be unloaded by - * passing the clientData to the unloadProc. + * calling TclFS_UnloadFile. * *---------------------------------------------------------------------- */ int -TclLoadFile( +Tcl_LoadFile( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code. */ - int symc, /* Number of symbols/procPtrs in the next two - * arrays. */ const char *symbols[], /* Names of functions to look up in the file's * symbol table. */ - Tcl_PackageInitProc **procPtrs[], - /* Where to return the addresses corresponding + int flags, /* Flags (unused) */ + void *procVPtrs, /* Where to return the addresses corresponding * to symbols[]. */ - Tcl_LoadHandle *handlePtr, /* Filled with token for shared library + Tcl_LoadHandle *handlePtr) /* Filled with token for shared library * information which can be used in * TclpFindSymbol. */ - ClientData *clientDataPtr, /* Filled with token for dynamically loaded - * file which will be passed back to - * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr) - /* Filled with address of Tcl_FSUnloadFileProc - * function which should be used for this - * file. */ { + void** procPtrs = (void**) procVPtrs; const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); const Tcl_Filesystem *copyFsPtr; + Tcl_FSUnloadFileProc* unloadProcPtr; Tcl_Obj *copyToPtr; Tcl_LoadHandle newLoadHandle = NULL; - ClientData newClientData = NULL; + Tcl_LoadHandle divertedLoadHandle = NULL; Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL; FsDivertLoad *tvdlPtr; int retVal; + int i; if (fsPtr == NULL) { Tcl_SetErrno(ENOENT); @@ -3076,18 +3059,12 @@ TclLoadFile( if (fsPtr->loadFileProc != NULL) { int retVal = fsPtr->loadFileProc(interp, pathPtr, handlePtr, - unloadProcPtr); + &unloadProcPtr); if (retVal == TCL_OK) { if (*handlePtr == NULL) { return TCL_ERROR; } - - /* - * Copy this across, since both are equal for the native fs. - */ - - *clientDataPtr = *handlePtr; Tcl_ResetResult(interp); goto resolveSymbols; } @@ -3147,7 +3124,7 @@ TclLoadFile( ret = Tcl_Read(data, buffer, size); Tcl_Close(interp, data); ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr, - unloadProcPtr); + &unloadProcPtr); if (ret == TCL_OK && *handlePtr != NULL) { *clientDataPtr = *handlePtr; goto resolveSymbols; @@ -3163,12 +3140,7 @@ TclLoadFile( * to load. */ - copyToPtr = TclpTempFileName(); - if (copyToPtr == NULL) { - Tcl_AppendResult(interp, "couldn't create temporary file: ", - Tcl_PosixError(interp), NULL); - return TCL_ERROR; - } + copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr); Tcl_IncrRefCount(copyToPtr); copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr); @@ -3223,8 +3195,8 @@ TclLoadFile( Tcl_ResetResult(interp); - retVal = TclLoadFile(interp, copyToPtr, symc, symbols, procPtrs, - &newLoadHandle, &newClientData, &newUnloadProcPtr); + retVal = Tcl_LoadFile(interp, copyToPtr, symbols, 0, procPtrs, + &newLoadHandle); if (retVal != TCL_OK) { /* * The file didn't load successfully. @@ -3251,8 +3223,6 @@ TclLoadFile( */ *handlePtr = newLoadHandle; - *clientDataPtr = newClientData; - *unloadProcPtr = newUnloadProcPtr; Tcl_ResetResult(interp); return TCL_OK; } @@ -3307,20 +3277,36 @@ TclLoadFile( } copyToPtr = NULL; - *handlePtr = newLoadHandle; - *clientDataPtr = tvdlPtr; - *unloadProcPtr = TclFSUnloadTempFile; + + + divertedLoadHandle = (Tcl_LoadHandle) + ckalloc(sizeof (struct Tcl_LoadHandle_)); + divertedLoadHandle->clientData = (ClientData) tvdlPtr; + divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol; + divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile; + *handlePtr = divertedLoadHandle; Tcl_ResetResult(interp); return retVal; resolveSymbols: - { - int i; - - for (i=0 ; i<symc ; i++) { - if (symbols[i] != NULL) { - *procPtrs[i] = TclpFindSymbol(interp, *handlePtr, symbols[i]); + /* + * At this point, *handlePtr is already set up to the handle for the + * loaded library. We now try to resolve the symbols. + */ + if (symbols != NULL) { + for (i=0 ; symbols[i] != NULL; i++) { + procPtrs[i] = Tcl_FindSymbol(interp, *handlePtr, symbols[i]); + if (procPtrs[i] == NULL) { + /* + * At least one symbol in the list was not found. + * Unload the file, and report the problem back to the + * caller. (Tcl_FindSymbol should already have left an + * appropriate error message.) + */ + (*handlePtr)->unloadFileProcPtr(*handlePtr); + *handlePtr = NULL; + return TCL_ERROR; } } } @@ -3328,6 +3314,113 @@ TclLoadFile( } /* + *----------------------------------------------------------------------------- + * + * DivertFindSymbol -- + * + * Find a symbol in a shared library loaded by copy-from-VFS. + * + *----------------------------------------------------------------------------- + */ + +static void* +DivertFindSymbol(Tcl_Interp* interp, /* Tcl interpreter */ + Tcl_LoadHandle loadHandle, /* Handle to the diverted module */ + const char* symbol) /* Symbol to resolve */ +{ + FsDivertLoad* tvdlPtr = (FsDivertLoad*) (loadHandle->clientData); + Tcl_LoadHandle originalHandle = tvdlPtr->loadHandle; + return originalHandle->findSymbolProcPtr(interp, originalHandle, symbol); +} + +/* + *----------------------------------------------------------------------------- + * + * DivertUnloadFile -- + * + * Unloads a file that has been loaded by copying from VFS to the + * native filesystem. + * + * Parameters: + * loadHandle -- Handle of the file to unload + * + *----------------------------------------------------------------------------- + */ + +static void +DivertUnloadFile(Tcl_LoadHandle loadHandle) +{ + FsDivertLoad* tvdlPtr = (FsDivertLoad*) (loadHandle->clientData); + Tcl_LoadHandle originalHandle = tvdlPtr->loadHandle; + + /* + * This test should never trigger, since we give the client data in the + * function above. + */ + + if (tvdlPtr == NULL) { + return; + } + + /* + * Call the real 'unloadfile' proc we actually used. It is very important + * that we call this first, so that the shared library is actually + * unloaded by the OS. Otherwise, the following 'delete' may well fail + * because the shared library is still in use. + */ + + originalHandle->unloadFileProcPtr(originalHandle); + + /* What filesystem contains the temp copy of the library? */ + + if (tvdlPtr->divertedFilesystem == NULL) { + /* + * It was the native filesystem, and we have a special function + * available just for this purpose, which we know works even at this + * late stage. + */ + + TclpDeleteFile(tvdlPtr->divertedFileNativeRep); + NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep); + } else { + /* + * Remove the temporary file we created. Note, we may crash here + * because encodings have been taken down already. + */ + + if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile) + != TCL_OK) { + /* + * The above may have failed because the filesystem, or something + * it depends upon (e.g. encodings) have been taken down because + * Tcl is exiting. + * + * We may need to work out how to delete this file more robustly + * (or give the filesystem the information it needs to delete the + * file more robustly). + * + * In particular, one problem might be that the filesystem cannot + * extract the information it needs from the above path object + * because Tcl's entire filesystem apparatus (the code in this + * file) has been finalized, and it refuses to pass the internal + * representation to the filesystem. + */ + } + + /* + * And free up the allocations. This will also of course remove a + * refCount from the Tcl_Filesystem to which this file belongs, which + * could then free up the filesystem if we are exiting. + */ + + Tcl_DecrRefCount(tvdlPtr->divertedFile); + } + + ckfree((void*)tvdlPtr); + ckfree((void*)loadHandle); +} + +/* * This function used to be in the platform specific directories, but it has * now been made to work cross-platform. */ @@ -3366,9 +3459,84 @@ TclpLoadFile( *clientDataPtr = handle; - *proc1Ptr = TclpFindSymbol(interp, handle, sym1); - *proc2Ptr = TclpFindSymbol(interp, handle, sym2); + *proc1Ptr = Tcl_FindSymbol(interp, handle, sym1); + *proc2Ptr = Tcl_FindSymbol(interp, handle, sym2); + return TCL_OK; +} + +/* + *----------------------------------------------------------------------------- + * + * Tcl_FindSymbol -- + * + * Find a symbol in a loaded library + * + * Results: + * Returns a pointer to the symbol if found. If not found, returns + * NULL and leaves an error message in the interpreter result. + * + * This function was once filesystem-specific, but has been made portable + * by having TclpDlopen return a structure that includes procedure pointers. + * + *----------------------------------------------------------------------------- + */ + +void* +Tcl_FindSymbol(Tcl_Interp* interp, /* Tcl interpreter */ + Tcl_LoadHandle loadHandle, /* Handle to the loaded library */ + const char* symbol) /* Name of the symbol to resolve */ +{ + return (*(loadHandle->findSymbolProcPtr))(interp, loadHandle, symbol); +} + +/* + *----------------------------------------------------------------------------- + * + * Tcl_FSUnloadFile -- + * + * Unloads a library given its handle. Checks first that the library + * supports unloading. + * + *----------------------------------------------------------------------------- + */ + +int +Tcl_FSUnloadFile(Tcl_Interp* interp, /* Tcl interpreter */ + Tcl_LoadHandle handle) /* Handle of the file to unload */ +{ + if (handle->unloadFileProcPtr == NULL) { + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("cannot unload: filesystem " + "does not support unloading", + -1)); + } + return TCL_ERROR; + } else { + TclpUnloadFile(handle); return TCL_OK; + } +} + +/* + *----------------------------------------------------------------------------- + * + * TclpUnloadFile -- + * + * Unloads a library given its handle + * + * This function was once filesystem-specific, but has been made portable + * by having TclpDlopen return a structure that includes procedure pointers. + * + *----------------------------------------------------------------------------- + */ + +void +TclpUnloadFile(Tcl_LoadHandle handle) +{ + if (handle->unloadFileProcPtr != NULL) { + (*(handle->unloadFileProcPtr))(handle); + } } /* diff --git a/generic/tclInt.h b/generic/tclInt.h index 422e203..6c70fd2 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.466 2010/03/27 22:40:14 nijtmans Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.467 2010/04/02 21:21:06 kennykb Exp $ */ #ifndef _TCLINT @@ -2772,6 +2772,25 @@ typedef struct ForIterData { int word; /* Index of the body script in the command */ } ForIterData; +/* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile + * and Tcl_FindSymbol. This structure corresponds to an opaque + * typedef in tcl.h */ + +typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle, + const char* symbol); +struct Tcl_LoadHandle_ { + ClientData clientData; /* Client data is the load handle in the + * native filesystem if a module was loaded + * there, or an opaque pointer to a structure + * for further bookkeeping on load-from-VFS + * and load-from-memory */ + TclFindSymbolProc* findSymbolProcPtr; + /* Procedure that resolves symbols in a + * loaded module */ + Tcl_FSUnloadFileProc* unloadFileProcPtr; + /* Procedure that unloads a loaded module */ +}; + /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world: @@ -2922,12 +2941,6 @@ MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n, int *lines, Tcl_Obj *const *elems); MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); -MODULE_SCOPE int TclLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, - int symc, const char *symbols[], - Tcl_PackageInitProc **procPtrs[], - Tcl_LoadHandle *handlePtr, - ClientData *clientDataPtr, - Tcl_FSUnloadFileProc **unloadProcPtr); MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *indexPtr, Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, @@ -2965,6 +2978,7 @@ MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); +MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, int len); MODULE_SCOPE int TclpDeleteFile(const char *path); @@ -3017,7 +3031,6 @@ MODULE_SCOPE char * TclpReadlink(const char *fileName, Tcl_DString *linkPtr); MODULE_SCOPE void TclpSetInterfaces(void); MODULE_SCOPE void TclpSetVariables(Tcl_Interp *interp); -MODULE_SCOPE void TclpUnloadFile(Tcl_LoadHandle loadHandle); MODULE_SCOPE void * TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr); MODULE_SCOPE void TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr, void *data); @@ -3058,8 +3071,6 @@ MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); -MODULE_SCOPE Tcl_PackageInitProc *TclpFindSymbol(Tcl_Interp *interp, - Tcl_LoadHandle loadHandle, const char *symbol); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr); diff --git a/generic/tclLoad.c b/generic/tclLoad.c index e6e2ba5..8ba90ed 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -9,7 +9,7 @@ * 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.24 2010/03/05 14:34:04 dkf Exp $ + * RCS: @(#) $Id: tclLoad.c,v 1.25 2010/04/02 21:21:06 kennykb Exp $ */ #include "tclInt.h" @@ -57,11 +57,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 @@ -131,15 +126,12 @@ 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; + const char *symbols[2]; + void* procPtrs[1]; const char *p, *fullFileName, *packageName; Tcl_LoadHandle loadHandle; - Tcl_FSUnloadFileProc *unLoadProcPtr = NULL; Tcl_UniChar ch; if ((objc < 2) || (objc > 4)) { @@ -359,33 +351,15 @@ 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, procPtrs, &loadHandle); Tcl_MutexUnlock(&packageMutex); - 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. */ @@ -398,11 +372,14 @@ Tcl_LoadObjCmd( ckalloc((unsigned) (Tcl_DStringLength(&pkgName) + 1)); strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName)); 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 = (Tcl_PackageInitProc*) procPtrs[0]; + 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; @@ -410,6 +387,11 @@ 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); } /* @@ -787,14 +769,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. */ @@ -839,9 +816,6 @@ Tcl_UnloadObjCmd( ckfree((char *) ipPtr); Tcl_MutexUnlock(&packageMutex); } else { - Tcl_AppendResult(interp, "file \"", fullFileName, - "\" cannot be unloaded: filesystem does not support unloading", - NULL); code = TCL_ERROR; } } @@ -1146,12 +1120,7 @@ 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 diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c index 27484ca..dbb0a25 100644 --- a/generic/tclLoadNone.c +++ b/generic/tclLoadNone.c @@ -1,7 +1,7 @@ /* * tclLoadNone.c -- * - * This procedure provides a version of the TclLoadFile for use in + * This procedure provides a version of the TclpDlopen for use in * systems that don't support dynamic loading; it just returns an error. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadNone.c,v 1.13 2008/04/27 22:21:31 dkf Exp $ + * RCS: @(#) $Id: tclLoadNone.c,v 1.14 2010/04/02 21:21:06 kennykb Exp $ */ #include "tclInt.h" @@ -55,33 +55,6 @@ TclpDlopen( /* *---------------------------------------------------------------------- * - * TclpFindSymbol -- - * - * Looks up a symbol, by name, through a handle associated with a - * previously loaded piece of code (shared library). This version of this - * routine should never be called because the associated TclpDlopen() - * function always returns an error. - * - * Results: - * Returns a pointer to the function associated with 'symbol' if it is - * found. Otherwise returns NULL and may leave an error message in the - * interp's result. - * - *---------------------------------------------------------------------- - */ - -Tcl_PackageInitProc * -TclpFindSymbol( - Tcl_Interp *interp, - Tcl_LoadHandle loadHandle, - const char *symbol) -{ - return NULL; -} - -/* - *---------------------------------------------------------------------- - * * TclGuessPackageName -- * * If the "load" command is invoked without providing a package name, @@ -110,32 +83,6 @@ TclGuessPackageName( } /* - *---------------------------------------------------------------------- - * - * TclpUnloadFile -- - * - * This procedure is called to carry out dynamic unloading of binary code; - * it is intended for use only on systems that don't support dynamic - * loading (it does nothing). - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -void -TclpUnloadFile( - Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to - * TclpDlopen(). The loadHandle is a token - * that represents the loaded file. */ -{ -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index b7e4b9a..7cfa58a 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.189 2010/03/20 15:40:14 dkf Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.190 2010/04/02 21:21:06 kennykb Exp $ */ #include "tclInt.h" @@ -1115,6 +1115,9 @@ const TclStubs tclStubs = { Tcl_CloseEx, /* 624 */ Tcl_NRExprObj, /* 625 */ Tcl_NRSubstObj, /* 626 */ + Tcl_LoadFile, /* 627 */ + Tcl_FindSymbol, /* 628 */ + Tcl_FSUnloadFile, /* 629 */ }; /* !END!: Do not edit above this line. */ |