Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge trunk |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | novem |
Files: | files | file ages | folders |
SHA1: |
389eae3a70359105e37c0464dcbbc285 |
User & Date: | jan.nijtmans 2013-05-15 11:03:41 |
Context
2013-05-17
| ||
13:49 | merge trunk check-in: c8652a1430 user: jan.nijtmans tags: novem | |
2013-05-15
| ||
11:03 | merge trunk check-in: 389eae3a70 user: jan.nijtmans tags: novem | |
10:56 | Removing a few changes that were not actually needed, and correcting comments. check-in: e112c51022 user: dkf tags: trunk | |
10:42 | merge trunk check-in: afed07eb5d user: jan.nijtmans tags: novem | |
Changes
Changes to generic/tclAssembly.c.
︙ | ︙ | |||
16 17 18 19 20 21 22 | /*- *- THINGS TO DO: *- More instructions: *- done - alternate exit point (affects stack and exception range checking) *- break and continue - if exception ranges can be sorted out. *- foreach_start4, foreach_step4 *- returnImm, returnStk | | | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | /*- *- THINGS TO DO: *- More instructions: *- done - alternate exit point (affects stack and exception range checking) *- break and continue - if exception ranges can be sorted out. *- foreach_start4, foreach_step4 *- returnImm, returnStk *- expandStart, expandStkTop, invokeExpanded *- dictFirst, dictNext, dictDone *- dictUpdateStart, dictUpdateEnd *- jumpTable testing *- syntax (?) *- returnCodeBranch */ |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
167 168 169 170 171 172 173 | */ typedef struct { const char *name; /* Name of object-based command. */ Tcl_ObjCmdProc *objProc; /* Object-based function for command. */ CompileProc *compileProc; /* Function called to compile command. */ Tcl_ObjCmdProc *nreProc; /* NR-based function for command */ | | < < > > > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 | */ typedef struct { const char *name; /* Name of object-based command. */ Tcl_ObjCmdProc *objProc; /* Object-based function for command. */ CompileProc *compileProc; /* Function called to compile command. */ Tcl_ObjCmdProc *nreProc; /* NR-based function for command */ int flags; /* Various flag bits, as defined below. */ } CmdInfo; #define CMD_IS_SAFE 1 /* Whether this command is part of the set of * commands present by default in a safe * interpreter. */ /* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle * expansion for itself rather than needing the generic layer to take care of * it for it. Defined in tclInt.h. */ /* * The built-in commands, and the functions that implement them: */ static const CmdInfo builtInCmds[] = { /* * Commands in the generic core. */ {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, {"concat", Tcl_ConcatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE}, {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE}, {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, CMD_IS_SAFE}, {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, CMD_IS_SAFE}, {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE}, {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE}, {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE}, {"join", Tcl_JoinObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE}, {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE}, {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE}, {"linsert", Tcl_LinsertObjCmd, NULL, NULL, CMD_IS_SAFE}, {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED}, {"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE}, {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE}, {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, {"package", Tcl_PackageObjCmd, NULL, NULL, CMD_IS_SAFE}, {"proc", Tcl_ProcObjCmd, NULL, NULL, CMD_IS_SAFE}, {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE}, {"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, CMD_IS_SAFE}, {"rename", Tcl_RenameObjCmd, NULL, NULL, CMD_IS_SAFE}, {"return", Tcl_ReturnObjCmd, TclCompileReturnCmd, NULL, CMD_IS_SAFE}, {"scan", Tcl_ScanObjCmd, NULL, NULL, CMD_IS_SAFE}, {"set", Tcl_SetObjCmd, TclCompileSetCmd, NULL, CMD_IS_SAFE}, {"split", Tcl_SplitObjCmd, NULL, NULL, CMD_IS_SAFE}, {"subst", Tcl_SubstObjCmd, TclCompileSubstCmd, TclNRSubstObjCmd, CMD_IS_SAFE}, {"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, TclNRSwitchObjCmd, CMD_IS_SAFE}, {"tailcall", NULL, TclCompileTailcallCmd, TclNRTailcallObjCmd, CMD_IS_SAFE}, {"throw", Tcl_ThrowObjCmd, TclCompileThrowCmd, NULL, CMD_IS_SAFE}, {"trace", Tcl_TraceObjCmd, NULL, NULL, CMD_IS_SAFE}, {"try", Tcl_TryObjCmd, TclCompileTryCmd, TclNRTryObjCmd, CMD_IS_SAFE}, {"unset", Tcl_UnsetObjCmd, TclCompileUnsetCmd, NULL, CMD_IS_SAFE}, {"uplevel", Tcl_UplevelObjCmd, NULL, TclNRUplevelObjCmd, CMD_IS_SAFE}, {"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, CMD_IS_SAFE}, {"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, CMD_IS_SAFE}, {"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, CMD_IS_SAFE}, {"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, CMD_IS_SAFE}, {"yieldto", NULL, NULL, TclNRYieldToObjCmd, CMD_IS_SAFE}, /* * Commands in the OS-interface. Note that many of these are unsafe. */ {"after", Tcl_AfterObjCmd, NULL, NULL, CMD_IS_SAFE}, {"cd", Tcl_CdObjCmd, NULL, NULL, 0}, {"close", Tcl_CloseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"eof", Tcl_EofObjCmd, NULL, NULL, CMD_IS_SAFE}, {"encoding", Tcl_EncodingObjCmd, NULL, NULL, 0}, {"exec", Tcl_ExecObjCmd, NULL, NULL, 0}, {"exit", Tcl_ExitObjCmd, NULL, NULL, 0}, {"fblocked", Tcl_FblockedObjCmd, NULL, NULL, CMD_IS_SAFE}, {"fconfigure", Tcl_FconfigureObjCmd, NULL, NULL, 0}, {"fcopy", Tcl_FcopyObjCmd, NULL, NULL, CMD_IS_SAFE}, {"fileevent", Tcl_FileEventObjCmd, NULL, NULL, CMD_IS_SAFE}, {"flush", Tcl_FlushObjCmd, NULL, NULL, CMD_IS_SAFE}, {"gets", Tcl_GetsObjCmd, NULL, NULL, CMD_IS_SAFE}, {"glob", Tcl_GlobObjCmd, NULL, NULL, 0}, {"load", Tcl_LoadObjCmd, NULL, NULL, 0}, {"open", Tcl_OpenObjCmd, NULL, NULL, 0}, {"pid", Tcl_PidObjCmd, NULL, NULL, CMD_IS_SAFE}, {"puts", Tcl_PutsObjCmd, NULL, NULL, CMD_IS_SAFE}, {"pwd", Tcl_PwdObjCmd, NULL, NULL, 0}, {"read", Tcl_ReadObjCmd, NULL, NULL, CMD_IS_SAFE}, {"seek", Tcl_SeekObjCmd, NULL, NULL, CMD_IS_SAFE}, {"socket", Tcl_SocketObjCmd, NULL, NULL, 0}, {"source", Tcl_SourceObjCmd, NULL, TclNRSourceObjCmd, 0}, {"tell", Tcl_TellObjCmd, NULL, NULL, CMD_IS_SAFE}, {"time", Tcl_TimeObjCmd, NULL, NULL, CMD_IS_SAFE}, {"unload", Tcl_UnloadObjCmd, NULL, NULL, 0}, {"update", Tcl_UpdateObjCmd, NULL, NULL, CMD_IS_SAFE}, {"vwait", Tcl_VwaitObjCmd, NULL, NULL, CMD_IS_SAFE}, {NULL, NULL, NULL, NULL, 0} }; /* * Math functions. All are safe. */ |
︙ | ︙ | |||
739 740 741 742 743 744 745 746 747 748 749 750 751 752 | cmdPtr->proc = TclInvokeObjectCommand; cmdPtr->clientData = cmdPtr; cmdPtr->objProc = cmdInfoPtr->objProc; cmdPtr->objClientData = NULL; cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; cmdPtr->flags = 0; cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; cmdPtr->nreProc = cmdInfoPtr->nreProc; Tcl_SetHashValue(hPtr, cmdPtr); } } | > > > | 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 | cmdPtr->proc = TclInvokeObjectCommand; cmdPtr->clientData = cmdPtr; cmdPtr->objProc = cmdInfoPtr->objProc; cmdPtr->objClientData = NULL; cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; cmdPtr->flags = 0; if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { cmdPtr->flags |= CMD_COMPILES_EXPANDED; } cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; cmdPtr->nreProc = cmdInfoPtr->nreProc; Tcl_SetHashValue(hPtr, cmdPtr); } } |
︙ | ︙ | |||
971 972 973 974 975 976 977 | { register const CmdInfo *cmdInfoPtr; if (interp == NULL) { return TCL_ERROR; } for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { | | | 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 | { register const CmdInfo *cmdInfoPtr; if (interp == NULL) { return TCL_ERROR; } for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) { Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name); } } TclMakeFileCommandSafe(interp); /* Ugh! */ return TCL_OK; } |
︙ | ︙ |
Changes to generic/tclCompCmds.c.
︙ | ︙ | |||
4462 4463 4464 4465 4466 4467 4468 | * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *valueTokenPtr; | | | 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 | * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *valueTokenPtr; int i, numWords, concat, build; Tcl_Obj *listObj, *objPtr; if (parsePtr->numWords == 1) { /* * [list] without arguments just pushes an empty object. */ |
︙ | ︙ | |||
4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 | /* * Push the all values onto the stack. */ numWords = parsePtr->numWords; valueTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i = 1; i < numWords; i++) { CompileWord(envPtr, valueTokenPtr, interp, i); valueTokenPtr = TokenAfter(valueTokenPtr); } | > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > | 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 | /* * Push the all values onto the stack. */ numWords = parsePtr->numWords; valueTokenPtr = TokenAfter(parsePtr->tokenPtr); concat = build = 0; for (i = 1; i < numWords; i++) { if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) { TclEmitInstInt4( INST_LIST, build, envPtr); if (concat) { TclEmitOpcode( INST_LIST_CONCAT, envPtr); } build = 0; concat = 1; } CompileWord(envPtr, valueTokenPtr, interp, i); if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD) { if (concat) { TclEmitOpcode( INST_LIST_CONCAT, envPtr); } else { concat = 1; } } else { build++; } valueTokenPtr = TokenAfter(valueTokenPtr); } if (build > 0) { TclEmitInstInt4( INST_LIST, build, envPtr); if (concat) { TclEmitOpcode( INST_LIST_CONCAT, envPtr); } } /* * If there was just one expanded word, we must ensure that it is a list * at this point. We use an [lrange ... 0 end] for this (instead of * [llength], as with literals) as we must drop any string representation * that might be hanging around. */ if (concat && numWords == 2) { TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); TclEmitInt4( -2, envPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileLlengthCmd -- |
︙ | ︙ |
Changes to generic/tclCompile.c.
︙ | ︙ | |||
276 277 278 279 280 281 282 | {"returnImm", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}}, /* Compiled [return], code, level are operands; options and result * are on the stack. */ {"expon", 1, -1, 0, {OPERAND_NONE}}, /* Binary exponentiation operator: push (stknext ** stktop) */ /* | | | | | | | 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 | {"returnImm", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}}, /* Compiled [return], code, level are operands; options and result * are on the stack. */ {"expon", 1, -1, 0, {OPERAND_NONE}}, /* Binary exponentiation operator: push (stknext ** stktop) */ /* * NOTE: the stack effects of expandStkTop and invokeExpanded are wrong - * but it cannot be done right at compile time, the stack effect is only * known at run time. The value for invokeExpanded is estimated better at * compile time. * See the comments further down in this file, where INST_INVOKE_EXPANDED * is emitted. */ {"expandStart", 1, 0, 0, {OPERAND_NONE}}, /* Start of command with {*} (expanded) arguments */ {"expandStkTop", 5, 0, 1, {OPERAND_UINT4}}, /* Expand the list at stacktop: push its elements on the stack */ {"invokeExpanded", 1, 0, 0, {OPERAND_NONE}}, /* Invoke the command marked by the last 'expandStart' */ |
︙ | ︙ | |||
535 536 537 538 539 540 541 | * the word at the top of the stack; * <objc,objv> = <op4,top op4 after popping 1> */ {"listConcat", 1, -1, 0, {OPERAND_NONE}}, /* Concatenates the two lists at the top of the stack into a single * list and pushes that resulting list onto the stack. * Stack: ... list1 list2 => ... [lconcat list1 list2] */ | < < > > | 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 | * the word at the top of the stack; * <objc,objv> = <op4,top op4 after popping 1> */ {"listConcat", 1, -1, 0, {OPERAND_NONE}}, /* Concatenates the two lists at the top of the stack into a single * list and pushes that resulting list onto the stack. * Stack: ... list1 list2 => ... [lconcat list1 list2] */ {NULL, 0, 0, 0, {OPERAND_NONE}} }; /* * Prototypes for procedures defined later in this file: */ static ByteCode * CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); static void DupByteCodeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static unsigned char * EncodeCmdLocMap(CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr); static void EnterCmdExtentData(CompileEnv *envPtr, int cmdNumber, int numSrcBytes, int numCodeBytes); static void EnterCmdStartData(CompileEnv *envPtr, int cmdNumber, int srcOffset, int codeOffset); static Command * FindCommandFromToken(Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Namespace *namespacePtr); static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); static int IsCompactibleCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr); static void PeepholeOptimize(CompileEnv *envPtr); #ifdef TCL_COMPILE_STATS |
︙ | ︙ | |||
1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 | } if (valuePtr != NULL) { Tcl_AppendObjToObj(valuePtr, tempPtr); Tcl_DecrRefCount(tempPtr); } return 1; } /* *---------------------------------------------------------------------- * * TclCompileScript -- * * Compile a Tcl script in a string. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 | } if (valuePtr != NULL) { Tcl_AppendObjToObj(valuePtr, tempPtr); Tcl_DecrRefCount(tempPtr); } return 1; } /* * --------------------------------------------------------------------- * * FindCommandFromToken -- * * A simple helper that looks up a command's compiler from its token. * * --------------------------------------------------------------------- */ static Command * FindCommandFromToken( Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Namespace *namespacePtr) { Tcl_DString ds; Command *cmdPtr; if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return NULL; } /* * We copy the string before trying to find the command by name. We used * to modify the string in place, but this is not safe because the name * resolution handlers could have side effects that rely on the unmodified * string. */ Tcl_DStringInit(&ds); TclDStringAppendToken(&ds, &tokenPtr[1]); cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds), namespacePtr, /*flags*/ 0); if (cmdPtr != NULL && (cmdPtr->compileProc == NULL || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION) || (cmdPtr->flags & CMD_HAS_EXEC_TRACES))) { cmdPtr = NULL; } Tcl_DStringFree(&ds); return cmdPtr; } /* *---------------------------------------------------------------------- * * TclCompileScript -- * * Compile a Tcl script in a string. |
︙ | ︙ | |||
1812 1813 1814 1815 1816 1817 1818 | * code. Init. to avoid compiler warning. */ unsigned char *entryCodeNext = envPtr->codeNext; const char *p, *next; Namespace *cmdNsPtr; Command *cmdPtr; Tcl_Token *tokenPtr; int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex; | < < < | 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 | * code. Init. to avoid compiler warning. */ unsigned char *entryCodeNext = envPtr->codeNext; const char *p, *next; Namespace *cmdNsPtr; Command *cmdPtr; Tcl_Token *tokenPtr; int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex; /* TIP #280 */ ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; int *wlines, wlineat, cmdLine, *clNext; Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); if (envPtr->iPtr == NULL) { Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); } if (numBytes < 0) { numBytes = strlen(script); } Tcl_ResetResult(interp); isFirstCmd = 1; if (envPtr->procPtr != NULL) { |
︙ | ︙ | |||
1875 1876 1877 1878 1879 1880 1881 | TclAdvanceLines(&cmdLine, p, parsePtr->commandStart); TclAdvanceContinuations(&cmdLine, &clNext, parsePtr->commandStart - envPtr->source); if (parsePtr->numWords > 0) { int expand = 0; /* Set if there are dynamic expansions to * handle */ | < < < < < < < | 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 | TclAdvanceLines(&cmdLine, p, parsePtr->commandStart); TclAdvanceContinuations(&cmdLine, &clNext, parsePtr->commandStart - envPtr->source); if (parsePtr->numWords > 0) { int expand = 0; /* Set if there are dynamic expansions to * handle */ /* * If not the first command, pop the previous command's result * and, if we're compiling a top level command, update the last * command's code size to account for the pop instruction. */ |
︙ | ︙ | |||
1934 1935 1936 1937 1938 1939 1940 | * words. */ for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr; wordIdx < parsePtr->numWords; wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { | | > > > > > > > > > > > > > > > > | 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 | * words. */ for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr; wordIdx < parsePtr->numWords; wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { expand = 1; break; } } /* * If expansion was requested, check if the command declares that * it knows how to compile it. Note that if expansion is requested * for the first word, this check will fail as the token type will * inhibit it. (That check is done inside FindCommandFromToken.) * This is as it should be. */ if (expand) { cmdPtr = FindCommandFromToken(interp, parsePtr->tokenPtr, (Tcl_Namespace *) cmdNsPtr); if (cmdPtr && (cmdPtr->flags & CMD_COMPILES_EXPANDED)) { expand = 0; } } envPtr->numCommands++; currCmdIndex = envPtr->numCommands - 1; lastTopLevelCmdIndex = currCmdIndex; startCodeOffset = envPtr->codeNext - envPtr->codeStart; EnterCmdStartData(envPtr, currCmdIndex, parsePtr->commandStart - envPtr->source, startCodeOffset); |
︙ | ︙ | |||
1987 1988 1989 1990 1991 1992 1993 | if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* * The word is not a simple string of characters. */ TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); | | < < < < < < | < < < < < | < < < | 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 | if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* * The word is not a simple string of characters. */ TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); if (expand && tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { TclEmitInstInt4(INST_EXPAND_STKTOP, envPtr->currStackDepth, envPtr); } continue; } /* * This is a simple string of literal characters (i.e. we know * it absolutely and can use it directly). If this is the * first word and the command has a compile procedure, let it * compile the command. */ if ((wordIdx == 0) && !expand) { cmdPtr = FindCommandFromToken(interp, tokenPtr, (Tcl_Namespace *) cmdNsPtr); if ((cmdPtr != NULL) && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) { int code, savedNumCmds = envPtr->numCommands; unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart; int update = 0; #ifdef TCL_COMPILE_DEBUG int startStackDepth = envPtr->currStackDepth; |
︙ | ︙ | |||
2144 2145 2146 2147 2148 2149 2150 | objIndex = TclRegisterNewCmdLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size); if (cmdPtr != NULL) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, objIndex), cmdPtr); } } else { | < < < < < < < < < < < < < < < < < < < < | 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 | objIndex = TclRegisterNewCmdLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size); if (cmdPtr != NULL) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, objIndex), cmdPtr); } } else { /* * Simple argument word of a command. We reach this if and * only if the command word was not compiled for whatever * reason. Register the literal's location for use by * uplevel, etc. commands, should they encounter it * unmodified. We care only if the we are in a context * which already allows absolute counting. |
︙ | ︙ | |||
2206 2207 2208 2209 2210 2211 2212 | * The end effect of this command's invocation is that all the * words of the command are popped from the stack, and the * result is pushed: the stack top changes by (1-wordIdx). * * Note that the estimates are not correct while the command * is being prepared and run, INST_EXPAND_STKTOP is not * stack-neutral in general. | < < < | | | 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 | * The end effect of this command's invocation is that all the * words of the command are popped from the stack, and the * result is pushed: the stack top changes by (1-wordIdx). * * Note that the estimates are not correct while the command * is being prepared and run, INST_EXPAND_STKTOP is not * stack-neutral in general. */ TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); TclAdjustStackDepth(1 - wordIdx, envPtr); } else if (wordIdx > 0) { /* * Save PC -> command map for the TclArgumentBC* functions. */ int isnew; Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo, |
︙ | ︙ | |||
2288 2289 2290 2291 2292 2293 2294 | if (envPtr->codeNext == entryCodeNext) { TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); } envPtr->numSrcBytes = p - script; TclStackFree(interp, parsePtr); | < | 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 | if (envPtr->codeNext == entryCodeNext) { TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); } envPtr->numSrcBytes = p - script; TclStackFree(interp, parsePtr); } /* *---------------------------------------------------------------------- * * TclCompileTokens -- * |
︙ | ︙ |
Changes to generic/tclCompile.h.
︙ | ︙ | |||
712 713 714 715 716 717 718 | #define INST_ARRAY_EXISTS_IMM 160 #define INST_ARRAY_MAKE_STK 161 #define INST_ARRAY_MAKE_IMM 162 #define INST_INVOKE_REPLACE 163 #define INST_LIST_CONCAT 164 | < | | 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 | #define INST_ARRAY_EXISTS_IMM 160 #define INST_ARRAY_MAKE_STK 161 #define INST_ARRAY_MAKE_IMM 162 #define INST_INVOKE_REPLACE 163 #define INST_LIST_CONCAT 164 /* The last opcode */ #define LAST_INST_OPCODE 164 /* * Table describing the Tcl bytecode instructions: their name (for displaying * code), total number of code bytes required (including operand bytes), and a * description of the type of each operand. These operand types include signed * and unsigned integers of length one and four bytes. The unsigned integers * are used for indexes or for, e.g., the count of objects to push in a "push" |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
4266 4267 4268 4269 4270 4271 4272 | */ opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); | < < < < < < < < < < < < | 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 | */ opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); case INST_LIST_LENGTH: valuePtr = OBJ_AT_TOS; if (TclListObjLength(interp, valuePtr, &length) != TCL_OK) { TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)), Tcl_GetObjResult(interp)); goto gotError; } |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 | * CMD_TRACE_ACTIVE - 1 means that trace processing is currently * underway for a rename/delete change. See the * two flags below for which is currently being * processed. * CMD_HAS_EXEC_TRACES - 1 means that this command has at least one * execution trace (as opposed to simple * delete/rename traces) in its tracePtr list. * TCL_TRACE_RENAME - A rename trace is in progress. Further * recursive renames will not be traced. * TCL_TRACE_DELETE - A delete trace is in progress. Further * recursive deletes will not be traced. * (these last two flags are defined in tcl.h) */ #define CMD_IS_DELETED 0x1 #define CMD_TRACE_ACTIVE 0x2 #define CMD_HAS_EXEC_TRACES 0x4 /* *---------------------------------------------------------------- * Data structures related to name resolution procedures. *---------------------------------------------------------------- */ | > > > > | 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 | * CMD_TRACE_ACTIVE - 1 means that trace processing is currently * underway for a rename/delete change. See the * two flags below for which is currently being * processed. * CMD_HAS_EXEC_TRACES - 1 means that this command has at least one * execution trace (as opposed to simple * delete/rename traces) in its tracePtr list. * CMD_COMPILES_EXPANDED - 1 means that this command has a compiler that * can handle expansion (provided it is not the * first word). * TCL_TRACE_RENAME - A rename trace is in progress. Further * recursive renames will not be traced. * TCL_TRACE_DELETE - A delete trace is in progress. Further * recursive deletes will not be traced. * (these last two flags are defined in tcl.h) */ #define CMD_IS_DELETED 0x1 #define CMD_TRACE_ACTIVE 0x2 #define CMD_HAS_EXEC_TRACES 0x4 #define CMD_COMPILES_EXPANDED 0x8 /* *---------------------------------------------------------------- * Data structures related to name resolution procedures. *---------------------------------------------------------------- */ |
︙ | ︙ |