summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls16
-rw-r--r--generic/tclDecls.h36
-rw-r--r--generic/tclIOUtil.c310
-rw-r--r--generic/tclInt.h31
-rw-r--r--generic/tclLoad.c71
-rw-r--r--generic/tclLoadNone.c57
-rw-r--r--generic/tclStubInit.c5
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. */