Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Improve code generation for [array set] in a common case. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
b274b30ee6c40d94e8eef68d4f0ae9a9 |
User & Date: | dkf 2013-04-29 09:31:53 |
Context
2013-04-30
| ||
18:49 | (::platform::LibcVersion): Followup to the 2013-01-30 change. The RE become too restrictive again. S... check-in: b15cddcf1f user: andreask tags: trunk | |
2013-04-29
| ||
12:34 |
Bringing vexpr up to date with the latest trunk.
Combining the vexpr patch with my fix to the m4 fi... Closed-Leaf check-in: 728208200b user: hypnotoad tags: hypnotoad-vexpr | |
12:31 | Bringing patch up to date with the latest trunk Closed-Leaf check-in: 216aa27e26 user: hypnotoad tags: hypnotoad-prefer-native-8.6 | |
09:31 | Improve code generation for [array set] in a common case. check-in: b274b30ee6 user: dkf tags: trunk | |
2013-04-25
| ||
07:40 | merge-mark check-in: f97e93ec09 user: jan.nijtmans tags: trunk | |
Changes
Changes to ChangeLog.
1 2 3 4 5 6 7 | 2013-04-23 Jan Nijtmans <[email protected]> * generic/tclDecls.h: Implement Tcl_NewBooleanObj, Tcl_DbNewBooleanObj and Tcl_SetBooleanObj as macros using Tcl_NewIntObj, Tcl_DbNewLongObj and Tcl_SetIntObj. Starting with Tcl 8.5, this is exactly the same, it only eliminates code duplication. * generic/tclInt.h: Eliminate use of NO_WIDE_TYPE everywhere: It's | > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 | 2013-04-29 Donal K. Fellows <[email protected]> * generic/tclCompCmds.c (TclCompileArraySetCmd): Generate better code when the list of things to set is a literal. 2013-04-23 Jan Nijtmans <[email protected]> * generic/tclDecls.h: Implement Tcl_NewBooleanObj, Tcl_DbNewBooleanObj and Tcl_SetBooleanObj as macros using Tcl_NewIntObj, Tcl_DbNewLongObj and Tcl_SetIntObj. Starting with Tcl 8.5, this is exactly the same, it only eliminates code duplication. * generic/tclInt.h: Eliminate use of NO_WIDE_TYPE everywhere: It's |
︙ | ︙ |
Changes to generic/tclCompCmds.c.
︙ | ︙ | |||
282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 | Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *dataTokenPtr; 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; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT, &localIndex, &simpleVarName, &isScalar, 1); | > > < > > > > > > < | > > | > > > > > > > > > > > > > > > | 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 | Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *dataTokenPtr; int simpleVarName, isScalar, localIndex; int isDataLiteral, isDataValid, isDataEven, len; int dataVar, iterVar, keyVar, valVar, infoIndex; int back, fwd, offsetBack, offsetFwd, savedStackDepth; Tcl_Obj *literalObj; ForeachInfo *infoPtr; if (parsePtr->numWords != 3) { return TCL_ERROR; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT, &localIndex, &simpleVarName, &isScalar, 1); if (!isScalar) { return TCL_ERROR; } dataTokenPtr = TokenAfter(varTokenPtr); literalObj = Tcl_NewObj(); isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj); isDataValid = (isDataLiteral && Tcl_ListObjLength(NULL, literalObj, &len) == TCL_OK); isDataEven = (isDataValid && (len & 1) == 0); /* * Special case: literal empty value argument is just an "ensure array" * operation. */ if (isDataEven && len == 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); goto done; } /* * Special case: literal odd-length argument is always an error. */ if (isDataValid && !isDataEven) { 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; PushLiteral(envPtr, "", 0); goto done; } /* * Prepare for the internal foreach. */ dataVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); |
︙ | ︙ | |||
355 356 357 358 359 360 361 | if (localIndex >= 0) { CompileWord(envPtr, varTokenPtr, interp, 1); } else { TclEmitInstInt4(INST_REVERSE, 2, envPtr); } CompileWord(envPtr, dataTokenPtr, interp, 2); TclEmitInstInt1(INST_INVOKE_STK1, 3, envPtr); | | > > > > > > > > | | | | | | | | | | | | | | | | > | 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 | if (localIndex >= 0) { CompileWord(envPtr, varTokenPtr, interp, 1); } else { TclEmitInstInt4(INST_REVERSE, 2, envPtr); } CompileWord(envPtr, dataTokenPtr, interp, 2); TclEmitInstInt1(INST_INVOKE_STK1, 3, envPtr); goto done; } 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, dataTokenPtr, interp, 2); if (!isDataLiteral || !isDataValid) { /* * Only need this safety check if we're handling a non-literal or list * containing an invalid literal; with valid list literals, we've * already checked (worth it because literals are a very common * use-case with [array set]). */ 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); |
︙ | ︙ | |||
435 436 437 438 439 440 441 | 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); } | > | | > > > | 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 | 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); } if (!isDataLiteral) { TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( dataVar, envPtr); } PushLiteral(envPtr, "", 0); done: Tcl_DecrRefCount(literalObj); return TCL_OK; } int TclCompileArrayUnsetCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command |
︙ | ︙ |
Changes to tests/set-old.test.
︙ | ︙ | |||
674 675 676 677 678 679 680 681 682 683 684 685 686 687 | } [list 1 "\"a\" isn't an array"] test set-old-8.57 {array command, array get with trivial pattern} { catch {unset a} set a(x) 1 set a(y) 2 array get a x } {x 1} test set-old-9.1 {ids for array enumeration} { catch {unset a} set a(a) 1 list [array star a] [array star a] [array done a s-1-a; array star a] \ [array done a s-2-a; array d a s-3-a; array start a] } {s-1-a s-2-a s-3-a s-1-a} | > > > > > | 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 | } [list 1 "\"a\" isn't an array"] test set-old-8.57 {array command, array get with trivial pattern} { catch {unset a} set a(x) 1 set a(y) 2 array get a x } {x 1} test set-old-8.58 {array command, array set with LVT and odd length literal} { list [catch {apply {{} { array set a {b c d} }}} msg] $msg } {1 {list must have an even number of elements}} test set-old-9.1 {ids for array enumeration} { catch {unset a} set a(a) 1 list [array star a] [array star a] [array done a s-1-a; array star a] \ [array done a s-2-a; array d a s-3-a; array start a] } {s-1-a s-2-a s-3-a s-1-a} |
︙ | ︙ |