summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclAssembly.c10
-rw-r--r--generic/tclCmdMZ.c4
-rw-r--r--generic/tclCompCmdsSZ.c279
-rw-r--r--generic/tclCompile.c8
-rw-r--r--generic/tclCompile.h18
-rw-r--r--generic/tclExecute.c67
-rw-r--r--generic/tclInt.h6
7 files changed, 306 insertions, 86 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 10df71a..9d2854d 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -472,6 +472,7 @@ static const TalInstDesc TalInstructionTable[] = {
{"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},
@@ -509,10 +510,11 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_REVERSE, /* 126 */
INST_NOP, /* 132 */
INST_STR_MAP, /* 141 */
- INST_COROUTINE_NAME, /* 143 */
- INST_NS_CURRENT, /* 144 */
- INST_INFO_LEVEL_NUM, /* 145 */
- INST_RESOLVE_COMMAND /* 147 */
+ INST_STR_FIND, /* 142 */
+ INST_COROUTINE_NAME, /* 145 */
+ INST_NS_CURRENT, /* 146 */
+ INST_INFO_LEVEL_NUM, /* 147 */
+ INST_RESOLVE_COMMAND /* 149 */
};
/*
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 1f210dd..de32fce 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -3304,14 +3304,14 @@ TclInitStringCmd(
{"bytelength", StringBytesCmd, NULL, NULL, NULL, 0},
{"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
- {"first", StringFirstCmd, NULL, NULL, NULL, 0},
+ {"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
{"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0},
{"is", StringIsCmd, NULL, NULL, NULL, 0},
{"last", StringLastCmd, NULL, NULL, NULL, 0},
{"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0},
{"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0},
{"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0},
- {"range", StringRangeCmd, NULL, 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},
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;
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 8b98746..6e2cfae 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -438,7 +438,13 @@ InstructionDesc const tclInstructionTable[] = {
{"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 */
+ * 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 */
+ {"strrangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}},
+ /* String Range: push (string range stktop op4 op4) */
{"yield", 1, 0, 0, {OPERAND_NONE}},
/* Makes the current coroutine yield the value at the top of the
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index ff2f0e3..2ea4209 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -683,20 +683,22 @@ typedef struct ByteCode {
/* For [string map] and [regsub] compilation */
#define INST_STR_MAP 141
+#define INST_STR_FIND 142
+#define INST_STR_RANGE_IMM 143
/* For operations to do with coroutines */
-#define INST_YIELD 142
-#define INST_COROUTINE_NAME 143
+#define INST_YIELD 144
+#define INST_COROUTINE_NAME 145
/* For compilation of basic information operations */
-#define INST_NS_CURRENT 144
-#define INST_INFO_LEVEL_NUM 145
-#define INST_INFO_LEVEL_ARGS 146
-#define INST_RESOLVE_COMMAND 147
-#define INST_TCLOO_SELF 148
+#define INST_NS_CURRENT 146
+#define INST_INFO_LEVEL_NUM 147
+#define INST_INFO_LEVEL_ARGS 148
+#define INST_RESOLVE_COMMAND 149
+#define INST_TCLOO_SELF 150
/* The last opcode */
-#define LAST_INST_OPCODE 148
+#define LAST_INST_OPCODE 150
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 10cbf46..f54155d 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4732,11 +4732,12 @@ TEBCresume(
O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
- case INST_STR_MAP: {
+ {
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. */
@@ -4781,7 +4782,71 @@ TEBCresume(
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) && TclUniCharNcmp(ustring2, p,
+ (unsigned long) 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_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);
}
case INST_STR_MATCH:
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 27da005..9e9784b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3631,6 +3631,9 @@ MODULE_SCOPE int TclCompileStringCmpCmd(Tcl_Interp *interp,
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);
@@ -3643,6 +3646,9 @@ MODULE_SCOPE int TclCompileStringMapCmd(Tcl_Interp *interp,
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);