Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Many simplifications to the TIP 280 machinery. * Removed support for non-NULL invoker when TCL_EVAL_DIRECT requested. * Eliminated TCL_EVAL_CTX eval flag. * Removed Tcl_Preserve-ability of ContLineLoc pointers. * Removed clLoc field of CompileEnv struct. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
2f5ee8efad801c30619b440509008a99 |
User & Date: | dgp 2013-08-07 17:11:21 |
Context
2013-08-11
| ||
14:42 | Never guess non-existing timezone name "America/Brasilia" on Windows. Reported by Arnulf Wiedemann check-in: bc57d06610 user: jan.nijtmans tags: trunk | |
2013-08-08
| ||
20:19 | merge trunk check-in: d66b65883f user: dkf tags: dkf-command-type | |
2013-08-07
| ||
18:34 | merge trunk check-in: b94fb74ee9 user: dgp tags: dgp-refactor | |
17:11 | Many simplifications to the TIP 280 machinery. * Removed support for non-NULL invoker when TCL_EV... check-in: 2f5ee8efad user: dgp tags: trunk | |
16:44 | Remove Tcl_Preserve support for ContLineLoc values. It's not needed. This allows the clLoc field of... check-in: 08cfa769ec user: dgp tags: dgp-bye-ctx-eval-flag | |
2013-08-06
| ||
16:41 | The value TCL_LOCATION_EVAL_LIST in the type field of a CmdFrame appears to exist only for the sake ... check-in: b673919222 user: dgp tags: trunk | |
Changes
Changes to generic/tclBasic.c.
︙ | ︙ | |||
5007 5008 5009 5010 5011 5012 5013 | expand = expandStack; p = script; bytesLeft = numBytes; /* * TIP #280 Initialize tracking. Do not push on the frame stack yet. * | < | | | | | | < < < < < < < < | 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 | expand = expandStack; p = script; bytesLeft = numBytes; /* * TIP #280 Initialize tracking. Do not push on the frame stack yet. * * We open a new context, either for a sourced script, or 'eval'. * For sourced files we always have a path object, even if nothing was * specified in the interp itself. That makes code using it simpler as * NULL checks can be left out. Sourced file without path in the * 'scriptFile' is possible during Tcl initialization. */ eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1; eeFramePtr->numLevels = iPtr->numLevels; eeFramePtr->framePtr = iPtr->framePtr; eeFramePtr->nextPtr = iPtr->cmdFramePtr; eeFramePtr->nline = 0; eeFramePtr->line = NULL; iPtr->cmdFramePtr = eeFramePtr; if (iPtr->evalFlags & TCL_EVAL_FILE) { /* * Set up for a sourced file. */ eeFramePtr->type = TCL_LOCATION_SOURCE; if (iPtr->scriptFile) { |
︙ | ︙ | |||
5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 | * * Tcl_EvalObjEx, TclEvalObjEx -- * * Execute Tcl commands stored in a Tcl object. These commands are * compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is * specified. * * Results: * The return value is one of the return codes defined in tcl.h (such as * TCL_OK), and the interpreter's result contains a value to supplement * the return code. * * Side effects: * The object is converted, if necessary, to a ByteCode object that holds | > > > > > | 5889 5890 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 | * * Tcl_EvalObjEx, TclEvalObjEx -- * * Execute Tcl commands stored in a Tcl object. These commands are * compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is * specified. * * If the flag TCL_EVAL_DIRECT is passed in, the value of invoker * must be NULL. Support for non-NULL invokers in that mode has * been removed since it was unused and untested. Failure to * follow this limitation will lead to an assertion panic. * * Results: * The return value is one of the return codes defined in tcl.h (such as * TCL_OK), and the interpreter's result contains a value to supplement * the return code. * * Side effects: * The object is converted, if necessary, to a ByteCode object that holds |
︙ | ︙ | |||
6072 6073 6074 6075 6076 6077 6078 | } { /* * We're not supposed to use the compiler or byte-code * interpreter. Let Tcl_EvalEx evaluate the command directly (and * probably more slowly). | < < < < < < < < | 6068 6069 6070 6071 6072 6073 6074 6075 6076 6077 6078 6079 6080 6081 | } { /* * We're not supposed to use the compiler or byte-code * interpreter. Let Tcl_EvalEx evaluate the command directly (and * probably more slowly). */ const char *script; int numSrcBytes; /* * Now we check if we have data about invisible continuation lines for |
︙ | ︙ | |||
6103 6104 6105 6106 6107 6108 6109 | * * Another important action is to save (and later restore) the * continuation line information of the caller, in case we are * executing nested commands in the eval/direct path. */ ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr; | < < < < < < < < < | < < < < < < < < < < < < < < < < < < | < < < < < < < < | < < | < | < < < < < < < < | < < < < < < < < < < < < < < < | | < < < < < < < < < < < < | 6091 6092 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 | * * Another important action is to save (and later restore) the * continuation line information of the caller, in case we are * executing nested commands in the eval/direct path. */ ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr; assert(invoker == NULL); iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr); Tcl_IncrRefCount(objPtr); script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); TclDecrRefCount(objPtr); iPtr->scriptCLLocPtr = saveCLLocPtr; return result; } } static int TEOEx_ByteCodeCallback( ClientData data[], |
︙ | ︙ |
Changes to generic/tclCompile.c.
︙ | ︙ | |||
709 710 711 712 713 714 715 | * lock on it. We release this lock in the function TclFreeCompileEnv(), * found in this file. The "lineCLPtr" hashtable is managed in the file * "tclObj.c". */ clLocPtr = TclContinuationsGet(objPtr); if (clLocPtr) { | < | < | 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 | * lock on it. We release this lock in the function TclFreeCompileEnv(), * found in this file. The "lineCLPtr" hashtable is managed in the file * "tclObj.c". */ clLocPtr = TclContinuationsGet(objPtr); if (clLocPtr) { compEnv.clNext = &clLocPtr->loc[0]; } TclCompileScript(interp, stringPtr, length, &compEnv); /* * Successful compilation. Add a "done" instruction at the end. */ |
︙ | ︙ | |||
738 739 740 741 742 743 744 | !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME) && IsCompactibleCompileEnv(interp, &compEnv)) { TclFreeCompileEnv(&compEnv); iPtr->compiledProcPtr = procPtr; TclInitCompileEnv(interp, &compEnv, stringPtr, length, iPtr->invokeCmdFramePtr, iPtr->invokeWord); if (clLocPtr) { | < | < | 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 | !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME) && IsCompactibleCompileEnv(interp, &compEnv)) { TclFreeCompileEnv(&compEnv); iPtr->compiledProcPtr = procPtr; TclInitCompileEnv(interp, &compEnv, stringPtr, length, iPtr->invokeCmdFramePtr, iPtr->invokeWord); if (clLocPtr) { compEnv.clNext = &clLocPtr->loc[0]; } compEnv.atCmdStart = 2; /* The disabling magic. */ TclCompileScript(interp, stringPtr, length, &compEnv); assert (compEnv.atCmdStart > 1); TclEmitOpcode(INST_DONE, &compEnv); assert (compEnv.atCmdStart > 1); } |
︙ | ︙ | |||
1485 1486 1487 1488 1489 1490 1491 | /* * Initialize the data about invisible continuation lines as empty, i.e. * not used. The caller (TclSetByteCodeFromAny) will set this up, if such * data is available. */ | < | 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 | /* * Initialize the data about invisible continuation lines as empty, i.e. * not used. The caller (TclSetByteCodeFromAny) will set this up, if such * data is available. */ envPtr->clNext = NULL; envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace; envPtr->auxDataArrayNext = 0; envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE; envPtr->mallocedAuxDataArray = 0; } |
︙ | ︙ | |||
1570 1571 1572 1573 1574 1575 1576 | if (envPtr->mallocedAuxDataArray) { ckfree(envPtr->auxDataArrayPtr); } if (envPtr->extCmdMapPtr) { ReleaseCmdWordData(envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; } | < < < < < < < < < < | 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 | if (envPtr->mallocedAuxDataArray) { ckfree(envPtr->auxDataArrayPtr); } if (envPtr->extCmdMapPtr) { ReleaseCmdWordData(envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; } } /* *---------------------------------------------------------------------- * * TclWordKnownAtCompileTime -- * |
︙ | ︙ |
Changes to generic/tclCompile.h.
︙ | ︙ | |||
361 362 363 364 365 366 367 | * inefficient. If set to 2, that instruction * should not be issued at all (by the generic * part of the command compiler). */ int expandCount; /* Number of INST_EXPAND_START instructions * encountered that have not yet been paired * with a corresponding * INST_INVOKE_EXPANDED. */ | < < < < | 361 362 363 364 365 366 367 368 369 370 371 372 373 374 | * inefficient. If set to 2, that instruction * should not be issued at all (by the generic * part of the command compiler). */ int expandCount; /* Number of INST_EXPAND_START instructions * encountered that have not yet been paired * with a corresponding * INST_INVOKE_EXPANDED. */ int *clNext; /* If not NULL, it refers to the next slot in * clLoc to check for an invisible * continuation line. */ } CompileEnv; /* * The structure defining the bytecode instructions resulting from compiling a |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
8770 8771 8772 8773 8774 8775 8776 | void TclGetSrcInfoForPc( CmdFrame *cfPtr) { ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; | > | > | > | < | 8770 8771 8772 8773 8774 8775 8776 8777 8778 8779 8780 8781 8782 8783 8784 8785 8786 8787 8788 8789 8790 8791 8792 | void TclGetSrcInfoForPc( CmdFrame *cfPtr) { ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; assert(cfPtr->type == TCL_LOCATION_BC); assert(cfPtr->cmd == NULL); cfPtr->cmd = GetSrcInfoForPc( (unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); assert(cfPtr->cmd != NULL); { /* * We now have the command. We can get the srcOffset back and from * there find the list of word locations for this command. */ ExtCmdLoc *eclPtr; ECL *locPtr = NULL; |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2197 2198 2199 2200 2201 2202 2203 | * TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with a * code other than TCL_OK or TCL_ERROR; 0 means codes * other than these should be turned into errors. */ #define TCL_ALLOW_EXCEPTIONS 4 #define TCL_EVAL_FILE 2 | < | 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 | * TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with a * code other than TCL_OK or TCL_ERROR; 0 means codes * other than these should be turned into errors. */ #define TCL_ALLOW_EXCEPTIONS 4 #define TCL_EVAL_FILE 2 /* * Flag bits for Interp structures: * * DELETED: Non-zero means the interpreter has been deleted: * don't process any more commands for it, and destroy * the structure as soon as all nested invocations of |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
93 94 95 96 97 98 99 | * that a Tcl_Obj was not allocated by some * other thread. */ #endif /* TCL_MEM_DEBUG && TCL_THREADS */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; | < | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | * that a Tcl_Obj was not allocated by some * other thread. */ #endif /* TCL_MEM_DEBUG && TCL_THREADS */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; static void TclThreadFinalizeContLines(ClientData clientData); static ThreadSpecificData *TclGetContLineTable(void); /* * Nested Tcl_Obj deletion management support * * All context references used in the object freeing code are pointers to this |
︙ | ︙ | |||
801 802 803 804 805 806 807 | ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { | < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < | 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 | ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(tsdPtr->lineCLPtr); ckfree(tsdPtr->lineCLPtr); tsdPtr->lineCLPtr = NULL; } /* *-------------------------------------------------------------- * * Tcl_RegisterObjType -- * * This function is called to register a new Tcl object type in the table |
︙ | ︙ | |||
1401 1402 1403 1404 1405 1406 1407 | { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { | | | 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 | { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } } } #else /* TCL_MEM_DEBUG */ |
︙ | ︙ | |||
1492 1493 1494 1495 1496 1497 1498 | { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { | | | 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 | { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } } } #endif /* TCL_MEM_DEBUG */ |
︙ | ︙ |
Changes to generic/tclParse.c.
︙ | ︙ | |||
9 10 11 12 13 14 15 16 17 18 19 20 21 22 | * Copyright (c) 1998-2000 Ajuba Solutions. * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclParse.h" /* * The following table provides parsing information about each possible 8-bit * character. The table is designed to be referenced with either signed or * unsigned characters, so it has 384 entries. The first 128 entries | > | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | * Copyright (c) 1998-2000 Ajuba Solutions. * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include <assert.h> #include "tclInt.h" #include "tclParse.h" /* * The following table provides parsing information about each possible 8-bit * character. The table is designed to be referenced with either signed or * unsigned characters, so it has 384 entries. The first 128 entries |
︙ | ︙ | |||
1574 1575 1576 1577 1578 1579 1580 | } objPtr = Tcl_GetObjResult(interp); /* * At this point we should have an object containing the value of a * variable. Just return the string from that object. * | | | | < < | < | | 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 | } objPtr = Tcl_GetObjResult(interp); /* * At this point we should have an object containing the value of a * variable. Just return the string from that object. * * Since TclSubstTokens above returned TCL_OK, we know that objPtr * is shared. It is in both the interp result and the value of the * variable. Returning the string relies on that to be true. */ assert( Tcl_IsShared(objPtr) ); Tcl_ResetResult(interp); return TclGetString(objPtr); } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to tests/parse.test.
︙ | ︙ | |||
1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 | test parse-21.0 {Bug 1884496} testevent { set ::script {testevent delete a; set a [p]; set ::done $a} proc ::p {} {string first s $::script} testevent queue a head $::script vwait done } {} cleanupTests } namespace delete ::tcl::test::parse return | > > > > > > | 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 | test parse-21.0 {Bug 1884496} testevent { set ::script {testevent delete a; set a [p]; set ::done $a} proc ::p {} {string first s $::script} testevent queue a head $::script vwait done } {} test parse-21.1 {TCL_EVAL_DIRECT coverage} testevent { testevent queue a head {testevent delete a; \ set ::done [dict get [info frame 0] line]} vwait done set ::done } 2 cleanupTests } namespace delete ::tcl::test::parse return |