diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2012-10-24 09:52:50 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2012-10-24 09:52:50 (GMT) |
commit | dd02fe2c44cb40476303d7dacb4bc769c50ba185 (patch) | |
tree | cb385a8e13cf43627827d3ad611656503781a145 /generic | |
parent | 72693da145d4b3a7f165eb5cdff0bd0defb87993 (diff) | |
parent | c450611fa62e31564086453d6921a47bd7fb9044 (diff) | |
download | tcl-dd02fe2c44cb40476303d7dacb4bc769c50ba185.zip tcl-dd02fe2c44cb40476303d7dacb4bc769c50ba185.tar.gz tcl-dd02fe2c44cb40476303d7dacb4bc769c50ba185.tar.bz2 |
merge trunk
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclCompCmds.c | 61 | ||||
-rw-r--r-- | generic/tclDictObj.c | 2 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 58 | ||||
-rw-r--r-- | generic/tclInt.h | 15 | ||||
-rw-r--r-- | generic/tclLoadNone.c | 3 |
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", |