summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclBasic.c1
-rw-r--r--generic/tclCompCmdsGR.c69
-rw-r--r--generic/tclCompile.c2
-rw-r--r--generic/tclCompile.h6
-rw-r--r--generic/tclExecute.c66
-rw-r--r--generic/tclInt.h3
6 files changed, 140 insertions, 7 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 13715f8..c9697d2 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -312,6 +312,7 @@ static const CmdInfo builtInCmds[] = {
{"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE},
{"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE},
{"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE},
+ {"xx", Tcl_LinsertObjCmd, TclCompileXxCmd, 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/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index bce71dc..4aa454b 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -3024,6 +3024,75 @@ TclCompileObjectSelfCmd(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileXxCmd --
+ *
+ * How to compile the "linsert2" command. We only bother with the case
+ * where the index is constant.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileXxCmd(
+ Tcl_Interp *interp, /* Tcl interpreter for context. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the
+ * command. */
+ TCL_UNUSED(Command *),
+ CompileEnv *envPtr) /* Holds the resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr, *listTokenPtr;
+ int idx, i;
+
+ if (parsePtr->numWords < 3) {
+ return TCL_ERROR;
+ }
+ listTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ /*
+ * 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) or an end-based index greater than 'end' itself.
+ */
+
+ tokenPtr = TokenAfter(listTokenPtr);
+
+ /*
+ * NOTE: This command treats all inserts at indices before the list
+ * the same as inserts at the start of the list, and all inserts
+ * after the list the same as inserts at the end of the list. We
+ * make that transformation here so we can use the optimized bytecode
+ * as much as possible.
+ */
+ if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_END,
+ &idx) != TCL_OK) {
+ return 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' (== TCL_INDEX_END), this is an append. Otherwise,
+ * this is a splice (== split, insert values as list, concat-3).
+ */
+
+ CompileWord(envPtr, listTokenPtr, interp, 1);
+
+ for (i=3 ; i<parsePtr->numWords ; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+
+ TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 2, envPtr);
+ TclEmitInt4(idx, envPtr);
+ TclEmitInt4(idx-1, envPtr);
+
+ return TCL_OK;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 2d22dc1..2535167 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -675,6 +675,8 @@ InstructionDesc const tclInstructionTable[] = {
/* String Less or equal: push (stknext <= stktop) */
{"strge", 1, -1, 0, {OPERAND_NONE}},
/* String Greater or equal: push (stknext >= stktop) */
+ {"lreplace4", 13, INT_MIN, 3, {OPERAND_UINT4, OPERAND_INT4, OPERAND_INT4}},
+ /* Stack: ... listobj num_elems first last new1 ... newN => ... newlistobj */
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 2843ef5..c82dc6e 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -848,8 +848,10 @@ typedef struct ByteCode {
#define INST_STR_LE 193
#define INST_STR_GE 194
+#define INST_LREPLACE4 195
+
/* The last opcode */
-#define LAST_INST_OPCODE 194
+#define LAST_INST_OPCODE 195
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
@@ -860,7 +862,7 @@ typedef struct ByteCode {
* instruction.
*/
-#define MAX_INSTRUCTION_OPERANDS 2
+#define MAX_INSTRUCTION_OPERANDS 3
typedef enum InstOperandType {
OPERAND_NONE,
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 408032b..629df59 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5244,11 +5244,67 @@ TEBCresume(
NEXT_INST_F(1, 1, 0);
}
- /*
- * End of INST_LIST and related instructions.
- * -----------------------------------------------------------------
- * Start of string-related instructions.
- */
+ case INST_LREPLACE4:
+ {
+ int firstIdx, lastIdx, numToDelete, numNewElems;
+ opnd = TclGetInt4AtPtr(pc + 1);
+ firstIdx = TclGetInt4AtPtr(pc + 5); /* First delete position */
+ lastIdx = TclGetInt4AtPtr(pc + 9); /* Last delete position */
+ numNewElems = opnd - 1;
+ valuePtr = OBJ_AT_DEPTH(numNewElems);
+ if (Tcl_ListObjLength(interp, valuePtr, &length) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ firstIdx = TclIndexDecode(firstIdx, length-1);
+ if (firstIdx == TCL_INDEX_NONE) {
+ firstIdx = 0;
+ } else if (firstIdx > length) {
+ firstIdx = length;
+ }
+ numToDelete = 0;
+ if (lastIdx != TCL_INDEX_NONE) {
+ lastIdx = TclIndexDecode(lastIdx, length - 1);
+ if (lastIdx >= firstIdx) {
+ numToDelete = lastIdx - firstIdx + 1;
+ }
+ }
+ if (Tcl_IsShared(valuePtr)) {
+ objResultPtr = Tcl_DuplicateObj(valuePtr);
+ if (Tcl_ListObjReplace(interp,
+ objResultPtr,
+ firstIdx,
+ numToDelete,
+ numNewElems,
+ &OBJ_AT_DEPTH(numNewElems-1))
+ != TCL_OK) {
+ TRACE_ERROR(interp);
+ Tcl_DecrRefCount(objResultPtr);
+ goto gotError;
+ }
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_V(13, opnd, 1);
+ } else {
+ if (Tcl_ListObjReplace(interp,
+ valuePtr,
+ firstIdx,
+ numToDelete,
+ numNewElems,
+ &OBJ_AT_DEPTH(numNewElems-1))
+ != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+ NEXT_INST_V(13, opnd-1, 0);
+ }
+ }
+
+ /*
+ * End of INST_LIST and related instructions.
+ * -----------------------------------------------------------------
+ * Start of string-related instructions.
+ */
case INST_STR_EQ:
case INST_STR_NEQ: /* String (in)equality check */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 40cf10c..a67c8f9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3954,6 +3954,9 @@ MODULE_SCOPE int TclCompileBasicMin1ArgCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileBasicMin2ArgCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileXxCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE Tcl_ObjCmdProc TclInvertOpCmd;
MODULE_SCOPE int TclCompileInvertOpCmd(Tcl_Interp *interp,
generated by cgit v0.12 at 2025-12-24 12:51:35 (GMT)