diff options
Diffstat (limited to 'generic/tclCompCmdsSZ.c')
| -rw-r--r-- | generic/tclCompCmdsSZ.c | 279 |
1 files changed, 209 insertions, 70 deletions
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index b8dada5..12396fe 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -133,6 +133,8 @@ const AuxDataType tclJumptableInfoType = { #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) \ @@ -351,6 +353,57 @@ TclCompileStringEqualCmd( /* *---------------------------------------------------------------------- * + * TclCompileStringFirstCmd -- + * + * Procedure called to compile the simplest and most common form of the + * "string first" 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 first" + * command at runtime. + * + *---------------------------------------------------------------------- + */ + +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; +} + +/* + *---------------------------------------------------------------------- + * * TclCompileStringIndexCmd -- * * Procedure called to compile the simplest and most common form of the @@ -630,7 +683,7 @@ TclCompileStringMapCmd( bytes = Tcl_GetStringFromObj(objv[1], &len); PushLiteral(envPtr, bytes, len); CompileWord(envPtr, stringTokenPtr, interp, 2); - TclEmitOpcode(INST_STR_MAP, envPtr); + OP(STR_MAP); } Tcl_DecrRefCount(mapObj); return TCL_OK; @@ -639,6 +692,113 @@ TclCompileStringMapCmd( /* *---------------------------------------------------------------------- * + * TclCompileStringRangeCmd -- + * + * Procedure called to compile the "string range" command (with constant + * indices). + * + * 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 compare" + * command at runtime. + * + *---------------------------------------------------------------------- + */ + +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, *tokenPtr; + Tcl_Obj *tmpObj; + int idx1, idx2, result; + + /* + * We don't support any flags; the bytecode isn't that sophisticated. + */ + + if (parsePtr->numWords != 4) { + return TCL_ERROR; + } + stringTokenPtr = TokenAfter(parsePtr->tokenPtr); + + /* + * 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). + */ + + tokenPtr = TokenAfter(stringTokenPtr); + tmpObj = Tcl_NewObj(); + if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) { + Tcl_DecrRefCount(tmpObj); + return TCL_ERROR; + } + result = TclGetIntFromObj(NULL, tmpObj, &idx1); + if (result == TCL_OK) { + if (idx1 < 0) { + result = TCL_ERROR; + } + } else { + result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1); + if (result == TCL_OK && idx1 > -2) { + result = TCL_ERROR; + } + } + TclDecrRefCount(tmpObj); + if (result != TCL_OK) { + return TCL_ERROR; + } + + /* + * 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). + */ + + tokenPtr = TokenAfter(tokenPtr); + tmpObj = Tcl_NewObj(); + if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) { + Tcl_DecrRefCount(tmpObj); + return TCL_ERROR; + } + result = TclGetIntFromObj(NULL, tmpObj, &idx2); + if (result == TCL_OK) { + if (idx2 < 0) { + result = TCL_ERROR; + } + } else { + result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2); + if (result == TCL_OK && idx2 > -2) { + result = TCL_ERROR; + } + } + TclDecrRefCount(tmpObj); + if (result != TCL_OK) { + return TCL_ERROR; + } + + /* + * Push the two operands onto the stack and then the test. + */ + + CompileWord(envPtr, stringTokenPtr, interp, 1); + OP44( STR_RANGE_IMM, idx1, idx2); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TclCompileSubstCmd -- * * Procedure called to compile the "subst" command. @@ -779,11 +939,11 @@ TclSubstCompile( } while (count > 255) { - TclEmitInstInt1(INST_CONCAT1, 255, envPtr); + OP1( CONCAT1, 255); count -= 254; } if (count > 1) { - TclEmitInstInt1(INST_CONCAT1, count, envPtr); + OP1( CONCAT1, count); count = 1; } @@ -804,7 +964,7 @@ TclSubstCompile( envPtr->line = bline; catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - TclEmitInstInt4(INST_BEGIN_CATCH4, catchRange, envPtr); + OP4( BEGIN_CATCH4, catchRange); ExceptionRangeStarts(envPtr, catchRange); switch (tokenPtr->type) { @@ -825,20 +985,20 @@ TclSubstCompile( ExceptionRangeEnds(envPtr, catchRange); /* Substitution produced TCL_OK */ - TclEmitOpcode(INST_END_CATCH, envPtr); + OP( END_CATCH); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup); /* Exceptional return codes processed here */ ExceptionRangeTarget(envPtr, catchRange, catchOffset); - TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr); - TclEmitOpcode(INST_PUSH_RESULT, envPtr); - TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr); - TclEmitOpcode(INST_END_CATCH, envPtr); - TclEmitOpcode(INST_RETURN_CODE_BRANCH, envPtr); + OP( PUSH_RETURN_OPTIONS); + OP( PUSH_RESULT); + OP( PUSH_RETURN_CODE); + OP( END_CATCH); + OP( RETURN_CODE_BRANCH); /* ERROR -> reraise it */ - TclEmitOpcode(INST_RETURN_STK, envPtr); - TclEmitOpcode(INST_NOP, envPtr); + OP( RETURN_STK); + OP( NOP); /* RETURN */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &returnFixup); @@ -857,14 +1017,14 @@ TclSubstCompile( Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d", (int) (CurrentOffset(envPtr) - breakFixup.codeOffset)); } - TclEmitOpcode(INST_POP, envPtr); - TclEmitOpcode(INST_POP, envPtr); + OP( POP); + OP( POP); breakJump = CurrentOffset(envPtr) - breakOffset; if (breakJump > 127) { - TclEmitInstInt4(INST_JUMP4, -breakJump, envPtr); + OP4(JUMP4, -breakJump); } else { - TclEmitInstInt1(INST_JUMP1, -breakJump, envPtr); + OP1(JUMP1, -breakJump); } /* CONTINUE destination */ @@ -872,8 +1032,8 @@ TclSubstCompile( Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d", (int) (CurrentOffset(envPtr) - continueFixup.codeOffset)); } - TclEmitOpcode(INST_POP, envPtr); - TclEmitOpcode(INST_POP, envPtr); + OP( POP); + OP( POP); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup); /* RETURN + other destination */ @@ -890,8 +1050,8 @@ TclSubstCompile( * Pull the result to top of stack, discard options dict. */ - TclEmitInstInt4(INST_REVERSE, 2, envPtr); - TclEmitOpcode(INST_POP, envPtr); + OP4( REVERSE, 2); + OP( POP); /* * We've emitted several POP instructions, and the automatic @@ -910,7 +1070,7 @@ TclSubstCompile( (int) (CurrentOffset(envPtr) - okFixup.codeOffset)); } if (count > 1) { - TclEmitInstInt1(INST_CONCAT1, count, envPtr); + OP1(CONCAT1, count); count = 1; } @@ -922,13 +1082,12 @@ TclSubstCompile( bline = envPtr->line; } - while (count > 255) { - TclEmitInstInt1(INST_CONCAT1, 255, envPtr); + OP1( CONCAT1, 255); count -= 254; } if (count > 1) { - TclEmitInstInt1(INST_CONCAT1, count, envPtr); + OP1( CONCAT1, count); } Tcl_FreeParse(&parse); @@ -1359,14 +1518,14 @@ IssueSwitchChainedTests( switch (mode) { case Switch_Exact: - TclEmitOpcode(INST_DUP, envPtr); + OP( DUP); TclCompileTokens(interp, bodyToken[i], 1, envPtr); - TclEmitOpcode(INST_STR_EQ, envPtr); + OP( STR_EQ); break; case Switch_Glob: TclCompileTokens(interp, bodyToken[i], 1, envPtr); - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr); + OP4( OVER, 1); + OP1( STR_MATCH, noCase); break; case Switch_Regexp: simple = exact = 0; @@ -1405,7 +1564,7 @@ IssueSwitchChainedTests( TclCompileTokens(interp, bodyToken[i], 1, envPtr); } - TclEmitInstInt4(INST_OVER, 1, envPtr); + OP4( OVER, 1); if (!simple) { /* * Pass correct RE compile flags. We use only Int1 @@ -1417,11 +1576,11 @@ IssueSwitchChainedTests( int cflags = TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0); - TclEmitInstInt1(INST_REGEXP, cflags, envPtr); + OP1(REGEXP, cflags); } else if (exact && !noCase) { - TclEmitOpcode(INST_STR_EQ, envPtr); + OP( STR_EQ); } else { - TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr); + OP1(STR_MATCH, noCase); } break; default: @@ -1486,7 +1645,7 @@ IssueSwitchChainedTests( * pattern. */ - TclEmitOpcode(INST_POP, envPtr); + OP( POP); envPtr->currStackDepth = savedStackDepth + 1; envPtr->line = bodyLines[i+1]; /* TIP #280 */ envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */ @@ -1508,7 +1667,7 @@ IssueSwitchChainedTests( */ if (!foundDefault) { - TclEmitOpcode(INST_POP, envPtr); + OP( POP); PushLiteral(envPtr, "", 0); } @@ -1619,9 +1778,9 @@ IssueSwitchJumpTable( */ jumpLocation = CurrentOffset(envPtr); - TclEmitInstInt4(INST_JUMP_TABLE, infoIndex, envPtr); + OP4( JUMP_TABLE, infoIndex); jumpToDefault = CurrentOffset(envPtr); - TclEmitInstInt4(INST_JUMP4, 0, envPtr); + OP4( JUMP4, 0); for (i=0 ; i<numBodyTokens ; i+=2) { /* @@ -1712,7 +1871,7 @@ IssueSwitchJumpTable( * rewriting when we fixed this all up. */ - TclEmitInstInt4(INST_JUMP4, 0, envPtr); + OP4( JUMP4, 0); } } @@ -2629,20 +2788,18 @@ TclCompileUnsetCmd( */ if (!simpleVarName) { - TclEmitInstInt1( INST_UNSET_STK, flags, envPtr); + OP1( UNSET_STK, flags); } else if (isScalar) { if (localIndex < 0) { - TclEmitInstInt1(INST_UNSET_STK, flags, envPtr); + OP1( UNSET_STK, flags); } else { - TclEmitInstInt1(INST_UNSET_SCALAR, flags, envPtr); - TclEmitInt4( localIndex, envPtr); + OP14( UNSET_SCALAR, flags, localIndex); } } else { if (localIndex < 0) { - TclEmitInstInt1(INST_UNSET_ARRAY_STK, flags, envPtr); + OP1( UNSET_ARRAY_STK, flags); } else { - TclEmitInstInt1(INST_UNSET_ARRAY, flags, envPtr); - TclEmitInt4( localIndex, envPtr); + OP14( UNSET_ARRAY, flags, localIndex); } } @@ -2779,7 +2936,7 @@ TclCompileWhileCmd( CompileBody(envPtr, bodyTokenPtr, interp); ExceptionRangeEnds(envPtr, range); envPtr->currStackDepth = savedStackDepth + 1; - TclEmitOpcode(INST_POP, envPtr); + OP( POP); /* * Compile the test expression then emit the conditional jump that @@ -2870,7 +3027,7 @@ TclCompileYieldCmd( CompileWord(envPtr, valueTokenPtr, interp, 1); } - TclEmitOpcode(INST_YIELD, envPtr); + OP( YIELD); return TCL_OK; } @@ -3199,7 +3356,7 @@ CompileAssociativeBinaryOpCmd( * calcuations, including roundoff errors. */ - TclEmitInstInt4(INST_REVERSE, words-1, envPtr); + OP4( REVERSE, words-1); } while (--words > 1) { TclEmitOpcode(instruction, envPtr); @@ -3290,31 +3447,19 @@ CompileComparisonOpCmd( CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); - if (tmpIndex <= 255) { - TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr); - } else { - TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); - } + STORE(tmpIndex); TclEmitOpcode(instruction, envPtr); for (words=3 ; words<parsePtr->numWords ;) { - if (tmpIndex <= 255) { - TclEmitInstInt1(INST_LOAD_SCALAR1, tmpIndex, envPtr); - } else { - TclEmitInstInt4(INST_LOAD_SCALAR4, tmpIndex, envPtr); - } + LOAD(tmpIndex); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); if (++words < parsePtr->numWords) { - if (tmpIndex <= 255) { - TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr); - } else { - TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); - } + STORE(tmpIndex); } TclEmitOpcode(instruction, envPtr); } for (; words>3 ; words--) { - TclEmitOpcode(INST_BITAND, envPtr); + OP( BITAND); } /* @@ -3322,13 +3467,7 @@ CompileComparisonOpCmd( * might be expensive elsewhere. */ - PushLiteral(envPtr, "", 0); - if (tmpIndex <= 255) { - TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr); - } else { - TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr); - } - TclEmitOpcode(INST_POP, envPtr); + OP14( UNSET_SCALAR, 0, tmpIndex); } return TCL_OK; } |