Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Added bytecode compilation of many Tcl commands, merged from development branch. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
8e20d1a93ffebebf7e904c556944868a |
User & Date: | dkf 2012-11-05 14:55:14 |
Context
2012-11-05
| ||
16:57 | Disable bytecompile of [tailcall] until it gets some repair. As is, it hopelessly bogs down debug-e... check-in: 681260c3fd user: dgp tags: trunk | |
15:17 | merge trunk check-in: 1fc3f2cbaf user: dkf tags: dkf-bytecode-8.6-main | |
14:55 | Added bytecode compilation of many Tcl commands, merged from development branch. check-in: 8e20d1a93f user: dkf tags: trunk | |
14:42 | TIP #413 check-in: 1763fa9dc9 user: jan.nijtmans tags: trunk, potential incompatibility | |
14:34 | Added compilation of [array exists], [array set] and [array unset]. Fixed a whole bunch of issues wi... check-in: 7c61073736 user: dkf tags: merge-to-trunk, dkf-bytecode-8.6-main | |
Changes
Changes to ChangeLog.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | 2012-11-05 Jan Nijtmans <[email protected]> IMPLEMENTATION OF TIP#413 Align the [string trim] and [string is space] commands, such that [string trim] by default trims all characters for which [string is space] returns 1, augmented with the NUL character. * generic/tclUtf.c: Add NEL, BOM and two more characters to [string is space] * generic/tclCmdMZ.c: Modify [string trim] for Unicode modifications. * generic/regc_locale.c: Regexp engine must match [string is space] * doc/string.n * tests/string.test 2012-10-31 Jan Nijtmans <[email protected]> * win/Makefile.in: Dde version number to 1.4.0, ready for Tcl 8.6.0rc1 * win/makefile.vc * win/tclWinDde.c * library/dde/pkgIndex.tcl | > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | 2012-11-05 Donal K. Fellows <[email protected]> Added bytecode compilation of many Tcl commands. Some of these are total compilations and some are only partial (i.e., only compile in some cases). The (sub-)commands affected are: * array: exists, set, unset * dict: create, exists, merge * format: (simple cases only) * info: commands, coroutine, level, object * info object: class, isa object, namespace * namespace: current, code, qualifiers, tail, which * regsub: (only cases convertable to simple [string map]) * self: (only no-argument and [self object] cases) * string: first, last, map, range * tailcall: * yield: [This was work originally done on the 'dkf-compile-misc-info' branch.] 2012-11-05 Jan Nijtmans <[email protected]> IMPLEMENTATION OF TIP#413 Align the [string trim] and [string is space] commands, such that [string trim] by default trims all characters for which [string is space] returns 1, augmented with the NUL character. * generic/tclUtf.c: Add NEL, BOM and two more characters to [string is space] * generic/tclCmdMZ.c: Modify [string trim] for Unicode modifications. * generic/regc_locale.c: Regexp engine must match [string is space] * doc/string.n * tests/string.test ***POTENTIAL INCOMPATIBILITY*** Code that relied on characters not previously trimmed being not removed will notice a difference; it is believed that this is rare, but a workaround to get the behavior in Tcl 8.5 is to use " \t\n\r" as an explicit trim set. 2012-10-31 Jan Nijtmans <[email protected]> * win/Makefile.in: Dde version number to 1.4.0, ready for Tcl 8.6.0rc1 * win/makefile.vc * win/tclWinDde.c * library/dde/pkgIndex.tcl |
︙ | ︙ |
Changes to generic/tclAssembly.c.
︙ | ︙ | |||
358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 | {"add", ASSEM_1BYTE, INST_ADD, 2, 1}, {"append", ASSEM_LVT, (INST_APPEND_SCALAR1<<8 | INST_APPEND_SCALAR4),1, 1}, {"appendArray", ASSEM_LVT, (INST_APPEND_ARRAY1<<8 | INST_APPEND_ARRAY4), 2, 1}, {"appendArrayStk", ASSEM_1BYTE, INST_APPEND_ARRAY_STK, 3, 1}, {"appendStk", ASSEM_1BYTE, INST_APPEND_STK, 2, 1}, {"beginCatch", ASSEM_BEGIN_CATCH, INST_BEGIN_CATCH4, 0, 0}, {"bitand", ASSEM_1BYTE, INST_BITAND, 2, 1}, {"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1}, {"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1}, {"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1}, {"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1}, {"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1}, {"dictExpand", ASSEM_1BYTE, INST_DICT_EXPAND, 3, 1}, {"dictGet", ASSEM_DICT_GET, INST_DICT_GET, INT_MIN,1}, {"dictIncrImm", ASSEM_SINT4_LVT4, INST_DICT_INCR_IMM, 1, 1}, {"dictLappend", ASSEM_LVT4, INST_DICT_LAPPEND, 2, 1}, {"dictRecombineStk",ASSEM_1BYTE, INST_DICT_RECOMBINE_STK,3, 0}, {"dictRecombineImm",ASSEM_LVT4, INST_DICT_RECOMBINE_IMM,2, 0}, | > > > > > > > | 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 | {"add", ASSEM_1BYTE, INST_ADD, 2, 1}, {"append", ASSEM_LVT, (INST_APPEND_SCALAR1<<8 | INST_APPEND_SCALAR4),1, 1}, {"appendArray", ASSEM_LVT, (INST_APPEND_ARRAY1<<8 | INST_APPEND_ARRAY4), 2, 1}, {"appendArrayStk", ASSEM_1BYTE, INST_APPEND_ARRAY_STK, 3, 1}, {"appendStk", ASSEM_1BYTE, INST_APPEND_STK, 2, 1}, {"arrayExistsImm", ASSEM_LVT4, INST_ARRAY_EXISTS_IMM, 0, 1}, {"arrayExistsStk", ASSEM_1BYTE, INST_ARRAY_EXISTS_STK, 1, 1}, {"arrayMakeImm", ASSEM_LVT4, INST_ARRAY_MAKE_IMM, 0, 0}, {"arrayMakeStk", ASSEM_1BYTE, INST_ARRAY_MAKE_STK, 1, 0}, {"beginCatch", ASSEM_BEGIN_CATCH, INST_BEGIN_CATCH4, 0, 0}, {"bitand", ASSEM_1BYTE, INST_BITAND, 2, 1}, {"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1}, {"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1}, {"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1}, {"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1}, {"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1}, {"currentNamespace",ASSEM_1BYTE, INST_NS_CURRENT, 0, 1}, {"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1}, {"dictExists", ASSEM_DICT_GET, INST_DICT_EXISTS, INT_MIN,1}, {"dictExpand", ASSEM_1BYTE, INST_DICT_EXPAND, 3, 1}, {"dictGet", ASSEM_DICT_GET, INST_DICT_GET, INT_MIN,1}, {"dictIncrImm", ASSEM_SINT4_LVT4, INST_DICT_INCR_IMM, 1, 1}, {"dictLappend", ASSEM_LVT4, INST_DICT_LAPPEND, 2, 1}, {"dictRecombineStk",ASSEM_1BYTE, INST_DICT_RECOMBINE_STK,3, 0}, {"dictRecombineImm",ASSEM_LVT4, INST_DICT_RECOMBINE_IMM,2, 0}, |
︙ | ︙ | |||
402 403 404 405 406 407 408 409 410 411 412 413 414 415 | {"incrArrayStk", ASSEM_1BYTE, INST_INCR_ARRAY_STK, 3, 1}, {"incrArrayStkImm", ASSEM_SINT1, INST_INCR_ARRAY_STK_IMM,2, 1}, {"incrImm", ASSEM_LVT1_SINT1, INST_INCR_SCALAR1_IMM, 0, 1}, {"incrStk", ASSEM_1BYTE, INST_INCR_SCALAR_STK, 2, 1}, {"incrStkImm", ASSEM_SINT1, INST_INCR_SCALAR_STK_IMM, 1, 1}, {"invokeStk", ASSEM_INVOKE, (INST_INVOKE_STK1 << 8 | INST_INVOKE_STK4), INT_MIN,1}, {"jump", ASSEM_JUMP, INST_JUMP1, 0, 0}, {"jump4", ASSEM_JUMP4, INST_JUMP4, 0, 0}, {"jumpFalse", ASSEM_JUMP, INST_JUMP_FALSE1, 1, 0}, {"jumpFalse4", ASSEM_JUMP4, INST_JUMP_FALSE4, 1, 0}, {"jumpTable", ASSEM_JUMPTABLE,INST_JUMP_TABLE, 1, 0}, | > > | 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 | {"incrArrayStk", ASSEM_1BYTE, INST_INCR_ARRAY_STK, 3, 1}, {"incrArrayStkImm", ASSEM_SINT1, INST_INCR_ARRAY_STK_IMM,2, 1}, {"incrImm", ASSEM_LVT1_SINT1, INST_INCR_SCALAR1_IMM, 0, 1}, {"incrStk", ASSEM_1BYTE, INST_INCR_SCALAR_STK, 2, 1}, {"incrStkImm", ASSEM_SINT1, INST_INCR_SCALAR_STK_IMM, 1, 1}, {"infoLevelArgs", ASSEM_1BYTE, INST_INFO_LEVEL_ARGS, 1, 1}, {"infoLevelNumber", ASSEM_1BYTE, INST_INFO_LEVEL_NUM, 0, 1}, {"invokeStk", ASSEM_INVOKE, (INST_INVOKE_STK1 << 8 | INST_INVOKE_STK4), INT_MIN,1}, {"jump", ASSEM_JUMP, INST_JUMP1, 0, 0}, {"jump4", ASSEM_JUMP4, INST_JUMP4, 0, 0}, {"jumpFalse", ASSEM_JUMP, INST_JUMP_FALSE1, 1, 0}, {"jumpFalse4", ASSEM_JUMP4, INST_JUMP_FALSE4, 1, 0}, {"jumpTable", ASSEM_JUMPTABLE,INST_JUMP_TABLE, 1, 0}, |
︙ | ︙ | |||
453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 | {"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1}, {"pop", ASSEM_1BYTE, INST_POP, 1, 0}, {"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1}, {"pushReturnOpts", ASSEM_1BYTE, INST_PUSH_RETURN_OPTIONS, 0, 1}, {"pushResult", ASSEM_1BYTE, INST_PUSH_RESULT, 0, 1}, {"regexp", ASSEM_REGEXP, INST_REGEXP, 2, 1}, {"reverse", ASSEM_REVERSE, INST_REVERSE, INT_MIN,-1-0}, {"rshift", ASSEM_1BYTE, INST_RSHIFT, 2, 1}, {"store", ASSEM_LVT, (INST_STORE_SCALAR1<<8 | INST_STORE_SCALAR4), 1, 1}, {"storeArray", ASSEM_LVT, (INST_STORE_ARRAY1<<8 | INST_STORE_ARRAY4), 2, 1}, {"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1}, {"storeStk", ASSEM_1BYTE, INST_STORE_SCALAR_STK, 2, 1}, {"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1}, {"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1}, {"strindex", ASSEM_1BYTE, INST_STR_INDEX, 2, 1}, {"strlen", ASSEM_1BYTE, INST_STR_LEN, 1, 1}, {"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1}, {"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1}, {"sub", ASSEM_1BYTE, INST_SUB, 2, 1}, {"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1}, {"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1}, {"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0}, {"unsetArray", ASSEM_BOOL_LVT4,INST_UNSET_ARRAY, 1, 0}, {"unsetArrayStk", ASSEM_BOOL, INST_UNSET_ARRAY_STK, 2, 0}, {"unsetStk", ASSEM_BOOL, INST_UNSET_STK, 1, 0}, {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1}, {"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1}, {"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0}, {NULL, 0, 0, 0, 0} }; /* * List of instructions that cannot throw an exception under any * circumstances. These instructions are the ones that are permissible after * an exception is caught but before the corresponding exception range is * popped from the stack. * The instructions must be in ascending order by numeric operation code. */ static const unsigned char NonThrowingByteCodes[] = { INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */ INST_JUMP1, INST_JUMP4, /* 34-35 */ INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */ INST_OVER, /* 95 */ INST_PUSH_RETURN_OPTIONS, /* 108 */ INST_REVERSE, /* 126 */ | > > > > > > > > > > > | > > > > > > | 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 | {"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1}, {"pop", ASSEM_1BYTE, INST_POP, 1, 0}, {"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1}, {"pushReturnOpts", ASSEM_1BYTE, INST_PUSH_RETURN_OPTIONS, 0, 1}, {"pushResult", ASSEM_1BYTE, INST_PUSH_RESULT, 0, 1}, {"regexp", ASSEM_REGEXP, INST_REGEXP, 2, 1}, {"resolveCmd", ASSEM_1BYTE, INST_RESOLVE_COMMAND, 1, 1}, {"reverse", ASSEM_REVERSE, INST_REVERSE, INT_MIN,-1-0}, {"rshift", ASSEM_1BYTE, INST_RSHIFT, 2, 1}, {"store", ASSEM_LVT, (INST_STORE_SCALAR1<<8 | INST_STORE_SCALAR4), 1, 1}, {"storeArray", ASSEM_LVT, (INST_STORE_ARRAY1<<8 | INST_STORE_ARRAY4), 2, 1}, {"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1}, {"storeStk", ASSEM_1BYTE, INST_STORE_SCALAR_STK, 2, 1}, {"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1}, {"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1}, {"strfind", ASSEM_1BYTE, INST_STR_FIND, 2, 1}, {"strindex", ASSEM_1BYTE, INST_STR_INDEX, 2, 1}, {"strlen", ASSEM_1BYTE, INST_STR_LEN, 1, 1}, {"strmap", ASSEM_1BYTE, INST_STR_MAP, 3, 1}, {"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1}, {"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1}, {"strrange", ASSEM_1BYTE, INST_STR_RANGE, 3, 1}, {"strrfind", ASSEM_1BYTE, INST_STR_FIND_LAST, 2, 1}, {"sub", ASSEM_1BYTE, INST_SUB, 2, 1}, {"tclooClass", ASSEM_1BYTE, INST_TCLOO_CLASS, 1, 1}, {"tclooIsObject", ASSEM_1BYTE, INST_TCLOO_IS_OBJECT, 1, 1}, {"tclooNamespace", ASSEM_1BYTE, INST_TCLOO_NS, 1, 1}, {"tclooSelf", ASSEM_1BYTE, INST_TCLOO_SELF, 0, 1}, {"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1}, {"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1}, {"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0}, {"unsetArray", ASSEM_BOOL_LVT4,INST_UNSET_ARRAY, 1, 0}, {"unsetArrayStk", ASSEM_BOOL, INST_UNSET_ARRAY_STK, 2, 0}, {"unsetStk", ASSEM_BOOL, INST_UNSET_STK, 1, 0}, {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1}, {"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1}, {"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0}, {"verifyDict", ASSEM_1BYTE, INST_DICT_VERIFY, 1, 0}, {"yield", ASSEM_1BYTE, INST_YIELD, 1, 1}, {NULL, 0, 0, 0, 0} }; /* * List of instructions that cannot throw an exception under any * circumstances. These instructions are the ones that are permissible after * an exception is caught but before the corresponding exception range is * popped from the stack. * The instructions must be in ascending order by numeric operation code. */ static const unsigned char NonThrowingByteCodes[] = { INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */ INST_JUMP1, INST_JUMP4, /* 34-35 */ INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */ INST_OVER, /* 95 */ INST_PUSH_RETURN_OPTIONS, /* 108 */ INST_REVERSE, /* 126 */ INST_NOP, /* 132 */ INST_STR_MAP, /* 143 */ INST_STR_FIND, /* 144 */ INST_COROUTINE_NAME, /* 149 */ INST_NS_CURRENT, /* 151 */ INST_INFO_LEVEL_NUM, /* 152 */ INST_RESOLVE_COMMAND /* 154 */ }; /* * Helper macros. */ #if defined(TCL_DEBUG_ASSEMBLY) && defined(__GNUC__) && __GNUC__ > 2 |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
127 128 129 130 131 132 133 | static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; static Tcl_Obj * GetCommandSource(Interp *iPtr, int objc, Tcl_Obj *const objv[], int lookup); static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); | < < | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; static Tcl_Obj * GetCommandSource(Interp *iPtr, int objc, Tcl_Obj *const objv[], int lookup); static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); static Tcl_NRPostProc NRRunObjProc; static Tcl_ObjCmdProc OldMathFuncProc; static void OldMathFuncDeleteProc(ClientData clientData); static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); static void TEOV_SwitchVarFrame(Tcl_Interp *interp); static void TEOV_PushExceptionHandlers(Tcl_Interp *interp, |
︙ | ︙ | |||
215 216 217 218 219 220 221 | {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, 1}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, 1}, {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, 1}, {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, 1}, {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, 1}, {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, 1}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, 1}, | | | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 | {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, 1}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, 1}, {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, 1}, {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, 1}, {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, 1}, {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, 1}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, 1}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, 1}, {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, 1}, {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, 1}, {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, 1}, {"join", Tcl_JoinObjCmd, NULL, NULL, 1}, {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, 1}, {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, 1}, {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, 1}, |
︙ | ︙ | |||
237 238 239 240 241 242 243 | {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, 1}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, 1}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, 1}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, 1}, {"package", Tcl_PackageObjCmd, NULL, NULL, 1}, {"proc", Tcl_ProcObjCmd, NULL, NULL, 1}, {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, 1}, | | | | | 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 | {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, 1}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, 1}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, 1}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, 1}, {"package", Tcl_PackageObjCmd, NULL, NULL, 1}, {"proc", Tcl_ProcObjCmd, NULL, NULL, 1}, {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, 1}, {"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, 1}, {"rename", Tcl_RenameObjCmd, NULL, NULL, 1}, {"return", Tcl_ReturnObjCmd, TclCompileReturnCmd, NULL, 1}, {"scan", Tcl_ScanObjCmd, NULL, NULL, 1}, {"set", Tcl_SetObjCmd, TclCompileSetCmd, NULL, 1}, {"split", Tcl_SplitObjCmd, NULL, NULL, 1}, {"subst", Tcl_SubstObjCmd, TclCompileSubstCmd, TclNRSubstObjCmd, 1}, {"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, TclNRSwitchObjCmd, 1}, {"tailcall", NULL, TclCompileTailcallCmd, TclNRTailcallObjCmd, 1}, {"throw", Tcl_ThrowObjCmd, TclCompileThrowCmd, NULL, 1}, {"trace", Tcl_TraceObjCmd, NULL, NULL, 1}, {"try", Tcl_TryObjCmd, TclCompileTryCmd, TclNRTryObjCmd, 1}, {"unset", Tcl_UnsetObjCmd, TclCompileUnsetCmd, NULL, 1}, {"uplevel", Tcl_UplevelObjCmd, NULL, TclNRUplevelObjCmd, 1}, {"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, 1}, {"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, 1}, {"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, 1}, {"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, 1}, {"yieldto", NULL, NULL, TclNRYieldToObjCmd, 1}, /* * Commands in the OS-interface. Note that many of these are unsafe. */ {"after", Tcl_AfterObjCmd, NULL, NULL, 1}, |
︙ | ︙ | |||
8319 8320 8321 8322 8323 8324 8325 | Interp *iPtr = (Interp *) interp; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?"); return TCL_ERROR; } | | | 8317 8318 8319 8320 8321 8322 8323 8324 8325 8326 8327 8328 8329 8330 8331 | Interp *iPtr = (Interp *) interp; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?"); return TCL_ERROR; } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { /* or is upleveled */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "tailcall can only be called from a proc or lambda", -1)); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL); return TCL_ERROR; } /* |
︙ | ︙ | |||
8359 8360 8361 8362 8363 8364 8365 | nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr)) || (nsPtr != ns1Ptr)) { Tcl_Panic("Tailcall failed to find the proper namespace"); } Tcl_IncrRefCount(nsObjPtr); | | | | 8357 8358 8359 8360 8361 8362 8363 8364 8365 8366 8367 8368 8369 8370 8371 8372 8373 8374 8375 8376 8377 8378 8379 8380 8381 | nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr)) || (nsPtr != ns1Ptr)) { Tcl_Panic("Tailcall failed to find the proper namespace"); } Tcl_IncrRefCount(nsObjPtr); TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr, NULL, NULL); tailcallPtr = TOP_CB(interp); TOP_CB(interp) = tailcallPtr->nextPtr; iPtr->varFramePtr->tailcallPtr = tailcallPtr; } return TCL_RETURN; } int TclNRTailcallEval( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = data[0]; Tcl_Obj *nsObjPtr = data[1]; |
︙ | ︙ | |||
8491 8492 8493 8494 8495 8496 8497 | } if (objc == 2) { Tcl_SetObjResult(interp, objv[1]); } NRE_ASSERT(!COR_IS_SUSPENDED(corPtr)); | | | 8489 8490 8491 8492 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 | } if (objc == 2) { Tcl_SetObjResult(interp, objv[1]); } NRE_ASSERT(!COR_IS_SUSPENDED(corPtr)); TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, clientData, NULL, NULL); return TCL_OK; } int TclNRYieldToObjCmd( ClientData clientData, |
︙ | ︙ | |||
8563 8564 8565 8566 8567 8568 8569 | ClientData nsPtr = data[2]; NRE_callback *cbPtr; /* * yieldTo: invoke the command using tailcall tech. */ | | | 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 8573 8574 8575 | ClientData nsPtr = data[2]; NRE_callback *cbPtr; /* * yieldTo: invoke the command using tailcall tech. */ TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsPtr, NULL, NULL); cbPtr = TOP_CB(interp); TOP_CB(interp) = cbPtr->nextPtr; TclSpliceTailcall(interp, cbPtr); return TCL_OK; } |
︙ | ︙ | |||
8708 8709 8710 8711 8712 8713 8714 | return result; } /* *---------------------------------------------------------------------- * | | | | | 8706 8707 8708 8709 8710 8711 8712 8713 8714 8715 8716 8717 8718 8719 8720 8721 8722 8723 8724 8725 8726 8727 8728 8729 8730 8731 8732 8733 8734 8735 | return result; } /* *---------------------------------------------------------------------- * * TclNRCoroutineActivateCallback -- * * This is the workhorse for coroutines: it implements both yield and * resume. * * It is important that both be implemented in the same callback: the * detection of the impossibility to suspend due to a busy C-stack relies * on the precise position of a local variable in the stack. We do not * want the compiler to play tricks on us, either by moving things around * or inlining. * *---------------------------------------------------------------------- */ int TclNRCoroutineActivateCallback( ClientData data[], Tcl_Interp *interp, int result) { CoroutineData *corPtr = data[0]; int type = PTR2INT(data[1]); int numLevels, unused; |
︙ | ︙ | |||
8898 8899 8900 8901 8902 8903 8904 | case COROUTINE_ARGUMENTS_ARBITRARY: if (objc > 1) { Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1)); } break; } | | | 8896 8897 8898 8899 8900 8901 8902 8903 8904 8905 8906 8907 8908 8909 8910 | case COROUTINE_ARGUMENTS_ARBITRARY: if (objc > 1) { Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1)); } break; } TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, NULL, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
9055 9056 9057 9058 9059 9060 9061 | RESTORE_CONTEXT(corPtr->caller); iPtr->execEnvPtr = corPtr->callerEEPtr; /* * Now just resume the coroutine. */ | | | 9053 9054 9055 9056 9057 9058 9059 9060 9061 9062 9063 9064 9065 9066 9067 | RESTORE_CONTEXT(corPtr->caller); iPtr->execEnvPtr = corPtr->callerEEPtr; /* * Now just resume the coroutine. */ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, NULL, NULL, NULL); return TCL_OK; } /* * This is used in the [info] ensemble */ |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
160 161 162 163 164 165 166 | * "info" command. */ static const EnsembleImplMap defaultInfoMap[] = { {"args", InfoArgsCmd, NULL, NULL, NULL, 0}, {"body", InfoBodyCmd, NULL, NULL, NULL, 0}, {"cmdcount", InfoCmdCountCmd, NULL, NULL, NULL, 0}, | | | | | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 | * "info" command. */ static const EnsembleImplMap defaultInfoMap[] = { {"args", InfoArgsCmd, NULL, NULL, NULL, 0}, {"body", InfoBodyCmd, NULL, NULL, NULL, 0}, {"cmdcount", InfoCmdCountCmd, NULL, NULL, NULL, 0}, {"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0}, {"complete", InfoCompleteCmd, NULL, NULL, NULL, 0}, {"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0}, {"default", InfoDefaultCmd, NULL, NULL, NULL, 0}, {"errorstack", InfoErrorStackCmd, NULL, NULL, NULL, 0}, {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, NULL, NULL, 0}, {"frame", InfoFrameCmd, NULL, NULL, NULL, 0}, {"functions", InfoFunctionsCmd, NULL, NULL, NULL, 0}, {"globals", TclInfoGlobalsCmd, NULL, NULL, NULL, 0}, {"hostname", InfoHostnameCmd, NULL, NULL, NULL, 0}, {"level", InfoLevelCmd, TclCompileInfoLevelCmd, NULL, NULL, 0}, {"library", InfoLibraryCmd, NULL, NULL, NULL, 0}, {"loaded", InfoLoadedCmd, NULL, NULL, NULL, 0}, {"locals", TclInfoLocalsCmd, NULL, NULL, NULL, 0}, {"nameofexecutable", InfoNameOfExecutableCmd, NULL, NULL, NULL, 0}, {"patchlevel", InfoPatchLevelCmd, NULL, NULL, NULL, 0}, {"procs", InfoProcsCmd, NULL, NULL, NULL, 0}, {"script", InfoScriptCmd, NULL, NULL, NULL, 0}, |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
3323 3324 3325 3326 3327 3328 3329 | TclInitStringCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap stringImplMap[] = { {"bytelength", StringBytesCmd, NULL, NULL, NULL, 0}, {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0}, {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0}, | | | | | | 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 | TclInitStringCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap stringImplMap[] = { {"bytelength", StringBytesCmd, NULL, NULL, NULL, 0}, {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0}, {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0}, {"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0}, {"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0}, {"is", StringIsCmd, NULL, NULL, NULL, 0}, {"last", StringLastCmd, TclCompileStringLastCmd, NULL, NULL, 0}, {"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0}, {"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0}, {"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0}, {"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0}, {"repeat", StringReptCmd, NULL, NULL, NULL, 0}, {"replace", StringRplcCmd, NULL, NULL, NULL, 0}, {"reverse", StringRevCmd, NULL, NULL, NULL, 0}, {"tolower", StringLowerCmd, NULL, NULL, NULL, 0}, {"toupper", StringUpperCmd, NULL, NULL, NULL, 0}, {"totitle", StringTitleCmd, NULL, NULL, NULL, 0}, {"trim", StringTrimCmd, NULL, NULL, NULL, 0}, |
︙ | ︙ |
Changes to generic/tclCompCmds.c.
︙ | ︙ | |||
11 12 13 14 15 16 17 18 19 20 21 22 23 24 | * * 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 "tclCompile.h" /* * Prototypes for procedures defined later in this file: */ static ClientData DupDictUpdateInfo(ClientData clientData); static void FreeDictUpdateInfo(ClientData clientData); | > | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | * * 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 "tclCompile.h" #include <assert.h> /* * Prototypes for procedures defined later in this file: */ static ClientData DupDictUpdateInfo(ClientData clientData); static void FreeDictUpdateInfo(ClientData clientData); |
︙ | ︙ | |||
221 222 223 224 225 226 227 228 229 230 231 232 233 234 | return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileBreakCmd -- * * Procedure called to compile the "break" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 | return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileArray*Cmd -- * * Functions called to compile "array" sucommands. * * Results: * All return TCL_OK for a successful compile, and TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "array" subcommand at * runtime. * *---------------------------------------------------------------------- */ int TclCompileArrayExistsCmd( 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. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int simpleVarName, isScalar, localIndex; if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, &simpleVarName, &isScalar, 1); if (!isScalar) { return TCL_ERROR; } if (localIndex >= 0) { TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); } else { TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); } return TCL_OK; } int TclCompileArraySetCmd( 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. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int simpleVarName, isScalar, localIndex; int dataVar, iterVar, keyVar, valVar, infoIndex; int back, fwd, offsetBack, offsetFwd, savedStackDepth; ForeachInfo *infoPtr; if (parsePtr->numWords != 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, &simpleVarName, &isScalar, 1); if (!isScalar) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); /* * Special case: literal empty value argument is just an "ensure array" * operation. */ if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD && tokenPtr[1].size == 0) { if (localIndex >= 0) { TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr); TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr); } else { TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); TclEmitInstInt1(INST_JUMP_TRUE1, 5, envPtr); savedStackDepth = envPtr->currStackDepth; TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr); TclEmitInstInt1(INST_JUMP1, 3, envPtr); envPtr->currStackDepth = savedStackDepth; TclEmitOpcode( INST_POP, envPtr); } PushLiteral(envPtr, "", 0); return TCL_OK; } /* * Prepare for the internal foreach. */ if (envPtr->procPtr == NULL) { return TCL_ERROR; } dataVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); iterVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); keyVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); valVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *)); infoPtr->numLists = 1; infoPtr->firstValueTemp = dataVar; infoPtr->loopCtTemp = iterVar; infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) * 2*sizeof(int)); infoPtr->varLists[0]->numVars = 2; infoPtr->varLists[0]->varIndexes[0] = keyVar; infoPtr->varLists[0]->varIndexes[1] = valVar; infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr); /* * Start issuing instructions to write to the array. */ CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_LIST_LENGTH, envPtr); PushLiteral(envPtr, "1", 1); TclEmitOpcode( INST_BITAND, envPtr); offsetFwd = CurrentOffset(envPtr); TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr); savedStackDepth = envPtr->currStackDepth; PushLiteral(envPtr, "list must have an even number of elements", strlen("list must have an even number of elements")); PushLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}", strlen("-errorCode {TCL ARGUMENT FORMAT}")); TclEmitInstInt4( INST_RETURN_IMM, 1, envPtr); TclEmitInt4( 0, envPtr); envPtr->currStackDepth = savedStackDepth; fwd = CurrentOffset(envPtr) - offsetFwd; TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); Emit14Inst( INST_STORE_SCALAR, dataVar, envPtr); TclEmitOpcode( INST_POP, envPtr); if (localIndex >= 0) { TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr); TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr); TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr); offsetBack = CurrentOffset(envPtr); TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr); offsetFwd = CurrentOffset(envPtr); TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); savedStackDepth = envPtr->currStackDepth; Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); TclEmitOpcode( INST_POP, envPtr); back = offsetBack - CurrentOffset(envPtr); TclEmitInstInt1(INST_JUMP1, back, envPtr); fwd = CurrentOffset(envPtr) - offsetFwd; TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); envPtr->currStackDepth = savedStackDepth; } else { TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); TclEmitInstInt1(INST_JUMP_TRUE1, 4, envPtr); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr); TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr); offsetBack = CurrentOffset(envPtr); TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr); offsetFwd = CurrentOffset(envPtr); TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); savedStackDepth = envPtr->currStackDepth; TclEmitOpcode( INST_DUP, envPtr); Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); TclEmitOpcode( INST_POP, envPtr); back = offsetBack - CurrentOffset(envPtr); TclEmitInstInt1(INST_JUMP1, back, envPtr); fwd = CurrentOffset(envPtr) - offsetFwd; TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); envPtr->currStackDepth = savedStackDepth; TclEmitOpcode( INST_POP, envPtr); } TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( dataVar, envPtr); PushLiteral(envPtr, "", 0); return TCL_OK; } int TclCompileArrayUnsetCmd( 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. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); int simpleVarName, isScalar, localIndex, savedStackDepth; if (parsePtr->numWords != 2) { return TCL_ERROR; } PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, &simpleVarName, &isScalar, 1); if (!isScalar) { return TCL_ERROR; } if (localIndex >= 0) { TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); TclEmitInstInt1(INST_JUMP_FALSE1, 8, envPtr); TclEmitInstInt1(INST_UNSET_SCALAR, 1, envPtr); TclEmitInt4( localIndex, envPtr); } else { TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); TclEmitInstInt1(INST_JUMP_FALSE1, 6, envPtr); savedStackDepth = envPtr->currStackDepth; TclEmitInstInt1(INST_UNSET_STK, 1, envPtr); TclEmitInstInt1(INST_JUMP1, 3, envPtr); envPtr->currStackDepth = savedStackDepth; TclEmitOpcode( INST_POP, envPtr); } PushLiteral(envPtr, "", 0); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileBreakCmd -- * * Procedure called to compile the "break" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. |
︙ | ︙ | |||
254 255 256 257 258 259 260 261 262 263 264 265 266 267 | } /* * Emit a break instruction. */ TclEmitOpcode(INST_BREAK, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileCatchCmd -- | > | 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 | } /* * Emit a break instruction. */ TclEmitOpcode(INST_BREAK, envPtr); PushLiteral(envPtr, "", 0); /* Evil hack! */ return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileCatchCmd -- |
︙ | ︙ | |||
560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 | } /* * Emit a continue instruction. */ TclEmitOpcode(INST_CONTINUE, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileDict*Cmd -- * * Functions called to compile "dict" sucommands. * * Results: * All return TCL_OK for a successful compile, and TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "dict" subcommand at * runtime. * | > < < < < < < < < < < < < < < < < < < < < | 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 | } /* * Emit a continue instruction. */ TclEmitOpcode(INST_CONTINUE, envPtr); PushLiteral(envPtr, "", 0); /* Evil hack! */ return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileDict*Cmd -- * * Functions called to compile "dict" sucommands. * * Results: * All return TCL_OK for a successful compile, and TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "dict" subcommand at * runtime. * *---------------------------------------------------------------------- */ int TclCompileDictSetCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command |
︙ | ︙ | |||
662 663 664 665 666 667 668 669 670 671 672 673 674 675 | /* * Now emit the instruction to do the dict manipulation. */ TclEmitInstInt4( INST_DICT_SET, numWords-2, envPtr); TclEmitInt4( dictVarIndex, envPtr); return TCL_OK; } int TclCompileDictIncrCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command | > | 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 | /* * Now emit the instruction to do the dict manipulation. */ TclEmitInstInt4( INST_DICT_SET, numWords-2, envPtr); TclEmitInt4( dictVarIndex, envPtr); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } int TclCompileDictIncrCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command |
︙ | ︙ | |||
779 780 781 782 783 784 785 786 787 788 789 790 791 792 | */ for (i=0 ; i<numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr); return TCL_OK; } int TclCompileDictUnsetCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 | */ for (i=0 ; i<numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } int TclCompileDictExistsCmd( 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; int numWords, i; DefineLineInformation; /* TIP #280 */ /* * There must be at least two arguments after the command (the single-arg * case is legal, but too special and magic for us to deal with here). */ if (parsePtr->numWords < 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); numWords = parsePtr->numWords-1; /* * Now we do the code generation. */ for (i=0 ; i<numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt4(INST_DICT_EXISTS, numWords-1, envPtr); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } int TclCompileDictUnsetCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command |
︙ | ︙ | |||
839 840 841 842 843 844 845 | } /* * Now emit the instruction to do the dict manipulation. */ TclEmitInstInt4( INST_DICT_UNSET, parsePtr->numWords-2, envPtr); | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 | } /* * Now emit the instruction to do the dict manipulation. */ TclEmitInstInt4( INST_DICT_UNSET, parsePtr->numWords-2, envPtr); TclEmitInt4( dictVarIndex, envPtr); return TCL_OK; } int TclCompileDictCreateCmd( 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. */ { DefineLineInformation; /* TIP #280 */ int worker; /* Temp var for building the value in. */ Tcl_Token *tokenPtr; Tcl_Obj *keyObj, *valueObj, *dictObj; const char *bytes; int i, len; if ((parsePtr->numWords & 1) == 0) { return TCL_ERROR; } /* * See if we can build the value at compile time... */ tokenPtr = TokenAfter(parsePtr->tokenPtr); dictObj = Tcl_NewObj(); Tcl_IncrRefCount(dictObj); for (i=1 ; i<parsePtr->numWords ; i+=2) { keyObj = Tcl_NewObj(); Tcl_IncrRefCount(keyObj); if (!TclWordKnownAtCompileTime(tokenPtr, keyObj)) { Tcl_DecrRefCount(keyObj); Tcl_DecrRefCount(dictObj); goto nonConstant; } tokenPtr = TokenAfter(tokenPtr); valueObj = Tcl_NewObj(); Tcl_IncrRefCount(valueObj); if (!TclWordKnownAtCompileTime(tokenPtr, valueObj)) { Tcl_DecrRefCount(keyObj); Tcl_DecrRefCount(valueObj); Tcl_DecrRefCount(dictObj); goto nonConstant; } tokenPtr = TokenAfter(tokenPtr); Tcl_DictObjPut(NULL, dictObj, keyObj, valueObj); Tcl_DecrRefCount(keyObj); Tcl_DecrRefCount(valueObj); } /* * We did! Excellent. The "verifyDict" is to do type forcing. */ bytes = Tcl_GetStringFromObj(dictObj, &len); PushLiteral(envPtr, bytes, len); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_DICT_VERIFY, envPtr); Tcl_DecrRefCount(dictObj); return TCL_OK; /* * Otherwise, we've got to issue runtime code to do the building, which we * do by [dict set]ting into an unnamed local variable. This requires that * we are in a context with an LVT. */ nonConstant: worker = TclFindCompiledLocal(NULL, 0, 1, envPtr); if (worker < 0) { return TCL_ERROR; } PushLiteral(envPtr, "", 0); Emit14Inst( INST_STORE_SCALAR, worker, envPtr); TclEmitOpcode( INST_POP, envPtr); tokenPtr = TokenAfter(parsePtr->tokenPtr); for (i=1 ; i<parsePtr->numWords ; i+=2) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i+1); tokenPtr = TokenAfter(tokenPtr); TclEmitInstInt4( INST_DICT_SET, 1, envPtr); TclEmitInt4( worker, envPtr); TclAdjustStackDepth(-1, envPtr); TclEmitOpcode( INST_POP, envPtr); } Emit14Inst( INST_LOAD_SCALAR, worker, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( worker, envPtr); return TCL_OK; } int TclCompileDictMergeCmd( 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. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int i, workerIndex, infoIndex, outLoop; /* * Deal with some special edge cases. Note that in the case with one * argument, the only thing to do is to verify the dict-ness. */ if (parsePtr->numWords < 2) { PushLiteral(envPtr, "", 0); return TCL_OK; } else if (parsePtr->numWords == 2) { tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_DICT_VERIFY, envPtr); return TCL_OK; } /* * There's real merging work to do. * * Allocate some working space. This means we'll only ever compile this * command when there's an LVT present. */ workerIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); if (workerIndex < 0) { return TCL_ERROR; } infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); /* * Get the first dictionary and verify that it is so. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_DICT_VERIFY, envPtr); Emit14Inst( INST_STORE_SCALAR, workerIndex, envPtr); TclEmitOpcode( INST_POP, envPtr); /* * For each of the remaining dictionaries... */ outLoop = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); TclEmitInstInt4( INST_BEGIN_CATCH4, outLoop, envPtr); ExceptionRangeStarts(envPtr, outLoop); for (i=2 ; i<parsePtr->numWords ; i++) { /* * Get the dictionary, and merge its pairs into the first dict (using * a small loop). */ tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); TclEmitInstInt1( INST_JUMP_TRUE1, 24, envPtr); TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitInstInt4( INST_DICT_SET, 1, envPtr); TclEmitInt4( workerIndex, envPtr); TclAdjustStackDepth(-1, envPtr); TclEmitOpcode( INST_POP, envPtr); TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr); TclEmitInstInt1( INST_JUMP_FALSE1, -20, envPtr); TclEmitOpcode( INST_POP, envPtr); TclEmitOpcode( INST_POP, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( infoIndex, envPtr); } ExceptionRangeEnds(envPtr, outLoop); TclEmitOpcode( INST_END_CATCH, envPtr); /* * Clean up any state left over. */ Emit14Inst( INST_LOAD_SCALAR, workerIndex, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( workerIndex, envPtr); TclEmitInstInt1( INST_JUMP1, 18, envPtr); /* * If an exception happens when starting to iterate over the second (and * subsequent) dicts. This is strictly not necessary, but it is nice. */ ExceptionRangeTarget(envPtr, outLoop, catchOffset); TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_END_CATCH, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( workerIndex, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( infoIndex, envPtr); TclEmitOpcode( INST_RETURN_STK, 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 |
︙ | ︙ | |||
1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 | SetLineInformation(3); CompileBody(envPtr, bodyTokenPtr, interp); if (collect == TCL_EACH_COLLECT) { Emit14Inst( INST_LOAD_SCALAR, keyVarIndex, envPtr); TclEmitInstInt4(INST_OVER, 1, envPtr); TclEmitInstInt4(INST_DICT_SET, 1, envPtr); TclEmitInt4( collectVar, envPtr); TclEmitOpcode( INST_POP, envPtr); } TclEmitOpcode( INST_POP, envPtr); /* * Both exception target ranges (error and loop) end here. */ | > | 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 | SetLineInformation(3); CompileBody(envPtr, bodyTokenPtr, interp); if (collect == TCL_EACH_COLLECT) { Emit14Inst( INST_LOAD_SCALAR, keyVarIndex, envPtr); TclEmitInstInt4(INST_OVER, 1, envPtr); TclEmitInstInt4(INST_DICT_SET, 1, envPtr); TclEmitInt4( collectVar, envPtr); TclAdjustStackDepth(-1, envPtr); TclEmitOpcode( INST_POP, envPtr); } TclEmitOpcode( INST_POP, envPtr); /* * Both exception target ranges (error and loop) end here. */ |
︙ | ︙ | |||
1066 1067 1068 1069 1070 1071 1072 | * terminated), ditching the exception info and jumping to the last * instruction for this command. In theory, this could be done using the * "finally" clause (next generated) but this is faster. */ ExceptionRangeTarget(envPtr, loopRange, breakOffset); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); | | | | | 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 | * terminated), ditching the exception info and jumping to the last * instruction for this command. In theory, this could be done using the * "finally" clause (next generated) but this is faster. */ ExceptionRangeTarget(envPtr, loopRange, breakOffset); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( infoIndex, envPtr); TclEmitOpcode( INST_END_CATCH, envPtr); endTargetOffset = CurrentOffset(envPtr); TclEmitInstInt4( INST_JUMP4, 0, envPtr); /* * Error handler "finally" clause, which force-terminates the iteration * and rethrows the error. */ ExceptionRangeTarget(envPtr, catchRange, catchOffset); TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( infoIndex, envPtr); TclEmitOpcode( INST_END_CATCH, envPtr); if (collect == TCL_EACH_COLLECT) { TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( collectVar, envPtr); } TclEmitOpcode( INST_RETURN_STK, envPtr); /* * Otherwise we're done (the jump after the DICT_FIRST points here) and we * need to pop the bogus key/value pair (pushed to keep stack calculations * easy!) Note that we skip the END_CATCH. [Bug 1382528] */ envPtr->currStackDepth = savedStackDepth + 2; jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset; TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement, envPtr->codeStart + emptyTargetOffset); TclEmitOpcode( INST_POP, envPtr); TclEmitOpcode( INST_POP, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( infoIndex, envPtr); |
︙ | ︙ | |||
1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 | TclEmitOpcode( INST_RETURN_STK, envPtr); if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); } TclStackFree(interp, keyTokenPtrs); return TCL_OK; } int TclCompileDictAppendCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command | > | 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 | TclEmitOpcode( INST_RETURN_STK, envPtr); if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); } TclStackFree(interp, keyTokenPtrs); envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } int TclCompileDictAppendCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command |
︙ | ︙ | |||
1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 | TclEmitOpcode( INST_DICT_EXPAND, envPtr); PushLiteral(envPtr, "", 0); TclEmitInstInt4(INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); PushLiteral(envPtr, "", 0); } } return TCL_OK; } /* * OK, we have a non-trivial body. This means that the focus is on * generating a try-finally structure where the INST_DICT_RECOMBINE_* goes * in the 'finally' clause. | > | 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 | TclEmitOpcode( INST_DICT_EXPAND, envPtr); PushLiteral(envPtr, "", 0); TclEmitInstInt4(INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); PushLiteral(envPtr, "", 0); } } envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } /* * OK, we have a non-trivial body. This means that the focus is on * generating a try-finally structure where the INST_DICT_RECOMBINE_* goes * in the 'finally' clause. |
︙ | ︙ | |||
1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 | } TclEmitOpcode( INST_RETURN_STK, envPtr); /* * Prepare for the start of the next command. */ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); } return TCL_OK; } | > | 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 | } TclEmitOpcode( INST_RETURN_STK, envPtr); /* * Prepare for the start of the next command. */ envPtr->currStackDepth = savedStackDepth + 1; if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); } return TCL_OK; } |
︙ | ︙ | |||
1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 | CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * General syntax: [error message ?errorInfo? ?errorCode?] * However, we only deal with the case where there is just a message. */ Tcl_Token *messageTokenPtr; DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords != 2) { return TCL_ERROR; } messageTokenPtr = TokenAfter(parsePtr->tokenPtr); PushLiteral(envPtr, "-code error -level 0", 20); CompileWord(envPtr, messageTokenPtr, interp, 1); TclEmitOpcode(INST_RETURN_STK, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileExprCmd -- | > > | 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 | CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * General syntax: [error message ?errorInfo? ?errorCode?] * However, we only deal with the case where there is just a message. */ Tcl_Token *messageTokenPtr; int savedStackDepth = envPtr->currStackDepth; DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords != 2) { return TCL_ERROR; } messageTokenPtr = TokenAfter(parsePtr->tokenPtr); PushLiteral(envPtr, "-code error -level 0", 20); CompileWord(envPtr, messageTokenPtr, interp, 1); TclEmitOpcode(INST_RETURN_STK, envPtr); envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileExprCmd -- |
︙ | ︙ | |||
2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 | Tcl_AppendToObj(appendObj, "]", -1); } } /* *---------------------------------------------------------------------- * * TclCompileGlobalCmd -- * * Procedure called to compile the "global" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 | Tcl_AppendToObj(appendObj, "]", -1); } } /* *---------------------------------------------------------------------- * * TclCompileFormatCmd -- * * Procedure called to compile the "format" command. Handles cases that * can be done as constants or simple string concatenation only. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "format" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileFormatCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; Tcl_Obj **objv, *formatObj, *tmpObj; char *bytes, *start; int i, j, len; /* * Don't handle any guaranteed-error cases. */ if (parsePtr->numWords < 2) { return TCL_ERROR; } /* * Check if the argument words are all compile-time-known literals; that's * a case we can handle by compiling to a constant. */ formatObj = Tcl_NewObj(); Tcl_IncrRefCount(formatObj); tokenPtr = TokenAfter(tokenPtr); if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) { Tcl_DecrRefCount(formatObj); return TCL_ERROR; } objv = ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *)); for (i=0 ; i+2 < parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); objv[i] = Tcl_NewObj(); Tcl_IncrRefCount(objv[i]); if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) { goto checkForStringConcatCase; } } /* * Everything is a literal, so the result is constant too (or an error if * the format is broken). Do the format now. */ tmpObj = Tcl_Format(interp, Tcl_GetString(formatObj), parsePtr->numWords-2, objv); for (; --i>=0 ;) { Tcl_DecrRefCount(objv[i]); } ckfree(objv); Tcl_DecrRefCount(formatObj); if (tmpObj == NULL) { return TCL_ERROR; } /* * Not an error, always a constant result, so just push the result as a * literal. Job done. */ bytes = Tcl_GetStringFromObj(tmpObj, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(tmpObj); return TCL_OK; checkForStringConcatCase: /* * See if we can generate a sequence of things to concatenate. This * requires that all the % sequences be %s or %%, as everything else is * sufficiently complex that we don't bother. * * First, get the state of the system relatively sensible (cleaning up * after our attempt to spot a literal). */ for (; --i>=0 ;) { Tcl_DecrRefCount(objv[i]); } ckfree(objv); tokenPtr = TokenAfter(parsePtr->tokenPtr); tokenPtr = TokenAfter(tokenPtr); i = 0; /* * Now scan through and check for non-%s and non-%% substitutions. */ for (bytes = Tcl_GetString(formatObj) ; *bytes ; bytes++) { if (*bytes == '%') { bytes++; if (*bytes == 's') { i++; continue; } else if (*bytes == '%') { continue; } Tcl_DecrRefCount(formatObj); return TCL_ERROR; } } /* * Check if the number of things to concatenate will fit in a byte. */ if (i+2 != parsePtr->numWords || i > 125) { Tcl_DecrRefCount(formatObj); return TCL_ERROR; } /* * Generate the pushes of the things to concatenate, a sequence of * literals and compiled tokens (of which at least one is non-literal or * we'd have the case in the first half of this function) which we will * concatenate. */ i = 0; /* The count of things to concat. */ j = 2; /* The index into the argument tokens, for * TIP#280 handling. */ start = Tcl_GetString(formatObj); /* The start of the currently-scanned literal * in the format string. */ tmpObj = Tcl_NewObj(); /* The buffer used to accumulate the literal * being built. */ for (bytes = start ; *bytes ; bytes++) { if (*bytes == '%') { Tcl_AppendToObj(tmpObj, start, bytes - start); if (*++bytes == '%') { Tcl_AppendToObj(tmpObj, "%", 1); } else { char *b = Tcl_GetStringFromObj(tmpObj, &len); /* * If there is a non-empty literal from the format string, * push it and reset. */ if (len > 0) { PushLiteral(envPtr, b, len); Tcl_DecrRefCount(tmpObj); tmpObj = Tcl_NewObj(); i++; } /* * Push the code to produce the string that would be * substituted with %s, except we'll be concatenating * directly. */ CompileWord(envPtr, tokenPtr, interp, j); tokenPtr = TokenAfter(tokenPtr); j++; i++; } start = bytes + 1; } } /* * Handle the case of a trailing literal. */ Tcl_AppendToObj(tmpObj, start, bytes - start); bytes = Tcl_GetStringFromObj(tmpObj, &len); if (len > 0) { PushLiteral(envPtr, bytes, len); i++; } Tcl_DecrRefCount(tmpObj); Tcl_DecrRefCount(formatObj); if (i > 1) { /* * Do the concatenation, which produces the result. */ TclEmitInstInt1(INST_CONCAT1, i, envPtr); } else { /* * EVIL HACK! Force there to be a string representation in the case * where there's just a "%s" in the format; case covered by the test * format-20.1 (and it is horrible...) */ TclEmitOpcode(INST_DUP, envPtr); PushLiteral(envPtr, "", 0); TclEmitOpcode(INST_STR_EQ, envPtr); TclEmitOpcode(INST_POP, envPtr); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileGlobalCmd -- * * Procedure called to compile the "global" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. |
︙ | ︙ | |||
3018 3019 3020 3021 3022 3023 3024 | return TCL_OK; } /* *---------------------------------------------------------------------- * | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 | return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileInfo*Cmd -- * * Procedures called to compile "info" subcommands. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "info" subcommand at * runtime. * *---------------------------------------------------------------------- */ int TclCompileInfoCommandsCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; Tcl_Obj *objPtr; char *bytes; /* * We require one compile-time known argument for the case we can compile. */ if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); objPtr = Tcl_NewObj(); Tcl_IncrRefCount(objPtr); if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { goto notCompilable; } bytes = Tcl_GetString(objPtr); /* * We require that the argument start with "::" and not have any of "*\[?" * in it. (Theoretically, we should look in only the final component, but * the difference is so slight given current naming practices.) */ if (bytes[0] != ':' || bytes[1] != ':' || !TclMatchIsTrivial(bytes)) { goto notCompilable; } Tcl_DecrRefCount(objPtr); /* * Confirmed as a literal that will not frighten the horses. Compile. Note * that the result needs to be list-ified. */ CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_STR_LEN, envPtr); TclEmitInstInt1( INST_JUMP_FALSE1, 7, envPtr); TclEmitInstInt4( INST_LIST, 1, envPtr); return TCL_OK; notCompilable: Tcl_DecrRefCount(objPtr); return TCL_ERROR; } int TclCompileInfoCoroutineCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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. */ { /* * Only compile [info coroutine] without arguments. */ if (parsePtr->numWords != 1) { return TCL_ERROR; } /* * Not much to do; we compile to a single instruction... */ TclEmitOpcode( INST_COROUTINE_NAME, envPtr); return TCL_OK; } int TclCompileInfoExistsCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being |
︙ | ︙ | |||
3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 | } else { TclEmitInstInt4( INST_EXIST_ARRAY, localIndex, envPtr); } } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileLappendCmd -- * * Procedure called to compile the "lappend" command. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 | } else { TclEmitInstInt4( INST_EXIST_ARRAY, localIndex, envPtr); } } return TCL_OK; } int TclCompileInfoLevelCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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. */ { /* * Only compile [info level] without arguments or with a single argument. */ if (parsePtr->numWords == 1) { /* * Not much to do; we compile to a single instruction... */ TclEmitOpcode( INST_INFO_LEVEL_NUM, envPtr); } else if (parsePtr->numWords != 2) { return TCL_ERROR; } else { DefineLineInformation; /* TIP #280 */ /* * Compile the argument, then add the instruction to convert it into a * list of arguments. */ SetLineInformation(1); CompileTokens(envPtr, TokenAfter(parsePtr->tokenPtr), interp); TclEmitOpcode( INST_INFO_LEVEL_ARGS, envPtr); } return TCL_OK; } int TclCompileInfoObjectClassCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); if (parsePtr->numWords != 2) { return TCL_ERROR; } CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_TCLOO_CLASS, envPtr); return TCL_OK; } int TclCompileInfoObjectIsACmd( Tcl_Interp *interp, /* Used for error reporting. */ 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) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); /* * We only handle [info object isa object <somevalue>]. The first three * words are compressed to a single token by the ensemble compilation * engine. */ if (parsePtr->numWords != 3) { return TCL_ERROR; } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size < 1 || strncmp(tokenPtr[1].start, "object", tokenPtr[1].size)) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); /* * Issue the code. */ CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode( INST_TCLOO_IS_OBJECT, envPtr); return TCL_OK; } int TclCompileInfoObjectNamespaceCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); if (parsePtr->numWords != 2) { return TCL_ERROR; } CompileWord(envPtr, tokenPtr, interp, 1); TclEmitOpcode( INST_TCLOO_NS, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileLappendCmd -- * * Procedure called to compile the "lappend" command. |
︙ | ︙ | |||
3932 3933 3934 3935 3936 3937 3938 | return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, TCL_EACH_COLLECT); } /* *---------------------------------------------------------------------- * | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 | return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, TCL_EACH_COLLECT); } /* *---------------------------------------------------------------------- * * TclCompileNamespace*Cmd -- * * Procedures called to compile the "namespace" command; currently, only * the subcommands "namespace current" and "namespace upvar" are compiled * to bytecodes, and the latter only inside a procedure(-like) context. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "namespace upvar" * command at runtime. * *---------------------------------------------------------------------- */ int TclCompileNamespaceCurrentCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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. */ { /* * Only compile [namespace current] without arguments. */ if (parsePtr->numWords != 1) { return TCL_ERROR; } /* * Not much to do; we compile to a single instruction... */ TclEmitOpcode( INST_NS_CURRENT, envPtr); return TCL_OK; } int TclCompileNamespaceCodeCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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 */ if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); /* * The specification of [namespace code] is rather shocking, in that it is * supposed to check if the argument is itself the result of [namespace * code] and not apply itself in that case. Which is excessively cautious, * but what the test suite checks for. */ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || (tokenPtr[1].size > 20 && strncmp(tokenPtr[1].start, "::namespace inscope ", 20) == 0)) { /* * Technically, we could just pass a literal '::namespace inscope ' * term through, but that's something which really shouldn't be * occurring as something that the user writes so we'll just punt it. */ return TCL_ERROR; } /* * Now we can compile using the same strategy as [namespace code]'s normal * implementation does internally. Note that we can't bind the namespace * name directly here, because TclOO plays complex games with namespaces; * the value needs to be determined at runtime for safety. */ PushLiteral(envPtr, "::namespace", 11); PushLiteral(envPtr, "inscope", 7); TclEmitOpcode( INST_NS_CURRENT, envPtr); CompileWord(envPtr, tokenPtr, interp, 1); TclEmitInstInt4( INST_LIST, 4, envPtr); return TCL_OK; } int TclCompileNamespaceQualifiersCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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 = TokenAfter(parsePtr->tokenPtr); DefineLineInformation; /* TIP #280 */ int off; if (parsePtr->numWords != 2) { return TCL_ERROR; } CompileWord(envPtr, tokenPtr, interp, 1); PushLiteral(envPtr, "0", 1); PushLiteral(envPtr, "::", 2); TclEmitInstInt4( INST_OVER, 2, envPtr); TclEmitOpcode( INST_STR_FIND_LAST, envPtr); off = CurrentOffset(envPtr); PushLiteral(envPtr, "1", 1); TclEmitOpcode( INST_SUB, envPtr); TclEmitInstInt4( INST_OVER, 2, envPtr); TclEmitInstInt4( INST_OVER, 1, envPtr); TclEmitOpcode( INST_STR_INDEX, envPtr); PushLiteral(envPtr, ":", 1); TclEmitOpcode( INST_STR_EQ, envPtr); off = off - CurrentOffset(envPtr); TclEmitInstInt1( INST_JUMP_TRUE1, off, envPtr); TclEmitOpcode( INST_STR_RANGE, envPtr); return TCL_OK; } int TclCompileNamespaceTailCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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 = TokenAfter(parsePtr->tokenPtr); DefineLineInformation; /* TIP #280 */ JumpFixup jumpFixup; if (parsePtr->numWords != 2) { return TCL_ERROR; } /* * Take care; only add 2 to found index if the string was actually found. */ CompileWord(envPtr, tokenPtr, interp, 1); PushLiteral(envPtr, "::", 2); TclEmitInstInt4( INST_OVER, 1, envPtr); TclEmitOpcode( INST_STR_FIND_LAST, envPtr); TclEmitOpcode( INST_DUP, envPtr); PushLiteral(envPtr, "0", 1); TclEmitOpcode( INST_GE, envPtr); TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup); PushLiteral(envPtr, "2", 1); TclEmitOpcode( INST_ADD, envPtr); TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127); PushLiteral(envPtr, "end", 3); TclEmitOpcode( INST_STR_RANGE, envPtr); return TCL_OK; } int TclCompileNamespaceUpvarCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being |
︙ | ︙ | |||
4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 | * Pop the namespace, and set the result to empty */ TclEmitOpcode( INST_POP, envPtr); PushLiteral(envPtr, "", 0); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileRegexpCmd -- * * Procedure called to compile the "regexp" command. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 | * Pop the namespace, and set the result to empty */ TclEmitOpcode( INST_POP, envPtr); PushLiteral(envPtr, "", 0); return TCL_OK; } int TclCompileNamespaceWhichCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *opt; int idx; if (parsePtr->numWords < 2 || parsePtr->numWords > 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); idx = 1; /* * If there's an option, check that it's "-command". We don't handle * "-variable" (currently) and anything else is an error. */ if (parsePtr->numWords == 3) { if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_ERROR; } opt = tokenPtr + 1; if (opt->size < 2 || opt->size > 8 || strncmp(opt->start, "-command", opt->size) != 0) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); idx++; } /* * Issue the bytecode. */ CompileWord(envPtr, tokenPtr, interp, idx); TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileRegexpCmd -- * * Procedure called to compile the "regexp" command. |
︙ | ︙ | |||
4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 | return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileReturnCmd -- * * Procedure called to compile the "return" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 | return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileRegsubCmd -- * * Procedure called to compile the "regsub" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "regsub" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileRegsubCmd( Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { /* * We only compile the case with [regsub -all] where the pattern is both * known at compile time and simple (i.e., no RE metacharacters). That is, * the pattern must be translatable into a glob like "*foo*" with no other * glob metacharacters inside it; there must be some "foo" in there too. * The substitution string must also be known at compile time and free of * metacharacters ("\digit" and "&"). Finally, there must not be a * variable mentioned in the [regsub] to write the result back to (because * we can't get the count of substitutions that would be the result in * that case). The key is that these are the conditions under which a * [string map] could be used instead, in particular a [string map] of the * form we can compile to bytecode. * * In short, we look for: * * regsub -all [--] simpleRE string simpleReplacement * * The only optional part is the "--", and no other options are handled. */ DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *stringTokenPtr; Tcl_Obj *patternObj = NULL, *replacementObj = NULL; Tcl_DString pattern; const char *bytes; int len, exact, result = TCL_ERROR; if (parsePtr->numWords < 5 || parsePtr->numWords > 6) { return TCL_ERROR; } /* * Parse the "-all", which must be the first argument (other options not * supported, non-"-all" substitution we can't compile). */ tokenPtr = TokenAfter(parsePtr->tokenPtr); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 4 || strncmp(tokenPtr[1].start, "-all", 4)) { return TCL_ERROR; } /* * Get the pattern into patternObj, checking for "--" in the process. */ Tcl_DStringInit(&pattern); tokenPtr = TokenAfter(tokenPtr); patternObj = Tcl_NewObj(); if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { goto done; } if (Tcl_GetString(patternObj)[0] == '-') { if (strcmp(Tcl_GetString(patternObj), "--") != 0 || parsePtr->numWords == 5) { goto done; } tokenPtr = TokenAfter(tokenPtr); Tcl_DecrRefCount(patternObj); patternObj = Tcl_NewObj(); if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { goto done; } } else if (parsePtr->numWords == 6) { goto done; } /* * Identify the code which produces the string to apply the substitution * to (stringTokenPtr), and the replacement string (into replacementObj). */ stringTokenPtr = TokenAfter(tokenPtr); tokenPtr = TokenAfter(stringTokenPtr); replacementObj = Tcl_NewObj(); if (!TclWordKnownAtCompileTime(tokenPtr, replacementObj)) { goto done; } /* * Next, higher-level checks. Is the RE a very simple glob? Is the * replacement "simple"? */ bytes = Tcl_GetStringFromObj(patternObj, &len); if (TclReToGlob(NULL, bytes, len, &pattern, &exact) != TCL_OK || exact) { goto done; } bytes = Tcl_DStringValue(&pattern); if (*bytes++ != '*') { goto done; } while (1) { switch (*bytes) { case '*': if (bytes[1] == '\0') { /* * OK, we've proved there are no metacharacters except for the * '*' at each end. */ len = Tcl_DStringLength(&pattern) - 2; if (len > 0) { goto isSimpleGlob; } /* * The pattern is "**"! I believe that should be impossible, * but we definitely can't handle that at all. */ } case '\0': case '?': case '[': case '\\': goto done; } bytes++; } isSimpleGlob: for (bytes = Tcl_GetString(replacementObj); *bytes; bytes++) { switch (*bytes) { case '\\': case '&': goto done; } } /* * Proved the simplicity constraints! Time to issue the code. */ result = TCL_OK; bytes = Tcl_DStringValue(&pattern) + 1; PushLiteral(envPtr, bytes, len); bytes = Tcl_GetStringFromObj(replacementObj, &len); PushLiteral(envPtr, bytes, len); CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords-2); TclEmitOpcode( INST_STR_MAP, envPtr); done: Tcl_DStringFree(&pattern); if (patternObj) { Tcl_DecrRefCount(patternObj); } if (replacementObj) { Tcl_DecrRefCount(replacementObj); } return result; } /* *---------------------------------------------------------------------- * * TclCompileReturnCmd -- * * Procedure called to compile the "return" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. |
︙ | ︙ | |||
4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 | * General syntax: [return ?-option value ...? ?result?] * An even number of words means an explicit result argument is present. */ int level, code, objc, size, status = TCL_OK; int numWords = parsePtr->numWords; int explicitResult = (0 == (numWords % 2)); int numOptionWords = numWords - 1 - explicitResult; Tcl_Obj *returnOpts, **objv; Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); DefineLineInformation; /* TIP #280 */ /* * Check for special case which can always be compiled: * return -options <opts> <msg> | > | 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 | * General syntax: [return ?-option value ...? ?result?] * An even number of words means an explicit result argument is present. */ int level, code, objc, size, status = TCL_OK; int numWords = parsePtr->numWords; int explicitResult = (0 == (numWords % 2)); int numOptionWords = numWords - 1 - explicitResult; int savedStackDepth = envPtr->currStackDepth; Tcl_Obj *returnOpts, **objv; Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); DefineLineInformation; /* TIP #280 */ /* * Check for special case which can always be compiled: * return -options <opts> <msg> |
︙ | ︙ | |||
4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 | && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) { Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr); Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr); CompileWord(envPtr, optsTokenPtr, interp, 2); CompileWord(envPtr, msgTokenPtr, interp, 3); TclEmitOpcode(INST_RETURN_STK, envPtr); return TCL_OK; } /* * Allocate some working space. */ | > | 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 | && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) { Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr); Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr); CompileWord(envPtr, optsTokenPtr, interp, 2); CompileWord(envPtr, msgTokenPtr, interp, 3); TclEmitOpcode(INST_RETURN_STK, envPtr); envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } /* * Allocate some working space. */ |
︙ | ︙ | |||
4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 | tailName = p; } localIndex = TclFindCompiledLocal(tailName, len, 1, envPtr); Tcl_DecrRefCount(tailPtr); return localIndex; } /* *---------------------------------------------------------------------- * * PushVarName -- * * Procedure used in the compiling where pushing a variable name is | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 5935 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 | tailName = p; } localIndex = TclFindCompiledLocal(tailName, len, 1, envPtr); Tcl_DecrRefCount(tailPtr); return localIndex; } int TclCompileObjectSelfCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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. */ { /* * We only handle [self] and [self object] (which is the same operation). * These are the only very common operations on [self] for which * bytecoding is at all reasonable. */ if (parsePtr->numWords == 1) { goto compileSelfObject; } else if (parsePtr->numWords == 2) { Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr), *subcmd; if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size==0) { return TCL_ERROR; } subcmd = tokenPtr + 1; if (strncmp(subcmd->start, "object", subcmd->size) == 0) { goto compileSelfObject; } else if (strncmp(subcmd->start, "namespace", subcmd->size) == 0) { goto compileSelfNamespace; } } /* * Can't compile; handle with runtime call. */ return TCL_ERROR; compileSelfObject: /* * This delegates the entire problem to a single opcode. */ TclEmitOpcode( INST_TCLOO_SELF, envPtr); return TCL_OK; compileSelfNamespace: /* * This is formally only correct with TclOO methods as they are currently * implemented; it assumes that the current namespace is invariably when a * TclOO context is present is the object's namespace, and that's * technically only something that's a matter of current policy. But it * avoids creating another opcode, so that's all good! */ TclEmitOpcode( INST_TCLOO_SELF, envPtr); TclEmitOpcode( INST_POP, envPtr); TclEmitOpcode( INST_NS_CURRENT, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * PushVarName -- * * Procedure used in the compiling where pushing a variable name is |
︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
︙ | ︙ | |||
129 130 131 132 133 134 135 136 137 138 139 140 141 142 | /* * Shorthand macros for instruction issuing. */ #define OP(name) TclEmitOpcode(INST_##name, envPtr) #define OP1(name,val) TclEmitInstInt1(INST_##name,(val),envPtr) #define OP4(name,val) TclEmitInstInt4(INST_##name,(val),envPtr) #define OP44(name,val1,val2) \ TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr) #define BODY(token,index) \ SetLineInformation((index));CompileBody(envPtr,(token),interp) #define PUSH(str) \ PushLiteral(envPtr,(str),strlen(str)) #define JUMP(var,name) \ | > > | 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | /* * Shorthand macros for instruction issuing. */ #define OP(name) TclEmitOpcode(INST_##name, envPtr) #define OP1(name,val) TclEmitInstInt1(INST_##name,(val),envPtr) #define OP4(name,val) TclEmitInstInt4(INST_##name,(val),envPtr) #define OP14(name,val1,val2) \ TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr) #define OP44(name,val1,val2) \ TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr) #define BODY(token,index) \ SetLineInformation((index));CompileBody(envPtr,(token),interp) #define PUSH(str) \ PushLiteral(envPtr,(str),strlen(str)) #define JUMP(var,name) \ |
︙ | ︙ | |||
245 246 247 248 249 250 251 | return TCL_OK; } /* *---------------------------------------------------------------------- * | | | | | | | 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 | return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileString*Cmd -- * * Procedures called to compile various subcommands of the "string" * command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "string" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileStringCmpCmd( Tcl_Interp *interp, /* Used for error reporting. */ |
︙ | ︙ | |||
292 293 294 295 296 297 298 | tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode(INST_STR_CMP, envPtr); return TCL_OK; } | < < < < < < < < < < < < < < < < < < < | 294 295 296 297 298 299 300 301 302 303 304 305 306 307 | tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode(INST_STR_CMP, envPtr); return TCL_OK; } int TclCompileStringEqualCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being |
︙ | ︙ | |||
343 344 345 346 347 348 349 | tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode(INST_STR_EQ, envPtr); return TCL_OK; } | | > > > > > > > > > > > > | < > | | > > > | < < > > | | > | > > > | > | > > > > > > | | > > > | > > > | > > > | > > | > > > > > > > > | 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 | tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode(INST_STR_EQ, envPtr); return TCL_OK; } int TclCompileStringFirstCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; /* * We don't support any flags; the bytecode isn't that sophisticated. */ if (parsePtr->numWords != 3) { return TCL_ERROR; } /* * Push the two operands onto the stack and then the test. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); OP(STR_FIND); return TCL_OK; } int TclCompileStringLastCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; /* * We don't support any flags; the bytecode isn't that sophisticated. */ if (parsePtr->numWords != 3) { return TCL_ERROR; } /* * Push the two operands onto the stack and then the test. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); OP(STR_FIND_LAST); return TCL_OK; } int TclCompileStringIndexCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being |
︙ | ︙ | |||
390 391 392 393 394 395 396 | tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode(INST_STR_INDEX, envPtr); return TCL_OK; } | < < < < < < < < < < < < < < < < < < < | 418 419 420 421 422 423 424 425 426 427 428 429 430 431 | tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); TclEmitOpcode(INST_STR_INDEX, envPtr); return TCL_OK; } int TclCompileStringMatchCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being |
︙ | ︙ | |||
490 491 492 493 494 495 496 | if (exactMatch) { TclEmitOpcode(INST_STR_EQ, envPtr); } else { TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr); } return TCL_OK; } | < < < < < < < < < < < < < < < < < < < | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 | if (exactMatch) { TclEmitOpcode(INST_STR_EQ, envPtr); } else { TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr); } return TCL_OK; } int TclCompileStringLenCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being |
︙ | ︙ | |||
549 550 551 552 553 554 555 556 557 558 559 560 561 562 | SetLineInformation(1); CompileTokens(envPtr, tokenPtr, interp); TclEmitOpcode(INST_STR_LEN, envPtr); } TclDecrRefCount(objPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileSubstCmd -- * * Procedure called to compile the "subst" command. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 | SetLineInformation(1); CompileTokens(envPtr, tokenPtr, interp); TclEmitOpcode(INST_STR_LEN, envPtr); } TclDecrRefCount(objPtr); return TCL_OK; } int TclCompileStringMapCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *mapTokenPtr, *stringTokenPtr; Tcl_Obj *mapObj, **objv; char *bytes; int len; /* * We only handle the case: * * string map {foo bar} $thing * * That is, a literal two-element list (doesn't need to be brace-quoted, * but does need to be compile-time knowable) and any old argument (the * thing to map). */ if (parsePtr->numWords != 3) { return TCL_ERROR; } mapTokenPtr = TokenAfter(parsePtr->tokenPtr); stringTokenPtr = TokenAfter(mapTokenPtr); mapObj = Tcl_NewObj(); Tcl_IncrRefCount(mapObj); if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) { Tcl_DecrRefCount(mapObj); return TCL_ERROR; } else if (Tcl_ListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) { Tcl_DecrRefCount(mapObj); return TCL_ERROR; } else if (len != 2) { Tcl_DecrRefCount(mapObj); return TCL_ERROR; } /* * Now issue the opcodes. Note that in the case that we know that the * first word is an empty word, we don't issue the map at all. That is the * correct semantics for mapping. */ bytes = Tcl_GetStringFromObj(objv[0], &len); if (len == 0) { CompileWord(envPtr, stringTokenPtr, interp, 2); } else { PushLiteral(envPtr, bytes, len); bytes = Tcl_GetStringFromObj(objv[1], &len); PushLiteral(envPtr, bytes, len); CompileWord(envPtr, stringTokenPtr, interp, 2); OP(STR_MAP); } Tcl_DecrRefCount(mapObj); return TCL_OK; } int TclCompileStringRangeCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr; Tcl_Obj *tmpObj; int idx1, idx2, result; if (parsePtr->numWords != 4) { return TCL_ERROR; } stringTokenPtr = TokenAfter(parsePtr->tokenPtr); fromTokenPtr = TokenAfter(stringTokenPtr); toTokenPtr = TokenAfter(fromTokenPtr); /* * Parse the first index. Will only compile if it is constant and not an * _integer_ less than zero (since we reserve negative indices here for * end-relative indexing). */ tmpObj = Tcl_NewObj(); result = TCL_ERROR; if (TclWordKnownAtCompileTime(fromTokenPtr, tmpObj)) { if (TclGetIntFromObj(NULL, tmpObj, &idx1) == TCL_OK) { if (idx1 >= 0) { result = TCL_OK; } } else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx1) == TCL_OK) { if (idx1 <= -2) { result = TCL_OK; } } } TclDecrRefCount(tmpObj); if (result != TCL_OK) { goto nonConstantIndices; } /* * Parse the second index. Will only compile if it is constant and not an * _integer_ less than zero (since we reserve negative indices here for * end-relative indexing). */ tmpObj = Tcl_NewObj(); result = TCL_ERROR; if (TclWordKnownAtCompileTime(toTokenPtr, tmpObj)) { if (TclGetIntFromObj(NULL, tmpObj, &idx2) == TCL_OK) { if (idx2 >= 0) { result = TCL_OK; } } else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx2) == TCL_OK) { if (idx2 <= -2) { result = TCL_OK; } } } TclDecrRefCount(tmpObj); if (result != TCL_OK) { goto nonConstantIndices; } /* * Push the operand onto the stack and then the substring operation. */ CompileWord(envPtr, stringTokenPtr, interp, 1); OP44( STR_RANGE_IMM, idx1, idx2); return TCL_OK; /* * Push the operands onto the stack and then the substring operation. */ nonConstantIndices: CompileWord(envPtr, stringTokenPtr, interp, 1); CompileWord(envPtr, fromTokenPtr, interp, 2); CompileWord(envPtr, toTokenPtr, interp, 3); OP( STR_RANGE); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileSubstCmd -- * * Procedure called to compile the "subst" command. |
︙ | ︙ | |||
693 694 695 696 697 698 699 | literal = TclRegisterNewLiteral(envPtr, buf, length); TclEmitPush(literal, envPtr); count++; continue; } while (count > 255) { | | | | | | | | | | | | | | | | | | | | | < | | > | 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 | literal = TclRegisterNewLiteral(envPtr, buf, length); TclEmitPush(literal, envPtr); count++; continue; } while (count > 255) { OP1( CONCAT1, 255); count -= 254; } if (count > 1) { OP1( CONCAT1, count); count = 1; } if (breakOffset == 0) { /* Jump to the start (jump over the jump to end) */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &startFixup); /* Jump to the end (all BREAKs land here) */ breakOffset = CurrentOffset(envPtr); TclEmitInstInt4(INST_JUMP4, 0, envPtr); /* Start */ if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d", (int) (CurrentOffset(envPtr) - startFixup.codeOffset)); } } envPtr->line = bline; catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); OP4( BEGIN_CATCH4, catchRange); ExceptionRangeStarts(envPtr, catchRange); switch (tokenPtr->type) { case TCL_TOKEN_COMMAND: TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2, envPtr); count++; break; case TCL_TOKEN_VARIABLE: TclCompileVarSubst(interp, tokenPtr, envPtr); count++; break; default: Tcl_Panic("unexpected token type in TclCompileSubstCmd: %d", tokenPtr->type); } ExceptionRangeEnds(envPtr, catchRange); /* Substitution produced TCL_OK */ OP( END_CATCH); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup); /* Exceptional return codes processed here */ ExceptionRangeTarget(envPtr, catchRange, catchOffset); OP( PUSH_RETURN_OPTIONS); OP( PUSH_RESULT); OP( PUSH_RETURN_CODE); OP( END_CATCH); OP( RETURN_CODE_BRANCH); /* ERROR -> reraise it */ OP( RETURN_STK); OP( NOP); /* RETURN */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &returnFixup); /* BREAK */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &breakFixup); /* CONTINUE */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &continueFixup); /* OTHER */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &otherFixup); /* BREAK destination */ if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d", (int) (CurrentOffset(envPtr) - breakFixup.codeOffset)); } OP( POP); OP( POP); breakJump = CurrentOffset(envPtr) - breakOffset; if (breakJump > 127) { OP4(JUMP4, -breakJump); } else { OP1(JUMP1, -breakJump); } /* CONTINUE destination */ if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d", (int) (CurrentOffset(envPtr) - continueFixup.codeOffset)); } OP( POP); OP( POP); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup); /* RETURN + other destination */ if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d", (int) (CurrentOffset(envPtr) - returnFixup.codeOffset)); } if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d", (int) (CurrentOffset(envPtr) - otherFixup.codeOffset)); } /* * Pull the result to top of stack, discard options dict. */ OP4( REVERSE, 2); OP( POP); /* * We've emitted several POP instructions, and the automatic * computations for stack depth requirements have been decrementing * for every one. However, we know that every branch actually taken * only encounters some of those instructions. No branch passes * through them all. So, we now have a stack requirements estimate * that is too low. Here we manually fix that up. */ TclAdjustStackDepth(5, envPtr); /* OK destination */ if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d", (int) (CurrentOffset(envPtr) - okFixup.codeOffset)); } if (count > 1) { OP1(CONCAT1, count); count = 1; } /* CONTINUE jump to here */ if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d", (int) (CurrentOffset(envPtr) - endFixup.codeOffset)); } bline = envPtr->line; } while (count > 255) { OP1( CONCAT1, 255); count -= 254; } if (count > 1) { OP1( CONCAT1, count); } Tcl_FreeParse(&parse); if (state != NULL) { Tcl_RestoreInterpState(interp, state); TclCompileSyntaxError(interp, envPtr); TclAdjustStackDepth(-1, envPtr); } /* Final target of the multi-jump from all BREAKs */ if (breakOffset > 0) { TclUpdateInstInt4AtPc(INST_JUMP4, CurrentOffset(envPtr) - breakOffset, envPtr->codeStart + breakOffset); } |
︙ | ︙ | |||
1273 1274 1275 1276 1277 1278 1279 | memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) { /* * Generate the test for the arm. */ switch (mode) { case Switch_Exact: | | | | | | 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 | memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) { /* * Generate the test for the arm. */ switch (mode) { case Switch_Exact: OP( DUP); TclCompileTokens(interp, bodyToken[i], 1, envPtr); OP( STR_EQ); break; case Switch_Glob: TclCompileTokens(interp, bodyToken[i], 1, envPtr); OP4( OVER, 1); OP1( STR_MATCH, noCase); break; case Switch_Regexp: simple = exact = 0; /* * Keep in sync with TclCompileRegexpCmd. */ |
︙ | ︙ | |||
1319 1320 1321 1322 1323 1324 1325 | Tcl_DStringFree(&ds); } } if (!simple) { TclCompileTokens(interp, bodyToken[i], 1, envPtr); } | | | | | | 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 | Tcl_DStringFree(&ds); } } if (!simple) { TclCompileTokens(interp, bodyToken[i], 1, envPtr); } OP4( OVER, 1); if (!simple) { /* * Pass correct RE compile flags. We use only Int1 * (8-bit), but that handles all the flags we want to * pass. Don't use TCL_REG_NOSUB as we may have backrefs * or capture vars. */ int cflags = TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0); OP1(REGEXP, cflags); } else if (exact && !noCase) { OP( STR_EQ); } else { OP1(STR_MATCH, noCase); } break; default: Tcl_Panic("unknown switch mode: %d", mode); } /* |
︙ | ︙ | |||
1400 1401 1402 1403 1404 1405 1406 | /* * Now do the actual compilation. Note that we do not use CompileBody * because we may have synthesized the tokens in a non-standard * pattern. */ | | | 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 | /* * Now do the actual compilation. Note that we do not use CompileBody * because we may have synthesized the tokens in a non-standard * pattern. */ OP( POP); envPtr->currStackDepth = savedStackDepth + 1; envPtr->line = bodyLines[i+1]; /* TIP #280 */ envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr); if (!foundDefault) { TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, |
︙ | ︙ | |||
1422 1423 1424 1425 1426 1427 1428 | * Discard the value we are matching against unless we've had a default * clause (in which case it will already be gone due to the code at the * start of processing an arm, guaranteed) and make the result of the * command an empty string. */ if (!foundDefault) { | | | 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 | * Discard the value we are matching against unless we've had a default * clause (in which case it will already be gone due to the code at the * start of processing an arm, guaranteed) and make the result of the * command an empty string. */ if (!foundDefault) { OP( POP); PushLiteral(envPtr, "", 0); } /* * Do jump fixups for arms that were executed. First, fill in the jumps of * all jumps that don't point elsewhere to point to here. */ |
︙ | ︙ | |||
1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 | * execute when the match succeeds. */ Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */ int *bodyLines, /* Array of line numbers for body list * items. */ int **bodyContLines) /* Array of continuation line info. */ { JumptableInfo *jtPtr; int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation; int mustGenerate, foundDefault, jumpToDefault, i; Tcl_DString buffer; Tcl_HashEntry *hPtr; /* * First, we push the value we're matching against on the stack. | > | 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 | * execute when the match succeeds. */ Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */ int *bodyLines, /* Array of line numbers for body list * items. */ int **bodyContLines) /* Array of continuation line info. */ { JumptableInfo *jtPtr; int savedStackDepth = envPtr->currStackDepth; int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation; int mustGenerate, foundDefault, jumpToDefault, i; Tcl_DString buffer; Tcl_HashEntry *hPtr; /* * First, we push the value we're matching against on the stack. |
︙ | ︙ | |||
1533 1534 1535 1536 1537 1538 1539 | * the "default" default, which just sets the result to empty). Note that * we will come back and rewrite the jump's offset parameter when we know * what it should be, and that all jumps we issue are of the wide kind * because that makes the code much easier to debug! */ jumpLocation = CurrentOffset(envPtr); | | | | 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 | * the "default" default, which just sets the result to empty). Note that * we will come back and rewrite the jump's offset parameter when we know * what it should be, and that all jumps we issue are of the wide kind * because that makes the code much easier to debug! */ jumpLocation = CurrentOffset(envPtr); OP4( JUMP_TABLE, infoIndex); jumpToDefault = CurrentOffset(envPtr); OP4( JUMP4, 0); for (i=0 ; i<numBodyTokens ; i+=2) { /* * For each arm, we must first work out what to do with the match * term. */ |
︙ | ︙ | |||
1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 | } mustGenerate = 0; /* * Compile the body of the arm. */ envPtr->line = bodyLines[i+1]; /* TIP #280 */ envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr); /* * Compile a jump in to the end of the command if this body is * anything other than a user-supplied default arm (to either skip * over the remaining bodies or the code that generates an empty * result). */ if (i+2 < numBodyTokens || !foundDefault) { finalFixups[numRealBodies++] = CurrentOffset(envPtr); /* * Easier by far to issue this jump as a fixed-width jump, since * otherwise we'd need to do a lot more (and more awkward) * rewriting when we fixed this all up. */ | > | > > | 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 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 | } mustGenerate = 0; /* * Compile the body of the arm. */ envPtr->currStackDepth = savedStackDepth; envPtr->line = bodyLines[i+1]; /* TIP #280 */ envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr); /* * Compile a jump in to the end of the command if this body is * anything other than a user-supplied default arm (to either skip * over the remaining bodies or the code that generates an empty * result). */ if (i+2 < numBodyTokens || !foundDefault) { finalFixups[numRealBodies++] = CurrentOffset(envPtr); /* * Easier by far to issue this jump as a fixed-width jump, since * otherwise we'd need to do a lot more (and more awkward) * rewriting when we fixed this all up. */ OP4( JUMP4, 0); } } /* * We're at the end. If we've not already done so through the processing * of a user-supplied default clause, add in a "default" default clause * now. */ if (!foundDefault) { envPtr->currStackDepth = savedStackDepth; TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault, envPtr->codeStart+jumpToDefault+1); PushLiteral(envPtr, "", 0); } /* * No more instructions to be issued; everything that needs to jump to the * end of the command is fixed up at this point. */ for (i=0 ; i<numRealBodies ; i++) { TclStoreInt4AtPtr(CurrentOffset(envPtr)-finalFixups[i], envPtr->codeStart+finalFixups[i]+1); } /* * Clean up all our temporary space and return. */ TclStackFree(interp, finalFixups); envPtr->currStackDepth = savedStackDepth + 1; } /* *---------------------------------------------------------------------- * * DupJumptableInfo, FreeJumptableInfo -- * |
︙ | ︙ | |||
1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 | keyPtr, pcOffset + offset); } } /* *---------------------------------------------------------------------- * * TclCompileThrowCmd -- * * Procedure called to compile the "throw" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 | keyPtr, pcOffset + offset); } } /* *---------------------------------------------------------------------- * * TclCompileTailcallCmd -- * * Procedure called to compile the "tailcall" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "tailcall" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileTailcallCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; if (parsePtr->numWords < 2 || parsePtr->numWords > 256 || envPtr->procPtr == NULL) { return TCL_ERROR; } for (i=1 ; i<parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); } TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords-1, envPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileThrowCmd -- * * Procedure called to compile the "throw" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. |
︙ | ︙ | |||
1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 | * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ int numWords = parsePtr->numWords; Tcl_Token *codeToken, *msgToken; Tcl_Obj *objPtr; if (numWords != 3) { return TCL_ERROR; } codeToken = TokenAfter(parsePtr->tokenPtr); | > | 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 | * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ int numWords = parsePtr->numWords; int savedStackDepth = envPtr->currStackDepth; Tcl_Token *codeToken, *msgToken; Tcl_Obj *objPtr; if (numWords != 3) { return TCL_ERROR; } codeToken = TokenAfter(parsePtr->tokenPtr); |
︙ | ︙ | |||
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 1826 1827 1828 1829 1830 1831 | * Must still do this; might generate an error when getting this * "ignored" value prepared as an argument. */ CompileWord(envPtr, msgToken, interp, 2); TclCompileSyntaxError(interp, envPtr); Tcl_DecrRefCount(objPtr); return TCL_OK; } if (len == 0) { /* * Must still do this; might generate an error when getting this * "ignored" value prepared as an argument. */ CompileWord(envPtr, msgToken, interp, 2); goto issueErrorForEmptyCode; } TclNewLiteralStringObj(errPtr, "-errorcode"); TclNewObj(dictPtr); Tcl_DictObjPut(NULL, dictPtr, errPtr, objPtr); Tcl_IncrRefCount(dictPtr); string = Tcl_GetStringFromObj(dictPtr, &len); CompileWord(envPtr, msgToken, interp, 2); PushLiteral(envPtr, string, len); TclDecrRefCount(dictPtr); OP44( RETURN_IMM, 1, 0); } else { /* * When the code token is not known at compilation time, we need to do * a little bit more work. The main tricky bit here is that the error * code has to be a list (a [throw] restriction) so we must emit extra * instructions to enforce that condition. */ | > > | 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 | * Must still do this; might generate an error when getting this * "ignored" value prepared as an argument. */ CompileWord(envPtr, msgToken, interp, 2); TclCompileSyntaxError(interp, envPtr); Tcl_DecrRefCount(objPtr); envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } if (len == 0) { /* * Must still do this; might generate an error when getting this * "ignored" value prepared as an argument. */ CompileWord(envPtr, msgToken, interp, 2); goto issueErrorForEmptyCode; } TclNewLiteralStringObj(errPtr, "-errorcode"); TclNewObj(dictPtr); Tcl_DictObjPut(NULL, dictPtr, errPtr, objPtr); Tcl_IncrRefCount(dictPtr); string = Tcl_GetStringFromObj(dictPtr, &len); CompileWord(envPtr, msgToken, interp, 2); PushLiteral(envPtr, string, len); TclDecrRefCount(dictPtr); OP44( RETURN_IMM, 1, 0); envPtr->currStackDepth = savedStackDepth + 1; } else { /* * When the code token is not known at compilation time, we need to do * a little bit more work. The main tricky bit here is that the error * code has to be a list (a [throw] restriction) so we must emit extra * instructions to enforce that condition. */ |
︙ | ︙ | |||
1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 | */ issueErrorForEmptyCode: PUSH( "type must be non-empty list"); PUSH( ""); OP44( RETURN_IMM, 1, 0); } TclDecrRefCount(objPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * | > | 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 | */ issueErrorForEmptyCode: PUSH( "type must be non-empty list"); PUSH( ""); OP44( RETURN_IMM, 1, 0); } envPtr->currStackDepth = savedStackDepth + 1; TclDecrRefCount(objPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 | Tcl_Obj **matchClauses, int *resultVars, int *optionVars, Tcl_Token **handlerTokens) { DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar; int i, j, len, forwardsNeedFixing = 0; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; char buf[TCL_INTEGER_SPACE]; resultVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); optionsVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); if (resultVar < 0 || optionsVar < 0) { | > | 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 | Tcl_Obj **matchClauses, int *resultVars, int *optionVars, Tcl_Token **handlerTokens) { DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar; int savedStackDepth = envPtr->currStackDepth; int i, j, len, forwardsNeedFixing = 0; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; char buf[TCL_INTEGER_SPACE]; resultVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); optionsVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); if (resultVar < 0 || optionsVar < 0) { |
︙ | ︙ | |||
2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 | /* * Match the errorcode according to try/trap rules. */ LOAD( optionsVar); PUSH( "-errorcode"); OP4( DICT_GET, 1); OP44( LIST_RANGE_IMM, 0, len-1); PUSH( TclGetString(matchClauses[i])); OP( STR_EQ); JUMP(notECJumpSource, JUMP_FALSE4); } else { notECJumpSource = -1; /* LINT */ } | > | 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 | /* * Match the errorcode according to try/trap rules. */ LOAD( optionsVar); PUSH( "-errorcode"); OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); PUSH( TclGetString(matchClauses[i])); OP( STR_EQ); JUMP(notECJumpSource, JUMP_FALSE4); } else { notECJumpSource = -1; /* LINT */ } |
︙ | ︙ | |||
2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 | if (forwardsToFix[j] == -1) { continue; } FIXJUMP(forwardsToFix[j]); forwardsToFix[j] = -1; } } BODY( handlerTokens[i], 5+i*4); } JUMP(addrsToFix[i], JUMP4); if (matchClauses[i]) { FIXJUMP(notECJumpSource); } | > | 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 | if (forwardsToFix[j] == -1) { continue; } FIXJUMP(forwardsToFix[j]); forwardsToFix[j] = -1; } } envPtr->currStackDepth = savedStackDepth; BODY( handlerTokens[i], 5+i*4); } JUMP(addrsToFix[i], JUMP4); if (matchClauses[i]) { FIXJUMP(notECJumpSource); } |
︙ | ︙ | |||
2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 | */ for (i=0 ; i<numHandlers ; i++) { FIXJUMP(addrsToFix[i]); } TclStackFree(interp, forwardsToFix); TclStackFree(interp, addrsToFix); return TCL_OK; } static int IssueTryFinallyInstructions( Tcl_Interp *interp, CompileEnv *envPtr, | > | 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 | */ for (i=0 ; i<numHandlers ; i++) { FIXJUMP(addrsToFix[i]); } TclStackFree(interp, forwardsToFix); TclStackFree(interp, addrsToFix); envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } static int IssueTryFinallyInstructions( Tcl_Interp *interp, CompileEnv *envPtr, |
︙ | ︙ | |||
2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 | * Compile the body, trapping any error in it so that we can trap on it * (if any trap matches) and run a finally clause. */ range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); OP4( BEGIN_CATCH4, range); ExceptionRangeStarts(envPtr, range); BODY( bodyToken, 1); ExceptionRangeEnds(envPtr, range); PUSH( "0"); OP4( REVERSE, 2); OP1( JUMP1, 4); ExceptionRangeTarget(envPtr, range, catchOffset); OP( PUSH_RETURN_CODE); | > | 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 | * Compile the body, trapping any error in it so that we can trap on it * (if any trap matches) and run a finally clause. */ range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); OP4( BEGIN_CATCH4, range); ExceptionRangeStarts(envPtr, range); envPtr->currStackDepth = savedStackDepth; BODY( bodyToken, 1); ExceptionRangeEnds(envPtr, range); PUSH( "0"); OP4( REVERSE, 2); OP1( JUMP1, 4); ExceptionRangeTarget(envPtr, range, catchOffset); OP( PUSH_RETURN_CODE); |
︙ | ︙ | |||
2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 | /* * Match the errorcode according to try/trap rules. */ LOAD( optionsVar); PUSH( "-errorcode"); OP4( DICT_GET, 1); OP44( LIST_RANGE_IMM, 0, len-1); PUSH( TclGetString(matchClauses[i])); OP( STR_EQ); JUMP(notECJumpSource, JUMP_FALSE4); } else { notECJumpSource = -1; /* LINT */ } | > | 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 | /* * Match the errorcode according to try/trap rules. */ LOAD( optionsVar); PUSH( "-errorcode"); OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); PUSH( TclGetString(matchClauses[i])); OP( STR_EQ); JUMP(notECJumpSource, JUMP_FALSE4); } else { notECJumpSource = -1; /* LINT */ } |
︙ | ︙ | |||
2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 | continue; } FIXJUMP(forwardsToFix[j]); forwardsToFix[j] = -1; } OP4( BEGIN_CATCH4, range); } BODY( handlerTokens[i], 5+i*4); ExceptionRangeEnds(envPtr, range); OP( PUSH_RETURN_OPTIONS); OP4( REVERSE, 2); OP1( JUMP1, 4); forwardsToFix[i] = -1; | > | 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 | continue; } FIXJUMP(forwardsToFix[j]); forwardsToFix[j] = -1; } OP4( BEGIN_CATCH4, range); } envPtr->currStackDepth = savedStackDepth; BODY( handlerTokens[i], 5+i*4); ExceptionRangeEnds(envPtr, range); OP( PUSH_RETURN_OPTIONS); OP4( REVERSE, 2); OP1( JUMP1, 4); forwardsToFix[i] = -1; |
︙ | ︙ | |||
2448 2449 2450 2451 2452 2453 2454 | } /* * Drop the result code. */ OP( POP); | < > > | 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 | } /* * Drop the result code. */ OP( POP); /* * Process the finally clause (at last!) Note that we do not wrap this in * error handlers because we would just rethrow immediately anyway. Then * (on normal success) we reissue the exception. Note also that * INST_RETURN_STK can proceed to the next instruction; that'll be the * next command (or some inter-command manipulation). */ envPtr->currStackDepth = savedStackDepth; BODY( finallyToken, 3 + 4*numHandlers); OP( POP); LOAD( optionsVar); LOAD( resultVar); OP( RETURN_STK); envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
2543 2544 2545 2546 2547 2548 2549 | &localIndex, &simpleVarName, &isScalar, 1); /* * Emit instructions to unset the variable. */ if (!simpleVarName) { | | | | < | | < | 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 | &localIndex, &simpleVarName, &isScalar, 1); /* * Emit instructions to unset the variable. */ if (!simpleVarName) { OP1( UNSET_STK, flags); } else if (isScalar) { if (localIndex < 0) { OP1( UNSET_STK, flags); } else { OP14( UNSET_SCALAR, flags, localIndex); } } else { if (localIndex < 0) { OP1( UNSET_ARRAY_STK, flags); } else { OP14( UNSET_ARRAY, flags, localIndex); } } varTokenPtr = TokenAfter(varTokenPtr); } PushLiteral(envPtr, "", 0); return TCL_OK; |
︙ | ︙ | |||
2693 2694 2695 2696 2697 2698 2699 | */ SetLineInformation(2); bodyCodeOffset = ExceptionRangeStarts(envPtr, range); CompileBody(envPtr, bodyTokenPtr, interp); ExceptionRangeEnds(envPtr, range); envPtr->currStackDepth = savedStackDepth + 1; | | | 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 | */ SetLineInformation(2); bodyCodeOffset = ExceptionRangeStarts(envPtr, range); CompileBody(envPtr, bodyTokenPtr, interp); ExceptionRangeEnds(envPtr, range); envPtr->currStackDepth = savedStackDepth + 1; OP( POP); /* * Compile the test expression then emit the conditional jump that * terminates the while. We already know it's a simple word. */ if (loopMayEnd) { |
︙ | ︙ | |||
2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 | */ pushResult: envPtr->currStackDepth = savedStackDepth; PushLiteral(envPtr, "", 0); return TCL_OK; } /* *---------------------------------------------------------------------- * * PushVarName -- * * Procedure used in the compiling where pushing a variable name is | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 | */ pushResult: envPtr->currStackDepth = savedStackDepth; PushLiteral(envPtr, "", 0); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclCompileYieldCmd -- * * Procedure called to compile the "yield" command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "yield" command at * runtime. * *---------------------------------------------------------------------- */ int TclCompileYieldCmd( Tcl_Interp *interp, /* Used for error reporting. */ 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. */ { if (parsePtr->numWords < 1 || parsePtr->numWords > 2) { return TCL_ERROR; } if (parsePtr->numWords == 1) { PushLiteral(envPtr, "", 0); } else { DefineLineInformation; /* TIP #280 */ Tcl_Token *valueTokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, valueTokenPtr, interp, 1); } OP( YIELD); return TCL_OK; } /* *---------------------------------------------------------------------- * * PushVarName -- * * Procedure used in the compiling where pushing a variable name is |
︙ | ︙ | |||
3070 3071 3072 3073 3074 3075 3076 | } if (words > 3) { /* * Reverse order of arguments to get precise agreement with [expr] in * calcuations, including roundoff errors. */ | | | 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 | } if (words > 3) { /* * Reverse order of arguments to get precise agreement with [expr] in * calcuations, including roundoff errors. */ OP4( REVERSE, words-1); } while (--words > 1) { TclEmitOpcode(instruction, envPtr); } return TCL_OK; } |
︙ | ︙ | |||
3161 3162 3163 3164 3165 3166 3167 | int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); int words; tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); | | < < < < | < < < < | < < < < | < | < < < < < | 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 | int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); int words; tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); STORE(tmpIndex); TclEmitOpcode(instruction, envPtr); for (words=3 ; words<parsePtr->numWords ;) { LOAD(tmpIndex); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); if (++words < parsePtr->numWords) { STORE(tmpIndex); } TclEmitOpcode(instruction, envPtr); } for (; words>3 ; words--) { OP( BITAND); } /* * Drop the value from the temp variable; retaining that reference * might be expensive elsewhere. */ OP14( UNSET_SCALAR, 0, tmpIndex); } return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclCompile.c.
︙ | ︙ | |||
33 34 35 36 37 38 39 | * This variable is linked to the Tcl variable "tcl_traceCompile". */ #ifdef TCL_COMPILE_DEBUG int tclTraceCompile = 0; static int traceInitialized = 0; #endif | | | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | * This variable is linked to the Tcl variable "tcl_traceCompile". */ #ifdef TCL_COMPILE_DEBUG int tclTraceCompile = 0; static int traceInitialized = 0; #endif /* * A table describing the Tcl bytecode instructions. Entries in this table * must correspond to the instruction opcode definitions in tclCompile.h. The * names "op1" and "op4" refer to an instruction's one or four byte first * operand. Similarly, "stktop" and "stknext" refer to the topmost and next to * topmost stack elements. * |
︙ | ︙ | |||
368 369 370 371 372 373 374 | {"jumpTable", 5, -1, 1, {OPERAND_AUX4}}, /* Jump according to the jump-table (in AuxData as indicated by the * operand) and the argument popped from the list. Always executes the * next instruction if no match against the table's entries was found. * Stack: ... value => ... * Note that the jump table contains offsets relative to the PC when * it points to this instruction; the code is relocatable. */ | | | | | 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 | {"jumpTable", 5, -1, 1, {OPERAND_AUX4}}, /* Jump according to the jump-table (in AuxData as indicated by the * operand) and the argument popped from the list. Always executes the * next instruction if no match against the table's entries was found. * Stack: ... value => ... * Note that the jump table contains offsets relative to the PC when * it points to this instruction; the code is relocatable. */ {"upvar", 5, -1, 1, {OPERAND_LVT4}}, /* finds level and otherName in stack, links to local variable at * index op1. Leaves the level on stack. */ {"nsupvar", 5, -1, 1, {OPERAND_LVT4}}, /* finds namespace and otherName in stack, links to local variable at * index op1. Leaves the namespace on stack. */ {"variable", 5, -1, 1, {OPERAND_LVT4}}, /* finds namespace and otherName in stack, links to local variable at * index op1. Leaves the namespace on stack. */ {"syntax", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}}, /* Compiled bytecodes to signal syntax error. */ {"reverse", 5, 0, 1, {OPERAND_UINT4}}, /* Reverse the order of the arg elements at the top of stack */ |
︙ | ︙ | |||
430 431 432 433 434 435 436 437 438 439 440 441 442 443 | /* Map variable contents back into a dictionary in a variable. Part of * [dict with]. * Stack: ... dictVarName path keyList => ... */ {"dictRecombineImm", 1, -2, 1, {OPERAND_LVT4}}, /* Map variable contents back into a dictionary in the local variable * indicated by the LVT index. Part of [dict with]. * Stack: ... path keyList => ... */ {NULL, 0, 0, 0, {OPERAND_NONE}} }; /* * Prototypes for procedures defined later in this file: */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 | /* Map variable contents back into a dictionary in a variable. Part of * [dict with]. * Stack: ... dictVarName path keyList => ... */ {"dictRecombineImm", 1, -2, 1, {OPERAND_LVT4}}, /* Map variable contents back into a dictionary in the local variable * indicated by the LVT index. Part of [dict with]. * Stack: ... path keyList => ... */ {"dictExists", 5, INT_MIN, 1, {OPERAND_UINT4}}, /* The top op4 words (min 1) are a key path into the dictionary just * below the keys on the stack, and all those values are replaced by a * boolean indicating whether it is possible to read out a value from * that key-path (like [dict exists]). * Stack: ... dict key1 ... keyN => ... boolean */ {"verifyDict", 1, -1, 0, {OPERAND_NONE}}, /* Verifies that the word on the top of the stack is a dictionary, * popping it if it is and throwing an error if it is not. * Stack: ... value => ... */ {"strmap", 1, -2, 0, {OPERAND_NONE}}, /* Simplified version of [string map] that only applies one change * string, and only case-sensitively. * Stack: ... from to string => ... changedString */ {"strfind", 1, -1, 0, {OPERAND_NONE}}, /* Find the first index of a needle string in a haystack string, * producing the index (integer) or -1 if nothing found. * Stack: ... needle haystack => ... index */ {"strrfind", 1, -1, 0, {OPERAND_NONE}}, /* Find the last index of a needle string in a haystack string, * producing the index (integer) or -1 if nothing found. * Stack: ... needle haystack => ... index */ {"strrangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}}, /* String Range: push (string range stktop op4 op4) */ {"strrange", 1, -2, 0, {OPERAND_NONE}}, /* String Range with non-constant arguments. * Stack: ... string idxA idxB => ... substring */ {"yield", 1, 0, 0, {OPERAND_NONE}}, /* Makes the current coroutine yield the value at the top of the * stack, and places the response back on top of the stack when it * resumes. * Stack: ... valueToYield => ... resumeValue */ {"coroName", 1, +1, 0, {OPERAND_NONE}}, /* Push the name of the interpreter's current coroutine as an object * on the stack. */ {"tailcall", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Do a tailcall with the opnd items on the stack as the thing to * tailcall to; opnd must be greater than 0 for the semantics to work * right. */ {"currentNamespace", 1, +1, 0, {OPERAND_NONE}}, /* Push the name of the interpreter's current namespace as an object * on the stack. */ {"infoLevelNumber", 1, +1, 0, {OPERAND_NONE}}, /* Push the stack depth (i.e., [info level]) of the interpreter as an * object on the stack. */ {"infoLevelArgs", 1, 0, 0, {OPERAND_NONE}}, /* Push the argument words to a stack depth (i.e., [info level <n>]) * of the interpreter as an object on the stack. * Stack: ... depth => ... argList */ {"resolveCmd", 1, 0, 0, {OPERAND_NONE}}, /* Resolves the command named on the top of the stack to its fully * qualified version, or produces the empty string if no such command * exists. Never generates errors. * Stack: ... cmdName => ... fullCmdName */ {"tclooSelf", 1, +1, 0, {OPERAND_NONE}}, /* Push the identity of the current TclOO object (i.e., the name of * its current public access command) on the stack. */ {"tclooClass", 1, 0, 0, {OPERAND_NONE}}, /* Push the class of the TclOO object named at the top of the stack * onto the stack. * Stack: ... object => ... class */ {"tclooNamespace", 1, 0, 0, {OPERAND_NONE}}, /* Push the namespace of the TclOO object named at the top of the * stack onto the stack. * Stack: ... object => ... namespace */ {"tclooIsObject", 1, 0, 0, {OPERAND_NONE}}, /* Push whether the value named at the top of the stack is a TclOO * object (i.e., a boolean). Can corrupt the interpreter result * despite not throwing, so not safe for use in a post-exception * context. * Stack: ... value => ... boolean */ {"arrayExistsStk", 1, 0, 0, {OPERAND_NONE}}, /* Looks up the element on the top of the stack and tests whether it * is an array. Pushes a boolean describing whether this is the * case. Also runs the whole-array trace on the named variable, so can * throw anything. * Stack: ... varName => ... boolean */ {"arrayExistsImm", 5, +1, 1, {OPERAND_UINT4}}, /* Looks up the variable indexed by opnd and tests whether it is an * array. Pushes a boolean describing whether this is the case. Also * runs the whole-array trace on the named variable, so can throw * anything. * Stack: ... => ... boolean */ {"arrayMakeStk", 1, -1, 0, {OPERAND_NONE}}, /* Forces the element on the top of the stack to be the name of an * array. * Stack: ... varName => ... */ {"arrayMakeImm", 5, 0, 1, {OPERAND_UINT4}}, /* Forces the variable indexed by opnd to be an array. Does not touch * the stack. */ {NULL, 0, 0, 0, {OPERAND_NONE}} }; /* * Prototypes for procedures defined later in this file: */ |
︙ | ︙ | |||
1669 1670 1671 1672 1673 1674 1675 | (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0); if ((cmdPtr != NULL) && (cmdPtr->compileProc != NULL) && !(cmdPtr->nsPtr->flags&NS_SUPPRESS_COMPILATION) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES) && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) { | | | > > > | 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 | (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0); if ((cmdPtr != NULL) && (cmdPtr->compileProc != NULL) && !(cmdPtr->nsPtr->flags&NS_SUPPRESS_COMPILATION) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES) && !(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; #endif /* * Mark the start of the command; the proper bytecode * length will be updated later. There is no need to * do this for the first bytecode in the compile env, * as the check is done before calling * TclNRExecuteByteCode(). Do emit an INST_START_CMD in |
︙ | ︙ | |||
1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 | update = 1; } code = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr); if (code == TCL_OK) { if (update) { /* * Fix the bytecode length. */ unsigned char *fixPtr = envPtr->codeStart + savedCodeNext + 1; | > > > > > > > > > > > > > > > > > > > | 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 | update = 1; } code = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr); if (code == TCL_OK) { /* * Confirm that the command compiler generated a * single value on the stack as its result. This * is only done in debugging mode, as it *should* * be correct and normal users have no reasonable * way to fix it anyway. */ #ifdef TCL_COMPILE_DEBUG int diff = envPtr->currStackDepth-startStackDepth; if (diff != 1 && (diff != 0 || *(envPtr->codeNext-1) != INST_DONE)) { Tcl_Panic("bad stack adjustment when compiling" " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, diff); } #endif if (update) { /* * Fix the bytecode length. */ unsigned char *fixPtr = envPtr->codeStart + savedCodeNext + 1; |
︙ | ︙ | |||
4616 4617 4618 4619 4620 4621 4622 | /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 | < | 4732 4733 4734 4735 4736 4737 4738 4739 4740 | /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * End: */ |
Changes to generic/tclCompile.h.
︙ | ︙ | |||
672 673 674 675 676 677 678 | /* For [unset] compilation */ #define INST_UNSET_SCALAR 134 #define INST_UNSET_ARRAY 135 #define INST_UNSET_ARRAY_STK 136 #define INST_UNSET_STK 137 | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 | /* For [unset] compilation */ #define INST_UNSET_SCALAR 134 #define INST_UNSET_ARRAY 135 #define INST_UNSET_ARRAY_STK 136 #define INST_UNSET_STK 137 /* For [dict with], [dict exists], [dict create] and [dict merge] */ #define INST_DICT_EXPAND 138 #define INST_DICT_RECOMBINE_STK 139 #define INST_DICT_RECOMBINE_IMM 140 #define INST_DICT_EXISTS 141 #define INST_DICT_VERIFY 142 /* For [string map] and [regsub] compilation */ #define INST_STR_MAP 143 #define INST_STR_FIND 144 #define INST_STR_FIND_LAST 145 #define INST_STR_RANGE_IMM 146 #define INST_STR_RANGE 147 /* For operations to do with coroutines and other NRE-manipulators */ #define INST_YIELD 148 #define INST_COROUTINE_NAME 149 #define INST_TAILCALL 150 /* For compilation of basic information operations */ #define INST_NS_CURRENT 151 #define INST_INFO_LEVEL_NUM 152 #define INST_INFO_LEVEL_ARGS 153 #define INST_RESOLVE_COMMAND 154 #define INST_TCLOO_SELF 155 #define INST_TCLOO_CLASS 156 #define INST_TCLOO_NS 157 #define INST_TCLOO_IS_OBJECT 158 /* For compilation of [array] subcommands */ #define INST_ARRAY_EXISTS_STK 159 #define INST_ARRAY_EXISTS_IMM 160 #define INST_ARRAY_MAKE_STK 161 #define INST_ARRAY_MAKE_IMM 162 /* The last opcode */ #define LAST_INST_OPCODE 162 /* * 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/tclDictObj.c.
︙ | ︙ | |||
85 86 87 88 89 90 91 | /* * Table of dict subcommand names and implementations. */ static const EnsembleImplMap implementationMap[] = { {"append", DictAppendCmd, TclCompileDictAppendCmd, NULL, NULL, 0 }, | | | | | 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | /* * Table of dict subcommand names and implementations. */ static const EnsembleImplMap implementationMap[] = { {"append", DictAppendCmd, TclCompileDictAppendCmd, NULL, NULL, 0 }, {"create", DictCreateCmd, TclCompileDictCreateCmd, NULL, NULL, 0 }, {"exists", DictExistsCmd, TclCompileDictExistsCmd, NULL, NULL, 0 }, {"filter", DictFilterCmd, NULL, NULL, NULL, 0 }, {"for", NULL, TclCompileDictForCmd, DictForNRCmd, NULL, 0 }, {"get", DictGetCmd, TclCompileDictGetCmd, NULL, NULL, 0 }, {"incr", DictIncrCmd, TclCompileDictIncrCmd, NULL, NULL, 0 }, {"info", DictInfoCmd, NULL, NULL, NULL, 0 }, {"keys", DictKeysCmd, NULL, NULL, NULL, 0 }, {"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL, 0 }, {"map", NULL, TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 }, {"merge", DictMergeCmd, TclCompileDictMergeCmd, NULL, NULL, 0 }, {"remove", DictRemoveCmd, NULL, NULL, NULL, 0 }, {"replace", DictReplaceCmd, NULL, NULL, NULL, 0 }, {"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 }, {"size", DictSizeCmd, NULL, NULL, NULL, 0 }, {"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 }, {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 }, {"values", DictValuesCmd, NULL, NULL, NULL, 0 }, |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 | * * 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 "tclCompile.h" #include "tommath.h" #include <math.h> #if NRE_ENABLE_ASSERTS #include <assert.h> #endif | > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | * * 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 "tclCompile.h" #include "tclOOInt.h" #include "tommath.h" #include <math.h> #if NRE_ENABLE_ASSERTS #include <assert.h> #endif |
︙ | ︙ | |||
2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 | TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")", O2S(objResultPtr))); NEXT_INST_F(1, 0, 0); } Tcl_SetObjResult(interp, objResultPtr); cleanup = 1; goto processExceptionReturn; case INST_DONE: if (tosPtr > initTosPtr) { /* * Set the interpreter's object result to point to the topmost * object from the stack, and check for a possible [catch]. The * stackTop's level and refCount will be handled by "processCatch" | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 | TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")", O2S(objResultPtr))); NEXT_INST_F(1, 0, 0); } Tcl_SetObjResult(interp, objResultPtr); cleanup = 1; goto processExceptionReturn; case INST_YIELD: { CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; TRACE(("%.30s => ", O2S(OBJ_AT_TOS))); if (!corPtr) { TRACE_APPEND(("ERROR: yield outside coroutine\n")); Tcl_SetObjResult(interp, Tcl_NewStringObj( "yield can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); goto gotError; } #ifdef TCL_COMPILE_DEBUG TRACE_WITH_OBJ(("yield, result="), iPtr->objResultPtr); if (traceInstructions) { fprintf(stdout, "\n"); } #endif /* TIP #280: Record the last piece of info needed by * 'TclGetSrcInfoForPc', and push the frame. */ bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, codePtr, bcFramePtr, pc - codePtr->codeStart); } pc++; cleanup = 1; TEBC_YIELD(); Tcl_SetObjResult(interp, OBJ_AT_TOS); TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, INT2PTR(0), NULL, NULL); return TCL_OK; } case INST_TAILCALL: { Tcl_Obj *listPtr, *nsObjPtr; NRE_callback *tailcallPtr; opnd = TclGetUInt1AtPtr(pc+1); if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd)); Tcl_SetObjResult(interp, Tcl_NewStringObj( "tailcall can only be called from a proc or lambda", -1)); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL); goto gotError; } #ifdef TCL_COMPILE_DEBUG { register int i; TRACE(("%d [", opnd)); for (i=opnd-1 ; i>=0 ; i++) { TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i)))); if (i > 0) { TRACE_APPEND((" ")); } } TRACE_APPEND(("] => RETURN...")); } #endif /* * Push the evaluation of the called command into the NR callback * stack. */ listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1)); nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1); Tcl_IncrRefCount(listPtr); Tcl_IncrRefCount(nsObjPtr); TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr, NULL, NULL); /* * Unstitch ourselves and do a [return]. */ tailcallPtr = TOP_CB(interp); TOP_CB(interp) = tailcallPtr->nextPtr; iPtr->varFramePtr->tailcallPtr = tailcallPtr; result = TCL_RETURN; cleanup = opnd; goto processExceptionReturn; } case INST_DONE: if (tosPtr > initTosPtr) { /* * Set the interpreter's object result to point to the topmost * object from the stack, and check for a possible [catch]. The * stackTop's level and refCount will be handled by "processCatch" |
︙ | ︙ | |||
3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 | CACHE_STACK_INFO(); } NEXT_INST_F(5, 0, 0); } /* * End of INST_UNSET instructions. * ----------------------------------------------------------------- * Start of variable linking instructions. */ { Var *otherPtr; CallFrame *framePtr, *savedFramePtr; | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 | CACHE_STACK_INFO(); } NEXT_INST_F(5, 0, 0); } /* * End of INST_UNSET instructions. * ----------------------------------------------------------------- * Start of INST_ARRAY instructions. */ case INST_ARRAY_EXISTS_IMM: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; cleanup = 0; part1Ptr = NULL; arrayPtr = NULL; TRACE(("%u => ", opnd)); varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } goto doArrayExists; case INST_ARRAY_EXISTS_STK: opnd = -1; pcAdjustment = 1; cleanup = 1; part1Ptr = OBJ_AT_TOS; TRACE(("\"%.30s\" => ", O2S(part1Ptr))); varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL, /*createPart1*/0, /*createPart2*/0, &arrayPtr); doArrayExists: if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY) && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) { DECACHE_STACK_INFO(); result = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY| TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd); CACHE_STACK_INFO(); if (result == TCL_ERROR) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); goto gotError; } } if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { objResultPtr = TCONST(1); } else { objResultPtr = TCONST(0); } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); case INST_ARRAY_MAKE_IMM: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; cleanup = 0; part1Ptr = NULL; arrayPtr = NULL; TRACE(("%u => ", opnd)); varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } goto doArrayMake; case INST_ARRAY_MAKE_STK: opnd = -1; pcAdjustment = 1; cleanup = 1; part1Ptr = OBJ_AT_TOS; TRACE(("\"%.30s\" => ", O2S(part1Ptr))); varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/1, /*createPart2*/0, &arrayPtr); if (varPtr == NULL) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); goto gotError; } doArrayMake: if (varPtr && !TclIsVarArray(varPtr)) { if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) { /* * Either an array element, or a scalar: lose! */ TclObjVarErrMsg(interp, part1Ptr, NULL, "array set", "variable isn't array", opnd); Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL); TRACE_APPEND(("ERROR: bad array ref: %.30s\n", O2S(Tcl_GetObjResult(interp)))); goto gotError; } TclSetVarArray(varPtr); varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable)); TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr)); #ifdef TCL_COMPILE_DEBUG TRACE_APPEND(("done\n")); } else { TRACE_APPEND(("nothing to do\n")); #endif } NEXT_INST_V(pcAdjustment, cleanup, 0); /* * End of INST_ARRAY instructions. * ----------------------------------------------------------------- * Start of variable linking instructions. */ { Var *otherPtr; CallFrame *framePtr, *savedFramePtr; |
︙ | ︙ | |||
4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 | } else { iResult = (i1 && i2); } objResultPtr = TCONST(iResult); TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult)); NEXT_INST_F(1, 2, 1); } /* * ----------------------------------------------------------------- * Start of INST_LIST and related instructions. */ { | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 | } else { iResult = (i1 && i2); } objResultPtr = TCONST(iResult); TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult)); NEXT_INST_F(1, 2, 1); } /* * ----------------------------------------------------------------- * Start of general introspector instructions. */ case INST_NS_CURRENT: { Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { TclNewLiteralStringObj(objResultPtr, "::"); } else { TclNewStringObj(objResultPtr, currNsPtr->fullName, strlen(currNsPtr->fullName)); } TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); } case INST_COROUTINE_NAME: { CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; TclNewObj(objResultPtr); if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) { Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr, objResultPtr); } TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); } case INST_INFO_LEVEL_NUM: TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_INFO_LEVEL_ARGS: { int level; register CallFrame *framePtr = iPtr->varFramePtr; register CallFrame *rootFramePtr = iPtr->rootFramePtr; valuePtr = OBJ_AT_TOS; if (TclGetIntFromObj(interp, valuePtr, &level) != TCL_OK) { TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)), Tcl_GetObjResult(interp)); goto gotError; } TRACE(("%d => ", level)); if (level <= 0) { level += framePtr->level; } for (; (framePtr->level!=level) && (framePtr!=rootFramePtr) ; framePtr = framePtr->callerVarPtr) { /* Empty loop body */ } if (framePtr == rootFramePtr) { Tcl_AppendResult(interp, "bad level \"", TclGetString(valuePtr), "\"", NULL); TRACE_APPEND(("ERROR: bad level\n")); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL", TclGetString(valuePtr), NULL); goto gotError; } objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv); TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } case INST_RESOLVE_COMMAND: { Tcl_Command cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS); TclNewObj(objResultPtr); if (cmd != NULL) { Tcl_GetCommandFullName(interp, cmd, objResultPtr); } TRACE_WITH_OBJ(("\"%.20s\" => ", O2S(OBJ_AT_TOS)), objResultPtr); NEXT_INST_F(1, 1, 1); } case INST_TCLOO_SELF: { CallFrame *framePtr = iPtr->varFramePtr; CallContext *contextPtr; if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { TRACE(("=> ERROR: no TclOO call context\n")); Tcl_SetObjResult(interp, Tcl_NewStringObj( "self may only be called from inside a method", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); goto gotError; } contextPtr = framePtr->clientData; /* * Call out to get the name; it's expensive to compute but cached. */ objResultPtr = TclOOObjectName(interp, contextPtr->oPtr); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); } { Object *oPtr; case INST_TCLOO_IS_OBJECT: oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS); objResultPtr = TCONST(oPtr != NULL ? 1 : 0); TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr); NEXT_INST_F(1, 1, 1); case INST_TCLOO_CLASS: oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS); if (oPtr == NULL) { TRACE(("%.30s => ERROR: not object\n", O2S(OBJ_AT_TOS))); goto gotError; } objResultPtr = TclOOObjectName(interp, oPtr->selfCls->thisPtr); TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr); NEXT_INST_F(1, 1, 1); case INST_TCLOO_NS: oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS); if (oPtr == NULL) { TRACE(("%.30s => ERROR: not object\n", O2S(OBJ_AT_TOS))); goto gotError; } /* * TclOO objects *never* have the global namespace as their NS. */ TclNewStringObj(objResultPtr, oPtr->namespacePtr->fullName, strlen(oPtr->namespacePtr->fullName)); TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr); NEXT_INST_F(1, 1, 1); } /* * ----------------------------------------------------------------- * Start of INST_LIST and related instructions. */ { |
︙ | ︙ | |||
4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 | length = Tcl_UniCharToUtf(ch, buf); objResultPtr = Tcl_NewStringObj(buf, length); } TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); case INST_STR_MATCH: nocase = TclGetInt1AtPtr(pc+1); valuePtr = OBJ_AT_TOS; /* String */ value2Ptr = OBJ_UNDER_TOS; /* Pattern */ /* | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 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 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 | length = Tcl_UniCharToUtf(ch, buf); objResultPtr = Tcl_NewStringObj(buf, length); } TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); case INST_STR_RANGE: TRACE(("\"%.20s\" %s %s =>", O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1; if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length, &fromIdx) != TCL_OK || TclGetIntForIndexM(interp, OBJ_AT_TOS, length, &toIdx) != TCL_OK) { goto gotError; } if (fromIdx < 0) { fromIdx = 0; } if (toIdx >= length) { toIdx = length; } if (toIdx >= fromIdx) { objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx); } else { TclNewObj(objResultPtr); } TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(1, 3, 1); case INST_STR_RANGE_IMM: valuePtr = OBJ_AT_TOS; fromIdx = TclGetInt4AtPtr(pc+1); toIdx = TclGetInt4AtPtr(pc+5); length = Tcl_GetCharLength(valuePtr); TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx)); /* * Adjust indices for end-based indexing. */ if (fromIdx < -1) { fromIdx += 1 + length; if (fromIdx < 0) { fromIdx = 0; } } else if (fromIdx >= length) { fromIdx = length; } if (toIdx < -1) { toIdx += 1 + length; if (toIdx < 0) { toIdx = 0; } } else if (toIdx >= length) { toIdx = length - 1; } /* * Check if we can do a sane substring. */ if (fromIdx <= toIdx) { objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx); } else { TclNewObj(objResultPtr); } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(9, 1, 1); { Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p; int length3; Tcl_Obj *value3Ptr; case INST_STR_MAP: valuePtr = OBJ_AT_TOS; /* "Main" string. */ value3Ptr = OBJ_UNDER_TOS; /* "Target" string. */ value2Ptr = OBJ_AT_DEPTH(2); /* "Source" string. */ if (value3Ptr == value2Ptr) { objResultPtr = valuePtr; NEXT_INST_V(1, 3, 1); } else if (valuePtr == value2Ptr) { objResultPtr = value3Ptr; NEXT_INST_V(1, 3, 1); } ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); if (length == 0) { objResultPtr = valuePtr; NEXT_INST_V(1, 3, 1); } ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); if (length2 > length || length2 == 0) { objResultPtr = valuePtr; NEXT_INST_V(1, 3, 1); } else if (length2 == length) { if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) { objResultPtr = valuePtr; } else { objResultPtr = value3Ptr; } NEXT_INST_V(1, 3, 1); } ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3); objResultPtr = Tcl_NewUnicodeObj(ustring1, 0); p = ustring1; end = ustring1 + length; for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3); } } if (p != ustring1) { /* * Put the rest of the unmapped chars onto result. */ Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p); } TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr); NEXT_INST_V(1, 3, 1); case INST_STR_FIND: ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */ ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */ match = -1; if (length2 > 0 && length2 <= length) { end = ustring1 + length - length2 + 1; for (p=ustring1 ; p<end ; p++) { if ((*p == *ustring2) && memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) { match = p - ustring1; break; } } } TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); TclNewIntObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */ ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */ match = -1; if (length2 > 0 && length2 <= length) { for (p=ustring1+length-length2 ; p>=ustring1 ; p--) { if ((*p == *ustring2) && memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) { match = p - ustring1; break; } } } TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); TclNewIntObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); } case INST_STR_MATCH: nocase = TclGetInt1AtPtr(pc+1); valuePtr = OBJ_AT_TOS; /* String */ value2Ptr = OBJ_UNDER_TOS; /* Pattern */ /* |
︙ | ︙ | |||
5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 | { int opnd2, allocateDict, done, i, allocdict; Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr; Tcl_Obj *emptyPtr, **keyPtrPtr; Tcl_DictSearch *searchPtr; DictUpdateInfo *duiPtr; case INST_DICT_GET: opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); dictPtr = OBJ_AT_DEPTH(opnd); if (opnd > 1) { | > > > > > > > > > > > > > > > > > | > > > | | | > > > > > > > > > > > > | 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 6178 6179 6180 6181 6182 6183 6184 6185 6186 6187 6188 6189 6190 6191 6192 6193 6194 6195 6196 6197 6198 6199 6200 6201 6202 6203 6204 6205 6206 6207 6208 6209 6210 6211 6212 6213 6214 6215 6216 6217 6218 6219 6220 6221 | { int opnd2, allocateDict, done, i, allocdict; Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr; Tcl_Obj *emptyPtr, **keyPtrPtr; Tcl_DictSearch *searchPtr; DictUpdateInfo *duiPtr; case INST_DICT_VERIFY: dictPtr = OBJ_AT_TOS; TRACE(("=> ")); if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) { TRACE_APPEND(("ERROR verifying dictionary nature of \"%s\": %s\n", O2S(OBJ_AT_DEPTH(opnd)), O2S(Tcl_GetObjResult(interp)))); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 1, 0); case INST_DICT_GET: case INST_DICT_EXISTS: { register Tcl_Interp *interp2 = interp; opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); dictPtr = OBJ_AT_DEPTH(opnd); if (*pc == INST_DICT_EXISTS) { interp2 = NULL; } if (opnd > 1) { dictPtr = TclTraceDictPath(interp2, dictPtr, opnd-1, &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ); if (dictPtr == NULL) { if (*pc == INST_DICT_EXISTS) { goto dictNotExists; } TRACE_WITH_OBJ(( "ERROR tracing dictionary path into \"%s\": ", O2S(OBJ_AT_DEPTH(opnd))), Tcl_GetObjResult(interp)); goto gotError; } } if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS, &objResultPtr) == TCL_OK) { if (*pc == INST_DICT_EXISTS) { objResultPtr = TCONST(objResultPtr ? 1 : 0); TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(5, opnd+1, 1); } if (objResultPtr) { TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(5, opnd+1, 1); } DECACHE_STACK_INFO(); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "key \"%s\" not known in dictionary", TclGetString(OBJ_AT_TOS))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", TclGetString(OBJ_AT_TOS), NULL); CACHE_STACK_INFO(); TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp)); } else { if (*pc == INST_DICT_EXISTS) { dictNotExists: objResultPtr = TCONST(0); TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(5, opnd+1, 1); } TRACE_WITH_OBJ(( "%u => ERROR reading leaf dictionary key \"%s\": ", opnd, O2S(dictPtr)), Tcl_GetObjResult(interp)); } goto gotError; } case INST_DICT_SET: case INST_DICT_UNSET: case INST_DICT_INCR_IMM: opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 | MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd; MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback; MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; MODULE_SCOPE void TclSpliceTailcall(Tcl_Interp *interp, struct NRE_callback *tailcallPtr); | > > | 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 | MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd; MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback; MODULE_SCOPE Tcl_NRPostProc TclNRCoroutineActivateCallback; MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd; MODULE_SCOPE Tcl_NRPostProc TclNRTailcallEval; MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; MODULE_SCOPE void TclSpliceTailcall(Tcl_Interp *interp, struct NRE_callback *tailcallPtr); |
︙ | ︙ | |||
3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 | *---------------------------------------------------------------- * Compilation procedures for commands in the generic core: *---------------------------------------------------------------- */ MODULE_SCOPE int TclCompileAppendCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileBreakCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileContinueCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileDictAppendCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); | > > > > > > > > > | > > > | > > > > > > | 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 | *---------------------------------------------------------------- * Compilation procedures for commands in the generic core: *---------------------------------------------------------------- */ MODULE_SCOPE int TclCompileAppendCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileArrayExistsCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileArraySetCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileArrayUnsetCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileBreakCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileContinueCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileDictAppendCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileDictCreateCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileDictExistsCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileDictForCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileDictGetCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileDictIncrCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileDictLappendCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileDictMapCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileDictMergeCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); 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); |
︙ | ︙ | |||
3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 | Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileForCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileForeachCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileGlobalCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileIfCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileInfoExistsCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileIncrCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLappendCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); | > > > > > > > > > > > > > > > > > > > > > | 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 | Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileForCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileForeachCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileFormatCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileGlobalCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileIfCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileInfoCommandsCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileInfoCoroutineCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileInfoExistsCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileInfoLevelCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileInfoObjectClassCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileInfoObjectIsACmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileInfoObjectNamespaceCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileIncrCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLappendCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); |
︙ | ︙ | |||
3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 | Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLreplaceCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLsetCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNamespaceUpvarCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileRegexpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileReturnCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileSetCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringCmpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringEqualCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringIndexCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringLenCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringMatchCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileSubstCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileSwitchCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileThrowCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileTryCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileUnsetCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileUpvarCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileVariableCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclInvertOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileInvertOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 | Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLreplaceCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLsetCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNamespaceCodeCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNamespaceCurrentCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNamespaceQualifiersCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNamespaceTailCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNamespaceUpvarCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNamespaceWhichCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileObjectSelfCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileRegexpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileRegsubCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileReturnCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileSetCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringCmpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringEqualCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringFirstCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringIndexCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringLastCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringLenCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringMapCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringMatchCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringRangeCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileSubstCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileSwitchCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileTailcallCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileThrowCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileTryCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileUnsetCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileUpvarCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileVariableCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileYieldCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclInvertOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileInvertOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, |
︙ | ︙ |
Changes to generic/tclNamesp.c.
︙ | ︙ | |||
100 101 102 103 104 105 106 | static int NamespaceCurrentCmd(ClientData dummy, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int NamespaceDeleteCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NamespaceEvalCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NRNamespaceEvalCmd(ClientData dummy, | | | 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 | static int NamespaceCurrentCmd(ClientData dummy, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int NamespaceDeleteCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NamespaceEvalCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NRNamespaceEvalCmd(ClientData dummy, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int NamespaceExistsCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NamespaceExportCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NamespaceForgetCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void NamespaceFree(Namespace *nsPtr); |
︙ | ︙ | |||
156 157 158 159 160 161 162 | /* * Array of values describing how to implement each standard subcommand of the * "namespace" command. */ static const EnsembleImplMap defaultNamespaceMap[] = { | | | | | | | | | | | | | | | | | | | | | 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 | /* * Array of values describing how to implement each standard subcommand of the * "namespace" command. */ static const EnsembleImplMap defaultNamespaceMap[] = { {"children", NamespaceChildrenCmd, NULL, NULL, NULL, 0}, {"code", NamespaceCodeCmd, TclCompileNamespaceCodeCmd, NULL, NULL, 0}, {"current", NamespaceCurrentCmd, TclCompileNamespaceCurrentCmd, NULL, NULL, 0}, {"delete", NamespaceDeleteCmd, NULL, NULL, NULL, 0}, {"ensemble", TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0}, {"eval", NamespaceEvalCmd, NULL, NRNamespaceEvalCmd, NULL, 0}, {"exists", NamespaceExistsCmd, NULL, NULL, NULL, 0}, {"export", NamespaceExportCmd, NULL, NULL, NULL, 0}, {"forget", NamespaceForgetCmd, NULL, NULL, NULL, 0}, {"import", NamespaceImportCmd, NULL, NULL, NULL, 0}, {"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0}, {"origin", NamespaceOriginCmd, NULL, NULL, NULL, 0}, {"parent", NamespaceParentCmd, NULL, NULL, NULL, 0}, {"path", NamespacePathCmd, NULL, NULL, NULL, 0}, {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0}, {"tail", NamespaceTailCmd, TclCompileNamespaceTailCmd, NULL, NULL, 0}, {"unknown", NamespaceUnknownCmd, NULL, NULL, NULL, 0}, {"upvar", NamespaceUpvarCmd, TclCompileNamespaceUpvarCmd, NULL, NULL, 0}, {"which", NamespaceWhichCmd, TclCompileNamespaceWhichCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; /* *---------------------------------------------------------------------- * * TclInitNamespaceSubsystem -- |
︙ | ︙ | |||
419 420 421 422 423 424 425 | if ((nsPtr->flags & NS_DYING) && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) { Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr); } framePtr->nsPtr = NULL; if (framePtr->tailcallPtr) { | | | 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 | if ((nsPtr->flags & NS_DYING) && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) { Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr); } framePtr->nsPtr = NULL; if (framePtr->tailcallPtr) { TclSpliceTailcall(interp, framePtr->tailcallPtr); } } /* *---------------------------------------------------------------------- * * TclPushStackFrame -- |
︙ | ︙ | |||
685 686 687 688 689 690 691 | */ parentPtr = NULL; simpleName = ""; } else if (*name == '\0') { Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace" " \"\": only global namespace can have empty name", -1)); | | | | 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 | */ parentPtr = NULL; simpleName = ""; } else if (*name == '\0') { Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace" " \"\": only global namespace can have empty name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", "CREATEGLOBAL", NULL); return NULL; } else { /* * Find the parent for the new namespace. */ TclGetNamespaceForQualName(interp, name, NULL, |
︙ | ︙ | |||
722 723 724 725 726 727 728 | #else parentPtr->childTablePtr != NULL && Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL #endif ) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create namespace \"%s\": already exists", name)); | | | | 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 | #else parentPtr->childTablePtr != NULL && Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL #endif ) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create namespace \"%s\": already exists", name)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", "CREATEEXISTING", NULL); return NULL; } } /* * Create the new namespace and root it in its parent. Increment the count * of namespaces created. |
︙ | ︙ | |||
1333 1334 1335 1336 1337 1338 1339 | TclGetNamespaceForQualName(interp, pattern, nsPtr, /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY), &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid export pattern" " \"%s\": pattern can't specify a namespace", pattern)); | | | 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 | TclGetNamespaceForQualName(interp, pattern, nsPtr, /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY), &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid export pattern" " \"%s\": pattern can't specify a namespace", pattern)); Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", NULL); return TCL_ERROR; } /* * Make sure that we don't already have the pattern in the array */ |
︙ | ︙ | |||
1538 1539 1540 1541 1542 1543 1544 | /* * From the pattern, find the namespace from which we are importing and * get the simple pattern (no namespace qualifiers or ::'s) at the end. */ if (strlen(pattern) == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1)); | | | | | 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 | /* * From the pattern, find the namespace from which we are importing and * get the simple pattern (no namespace qualifiers or ::'s) at the end. */ if (strlen(pattern) == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1)); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", NULL); return TCL_ERROR; } TclGetNamespaceForQualName(interp, pattern, nsPtr, /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY), &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if (importNsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown namespace in import pattern \"%s\"", pattern)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL); return TCL_ERROR; } if (importNsPtr == nsPtr) { if (pattern == simplePattern) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no namespace specified in import pattern \"%s\"", pattern)); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "ORIGIN", NULL); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "import pattern \"%s\" tries to import from namespace" " \"%s\" into itself", pattern, importNsPtr->name)); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "SELF", NULL); } return TCL_ERROR; } /* * Scan through the command table in the source namespace and look for * exported commands that match the string pattern. Create an "imported |
︙ | ︙ | |||
1684 1685 1686 1687 1688 1689 1690 | linkCmd = dataPtr->realCmdPtr; if (overwrite == linkCmd) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "import pattern \"%s\" would create a loop" " containing command \"%s\"", pattern, Tcl_DStringValue(&ds))); Tcl_DStringFree(&ds); | | | 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 | linkCmd = dataPtr->realCmdPtr; if (overwrite == linkCmd) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "import pattern \"%s\" would create a loop" " containing command \"%s\"", pattern, Tcl_DStringValue(&ds))); Tcl_DStringFree(&ds); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", NULL); return TCL_ERROR; } } } dataPtr = ckalloc(sizeof(ImportedCmdData)); importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), |
︙ | ︙ | |||
1724 1725 1726 1727 1728 1729 1730 | */ return TCL_OK; } } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't import command \"%s\": already exists", cmdName)); | | | 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 | */ return TCL_OK; } } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't import command \"%s\": already exists", cmdName)); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "OVERWRITE", NULL); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
3281 3282 3283 3284 3285 3286 3287 | result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, namespacePtr, /*isProcCallFrame*/ 0); if (result != TCL_OK) { return TCL_ERROR; } if (iPtr->ensembleRewrite.sourceObjs == NULL) { | | | | | | | 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 | result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, namespacePtr, /*isProcCallFrame*/ 0); if (result != TCL_OK) { return TCL_ERROR; } if (iPtr->ensembleRewrite.sourceObjs == NULL) { framePtr->objc = objc; framePtr->objv = objv; } else { framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs - iPtr->ensembleRewrite.numInsertedObjs; framePtr->objv = iPtr->ensembleRewrite.sourceObjs; } if (objc == 3) { /* * TIP #280: Make actual argument location available to eval'd script. */ |
︙ | ︙ | |||
3744 3745 3746 3747 3748 3749 3750 | result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, namespacePtr, /*isProcCallFrame*/ 0); if (result != TCL_OK) { return result; } if (iPtr->ensembleRewrite.sourceObjs == NULL) { | | | | | | | 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 | result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, namespacePtr, /*isProcCallFrame*/ 0); if (result != TCL_OK) { return result; } if (iPtr->ensembleRewrite.sourceObjs == NULL) { framePtr->objc = objc; framePtr->objv = objv; } else { framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs - iPtr->ensembleRewrite.numInsertedObjs; framePtr->objv = iPtr->ensembleRewrite.sourceObjs; } /* * Execute the command. If there is just one argument, just treat it as a * script and evaluate it. Otherwise, create a list from the arguments * after the first one, then concatenate the first argument and the list * of extra arguments to form the command to evaluate. |
︙ | ︙ | |||
3954 3955 3956 3957 3958 3959 3960 | } /* * If no path is given, return the current path. */ if (objc == 1) { | | | | | | 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 | } /* * If no path is given, return the current path. */ if (objc == 1) { Tcl_Obj *resultObj = Tcl_NewObj(); for (i=0 ; i<nsPtr->commandPathLength ; i++) { if (nsPtr->commandPathArray[i].nsPtr != NULL) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( nsPtr->commandPathArray[i].nsPtr->fullName, -1)); } } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* * There is a path given, so parse it into an array of namespace pointers. */ |
︙ | ︙ | |||
4839 4840 4841 4842 4843 4844 4845 | const char *script, /* First character in script containing * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ int length, /* Number of bytes in command (-1 means use * all bytes up to first null byte). */ const unsigned char *pc, /* Current pc of bytecode execution context */ | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 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 | const char *script, /* First character in script containing * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ int length, /* Number of bytes in command (-1 means use * all bytes up to first null byte). */ const unsigned char *pc, /* Current pc of bytecode execution context */ Tcl_Obj **tosPtr) /* Current stack of bytecode execution * context */ { register const char *p; Interp *iPtr = (Interp *) interp; int overflow, limit = 150; Var *varPtr, *arrayPtr; if (iPtr->flags & ERR_ALREADY_LOGGED) { /* * Someone else has already logged error information for this command; * we shouldn't add anything more. */ return; } if (command != NULL) { /* * Compute the line number where the error occurred. */ iPtr->errorLine = 1; for (p = script; p != command; p++) { if (*p == '\n') { iPtr->errorLine++; } } if (length < 0) { length = strlen(command); } overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL) ? "while executing" : "invoked from within"), (overflow ? limit : length), command, (overflow ? "..." : ""))); varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY, NULL, 0, 0, &arrayPtr); if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) { /* * Should not happen. */ return; } else { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); VarTrace *tracePtr = Tcl_GetHashValue(hPtr); if (tracePtr->traceProc != EstablishErrorInfoTraces) { /* * The most recent trace set on ::errorInfo is not the one the * core itself puts on last. This means some other code is * tracing the variable, and the additional trace(s) might be * write traces that expect the timing of writes to * ::errorInfo that existed Tcl releases before 8.5. To * satisfy that compatibility need, we write the current * -errorinfo value to the ::errorInfo variable. */ Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo, TCL_GLOBAL_ONLY); } } } /* * TIP #348 */ if (Tcl_IsShared(iPtr->errorStack)) { Tcl_Obj *newObj; newObj = Tcl_DuplicateObj(iPtr->errorStack); Tcl_DecrRefCount(iPtr->errorStack); Tcl_IncrRefCount(newObj); iPtr->errorStack = newObj; } if (iPtr->resetErrorStack) { int len; iPtr->resetErrorStack = 0; Tcl_ListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list intrep as much as possible. */ Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL); if (pc != NULL) { Tcl_Obj *innerContext; innerContext = TclGetInnerContext(interp, pc, tosPtr); if (innerContext != NULL) { Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, innerContext); } } else if (command != NULL) { Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewStringObj(command, length)); } } if (!iPtr->framePtr->objc) { /* * Special frame, nothing to report. */ } else if (iPtr->varFramePtr != iPtr->framePtr) { /* * uplevel case, [lappend errorstack UP $relativelevel] */ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj( iPtr->framePtr->level - iPtr->varFramePtr->level)); } else if (iPtr->framePtr != iPtr->rootFramePtr) { /* * normal case, [lappend errorstack CALL [info level 0]] */ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewListObj( iPtr->framePtr->objc, iPtr->framePtr->objv)); } } /* *---------------------------------------------------------------------- * * TclErrorStackResetIf -- * * The TIP 348 reset/no-bc part of TLCI, for specific use by * TclCompileSyntaxError. * * Results: * None. * * Side effects: * Reset errorstack if it needs be, and in that case remember the * passed-in error message as inner context. * *---------------------------------------------------------------------- */ void TclErrorStackResetIf( Tcl_Interp *interp, const char *msg, int length) { Interp *iPtr = (Interp *) interp; if (Tcl_IsShared(iPtr->errorStack)) { Tcl_Obj *newObj; newObj = Tcl_DuplicateObj(iPtr->errorStack); Tcl_DecrRefCount(iPtr->errorStack); Tcl_IncrRefCount(newObj); iPtr->errorStack = newObj; } if (iPtr->resetErrorStack) { int len; iPtr->resetErrorStack = 0; Tcl_ListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list intrep as much as possible. */ Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewStringObj(msg, length)); } } /* *---------------------------------------------------------------------- * * Tcl_LogCommandInfo -- |
︙ | ︙ | |||
5061 5062 5063 5064 5065 5066 5067 | /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 | < | 5061 5062 5063 5064 5065 5066 5067 5068 5069 | /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * End: */ |
Changes to generic/tclOO.c.
︙ | ︙ | |||
310 311 312 313 314 315 316 317 318 319 320 321 322 323 | { static Tcl_ThreadDataKey tsdKey; ThreadLocalData *tsdPtr = Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); Foundation *fPtr = ckalloc(sizeof(Foundation)); Tcl_Obj *namePtr, *argsPtr, *bodyPtr; Tcl_DString buffer; int i; /* * Initialize the structure that holds the OO system core. This is * attached to the interpreter via an assocData entry; not very efficient, * but the best we can do without hacking the core more. */ | > | 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 | { static Tcl_ThreadDataKey tsdKey; ThreadLocalData *tsdPtr = Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); Foundation *fPtr = ckalloc(sizeof(Foundation)); Tcl_Obj *namePtr, *argsPtr, *bodyPtr; Tcl_DString buffer; Command *cmdPtr; int i; /* * Initialize the structure that holds the OO system core. This is * attached to the interpreter via an assocData entry; not very efficient, * but the best we can do without hacking the core more. */ |
︙ | ︙ | |||
436 437 438 439 440 441 442 | * ensemble. */ Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::oo::Helpers::nextto", TclOONextToObjCmd, NULL, NULL); | | | > | 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 | * ensemble. */ Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::oo::Helpers::nextto", TclOONextToObjCmd, NULL, NULL); cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self", TclOOSelfObjCmd, NULL, NULL); cmdPtr->compileProc = TclCompileObjectSelfCmd; Tcl_CreateObjCommand(interp, "::oo::define", TclOODefineObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::oo::objdefine", TclOOObjDefObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL,NULL); TclOOInitInfo(interp); |
︙ | ︙ |
Changes to generic/tclOOInfo.c.
︙ | ︙ | |||
39 40 41 42 43 44 45 | static Tcl_ObjCmdProc InfoClassMethodsCmd; static Tcl_ObjCmdProc InfoClassMethodTypeCmd; static Tcl_ObjCmdProc InfoClassMixinsCmd; static Tcl_ObjCmdProc InfoClassSubsCmd; static Tcl_ObjCmdProc InfoClassSupersCmd; static Tcl_ObjCmdProc InfoClassVariablesCmd; | < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < | | < < < < < < < < < < < | < < < < < < | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | static Tcl_ObjCmdProc InfoClassMethodsCmd; static Tcl_ObjCmdProc InfoClassMethodTypeCmd; static Tcl_ObjCmdProc InfoClassMixinsCmd; static Tcl_ObjCmdProc InfoClassSubsCmd; static Tcl_ObjCmdProc InfoClassSupersCmd; static Tcl_ObjCmdProc InfoClassVariablesCmd; /* * List of commands that are used to implement the [info object] subcommands. */ static const EnsembleImplMap infoObjectCmds[] = { {"call", InfoObjectCallCmd, NULL, NULL, NULL, 0}, {"class", InfoObjectClassCmd, TclCompileInfoObjectClassCmd, NULL, NULL, 0}, {"definition", InfoObjectDefnCmd, NULL, NULL, NULL, 0}, {"filters", InfoObjectFiltersCmd, NULL, NULL, NULL, 0}, {"forward", InfoObjectForwardCmd, NULL, NULL, NULL, 0}, {"isa", InfoObjectIsACmd, TclCompileInfoObjectIsACmd, NULL, NULL, 0}, {"methods", InfoObjectMethodsCmd, NULL, NULL, NULL, 0}, {"methodtype", InfoObjectMethodTypeCmd, NULL, NULL, NULL, 0}, {"mixins", InfoObjectMixinsCmd, NULL, NULL, NULL, 0}, {"namespace", InfoObjectNsCmd, TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0}, {"variables", InfoObjectVariablesCmd, NULL, NULL, NULL, 0}, {"vars", InfoObjectVarsCmd, NULL, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; /* * List of commands that are used to implement the [info class] subcommands. */ static const EnsembleImplMap infoClassCmds[] = { {"call", InfoClassCallCmd, NULL, NULL, NULL, 0}, {"constructor", InfoClassConstrCmd, NULL, NULL, NULL, 0}, {"definition", InfoClassDefnCmd, NULL, NULL, NULL, 0}, {"destructor", InfoClassDestrCmd, NULL, NULL, NULL, 0}, {"filters", InfoClassFiltersCmd, NULL, NULL, NULL, 0}, {"forward", InfoClassForwardCmd, NULL, NULL, NULL, 0}, {"instances", InfoClassInstancesCmd, NULL, NULL, NULL, 0}, {"methods", InfoClassMethodsCmd, NULL, NULL, NULL, 0}, {"methodtype", InfoClassMethodTypeCmd, NULL, NULL, NULL, 0}, {"mixins", InfoClassMixinsCmd, NULL, NULL, NULL, 0}, {"subclasses", InfoClassSubsCmd, NULL, NULL, NULL, 0}, {"superclasses", InfoClassSupersCmd, NULL, NULL, NULL, 0}, {"variables", InfoClassVariablesCmd, NULL, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; /* * ---------------------------------------------------------------------- * * TclOOInitInfo -- * * Adjusts the Tcl core [info] command to contain subcommands ("object" * and "class") for introspection of objects and classes. * * ---------------------------------------------------------------------- */ void TclOOInitInfo( Tcl_Interp *interp) { Tcl_Command infoCmd; /* * Build the ensembles used to implement [info object] and [info class]. */ TclMakeEnsemble(interp, "::oo::InfoObject", infoObjectCmds); TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds); /* * Install into the master [info] ensemble. */ infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY); if (infoCmd != NULL && Tcl_IsEnsemble(infoCmd)) { |
︙ | ︙ |
Changes to generic/tclVar.c.
︙ | ︙ | |||
4220 4221 4222 4223 4224 4225 4226 | Tcl_Command TclInitArrayCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap arrayImplMap[] = { {"anymore", ArrayAnyMoreCmd, NULL, NULL, NULL, 0}, {"donesearch", ArrayDoneSearchCmd, NULL, NULL, NULL, 0}, | | | | | 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 | Tcl_Command TclInitArrayCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap arrayImplMap[] = { {"anymore", ArrayAnyMoreCmd, NULL, NULL, NULL, 0}, {"donesearch", ArrayDoneSearchCmd, NULL, NULL, NULL, 0}, {"exists", ArrayExistsCmd, TclCompileArrayExistsCmd, NULL, NULL, 0}, {"get", ArrayGetCmd, NULL, NULL, NULL, 0}, {"names", ArrayNamesCmd, NULL, NULL, NULL, 0}, {"nextelement", ArrayNextElementCmd, NULL, NULL, NULL, 0}, {"set", ArraySetCmd, TclCompileArraySetCmd, NULL, NULL, 0}, {"size", ArraySizeCmd, NULL, NULL, NULL, 0}, {"startsearch", ArrayStartSearchCmd, NULL, NULL, NULL, 0}, {"statistics", ArrayStatsCmd, NULL, NULL, NULL, 0}, {"unset", ArrayUnsetCmd, TclCompileArrayUnsetCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; return TclMakeEnsemble(interp, "array", arrayImplMap); } /* |
︙ | ︙ |
Changes to tests/dict.test.
︙ | ︙ | |||
74 75 76 77 78 79 80 81 82 83 84 85 86 87 | } -result {} test dict-2.7 {dict create command - #-quoting in string rep} { dict create # #comment } {{#} #comment} test dict-2.8 {dict create command - #-quoting in string rep} -body { dict create #a x #b x } -match glob -result {{#?} x #? x} test dict-3.1 {dict get command} {dict get {a b} a} b test dict-3.2 {dict get command} {dict get {a b c d} a} b test dict-3.3 {dict get command} {dict get {a b c d} c} d test dict-3.4 {dict get command} -returnCodes error -body { dict get {a b c d} b } -result {key "b" not known in dictionary} | > > > > > > > > > > > > > > > > > > | 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | } -result {} test dict-2.7 {dict create command - #-quoting in string rep} { dict create # #comment } {{#} #comment} test dict-2.8 {dict create command - #-quoting in string rep} -body { dict create #a x #b x } -match glob -result {{#?} x #? x} test dict-2.9 {dict create command: compilation} { apply {{} {dict create [format a] b}} } {a b} test dict-2.10 {dict create command: compilation} { apply {{} {dict create [format a] b c d}} } {a b c d} test dict-2.11 {dict create command: compilation} { apply {{} {dict create [format a] b c d a x}} } {a x c d} test dict-2.12 {dict create command: non-compilation} { dict create [format a] b } {a b} test dict-2.13 {dict create command: non-compilation} { dict create [format a] b c d } {a b c d} test dict-2.14 {dict create command: non-compilation} { dict create [format a] b c d a x } {a x c d} test dict-3.1 {dict get command} {dict get {a b} a} b test dict-3.2 {dict get command} {dict get {a b c d} a} b test dict-3.3 {dict get command} {dict get {a b c d} c} d test dict-3.4 {dict get command} -returnCodes error -body { dict get {a b c d} b } -result {key "b" not known in dictionary} |
︙ | ︙ | |||
1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 | } {a x c y} test dict-20.9 {dict merge command} { dict merge {a b c d} {c y a x} } {a x c y} test dict-20.10 {dict merge command} { dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -} } {a - c d e f 1 - 3 4} test dict-21.1 {dict update command} -returnCodes 1 -body { dict update } -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} test dict-21.2 {dict update command} -returnCodes 1 -body { dict update v } -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 | } {a x c y} test dict-20.9 {dict merge command} { dict merge {a b c d} {c y a x} } {a x c y} test dict-20.10 {dict merge command} { dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -} } {a - c d e f 1 - 3 4} test dict-20.11 {dict merge command} { apply {{} {dict merge}} } {} test dict-20.12 {dict merge command} { apply {{} {dict merge {a b c d e f}}} } {a b c d e f} test dict-20.13 {dict merge command} -body { apply {{} {dict merge {a b c d e}}} } -result {missing value to go with key} -returnCodes error test dict-20.14 {dict merge command} { apply {{} {dict merge {a b c d} {e f g h}}} } {a b c d e f g h} test dict-20.15 {dict merge command} -body { apply {{} {dict merge {a b c d e} {e f g h}}} } -result {missing value to go with key} -returnCodes error test dict-20.16 {dict merge command} -body { apply {{} {dict merge {a b c d} {e f g h i}}} } -result {missing value to go with key} -returnCodes error test dict-20.17 {dict merge command} { apply {{} {dict merge {a b c d e f} {e x g h}}} } {a b c d e x g h} test dict-20.18 {dict merge command} { apply {{} {dict merge {a b c d} {a x c y}}} } {a x c y} test dict-20.19 {dict merge command} { apply {{} {dict merge {a b c d} {c y a x}}} } {a x c y} test dict-20.20 {dict merge command} { apply {{} {dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}}} } {a - c d e f 1 - 3 4} test dict-21.1 {dict update command} -returnCodes 1 -body { dict update } -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} test dict-21.2 {dict update command} -returnCodes 1 -body { dict update v } -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} |
︙ | ︙ |
Changes to tests/info.test.
︙ | ︙ | |||
1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 | set y DL. etrace }] 0 2] \n } } -result {* {type source line 1944 file info.test cmd {info frame $level} proc ::etrace level 0} * {type source line 1951 file info.test cmd etrace level 1} * {type source line 1949 file info.test cmd uplevel\\ \\\\ level 1}} -cleanup {interp delete sub} # ------------------------------------------------------------------------- unset -nocomplain res # cleanup catch {namespace delete test_ns_info1 test_ns_info2} ::tcltest::cleanupTests | > > > > > > | 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 | set y DL. etrace }] 0 2] \n } } -result {* {type source line 1944 file info.test cmd {info frame $level} proc ::etrace level 0} * {type source line 1951 file info.test cmd etrace level 1} * {type source line 1949 file info.test cmd uplevel\\ \\\\ level 1}} -cleanup {interp delete sub} # This test at the end of this file _only_ to avoid disturbing above line # numbers. It _belongs_ after info-9.12 test info-9.13 {info level option, value in global context} -body { uplevel #0 {info level 2} } -returnCodes error -result {bad level "2"} # ------------------------------------------------------------------------- unset -nocomplain res # cleanup catch {namespace delete test_ns_info1 test_ns_info2} ::tcltest::cleanupTests |
︙ | ︙ |