diff options
| -rw-r--r-- | generic/tclAssembly.c | 10 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 4 | ||||
| -rw-r--r-- | generic/tclCompCmdsSZ.c | 279 | ||||
| -rw-r--r-- | generic/tclCompile.c | 8 | ||||
| -rw-r--r-- | generic/tclCompile.h | 18 | ||||
| -rw-r--r-- | generic/tclExecute.c | 67 | ||||
| -rw-r--r-- | generic/tclInt.h | 6 |
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); |