summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-10-24 09:52:50 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-10-24 09:52:50 (GMT)
commitdd02fe2c44cb40476303d7dacb4bc769c50ba185 (patch)
treecb385a8e13cf43627827d3ad611656503781a145 /generic
parent72693da145d4b3a7f165eb5cdff0bd0defb87993 (diff)
parentc450611fa62e31564086453d6921a47bd7fb9044 (diff)
downloadtcl-dd02fe2c44cb40476303d7dacb4bc769c50ba185.zip
tcl-dd02fe2c44cb40476303d7dacb4bc769c50ba185.tar.gz
tcl-dd02fe2c44cb40476303d7dacb4bc769c50ba185.tar.bz2
merge trunk
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCompCmds.c61
-rw-r--r--generic/tclDictObj.c2
-rw-r--r--generic/tclIOUtil.c58
-rw-r--r--generic/tclInt.h15
-rw-r--r--generic/tclLoadNone.c3
5 files changed, 78 insertions, 61 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 3f916a6..bba5384 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -787,6 +787,67 @@ TclCompileDictGetCmd(
}
int
+TclCompileDictUnsetCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokenPtr;
+ DefineLineInformation; /* TIP #280 */
+ int i, dictVarIndex, nameChars;
+ const char *name;
+
+ /*
+ * There must be at least one argument after the variable name for us to
+ * compile to bytecode.
+ */
+
+ if (parsePtr->numWords < 3) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * The dictionary variable must be a local scalar that is knowable at
+ * compile time; anything else exceeds the complexity of the opcode. So
+ * discover what the index is.
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+ name = tokenPtr[1].start;
+ nameChars = tokenPtr[1].size;
+ if (!TclIsLocalScalar(name, nameChars)) {
+ return TCL_ERROR;
+ }
+ dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
+ if (dictVarIndex < 0) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Remaining words (the key path) can be handled normally.
+ */
+
+ for (i=2 ; i<parsePtr->numWords ; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+
+ /*
+ * Now emit the instruction to do the dict manipulation.
+ */
+
+ TclEmitInstInt4( INST_DICT_UNSET, parsePtr->numWords-2, envPtr);
+ TclEmitInt4( dictVarIndex, envPtr);
+ return TCL_OK;
+}
+
+int
TclCompileDictForCmd(
Tcl_Interp *interp, /* Used for looking up stuff. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index d1087b2..ea9411c 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -104,7 +104,7 @@ static const EnsembleImplMap implementationMap[] = {
{"replace", DictReplaceCmd, NULL, NULL, NULL, 0 },
{"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 },
{"size", DictSizeCmd, NULL, NULL, NULL, 0 },
- {"unset", DictUnsetCmd, NULL, NULL, NULL, 0 },
+ {"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 },
{"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 },
{"values", DictValuesCmd, NULL, NULL, NULL, 0 },
{"with", DictWithCmd, TclCompileDictWithCmd, NULL, NULL, 0 },
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 2d6d898..ab08353 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) {
@@ -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 9bf492c..02c8a35 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);
@@ -3523,6 +3519,9 @@ MODULE_SCOPE int TclCompileDictLappendCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileDictSetCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileDictUnsetCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileDictUpdateCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
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",