summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog14
-rw-r--r--generic/tclBasic.c6
-rw-r--r--generic/tclIOUtil.c60
-rw-r--r--generic/tclInt.h12
-rw-r--r--generic/tclLoadNone.c3
-rw-r--r--unix/tclLoadDl.c3
-rw-r--r--unix/tclLoadDyld.c13
-rw-r--r--unix/tclLoadNext.c3
-rw-r--r--unix/tclLoadOSF.c3
-rw-r--r--unix/tclLoadShl.c3
-rw-r--r--win/tclWinLoad.c3
11 files changed, 49 insertions, 74 deletions
diff --git a/ChangeLog b/ChangeLog
index bafd366..22f24b8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2012-10-23 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.h: Add "flags" parameter from Tcl_LoadFile to
+ * generic/tclIOUtil.c: to various internal functions, so these
+ * generic/tclLoadNone.c: flags are available through the whole
+ * unix/tclLoad*.c: filesystem for (future) internal use.
+ * win/tclWinLoad.c:
+
+2012-10-17 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (TclNRCoroutineObjCmd): insure that numlevels
+ are properly set, fix bug discovered by dkf and reported at
+ http://code.activestate.com/lists/tcl-core/12213/
+
2012-10-16 Donal K. Fellows <dkf@users.sf.net>
IMPLEMENTATION OF TIP#405
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7c08f2f..3848d5b 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -9028,7 +9028,6 @@ TclNRCoroutineObjCmd(
corPtr->running.lineLABCPtr = corPtr->lineLABCPtr;
corPtr->stackLevel = NULL;
corPtr->auxNumLevels = 0;
- iPtr->numLevels--;
/*
* Create the coro's execEnv, switch to it to push the exit and coro
@@ -9047,16 +9046,17 @@ TclNRCoroutineObjCmd(
TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
NULL, NULL, NULL);
+ /* insure that the command is looked up in the correct namespace */
iPtr->lookupNsPtr = lookupNsPtr;
Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
+ iPtr->numLevels--;
SAVE_CONTEXT(corPtr->running);
RESTORE_CONTEXT(corPtr->caller);
iPtr->execEnvPtr = corPtr->callerEEPtr;
/*
- * Now just resume the coroutine. Take care to insure that the command is
- * looked up in the correct namespace.
+ * Now just resume the coroutine.
*/
TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 2d6d898..7991239 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -182,8 +182,8 @@ const Tcl_Filesystem tclNativeFilesystem = {
TclpObjRenameFile,
TclpObjCopyDirectory,
TclpObjLstat,
- TclpDlopen,
- /* Needs a cast since we're using version_2. */
+ /* Needs casts since we're using version_2. */
+ (Tcl_FSLoadFileProc *) TclpDlopen,
(Tcl_FSGetCwdProc *) TclpGetNativeCwd,
TclpObjChdir
};
@@ -3120,7 +3120,7 @@ Tcl_LoadFile(
* code. */
const char *const symbols[],/* Names of functions to look up in the file's
* symbol table. */
- int flags, /* Flags (unused) */
+ int flags, /* Flags */
void *procVPtrs, /* Where to return the addresses corresponding
* to symbols[]. */
Tcl_LoadHandle *handlePtr) /* Filled with token for shared library
@@ -3145,8 +3145,8 @@ Tcl_LoadFile(
}
if (fsPtr->loadFileProc != NULL) {
- int retVal = fsPtr->loadFileProc(interp, pathPtr, handlePtr,
- &unloadProcPtr);
+ int retVal = ((Tcl_FSLoadFileProc2 *)(fsPtr->loadFileProc))
+ (interp, pathPtr, handlePtr, &unloadProcPtr, flags);
if (retVal == TCL_OK) {
if (*handlePtr == NULL) {
@@ -3204,7 +3204,7 @@ Tcl_LoadFile(
if (!data) {
goto mustCopyToTempAnyway;
}
- buffer = TclpLoadMemoryGetBuffer(interp, size);
+ buffer = TclpLoadMemoryGetBuffer(interp, size, flags);
if (!buffer) {
Tcl_Close(interp, data);
goto mustCopyToTempAnyway;
@@ -3212,7 +3212,7 @@ Tcl_LoadFile(
ret = Tcl_Read(data, buffer, size);
Tcl_Close(interp, data);
ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
- &unloadProcPtr);
+ &unloadProcPtr, flags);
if (ret == TCL_OK && *handlePtr != NULL) {
goto resolveSymbols;
}
@@ -3283,7 +3283,7 @@ Tcl_LoadFile(
Tcl_ResetResult(interp);
- retVal = Tcl_LoadFile(interp, copyToPtr, symbols, 0, procPtrs,
+ retVal = Tcl_LoadFile(interp, copyToPtr, symbols, flags, procPtrs,
&newLoadHandle);
if (retVal != TCL_OK) {
/*
@@ -3515,50 +3515,6 @@ DivertUnloadFile(
}
/*
- * This function used to be in the platform specific directories, but it has
- * now been made to work cross-platform.
- */
-
-int
-TclpLoadFile(
- Tcl_Interp *interp, /* Used for error reporting. */
- Tcl_Obj *pathPtr, /* Name of the file containing the desired
- * code (UTF-8). */
- const char *sym1, const char *sym2,
- /* Names of two functions to look up in the
- * file's symbol table. */
- Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr,
- /* Where to return the addresses corresponding
- * to sym1 and sym2. */
- 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. */
-{
- Tcl_LoadHandle handle = NULL;
- int res;
-
- res = TclpDlopen(interp, pathPtr, &handle, unloadProcPtr);
-
- if (res != TCL_OK) {
- return res;
- }
-
- if (handle == NULL) {
- return TCL_ERROR;
- }
-
- *clientDataPtr = handle;
-
- *proc1Ptr = (Tcl_PackageInitProc*) Tcl_FindSymbol(interp, handle, sym1);
- *proc2Ptr = (Tcl_PackageInitProc*) Tcl_FindSymbol(interp, handle, sym2);
- return TCL_OK;
-}
-
-/*
*----------------------------------------------------------------------
*
* Tcl_FindSymbol --
diff --git a/generic/tclInt.h b/generic/tclInt.h
index c716ed2..860755a 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2564,6 +2564,8 @@ typedef struct List {
#define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2)
typedef ClientData (TclFSGetCwdProc2)(ClientData clientData);
+typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
/*
* The following types are used for getting and storing platform-specific file
@@ -3082,12 +3084,6 @@ MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr,
MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE void TclpInitPlatform(void);
MODULE_SCOPE void TclpInitUnlock(void);
-MODULE_SCOPE int TclpLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
- const char *sym1, const char *sym2,
- Tcl_PackageInitProc **proc1Ptr,
- Tcl_PackageInitProc **proc2Ptr,
- ClientData *clientDataPtr,
- Tcl_FSUnloadFileProc **unloadProcPtr);
MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void);
MODULE_SCOPE void TclpMasterLock(void);
MODULE_SCOPE void TclpMasterUnlock(void);
@@ -3166,13 +3162,13 @@ MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_LoadHandle *loadHandle,
- Tcl_FSUnloadFileProc **unloadProcPtr);
+ Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
MODULE_SCOPE int TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
#ifdef TCL_LOAD_FROM_MEMORY
MODULE_SCOPE void * TclpLoadMemoryGetBuffer(Tcl_Interp *interp, int size);
MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer,
int size, int codeSize, Tcl_LoadHandle *loadHandle,
- Tcl_FSUnloadFileProc **unloadProcPtr);
+ Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
#endif
MODULE_SCOPE void TclInitThreadStorage(void);
MODULE_SCOPE void TclFinalizeThreadDataThread(void);
diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c
index 6b48aee..f030d89 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -39,10 +39,11 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"dynamic loading is not currently available on this system",
diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c
index a48aa23..9ff7657 100644
--- a/unix/tclLoadDl.c
+++ b/unix/tclLoadDl.c
@@ -66,10 +66,11 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
void *handle;
Tcl_LoadHandle newHandle;
diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c
index 95735a4..4f39d1f 100644
--- a/unix/tclLoadDyld.c
+++ b/unix/tclLoadDyld.c
@@ -16,7 +16,7 @@
#include "tclInt.h"
#ifndef MODULE_SCOPE
-# define MODULE_SCOPE extern
+# define MODULE_SCOPE extern
#endif
/*
@@ -148,10 +148,11 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
Tcl_DyldLoadHandle *dyldLoadHandle;
Tcl_LoadHandle newHandle;
@@ -238,7 +239,7 @@ TclpDlopen(
&dyldObjFileImage);
if (err == NSObjectFileImageSuccess && dyldObjFileImage) {
module = NSLinkModule(dyldObjFileImage, nativePath,
- NSLINKMODULE_OPTION_BINDNOW
+ NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_PRIVATE
| NSLINKMODULE_OPTION_RETURN_ON_ERROR);
NSDestroyObjectFileImage(dyldObjFileImage);
if (module) {
@@ -552,10 +553,11 @@ TclpLoadMemory(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
Tcl_LoadHandle newHandle;
Tcl_DyldLoadHandle *dyldLoadHandle;
@@ -658,7 +660,8 @@ TclpLoadMemory(
*/
module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]",
- NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_RETURN_ON_ERROR);
+ NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_PRIVATE
+ | NSLINKMODULE_OPTION_RETURN_ON_ERROR);
NSDestroyObjectFileImage(dyldObjFileImage);
if (!module) {
NSLinkEditErrors editError;
diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c
index 06df2db..f5911f8 100644
--- a/unix/tclLoadNext.c
+++ b/unix/tclLoadNext.c
@@ -46,10 +46,11 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
Tcl_LoadHandle newHandle;
struct mach_header *header;
diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c
index 6e76b55..377ed28 100644
--- a/unix/tclLoadOSF.c
+++ b/unix/tclLoadOSF.c
@@ -70,10 +70,11 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
Tcl_LoadHandle newHandle;
ldr_module_t lm;
diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c
index 7b80bcc..f73c164 100644
--- a/unix/tclLoadShl.c
+++ b/unix/tclLoadShl.c
@@ -57,10 +57,11 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
shl_t handle;
Tcl_LoadHandle newHandle;
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index 6294086..3e11224 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -57,10 +57,11 @@ TclpDlopen(
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
+ int flags)
{
HINSTANCE hInstance;
const TCHAR *nativeName;
generated by cgit v0.12 at 2024-11-23 20:48:44 (GMT)