From 61814ba324f4652c444ecb2776f2cf8eb799dac7 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Sun, 30 Oct 2022 03:04:11 +0000 Subject: Implement lreplace4 BCC instruction --- generic/tclBasic.c | 1 + generic/tclCompCmdsGR.c | 69 +++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclCompile.c | 2 ++ generic/tclCompile.h | 6 +++-- generic/tclExecute.c | 66 ++++++++++++++++++++++++++++++++++++++++++---- generic/tclInt.h | 3 +++ 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 ; inumWords ; 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, -- cgit v0.12