summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclAssembly.c50
-rw-r--r--generic/tclBasic.c4
-rw-r--r--generic/tclCmdMZ.c16
-rw-r--r--generic/tclCompCmds.c98
-rw-r--r--generic/tclCompCmdsGR.c447
-rw-r--r--generic/tclCompCmdsSZ.c408
-rw-r--r--generic/tclCompile.c73
-rw-r--r--generic/tclCompile.h16
-rw-r--r--generic/tclExecute.c121
-rw-r--r--generic/tclInt.h27
-rw-r--r--generic/tclOptimize.c6
-rwxr-xr-x[-rw-r--r--]generic/tclStrToD.c0
-rw-r--r--generic/tclStubLibTbl.c58
13 files changed, 1014 insertions, 310 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index fc51457..cd0a42d 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -246,8 +246,6 @@ static void BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx,
int opnd, int count);
static void BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
int param, int count);
-static void BBEmitInvoke1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
- int param, int count);
static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx,
int count);
static int BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
@@ -351,7 +349,8 @@ static const TalInstDesc TalInstructionTable[] = {
{"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1},
{"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1},
{"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1},
- {"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1},
+ {"concat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1},
+ {"concatStk", ASSEM_LIST, INST_CONCAT_STK, INT_MIN,1},
{"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1},
{"currentNamespace",ASSEM_1BYTE, INST_NS_CURRENT, 0, 1},
{"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1},
@@ -454,7 +453,11 @@ static const TalInstDesc TalInstructionTable[] = {
| INST_STORE_ARRAY4), 2, 1},
{"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1},
{"storeStk", ASSEM_1BYTE, INST_STORE_STK, 2, 1},
+ {"strLower", ASSEM_1BYTE, INST_STR_LOWER, 1, 1},
+ {"strTitle", ASSEM_1BYTE, INST_STR_TITLE, 1, 1},
+ {"strUpper", ASSEM_1BYTE, INST_STR_UPPER, 1, 1},
{"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1},
+ {"strcat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,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},
@@ -464,6 +467,9 @@ static const TalInstDesc TalInstructionTable[] = {
{"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1},
{"strrange", ASSEM_1BYTE, INST_STR_RANGE, 3, 1},
{"strrfind", ASSEM_1BYTE, INST_STR_FIND_LAST, 2, 1},
+ {"strtrim", ASSEM_1BYTE, INST_STR_TRIM, 2, 1},
+ {"strtrimLeft", ASSEM_1BYTE, INST_STR_TRIM_LEFT, 2, 1},
+ {"strtrimRight", ASSEM_1BYTE, INST_STR_TRIM_RIGHT, 2, 1},
{"sub", ASSEM_1BYTE, INST_SUB, 2, 1},
{"tclooClass", ASSEM_1BYTE, INST_TCLOO_CLASS, 1, 1},
{"tclooIsObject", ASSEM_1BYTE, INST_TCLOO_IS_OBJECT, 1, 1},
@@ -495,6 +501,7 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */
INST_JUMP1, INST_JUMP4, /* 34-35 */
INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */
+ INST_LIST, /* 79 */
INST_OVER, /* 95 */
INST_PUSH_RETURN_OPTIONS, /* 108 */
INST_REVERSE, /* 126 */
@@ -504,7 +511,10 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_COROUTINE_NAME, /* 149 */
INST_NS_CURRENT, /* 151 */
INST_INFO_LEVEL_NUM, /* 152 */
- INST_RESOLVE_COMMAND /* 154 */
+ INST_RESOLVE_COMMAND, /* 154 */
+ INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT, /* 166-168 */
+ INST_CONCAT_STK, /* 169 */
+ INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE /* 170-172 */
};
/*
@@ -681,13 +691,10 @@ BBEmitInstInt4(
/*
*-----------------------------------------------------------------------------
*
- * BBEmitInst1or4, BBEmitInvoke1or4 --
+ * BBEmitInst1or4 --
*
* Emits a 1- or 4-byte operation according to the magnitude of the
- * operand. The Invoke variant generates wrapping stack-balance
- * management if necessary (which is not normally required in assembled
- * code, as loop exception ranges, expansions, breaks and continues can't
- * be issued currently).
+ * operand.
*
*-----------------------------------------------------------------------------
*/
@@ -719,29 +726,6 @@ BBEmitInst1or4(
TclUpdateAtCmdStart(op, envPtr);
BBUpdateStackReqs(bbPtr, tblIdx, count);
}
-
-static void
-BBEmitInvoke1or4(
- AssemblyEnv* assemEnvPtr, /* Assembly environment */
- int tblIdx, /* Index in TalInstructionTable of op */
- int param, /* Variable-length parameter */
- int count) /* Arity if variadic */
-{
- CompileEnv* envPtr = assemEnvPtr->envPtr;
- /* Compilation environment */
- BasicBlock* bbPtr = assemEnvPtr->curr_bb;
- /* Current basic block */
- int op = TalInstructionTable[tblIdx].tclInstCode;
-
- if (param <= 0xff) {
- op >>= 8;
- } else {
- op &= 0xff;
- }
- TclEmitInvoke(envPtr, op, param);
- TclUpdateAtCmdStart(op, envPtr);
- BBUpdateStackReqs(bbPtr, tblIdx, count);
-}
/*
*-----------------------------------------------------------------------------
@@ -1478,7 +1462,7 @@ AssembleOneLine(
goto cleanup;
}
- BBEmitInvoke1or4(assemEnvPtr, tblIdx, opnd, opnd);
+ BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd);
break;
case ASSEM_JUMP:
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 8ec94ca..7c02706 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -211,7 +211,7 @@ static const CmdInfo builtInCmds[] = {
{"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE},
#endif
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
- {"concat", Tcl_ConcatObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE},
{"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE},
{"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE},
{"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE},
@@ -227,7 +227,7 @@ static const CmdInfo builtInCmds[] = {
{"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE},
{"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE},
{"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE},
- {"linsert", Tcl_LinsertObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE},
{"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
{"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE},
{"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE},
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 5087fbb..cefe850 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -35,6 +35,8 @@ static int UniCharIsHexDigit(int character);
/*
* Default set of characters to trim in [string trim] and friends. This is a
* UTF-8 literal string containing all Unicode space characters [TIP #413]
+ *
+ * Synch with tclCompCmdsSZ.c
*/
#define DEFAULT_TRIM_SET \
@@ -3337,14 +3339,14 @@ TclInitStringCmd(
{"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0},
{"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0},
{"repeat", StringReptCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
- {"replace", StringRplcCmd, NULL, NULL, NULL, 0},
+ {"replace", StringRplcCmd, TclCompileStringReplaceCmd, NULL, NULL, 0},
{"reverse", StringRevCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"tolower", StringLowerCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
- {"toupper", StringUpperCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
- {"totitle", StringTitleCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
- {"trim", StringTrimCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
- {"trimleft", StringTrimLCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
- {"trimright", StringTrimRCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"tolower", StringLowerCmd, TclCompileStringToLowerCmd, NULL, NULL, 0},
+ {"toupper", StringUpperCmd, TclCompileStringToUpperCmd, NULL, NULL, 0},
+ {"totitle", StringTitleCmd, TclCompileStringToTitleCmd, NULL, NULL, 0},
+ {"trim", StringTrimCmd, TclCompileStringTrimCmd, NULL, NULL, 0},
+ {"trimleft", StringTrimLCmd, TclCompileStringTrimLCmd, NULL, NULL, 0},
+ {"trimright", StringTrimRCmd, TclCompileStringTrimRCmd, NULL, NULL, 0},
{"wordend", StringEndCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"wordstart", StringStartCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 323aa87..51ac9ed 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -65,6 +65,13 @@ const AuxDataType tclDictUpdateInfoType = {
FreeDictUpdateInfo, /* freeProc */
PrintDictUpdateInfo /* printProc */
};
+
+/*
+ * The definition of what whitespace is stripped when [concat]enating. Must be
+ * kept in synch with tclUtil.c
+ */
+
+#define CONCAT_WS " \f\v\r\t\n"
/*
*----------------------------------------------------------------------
@@ -690,6 +697,93 @@ TclCompileCatchCmd(
/*
*----------------------------------------------------------------------
*
+ * TclCompileConcatCmd --
+ *
+ * Procedure called to compile the "concat" 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 "concat" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileConcatCmd(
+ 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_Obj *objPtr, *listObj;
+ Tcl_Token *tokenPtr;
+ int i;
+
+ /* TODO: Consider compiling expansion case. */
+ if (parsePtr->numWords == 1) {
+ /*
+ * [concat] without arguments just pushes an empty object.
+ */
+
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
+ }
+
+ /*
+ * Test if all arguments are compile-time known. If they are, we can
+ * implement with a simple push.
+ */
+
+ listObj = Tcl_NewObj();
+ for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ objPtr = Tcl_NewObj();
+ if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+ Tcl_DecrRefCount(objPtr);
+ Tcl_DecrRefCount(listObj);
+ listObj = NULL;
+ break;
+ }
+ (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
+ }
+ if (listObj != NULL) {
+ Tcl_Obj **objs;
+ const char *bytes;
+ int len;
+
+ Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
+ objPtr = Tcl_ConcatObj(len, objs);
+ Tcl_DecrRefCount(listObj);
+ bytes = Tcl_GetStringFromObj(objPtr, &len);
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(objPtr);
+ return TCL_OK;
+ }
+
+ /*
+ * General case: runtime concat.
+ */
+
+ for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+
+ TclEmitInstInt4( INST_CONCAT_STK, i-1, envPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileContinueCmd --
*
* Procedure called to compile the "continue" command.
@@ -1678,7 +1772,7 @@ TclCompileDictAppendCmd(
tokenPtr = TokenAfter(tokenPtr);
}
if (parsePtr->numWords > 4) {
- TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr);
}
/*
@@ -3011,7 +3105,7 @@ TclCompileFormatCmd(
* Do the concatenation, which produces the result.
*/
- TclEmitInstInt1(INST_CONCAT1, i, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr);
} else {
/*
* EVIL HACK! Force there to be a string representation in the case
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index b7c89df..fc54620 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -28,6 +28,58 @@ static void CompileReturnInternal(CompileEnv *envPtr,
static int IndexTailVarIfKnown(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr);
+#define INDEX_END (-2)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromToken --
+ *
+ * Parse a token and get the encoded version of the index (as understood
+ * by TEBC), assuming it is at all knowable at compile time. Only handles
+ * indices that are integers or 'end' or 'end-integer'.
+ *
+ * Returns:
+ * TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
+ *
+ * Side effects:
+ * Sets *index to the index value if successful.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetIndexFromToken(
+ Tcl_Token *tokenPtr,
+ int *index)
+{
+ Tcl_Obj *tmpObj = Tcl_NewObj();
+ int result, idx;
+
+ if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+ Tcl_DecrRefCount(tmpObj);
+ return TCL_ERROR;
+ }
+
+ result = TclGetIntFromObj(NULL, tmpObj, &idx);
+ if (result == TCL_OK) {
+ if (idx < 0) {
+ result = TCL_ERROR;
+ }
+ } else {
+ result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
+ if (result == TCL_OK && idx > INDEX_END) {
+ result = TCL_ERROR;
+ }
+ }
+ Tcl_DecrRefCount(tmpObj);
+
+ if (result == TCL_OK) {
+ *index = idx;
+ }
+
+ return result;
+}
/*
*----------------------------------------------------------------------
@@ -1029,7 +1081,7 @@ TclCompileLassignCmd(
*/
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
- TclEmitInt4( -2 /* == "end" */, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
return TCL_OK;
}
@@ -1062,7 +1114,7 @@ TclCompileLindexCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *idxTokenPtr, *valTokenPtr;
- int i, numWords = parsePtr->numWords;
+ int i, idx, numWords = parsePtr->numWords;
DefineLineInformation; /* TIP #280 */
/*
@@ -1080,46 +1132,28 @@ TclCompileLindexCmd(
}
idxTokenPtr = TokenAfter(valTokenPtr);
- if (idxTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- Tcl_Obj *tmpObj;
- int idx, result;
-
- tmpObj = Tcl_NewStringObj(idxTokenPtr[1].start, idxTokenPtr[1].size);
- result = TclGetIntFromObj(NULL, tmpObj, &idx);
- if (result == TCL_OK) {
- if (idx < 0) {
- result = TCL_ERROR;
- }
- } else {
- result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx);
- if (result == TCL_OK && idx > -2) {
- result = TCL_ERROR;
- }
- }
- TclDecrRefCount(tmpObj);
-
- if (result == TCL_OK) {
- /*
- * All checks have been completed, and we have exactly one of
- * these constructs:
- * lindex <arbitraryValue> <posInt>
- * lindex <arbitraryValue> end-<posInt>
- * This is best compiled as a push of the arbitrary value followed
- * by an "immediate lindex" which is the most efficient variety.
- */
-
- CompileWord(envPtr, valTokenPtr, interp, 1);
- TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr);
- return TCL_OK;
- }
-
+ if (GetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) {
/*
- * If the conversion failed or the value was negative, we just keep on
- * going with the more complex compilation.
+ * All checks have been completed, and we have exactly one of these
+ * constructs:
+ * lindex <arbitraryValue> <posInt>
+ * lindex <arbitraryValue> end-<posInt>
+ * This is best compiled as a push of the arbitrary value followed by
+ * an "immediate lindex" which is the most efficient variety.
*/
+
+ CompileWord(envPtr, valTokenPtr, interp, 1);
+ TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr);
+ return TCL_OK;
}
/*
+ * If the value was not known at compile time, the conversion failed or
+ * the value was negative, we just keep on going with the more complex
+ * compilation.
+ */
+
+ /*
* Push the operands onto the stack.
*/
@@ -1265,7 +1299,7 @@ TclCompileListCmd(
if (concat && numWords == 2) {
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
- TclEmitInt4( -2, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
}
return TCL_OK;
}
@@ -1332,8 +1366,7 @@ TclCompileLrangeCmd(
{
Tcl_Token *tokenPtr, *listTokenPtr;
DefineLineInformation; /* TIP #280 */
- Tcl_Obj *tmpObj;
- int idx1, idx2, result;
+ int idx1, idx2;
if (parsePtr->numWords != 4) {
return TCL_ERROR;
@@ -1341,56 +1374,18 @@ TclCompileLrangeCmd(
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
- * Parse the first index. Will only compile if it is constant and not an
+ * Parse the indices. Will only compile if both are constants and not an
* _integer_ less than zero (since we reserve negative indices here for
- * end-relative indexing).
+ * end-relative indexing) or an end-based index greater than 'end' itself.
*/
tokenPtr = TokenAfter(listTokenPtr);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
return TCL_ERROR;
}
- tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
- 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);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
- }
- tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
- 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) {
+ if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
return TCL_ERROR;
}
@@ -1409,19 +1404,16 @@ TclCompileLrangeCmd(
/*
*----------------------------------------------------------------------
*
- * TclCompileLreplaceCmd --
+ * TclCompileLinsertCmd --
*
- * How to compile the "lreplace" command. We only bother with the case
- * where there are no elements to insert and where both the 'first' and
- * 'last' arguments are constant and one can be deterined to be at the
- * end of the list. (This is the case that could also be written with
- * "lrange".)
+ * How to compile the "linsert" command. We only bother with the case
+ * where the index is constant.
*
*----------------------------------------------------------------------
*/
int
-TclCompileLreplaceCmd(
+TclCompileLinsertCmd(
Tcl_Interp *interp, /* Tcl interpreter for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
@@ -1431,101 +1423,272 @@ TclCompileLreplaceCmd(
{
Tcl_Token *tokenPtr, *listTokenPtr;
DefineLineInformation; /* TIP #280 */
- Tcl_Obj *tmpObj;
- int idx1, idx2, result, guaranteedDropAll = 0;
+ int idx, i;
- if (parsePtr->numWords != 4) {
+ if (parsePtr->numWords < 3) {
return TCL_ERROR;
}
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
- * Parse the first index. Will only compile if it is constant and not an
+ * Parse the 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).
+ * end-relative indexing) or an end-based index greater than 'end' itself.
*/
tokenPtr = TokenAfter(listTokenPtr);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ if (GetIndexFromToken(tokenPtr, &idx) != TCL_OK) {
return TCL_ERROR;
}
- tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
- result = TclGetIntFromObj(NULL, tmpObj, &idx1);
- if (result == TCL_OK) {
- if (idx1 < 0) {
- result = TCL_ERROR;
- }
+
+ /*
+ * There are four main cases. If there are no values to insert, this is
+ * just a confirm-listiness check. If the index is '0', this is a prepend.
+ * If the index is 'end' (== INDEX_END), this is an append. Otherwise,
+ * this is a splice (== split, insert values as list, concat-3).
+ */
+
+ CompileWord(envPtr, listTokenPtr, interp, 1);
+ if (parsePtr->numWords == 3) {
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ return TCL_OK;
+ }
+
+ for (i=3 ; i<parsePtr->numWords ; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+ TclEmitInstInt4( INST_LIST, i-3, envPtr);
+
+ if (idx == 0 /*start*/) {
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ } else if (idx == INDEX_END /*end*/) {
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
} else {
- result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1);
- if (result == TCL_OK && idx1 > -2) {
- result = TCL_ERROR;
+ if (idx < 0) {
+ idx++;
}
+ TclEmitInstInt4( INST_OVER, 1, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( idx-1, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 3, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
}
- TclDecrRefCount(tmpObj);
- if (result != TCL_OK) {
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLreplaceCmd --
+ *
+ * How to compile the "lreplace" command. We only bother with the case
+ * where the indices are constant.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLreplaceCmd(
+ Tcl_Interp *interp, /* Tcl interpreter for context. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the
+ * command. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds the resulting instructions. */
+{
+ Tcl_Token *tokenPtr, *listTokenPtr;
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Obj *tmpObj;
+ int idx1, idx2, i, offset;
+
+ if (parsePtr->numWords < 4) {
return TCL_ERROR;
}
+ listTokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
- * Parse the second index. Will only compile if it is constant and not an
+ * Parse the indices. Will only compile if both are constants and not an
* _integer_ less than zero (since we reserve negative indices here for
- * end-relative indexing).
+ * end-relative indexing) or an end-based index greater than 'end' itself.
*/
- tokenPtr = TokenAfter(tokenPtr);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ tokenPtr = TokenAfter(listTokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
return TCL_ERROR;
}
- tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
- 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) {
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
return TCL_ERROR;
}
/*
- * Sanity check: can only issue when we're removing a range at one or
- * other end of the list. If we're at one end or the other, convert the
- * indices into the equivalent for an [lrange].
+ * Work out what this [lreplace] is actually doing.
*/
+ tmpObj = NULL;
+ CompileWord(envPtr, listTokenPtr, interp, 1);
+ if (parsePtr->numWords == 4) {
+ if (idx1 == 0) {
+ if (idx2 == INDEX_END) {
+ goto dropAll;
+ }
+ idx1 = idx2 + 1;
+ idx2 = INDEX_END;
+ goto dropEnd;
+ } else if (idx2 == INDEX_END) {
+ idx2 = idx1 - 1;
+ idx1 = 0;
+ goto dropEnd;
+ } else {
+ if (idx1 > 0) {
+ tmpObj = Tcl_NewIntObj(idx1);
+ Tcl_IncrRefCount(tmpObj);
+ }
+ goto dropRange;
+ }
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ for (i=4 ; i<parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ TclEmitInstInt4( INST_LIST, i - 4, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
if (idx1 == 0) {
- if (idx2 == -2) {
- guaranteedDropAll = 1;
+ if (idx2 == INDEX_END) {
+ goto replaceAll;
}
idx1 = idx2 + 1;
- idx2 = -2;
- } else if (idx2 == -2) {
+ idx2 = INDEX_END;
+ goto replaceHead;
+ } else if (idx2 == INDEX_END) {
idx2 = idx1 - 1;
idx1 = 0;
+ goto replaceTail;
} else {
- return TCL_ERROR;
+ if (idx1 > 0 && idx2 > 0 && idx2 < idx1) {
+ idx2 = idx1 - 1;
+ } else if (idx1 < 0 && idx2 < 0 && idx2 < idx1) {
+ idx2 = idx1 - 1;
+ }
+ if (idx1 > 0) {
+ tmpObj = Tcl_NewIntObj(idx1);
+ Tcl_IncrRefCount(tmpObj);
+ }
+ goto replaceRange;
}
/*
- * Issue instructions. It's not safe to skip doing the LIST_RANGE, as
- * we've not proved that the 'list' argument is really a list. Not that it
- * is worth trying to do that given current knowledge.
+ * Issue instructions to perform the operations relating to configurations
+ * that just drop. The only argument pushed on the stack is the list to
+ * operate on.
*/
- CompileWord(envPtr, listTokenPtr, interp, 1);
- if (guaranteedDropAll) {
+ dropAll:
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ PushStringLiteral(envPtr, "");
+ goto done;
+
+ dropEnd:
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
+ TclEmitInt4( idx2, envPtr);
+ goto done;
+
+ dropRange:
+ if (tmpObj != NULL) {
+ TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- PushStringLiteral(envPtr, "");
- } else {
- TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
- TclEmitInt4( idx2, envPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
+ TclEmitOpcode( INST_GT, envPtr);
+ offset = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
+ "list doesn't contain element %d", idx1), NULL), envPtr);
+ CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
+ Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
+ envPtr->codeStart + offset + 1);
+ TclAdjustStackDepth(-1, envPtr);
+ }
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( idx1 - 1, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ goto done;
+
+ /*
+ * Issue instructions to perform the operations relating to configurations
+ * that do real replacement. All arguments are pushed and assembled into a
+ * pair: the list of values to replace with, and the list to do the
+ * surgery on.
+ */
+
+ replaceAll:
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ goto done;
+
+ replaceHead:
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
+ TclEmitInt4( idx2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ goto done;
+
+ replaceTail:
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
+ TclEmitInt4( idx2, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ goto done;
+
+ replaceRange:
+ if (tmpObj != NULL) {
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
+ TclEmitOpcode( INST_GT, envPtr);
+ offset = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
+ "list doesn't contain element %d", idx1), NULL), envPtr);
+ CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
+ Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
+ envPtr->codeStart + offset + 1);
+ TclAdjustStackDepth(-1, envPtr);
+ }
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( idx1 - 1, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 3, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ goto done;
+
+ /*
+ * Clean up the allocated memory.
+ */
+
+ done:
+ if (tmpObj != NULL) {
+ Tcl_DecrRefCount(tmpObj);
}
return TCL_OK;
}
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 3e4a55a..110476e 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -101,6 +101,59 @@ const AuxDataType tclJumptableInfoType = {
if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
#define INVOKE(name) \
TclEmitInvoke(envPtr,INST_##name)
+
+#define INDEX_END (-2)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromToken --
+ *
+ * Parse a token and get the encoded version of the index (as understood
+ * by TEBC), assuming it is at all knowable at compile time. Only handles
+ * indices that are integers or 'end' or 'end-integer'.
+ *
+ * Returns:
+ * TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
+ *
+ * Side effects:
+ * Sets *index to the index value if successful.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetIndexFromToken(
+ Tcl_Token *tokenPtr,
+ int *index)
+{
+ Tcl_Obj *tmpObj = Tcl_NewObj();
+ int result, idx;
+
+ if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+ Tcl_DecrRefCount(tmpObj);
+ return TCL_ERROR;
+ }
+
+ result = TclGetIntFromObj(NULL, tmpObj, &idx);
+ if (result == TCL_OK) {
+ if (idx < 0) {
+ result = TCL_ERROR;
+ }
+ } else {
+ result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
+ if (result == TCL_OK && idx > INDEX_END) {
+ result = TCL_ERROR;
+ }
+ }
+ Tcl_DecrRefCount(tmpObj);
+
+ if (result == TCL_OK) {
+ *index = idx;
+ }
+
+ return result;
+}
/*
*----------------------------------------------------------------------
@@ -565,8 +618,7 @@ TclCompileStringRangeCmd(
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr;
- Tcl_Obj *tmpObj;
- int idx1, idx2, result;
+ int idx1, idx2;
if (parsePtr->numWords != 4) {
return TCL_ERROR;
@@ -576,50 +628,13 @@ TclCompileStringRangeCmd(
toTokenPtr = TokenAfter(fromTokenPtr);
/*
- * 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).
+ * Parse the two indices.
*/
- tmpObj = Tcl_NewObj();
- result = TCL_ERROR;
- if (TclWordKnownAtCompileTime(fromTokenPtr, tmpObj)) {
- if (TclGetIntFromObj(NULL, tmpObj, &idx1) == TCL_OK) {
- if (idx1 >= 0) {
- result = TCL_OK;
- }
- } else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx1) == TCL_OK) {
- if (idx1 <= -2) {
- result = TCL_OK;
- }
- }
- }
- TclDecrRefCount(tmpObj);
- if (result != TCL_OK) {
+ if (GetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) {
goto nonConstantIndices;
}
-
- /*
- * 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).
- */
-
- tmpObj = Tcl_NewObj();
- result = TCL_ERROR;
- if (TclWordKnownAtCompileTime(toTokenPtr, tmpObj)) {
- if (TclGetIntFromObj(NULL, tmpObj, &idx2) == TCL_OK) {
- if (idx2 >= 0) {
- result = TCL_OK;
- }
- } else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx2) == TCL_OK) {
- if (idx2 <= -2) {
- result = TCL_OK;
- }
- }
- }
- TclDecrRefCount(tmpObj);
- if (result != TCL_OK) {
+ if (GetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) {
goto nonConstantIndices;
}
@@ -642,6 +657,303 @@ TclCompileStringRangeCmd(
OP( STR_RANGE);
return TCL_OK;
}
+
+int
+TclCompileStringReplaceCmd(
+ Tcl_Interp *interp, /* Tcl interpreter for context. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the
+ * command. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds the resulting instructions. */
+{
+ Tcl_Token *tokenPtr, *valueTokenPtr, *replacementTokenPtr = NULL;
+ DefineLineInformation; /* TIP #280 */
+ int idx1, idx2;
+
+ if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
+ return TCL_ERROR;
+ }
+ valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (parsePtr->numWords == 5) {
+ tokenPtr = TokenAfter(valueTokenPtr);
+ tokenPtr = TokenAfter(tokenPtr);
+ replacementTokenPtr = TokenAfter(tokenPtr);
+ }
+
+ /*
+ * Parse the indices. Will only compile special cases if both are
+ * constants and not an _integer_ less than zero (since we reserve
+ * negative indices here for end-relative indexing) or an end-based index
+ * greater than 'end' itself.
+ */
+
+ tokenPtr = TokenAfter(valueTokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
+ goto genericReplace;
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
+ goto genericReplace;
+ }
+
+ /*
+ * We handle these replacements specially: first character (where
+ * idx1=idx2=0) and suffixes (where idx1=idx2=INDEX_END). Anything else
+ * and the semantics get rather screwy.
+ */
+
+ if (idx1 == 0 && idx2 == 0) {
+ int notEq, end;
+
+ /*
+ * Just working with the first character.
+ */
+
+ CompileWord(envPtr, valueTokenPtr, interp, 1);
+ if (replacementTokenPtr == NULL) {
+ /* Drop first */
+ OP44( STR_RANGE_IMM, 1, INDEX_END);
+ return TCL_OK;
+ }
+ /* Replace first */
+ CompileWord(envPtr, replacementTokenPtr, interp, 4);
+ OP4( OVER, 1);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP_FALSE, notEq);
+ OP( POP);
+ JUMP1( JUMP, end);
+ FIXJUMP1(notEq);
+ TclAdjustStackDepth(1, envPtr);
+ OP4( REVERSE, 2);
+ OP44( STR_RANGE_IMM, 1, INDEX_END);
+ OP1( STR_CONCAT1, 2);
+ FIXJUMP1(end);
+ return TCL_OK;
+
+ } else if (idx1 == INDEX_END && idx2 == INDEX_END) {
+ int notEq, end;
+
+ /*
+ * Just working with the last character.
+ */
+
+ CompileWord(envPtr, valueTokenPtr, interp, 1);
+ if (replacementTokenPtr == NULL) {
+ /* Drop last */
+ OP44( STR_RANGE_IMM, 0, INDEX_END-1);
+ return TCL_OK;
+ }
+ /* Replace last */
+ CompileWord(envPtr, replacementTokenPtr, interp, 4);
+ OP4( OVER, 1);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP_FALSE, notEq);
+ OP( POP);
+ JUMP1( JUMP, end);
+ FIXJUMP1(notEq);
+ TclAdjustStackDepth(1, envPtr);
+ OP4( REVERSE, 2);
+ OP44( STR_RANGE_IMM, 0, INDEX_END-1);
+ OP4( REVERSE, 2);
+ OP1( STR_CONCAT1, 2);
+ FIXJUMP1(end);
+ return TCL_OK;
+
+ } else {
+ /*
+ * Too complicated to optimize, but we know the number of arguments is
+ * correct so we can issue a call of the "standard" implementation.
+ */
+
+ genericReplace:
+ return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+}
+
+/*
+ * Synch with tclCmdMZ.c
+ */
+
+#define DEFAULT_TRIM_SET \
+ "\x09\x0a\x0b\x0c\x0d " /* ASCII */\
+ "\xc0\x80" /* nul (U+0000) */\
+ "\xc2\x85" /* next line (U+0085) */\
+ "\xc2\xa0" /* non-breaking space (U+00a0) */\
+ "\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
+ "\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
+ "\xe2\x80\x80" /* en quad (U+2000) */\
+ "\xe2\x80\x81" /* em quad (U+2001) */\
+ "\xe2\x80\x82" /* en space (U+2002) */\
+ "\xe2\x80\x83" /* em space (U+2003) */\
+ "\xe2\x80\x84" /* three-per-em space (U+2004) */\
+ "\xe2\x80\x85" /* four-per-em space (U+2005) */\
+ "\xe2\x80\x86" /* six-per-em space (U+2006) */\
+ "\xe2\x80\x87" /* figure space (U+2007) */\
+ "\xe2\x80\x88" /* punctuation space (U+2008) */\
+ "\xe2\x80\x89" /* thin space (U+2009) */\
+ "\xe2\x80\x8a" /* hair space (U+200a) */\
+ "\xe2\x80\x8b" /* zero width space (U+200b) */\
+ "\xe2\x80\xa8" /* line separator (U+2028) */\
+ "\xe2\x80\xa9" /* paragraph separator (U+2029) */\
+ "\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
+ "\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
+ "\xe2\x81\xa0" /* word joiner (U+2060) */\
+ "\xe3\x80\x80" /* ideographic space (U+3000) */\
+ "\xef\xbb\xbf" /* zero width no-break space (U+feff) */
+
+int
+TclCompileStringTrimLCmd(
+ 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;
+
+ if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ if (parsePtr->numWords == 3) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ } else {
+ PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+ }
+ OP( STR_TRIM_LEFT);
+ return TCL_OK;
+}
+
+int
+TclCompileStringTrimRCmd(
+ 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;
+
+ if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ if (parsePtr->numWords == 3) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ } else {
+ PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+ }
+ OP( STR_TRIM_RIGHT);
+ return TCL_OK;
+}
+
+int
+TclCompileStringTrimCmd(
+ 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;
+
+ if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ if (parsePtr->numWords == 3) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ } else {
+ PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+ }
+ OP( STR_TRIM);
+ return TCL_OK;
+}
+
+int
+TclCompileStringToUpperCmd(
+ 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;
+
+ if (parsePtr->numWords != 2) {
+ return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ OP( STR_UPPER);
+ return TCL_OK;
+}
+
+int
+TclCompileStringToLowerCmd(
+ 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;
+
+ if (parsePtr->numWords != 2) {
+ return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ OP( STR_LOWER);
+ return TCL_OK;
+}
+
+int
+TclCompileStringToTitleCmd(
+ 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;
+
+ if (parsePtr->numWords != 2) {
+ return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ OP( STR_TITLE);
+ return TCL_OK;
+}
/*
*----------------------------------------------------------------------
@@ -752,7 +1064,7 @@ TclSubstCompile(
/*
* Tricky point! If the first token does not result in a *guaranteed* push
* of a Tcl_Obj on the stack, we must push an empty object. Otherwise it
- * is possible to get to an INST_CONCAT1 or INST_DONE without enough
+ * is possible to get to an INST_STR_CONCAT1 or INST_DONE without enough
* values on the stack, resulting in a crash. Thanks to Joe Mistachkin for
* identifying a script that could trigger this case.
*/
@@ -817,11 +1129,11 @@ TclSubstCompile(
}
while (count > 255) {
- OP1( CONCAT1, 255);
+ OP1( STR_CONCAT1, 255);
count -= 254;
}
if (count > 1) {
- OP1( CONCAT1, count);
+ OP1( STR_CONCAT1, count);
count = 1;
}
@@ -941,7 +1253,7 @@ TclSubstCompile(
(int) (CurrentOffset(envPtr) - okFixup.codeOffset));
}
if (count > 1) {
- OP1(CONCAT1, count);
+ OP1(STR_CONCAT1, count);
count = 1;
}
@@ -954,11 +1266,11 @@ TclSubstCompile(
}
while (count > 255) {
- OP1( CONCAT1, 255);
+ OP1( STR_CONCAT1, 255);
count -= 254;
}
if (count > 1) {
- OP1( CONCAT1, count);
+ OP1( STR_CONCAT1, count);
}
Tcl_FreeParse(&parse);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index f3e9db3..db97c45 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -63,7 +63,7 @@ InstructionDesc const tclInstructionTable[] = {
/* Pop the topmost stack object */
{"dup", 1, +1, 0, {OPERAND_NONE}},
/* Duplicate the topmost stack object and push the result */
- {"concat1", 2, INT_MIN, 1, {OPERAND_UINT1}},
+ {"strcat", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Concatenate the top op1 items and push result */
{"invokeStk1", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
@@ -546,15 +546,66 @@ InstructionDesc const tclInstructionTable[] = {
* until the matching stack depth is reached. */
/* New foreach implementation */
- {"foreach_start", 5, +2, 1, {OPERAND_AUX4}},
+ {"foreach_start", 5, +2, 1, {OPERAND_AUX4}},
/* Initialize execution of a foreach loop. Operand is aux data index
* of the ForeachInfo structure for the foreach command. It pushes 2
* elements which hold runtime params for foreach_step, they are later
- * dropped by foreach_end together with the value lists. */
- {"foreach_step", 1, 0, 0, {OPERAND_NONE}},
- /* "Step" or begin next iteration of foreach loop. */
- {"foreach_end", 1, 0, 0, {OPERAND_NONE}},
- {"lmap_collect", 1, -1, 0, {OPERAND_NONE}},
+ * dropped by foreach_end together with the value lists. NOTE that the
+ * iterator-tracker and info reference must not be passed to bytecodes
+ * that handle normal Tcl values. NOTE that this instruction jumps to
+ * the foreach_step instruction paired with it; the stack info below
+ * is only nominal.
+ * Stack: ... listObjs... => ... listObjs... iterTracker info */
+ {"foreach_step", 1, 0, 0, {OPERAND_NONE}},
+ /* "Step" or begin next iteration of foreach loop. Assigns to foreach
+ * iteration variables. May jump to straight after the foreach_start
+ * that pushed the iterTracker and info values. MUST be followed
+ * immediately by a foreach_end.
+ * Stack: ... listObjs... iterTracker info =>
+ * ... listObjs... iterTracker info */
+ {"foreach_end", 1, 0, 0, {OPERAND_NONE}},
+ /* Clean up a foreach loop by dropping the info value, the tracker
+ * value and the lists that were being iterated over.
+ * Stack: ... listObjs... iterTracker info => ... */
+ {"lmap_collect", 1, -1, 0, {OPERAND_NONE}},
+ /* Appends the value at the top of the stack to the list located on
+ * the stack the "other side" of the foreach-related values.
+ * Stack: ... collector listObjs... iterTracker info value =>
+ * ... collector listObjs... iterTracker info */
+
+ {"strtrim", 1, -1, 0, {OPERAND_NONE}},
+ /* [string trim] core: removes the characters (designated by the value
+ * at the top of the stack) from both ends of the string and pushes
+ * the resulting string.
+ * Stack: ... string charset => ... trimmedString */
+ {"strtrimLeft", 1, -1, 0, {OPERAND_NONE}},
+ /* [string trimleft] core: removes the characters (designated by the
+ * value at the top of the stack) from the left of the string and
+ * pushes the resulting string.
+ * Stack: ... string charset => ... trimmedString */
+ {"strtrimRight", 1, -1, 0, {OPERAND_NONE}},
+ /* [string trimright] core: removes the characters (designated by the
+ * value at the top of the stack) from the right of the string and
+ * pushes the resulting string.
+ * Stack: ... string charset => ... trimmedString */
+
+ {"concatStk", 5, INT_MIN, 1, {OPERAND_UINT4}},
+ /* Wrapper round Tcl_ConcatObj(), used for [concat] and [eval]. opnd
+ * is number of values to concatenate.
+ * Operation: push concat(stk1 stk2 ... stktop) */
+
+ {"strUpper", 1, 0, 0, {OPERAND_NONE}},
+ /* [string toupper] core: converts whole string to upper case using
+ * the default (extended "C" locale) rules.
+ * Stack: ... string => ... newString */
+ {"strLower", 1, 0, 0, {OPERAND_NONE}},
+ /* [string tolower] core: converts whole string to upper case using
+ * the default (extended "C" locale) rules.
+ * Stack: ... string => ... newString */
+ {"strTitle", 1, 0, 0, {OPERAND_NONE}},
+ /* [string totitle] core: converts whole string to upper case using
+ * the default (extended "C" locale) rules.
+ * Stack: ... string => ... newString */
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
@@ -2407,11 +2458,11 @@ TclCompileTokens(
*/
while (numObjsToConcat > 255) {
- TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
numObjsToConcat -= 254; /* concat pushes 1 obj, the result */
}
if (numObjsToConcat > 1) {
- TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, numObjsToConcat, envPtr);
}
/*
@@ -2543,11 +2594,11 @@ TclCompileExprWords(
}
concatItems = 2*numWords - 1;
while (concatItems > 255) {
- TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
concatItems -= 254;
}
if (concatItems > 1) {
- TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, concatItems, envPtr);
}
TclEmitOpcode(INST_EXPR_STK, envPtr);
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index b3c8442..6226f7f 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -512,7 +512,7 @@ typedef struct ByteCode {
#define INST_PUSH4 2
#define INST_POP 3
#define INST_DUP 4
-#define INST_CONCAT1 5
+#define INST_STR_CONCAT1 5
#define INST_INVOKE_STK1 6
#define INST_INVOKE_STK4 7
#define INST_EVAL_STK 8
@@ -769,14 +769,24 @@ typedef struct ByteCode {
#define INST_EXPAND_DROP 165
/* New foreach implementation */
-
#define INST_FOREACH_START 166
#define INST_FOREACH_STEP 167
#define INST_FOREACH_END 168
#define INST_LMAP_COLLECT 169
+/* For compilation of [string trim] and related */
+#define INST_STR_TRIM 170
+#define INST_STR_TRIM_LEFT 171
+#define INST_STR_TRIM_RIGHT 172
+
+#define INST_CONCAT_STK 173
+
+#define INST_STR_UPPER 174
+#define INST_STR_LOWER 175
+#define INST_STR_TITLE 176
+
/* The last opcode */
-#define LAST_INST_OPCODE 169
+#define LAST_INST_OPCODE 176
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 9261f19..73f388b 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2563,7 +2563,7 @@ TEBCresume(
NEXT_INST_F(5, 0, 0);
}
- case INST_CONCAT1: {
+ case INST_STR_CONCAT1: {
int appendLen = 0;
char *bytes, *p;
Tcl_Obj **currPtr;
@@ -2712,6 +2712,17 @@ TEBCresume(
NEXT_INST_V(2, opnd, 1);
}
+ case INST_CONCAT_STK:
+ /*
+ * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
+ * and then decrement their ref counts.
+ */
+
+ opnd = TclGetUInt4AtPtr(pc+1);
+ objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1));
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+ NEXT_INST_V(5, opnd, 1);
+
case INST_EXPAND_START:
/*
* Push an element to the auxObjList. This records the current
@@ -4991,6 +5002,55 @@ TEBCresume(
TRACE(("%.20s => %d\n", O2S(valuePtr), length));
NEXT_INST_F(1, 1, 1);
+ case INST_STR_UPPER:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.25s\" => ", O2S(valuePtr)));
+ if (Tcl_IsShared(valuePtr)) {
+ s1 = TclGetStringFromObj(valuePtr, &length);
+ TclNewStringObj(objResultPtr, s1, length);
+ length = Tcl_UtfToUpper(TclGetString(objResultPtr));
+ Tcl_SetObjLength(objResultPtr, length);
+ TRACE_APPEND(("\"%.25s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ length = Tcl_UtfToUpper(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, length);
+ TRACE_APPEND(("\"%.25s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+ case INST_STR_LOWER:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.25s\" => ", O2S(valuePtr)));
+ if (Tcl_IsShared(valuePtr)) {
+ s1 = TclGetStringFromObj(valuePtr, &length);
+ TclNewStringObj(objResultPtr, s1, length);
+ length = Tcl_UtfToLower(TclGetString(objResultPtr));
+ Tcl_SetObjLength(objResultPtr, length);
+ TRACE_APPEND(("\"%.25s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ length = Tcl_UtfToLower(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, length);
+ TRACE_APPEND(("\"%.25s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+ case INST_STR_TITLE:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.25s\" => ", O2S(valuePtr)));
+ if (Tcl_IsShared(valuePtr)) {
+ s1 = TclGetStringFromObj(valuePtr, &length);
+ TclNewStringObj(objResultPtr, s1, length);
+ length = Tcl_UtfToTitle(TclGetString(objResultPtr));
+ Tcl_SetObjLength(objResultPtr, length);
+ TRACE_APPEND(("\"%.25s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ length = Tcl_UtfToTitle(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, length);
+ TRACE_APPEND(("\"%.25s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+
case INST_STR_INDEX:
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
@@ -5256,6 +5316,65 @@ TEBCresume(
objResultPtr = TCONST(match);
NEXT_INST_F(0, 2, 1);
+ {
+ const char *string1, *string2;
+ int trim1, trim2;
+
+ case INST_STR_TRIM:
+ valuePtr = OBJ_UNDER_TOS; /* String */
+ value2Ptr = OBJ_AT_TOS; /* TrimSet */
+ string2 = TclGetStringFromObj(value2Ptr, &length2);
+ string1 = TclGetStringFromObj(valuePtr, &length);
+ trim1 = TclTrimLeft(string1, length, string2, length2);
+ if (trim1 < length) {
+ trim2 = TclTrimRight(string1, length, string2, length2);
+ } else {
+ trim2 = 0;
+ }
+ if (trim1 == 0 && trim2 == 0) {
+ TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
+ O2S(valuePtr), O2S(value2Ptr)), valuePtr);
+ NEXT_INST_F(1, 1, 0);
+ } else {
+ objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2);
+ TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
+ O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
+ NEXT_INST_F(1, 2, 1);
+ }
+ case INST_STR_TRIM_LEFT:
+ valuePtr = OBJ_UNDER_TOS; /* String */
+ value2Ptr = OBJ_AT_TOS; /* TrimSet */
+ string2 = TclGetStringFromObj(value2Ptr, &length2);
+ string1 = TclGetStringFromObj(valuePtr, &length);
+ trim1 = TclTrimLeft(string1, length, string2, length2);
+ if (trim1 == 0) {
+ TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
+ O2S(valuePtr), O2S(value2Ptr)), valuePtr);
+ NEXT_INST_F(1, 1, 0);
+ } else {
+ objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1);
+ TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
+ O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
+ NEXT_INST_F(1, 2, 1);
+ }
+ case INST_STR_TRIM_RIGHT:
+ valuePtr = OBJ_UNDER_TOS; /* String */
+ value2Ptr = OBJ_AT_TOS; /* TrimSet */
+ string2 = TclGetStringFromObj(value2Ptr, &length2);
+ string1 = TclGetStringFromObj(valuePtr, &length);
+ trim2 = TclTrimRight(string1, length, string2, length2);
+ if (trim2 == 0) {
+ TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
+ O2S(valuePtr), O2S(value2Ptr)), valuePtr);
+ NEXT_INST_F(1, 1, 0);
+ } else {
+ objResultPtr = Tcl_NewStringObj(string1, length-trim2);
+ TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
+ O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
+ NEXT_INST_F(1, 2, 1);
+ }
+ }
+
case INST_REGEXP:
cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
valuePtr = OBJ_AT_TOS; /* String */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 8ccfadb..1ad32df 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3442,6 +3442,9 @@ MODULE_SCOPE int TclCompileBreakCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileConcatCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileContinueCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3541,6 +3544,9 @@ MODULE_SCOPE int TclCompileLassignCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileLindexCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileLinsertCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileListCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3622,6 +3628,27 @@ MODULE_SCOPE int TclCompileStringMatchCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileStringRangeCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringReplaceCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringToLowerCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringToTitleCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringToUpperCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringTrimCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringTrimLCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringTrimRCmd(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);
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
index 74de7a3..827d89d 100644
--- a/generic/tclOptimize.c
+++ b/generic/tclOptimize.c
@@ -191,7 +191,7 @@ TrimUnreachable(
* ConvertZeroEffectToNOP --
*
* Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also
- * replace PUSH empty/CONCAT and TRY_CVT_NUMERIC (when followed by an
+ * replace PUSH empty/STR_CONCAT and TRY_CVT_NUMERIC (when followed by an
* operation that guarantees the check for arithmeticity) and eliminate
* LNOT when we can invert the following JUMP condition.
*
@@ -227,7 +227,7 @@ ConvertZeroEffectToNOP(
case INST_PUSH1:
if (nextInst == INST_POP) {
blank = size + InstLength(nextInst);
- } else if (nextInst == INST_CONCAT1
+ } else if (nextInst == INST_STR_CONCAT1
&& TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
TclGetUInt1AtPtr(currentInstPtr + 1));
@@ -242,7 +242,7 @@ ConvertZeroEffectToNOP(
case INST_PUSH4:
if (nextInst == INST_POP) {
blank = size + 1;
- } else if (nextInst == INST_CONCAT1
+ } else if (nextInst == INST_STR_CONCAT1
&& TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
TclGetUInt4AtPtr(currentInstPtr + 1));
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 883e2ea..883e2ea 100644..100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
diff --git a/generic/tclStubLibTbl.c b/generic/tclStubLibTbl.c
deleted file mode 100644
index 0391502..0000000
--- a/generic/tclStubLibTbl.c
+++ /dev/null
@@ -1,58 +0,0 @@
-/*
- * tclStubLibTbl.c --
- *
- * Stub object that will be statically linked into extensions that want
- * to access Tcl.
- *
- * Copyright (c) 1998-1999 by Scriptics Corporation.
- * Copyright (c) 1998 Paul Duffin.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInitStubTable --
- *
- * Initialize the stub table, using the structure pointed at
- * by the "version" argument.
- *
- * Results:
- * Outputs the value of the "version" argument.
- *
- * Side effects:
- * Sets the stub table pointers.
- *
- *----------------------------------------------------------------------
- */
-MODULE_SCOPE const char *
-TclInitStubTable(
- const char *version) /* points to the version field of a
- TclStubInfoType structure variable. */
-{
- tclStubsPtr = ((const TclStubInfoType *) version)->stubs;
-
- if (tclStubsPtr->hooks) {
- tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
- tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
- tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
- } else {
- tclPlatStubsPtr = NULL;
- tclIntStubsPtr = NULL;
- tclIntPlatStubsPtr = NULL;
- }
-
- return version;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */