summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmdsSZ.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-10-30 18:20:28 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-10-30 18:20:28 (GMT)
commitf33e163df8aba6bc58d84fc11c3c487e6874ae32 (patch)
treefbe68dcfedfe80e6188afe653fa790c24ed4e415 /generic/tclCompCmdsSZ.c
parenta0eff2e10d8d67a7d2a9ed66aec116ebf483dfc8 (diff)
downloadtcl-f33e163df8aba6bc58d84fc11c3c487e6874ae32.zip
tcl-f33e163df8aba6bc58d84fc11c3c487e6874ae32.tar.gz
tcl-f33e163df8aba6bc58d84fc11c3c487e6874ae32.tar.bz2
Compilation of [string first] and [string range] (with constant indices).
Diffstat (limited to 'generic/tclCompCmdsSZ.c')
-rw-r--r--generic/tclCompCmdsSZ.c279
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;
}