From 9244b6ed0810e743ee573d8403df7283d9e1486e Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 15 May 2015 22:14:32 +0000
Subject: [85ce4bf928] Fix for problems with storing Inf with [binary format
 R].

---
 generic/tclBinary.c |  4 ++-
 tests/binary.test   | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 70 insertions(+), 5 deletions(-)

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 981f174..2ff898b 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -1912,7 +1912,9 @@ FormatNumber(
 	 * valid range for float.
 	 */
 
-	if (fabs(dvalue) > (double)FLT_MAX) {
+	if (fabs(dvalue) > (FLT_MAX + pow(2, (FLT_MAX_EXP - FLT_MANT_DIG - 1)))) {
+	    fvalue = (dvalue >= 0.0) ? INFINITY : -INFINITY;	// c99
+	} else if (fabs(dvalue) >= FLT_MAX) {
 	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
 	} else {
 	    fvalue = (float) dvalue;
diff --git a/tests/binary.test b/tests/binary.test
index 40b1315..7e7818b 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -508,10 +508,10 @@ test binary-13.11 {Tcl_BinaryObjCmd: format} littleEndian {
 } \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
 test binary-13.12 {Tcl_BinaryObjCmd: float overflow} bigEndian {
     binary format f -3.402825e+38
-} \xff\x7f\xff\xff
+} \xff\x80\x00\x00
 test binary-13.13 {Tcl_BinaryObjCmd: float overflow} littleEndian {
     binary format f -3.402825e+38
-} \xff\xff\x7f\xff
+} \x00\x00\x80\xff
 test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian {
     binary format f -3.402825e-100
 } \x80\x00\x00\x00
@@ -533,6 +533,18 @@ test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian {
     set a {1.6 3.4}
     binary format f1 $a
 } \xcd\xcc\xcc\x3f
+test binary-13.20 {Tcl_BinaryObjCmd: format float Inf} bigEndian {
+    binary format f Inf
+} \x7f\x80\x00\x00
+test binary-13.21 {Tcl_BinaryObjCmd: format float Inf} littleEndian {
+    binary format f Inf
+} \x00\x00\x80\x7f
+test binary-13.22 {Tcl_BinaryObjCmd: format float -Inf} bigEndian {
+    binary format f -Inf
+} \xff\x80\x00\x00
+test binary-13.23 {Tcl_BinaryObjCmd: format float -Inf} littleEndian {
+    binary format f -Inf
+} \x00\x00\x80\xff
 
 test binary-14.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     binary format d
@@ -1941,10 +1953,10 @@ test binary-53.11 {Tcl_BinaryObjCmd: format} {} {
 } \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
 test binary-53.12 {Tcl_BinaryObjCmd: float overflow} {} {
     binary format R -3.402825e+38
-} \xff\x7f\xff\xff
+} \xff\x80\x00\x00
 test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {} {
     binary format r -3.402825e+38
-} \xff\xff\x7f\xff
+} \x00\x00\x80\xff
 test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} {
     binary format R -3.402825e-100
 } \x80\x00\x00\x00
@@ -1966,6 +1978,41 @@ test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
     set a {1.6 3.4}
     binary format r1 $a
 } \xcd\xcc\xcc\x3f
+test binary-53.20 {Tcl_BinaryObjCmd: float Inf} {} {
+    binary format R Inf
+} \x7f\x80\x00\x00
+test binary-53.21 {Tcl_BinaryObjCmd: float Inf} {} {
+    binary format r Inf
+} \x00\x00\x80\x7f
+test binary-53.22 {Binary float Inf round trip} -body {
+    binary scan [binary format R Inf] R inf
+    binary scan [binary format R -Inf] R inf_
+    list $inf $inf_
+} -result {Inf -Inf}
+test binary-53.23 {Binary float round to FLT_MAX} -body {
+    binary scan [binary format H* 7f7fffff] R fltmax
+    binary scan [binary format H* 47effffff0000000] Q round_to_fltmax
+    binary scan [binary format R $round_to_fltmax] R fltmax1
+    expr {$fltmax eq $fltmax1}
+} -result 1
+test binary-53.24 {Binary float round to -FLT_MAX} -body {
+    binary scan [binary format H* ff7fffff] R fltmax
+    binary scan [binary format H* c7effffff0000000] Q round_to_fltmax
+    binary scan [binary format R $round_to_fltmax] R fltmax1
+    expr {$fltmax eq $fltmax1}
+} -result 1
+test binary-53.25 {Binary float round to Inf} -body {
+    binary scan [binary format H* 47effffff0000001] Q round_to_inf
+    binary scan [binary format R $round_to_inf] R inf1
+    expr {$inf1 eq Inf}
+} -result 1
+test binary-53.26 {Binary float round to -Inf} -body {
+    binary scan [binary format H* c7effffff0000001] Q round_to_inf
+    binary scan [binary format R $round_to_inf] R inf1
+    expr {$inf1 eq -Inf}
+} -result 1
+
+
 
 # scan t (s)
 test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
@@ -2369,6 +2416,22 @@ test binary-62.6 {infinity} ieeeFloatingPoint {
     binary scan [binary format w 0xfff0000000000000] q d
     set d
 } -Inf
+test binary-62.7 {infinity} ieeeFloatingPoint {
+    binary scan [binary format r Inf] iu i
+    format 0x%08x $i
+} 0x7f800000
+test binary-62.8 {infinity} ieeeFloatingPoint {
+    binary scan [binary format r -Inf] iu i
+    format 0x%08x $i
+} 0xff800000
+test binary-62.9 {infinity} ieeeFloatingPoint {
+    binary scan [binary format i 0x7f800000] r d
+    set d
+} Inf
+test binary-62.10 {infinity} ieeeFloatingPoint {
+    binary scan [binary format i 0xff800000] r d
+    set d
+} -Inf
 
 # scan/format Not-a-Number
 
-- 
cgit v0.12

-- 
cgit v0.12


From 61814ba324f4652c444ecb2776f2cf8eb799dac7 Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
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 ; 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,
-- 
cgit v0.12


From 5da6b8e3c356a3786e96336ea19a8c4fabcb17fa Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
Date: Sun, 30 Oct 2022 04:27:03 +0000
Subject: New bytecode for linsert

---
 generic/tclCompCmdsGR.c | 41 +++++------------------------------------
 generic/tclCompile.c    |  8 ++++++--
 generic/tclCompile.h    |  2 +-
 generic/tclExecute.c    | 15 ++++++++-------
 4 files changed, 20 insertions(+), 46 deletions(-)

diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 4aa454b..ddb9746 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -1391,48 +1391,16 @@ TclCompileLinsertCmd(
      */
 
     CompileWord(envPtr, listTokenPtr, interp, 1);
-    if (parsePtr->numWords == 3) {
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
-	TclEmitInt4(			(int)TCL_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 == (int)TCL_INDEX_START) {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
-    } else if (idx == (int)TCL_INDEX_END) {
-	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
-    } else {
-	/*
-	 * Here we handle two ranges for idx. First when idx > 0, we
-	 * want the first half of the split to end at index idx-1 and
-	 * the second half to start at index idx.
-	 * Second when idx < TCL_INDEX_END, indicating "end-N" indexing,
-	 * we want the first half of the split to end at index end-N and
-	 * the second half to start at index end-N+1. We accomplish this
-	 * with a pre-adjustment of the end-N value.
-	 * The root of this is that the commands [lrange] and [linsert]
-	 * differ in their interpretation of the "end" index.
-	 */
-
-	if (idx < (int)TCL_INDEX_END) {
-	    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(			(int)TCL_INDEX_END,		envPtr);
-	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
-	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
-    }
+    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 2, envPtr);
+    TclEmitInt4(0, envPtr);
+    TclEmitInt4(idx, envPtr);
+    TclEmitInt4(idx-1, envPtr);
 
     return TCL_OK;
 }
@@ -3086,6 +3054,7 @@ TclCompileXxCmd(
     }
 
     TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 2, envPtr);
+    TclEmitInt4(0, envPtr);
     TclEmitInt4(idx, envPtr);
     TclEmitInt4(idx-1, envPtr);
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 2535167..c01ddb8 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -675,8 +675,12 @@ 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 */
+    {"lreplace4",	  17,   INT_MIN,    4,	{OPERAND_UINT4, OPERAND_UINT4, OPERAND_INT4, OPERAND_INT4}},
+	/* Operands: number of arguments, end_indicator, firstIdx, lastIdx
+	 * end_indicator: 0 if "end" is treated as index of last element, 
+	 *                1 if "end" is position after last element
+	 * firstIdx,lastIdx: range of elements to delete
+	 * Stack: ... listobj new1 ... newN => ... newlistobj */
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index c82dc6e..9633050 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -862,7 +862,7 @@ typedef struct ByteCode {
  * instruction.
  */
 
-#define MAX_INSTRUCTION_OPERANDS 3
+#define MAX_INSTRUCTION_OPERANDS 4
 
 typedef enum InstOperandType {
     OPERAND_NONE,
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 629df59..2713093 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5246,17 +5246,18 @@ TEBCresume(
 
     case INST_LREPLACE4:
 	{
-	    int firstIdx, lastIdx, numToDelete, numNewElems;
+	    int firstIdx, lastIdx, numToDelete, numNewElems, end_indicator;
 	    opnd = TclGetInt4AtPtr(pc + 1);
-	    firstIdx = TclGetInt4AtPtr(pc + 5); /* First delete position */
-	    lastIdx = TclGetInt4AtPtr(pc + 9);  /* Last delete position */
+	    end_indicator = TclGetInt4AtPtr(pc + 5);
+	    firstIdx = TclGetInt4AtPtr(pc + 9);
+	    lastIdx = TclGetInt4AtPtr(pc + 13);
 	    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);
+	    firstIdx = TclIndexDecode(firstIdx, length-end_indicator);
 	    if (firstIdx == TCL_INDEX_NONE) {
 		firstIdx = 0;
 	    } else if (firstIdx > length) {
@@ -5264,7 +5265,7 @@ TEBCresume(
 	    }
 	    numToDelete = 0;
 	    if (lastIdx != TCL_INDEX_NONE) {
-		lastIdx = TclIndexDecode(lastIdx, length - 1);
+		lastIdx = TclIndexDecode(lastIdx, length - end_indicator);
 		if (lastIdx >= firstIdx) {
 		    numToDelete = lastIdx - firstIdx + 1;
 		}
@@ -5283,7 +5284,7 @@ TEBCresume(
 		    goto gotError;
 		}
 		TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
-		NEXT_INST_V(13, opnd, 1);
+		NEXT_INST_V(17, opnd, 1);
 	    } else {
 		if (Tcl_ListObjReplace(interp,
 				       valuePtr,
@@ -5296,7 +5297,7 @@ TEBCresume(
 		    goto gotError;
 		}
 		TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
-		NEXT_INST_V(13, opnd-1, 0);
+		NEXT_INST_V(17, opnd-1, 0);
 	    }
 	}
 
-- 
cgit v0.12


From b2223e8eaf55dad117f1f99bc23ead87a30a7db3 Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
Date: Sun, 30 Oct 2022 10:43:58 +0000
Subject: New bytecode implementation for lreplace

---
 generic/tclCompCmdsGR.c | 191 ++++++++++++++----------------------------------
 generic/tclCompile.c    |   4 +-
 2 files changed, 55 insertions(+), 140 deletions(-)

diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index ddb9746..72716a4 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -1363,33 +1363,21 @@ TclCompileLinsertCmd(
     }
     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
+     * 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) {
+    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_END, &idx)
+	!= TCL_OK) {
+	/* Not a constant index. */
 	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++) {
@@ -1397,10 +1385,12 @@ TclCompileLinsertCmd(
 	CompileWord(envPtr, tokenPtr, interp, i);
     }
 
+    /* First operand is count of new elements */
     TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 2, envPtr);
-    TclEmitInt4(0, envPtr);
-    TclEmitInt4(idx, envPtr);
-    TclEmitInt4(idx-1, envPtr);
+    TclEmitInt4(0, envPtr); /* "end" refers to position AFTER last element */
+    TclEmitInt4(idx, envPtr);/* Insertion point (also start of range to delete) */
+    TclEmitInt4(TCL_INDEX_NONE, envPtr); /* End of range to delete.
+					    TCL_INDEX_NONE => no deletions */
 
     return TCL_OK;
 }
@@ -1426,8 +1416,7 @@ TclCompileLreplaceCmd(
 {
     DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr, *listTokenPtr;
-    int idx1, idx2, i;
-    int emptyPrefix=1, suffixStart = 0;
+    int first, last, i, end_indicator;
 
     if (parsePtr->numWords < 4) {
 	return TCL_ERROR;
@@ -1436,108 +1425,35 @@ TclCompileLreplaceCmd(
 
     tokenPtr = TokenAfter(listTokenPtr);
     if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
-	    &idx1) != TCL_OK) {
+	    &first) != TCL_OK) {
 	return TCL_ERROR;
     }
 
     tokenPtr = TokenAfter(tokenPtr);
     if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
-	    &idx2) != TCL_OK) {
+	    &last) != TCL_OK) {
 	return TCL_ERROR;
     }
-
-    /*
-     * General structure of the [lreplace] result is
-     *		prefix replacement suffix
-     * In a few cases we can predict various parts will be empty and
-     * take advantage.
-     *
-     * The proper suffix begins with the greater of indices idx1 or
-     * idx2 + 1. If we cannot tell at compile time which is greater,
-     * we must defer to direct evaluation.
-     */
-
-    if (idx1 == (int)TCL_INDEX_NONE) {
-	suffixStart = (int)TCL_INDEX_NONE;
-    } else if (idx2 == (int)TCL_INDEX_NONE) {
-	suffixStart = idx1;
-    } else if (idx2 == (int)TCL_INDEX_END) {
-	suffixStart = (int)TCL_INDEX_NONE;
-    } else if (((idx2 < (int)TCL_INDEX_END) && (idx1 <= (int)TCL_INDEX_END))
-	    || ((idx2 >= (int)TCL_INDEX_START) && (idx1 >= (int)TCL_INDEX_START))) {
-	suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1;
-    } else {
-	return TCL_ERROR;
+    end_indicator = 1; /* "end" means last element by default */
+    if (first == (int)TCL_INDEX_NONE) {
+	/* Special case: first == TCL_INDEX_NONE => Range after last element. */
+	first = TCL_INDEX_END; /* Insert at end where ... */
+	end_indicator = 0;     /* ... end means AFTER last element */
+	last = TCL_INDEX_NONE; /* Informs lreplace, nothing to replace */
     }
 
-    /* All paths start with computing/pushing the original value. */
     CompileWord(envPtr, listTokenPtr, interp, 1);
 
-    /*
-     * Push all the replacement values next so any errors raised in
-     * creating them get raised first.
-     */
-    if (parsePtr->numWords > 4) {
-	/* Push the replacement arguments */
+    for (i=4 ; i<parsePtr->numWords ; i++) {
 	tokenPtr = TokenAfter(tokenPtr);
-	for (i=4 ; i<parsePtr->numWords ; i++) {
-	    CompileWord(envPtr, tokenPtr, interp, i);
-	    tokenPtr = TokenAfter(tokenPtr);
-	}
-
-	/* Make a list of them... */
-	TclEmitInstInt4(	INST_LIST, i - 4,		envPtr);
-
-	emptyPrefix = 0;
-    }
-
-    if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
-	/*
-	 * This is a "no-op". Example: [lreplace {a b c} 2 0]
-	 * We still do a list operation to get list-verification
-	 * and canonicalization side effects.
-	 */
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
-	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
-	return TCL_OK;
-    }
-
-    if (idx1 != (int)TCL_INDEX_START) {
-	/* Prefix may not be empty; generate bytecode to push it */
-	if (emptyPrefix) {
-	    TclEmitOpcode(	INST_DUP,			envPtr);
-	} else {
-	    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
-	}
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
-	TclEmitInt4(			idx1 - 1,		envPtr);
-	if (!emptyPrefix) {
-	    TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-	    TclEmitOpcode(	INST_LIST_CONCAT,		envPtr);
-	}
-	emptyPrefix = 0;
-    }
-
-    if (!emptyPrefix) {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-    }
-
-    if (suffixStart == (int)TCL_INDEX_NONE) {
-	TclEmitOpcode(		INST_POP,			envPtr);
-	if (emptyPrefix) {
-	    PushStringLiteral(envPtr, "");
-	}
-    } else {
-	/* Suffix may not be empty; generate bytecode to push it */
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, suffixStart, envPtr);
-	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
-	if (!emptyPrefix) {
-	    TclEmitOpcode(	INST_LIST_CONCAT,		envPtr);
-	}
+	CompileWord(envPtr, tokenPtr, interp, i);
     }
 
-    return TCL_OK;
-}
+    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 3, envPtr);
+    TclEmitInt4(end_indicator, envPtr);
+    TclEmitInt4(first, envPtr);
+    TclEmitInt4(last, envPtr);
+    return TCL_OK;}
 
 /*
  *----------------------------------------------------------------------
@@ -3012,52 +2928,51 @@ TclCompileXxCmd(
 {
     DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr, *listTokenPtr;
-    int idx, i;
+    int first, last, i, end_indicator;
 
-    if (parsePtr->numWords < 3) {
+    if (parsePtr->numWords < 4) {
 	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);
+    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
+	    &first) != TCL_OK) {
+	return TCL_ERROR;
+    }
 
-    /*
-     * 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) {
+    tokenPtr = TokenAfter(tokenPtr);
+    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
+	    &last) != TCL_OK) {
 	return TCL_ERROR;
     }
+    end_indicator = 1; /* "end" means last element by default */
+    if (first == (int)TCL_INDEX_NONE) {
+	/* first == TCL_INDEX_NONE => Range after last element. */
+	first = TCL_INDEX_END; /* Insert at end where ... */
+	end_indicator = 0;     /* ... end means AFTER last element */
+	last = TCL_INDEX_NONE; /* Informs lreplace, nothing to replace */
+    } else if (last == TCL_INDEX_NONE) {
+	/*
+	 * last == TCL_INDEX_NONE => last precedes first element
+	 * lreplace4 will treat this as nothing to delete
+	 * Nought to do, just here for clarity, will be optimized away
+	 */
+    } else {
 
-    /*
-     * 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++) {
+    for (i=4 ; i<parsePtr->numWords ; i++) {
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr, interp, i);
     }
 
-    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 2, envPtr);
-    TclEmitInt4(0, envPtr);
-    TclEmitInt4(idx, envPtr);
-    TclEmitInt4(idx-1, envPtr);
-
+    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 3, envPtr);
+    TclEmitInt4(end_indicator, envPtr);
+    TclEmitInt4(first, envPtr);
+    TclEmitInt4(last, envPtr);
     return TCL_OK;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c01ddb8..57e2d71 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -677,8 +677,8 @@ InstructionDesc const tclInstructionTable[] = {
 	/* String Greater or equal:	push (stknext >= stktop) */
     {"lreplace4",	  17,   INT_MIN,    4,	{OPERAND_UINT4, OPERAND_UINT4, OPERAND_INT4, OPERAND_INT4}},
 	/* Operands: number of arguments, end_indicator, firstIdx, lastIdx
-	 * end_indicator: 0 if "end" is treated as index of last element, 
-	 *                1 if "end" is position after last element
+	 * end_indicator: 1 if "end" is treated as index of last element, 
+	 *                0 if "end" is position after last element
 	 * firstIdx,lastIdx: range of elements to delete
 	 * Stack: ... listobj new1 ... newN => ... newlistobj */
 
-- 
cgit v0.12


From d9a19f95121e4fd846211083cc7c3b0d22c7a564 Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
Date: Sun, 30 Oct 2022 17:41:56 +0000
Subject: Bytecode compiler for ledit

---
 generic/tclBasic.c      |   5 +-
 generic/tclCompCmdsGR.c | 187 ++++++++++++++++++++++++++++++------------------
 generic/tclInt.h        |   3 +
 tests/lreplace.test     |   1 +
 4 files changed, 124 insertions(+), 72 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c9697d2..a1eb4cc 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -310,9 +310,9 @@ static const CmdInfo builtInCmds[] = {
     {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
     {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
+    {"ledit",		Tcl_LeditObjCmd,	TclCompileLeditCmd,	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},
@@ -323,10 +323,9 @@ static const CmdInfo builtInCmds[] = {
     {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
     {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
-    {"lseq",            Tcl_LseqObjCmd,         NULL,                   NULL,   CMD_IS_SAFE},
+    {"lseq",		Tcl_LseqObjCmd,         NULL,                   NULL,   CMD_IS_SAFE},
     {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
     {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
-    {"ledit",		Tcl_LeditObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
     {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 72716a4..bf6288a 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -1036,6 +1036,124 @@ TclCompileLassignCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileLeditCmd --
+ *
+ *	How to compile the "ledit" command. We only bother with the case
+ *	where the index is constant.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLeditCmd(
+    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, *varTokenPtr;
+    int localIndex;             /* Index of var in local var table. */
+    int isScalar;		/* Flag == 1 if scalar, 0 if array. */
+    int tempDepth;		/* Depth used for emitting one part of the
+				 * code burst. */
+    int first, last, i, end_indicator;
+
+    if (parsePtr->numWords < 4) {
+	return TCL_ERROR;
+    }
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    tokenPtr = TokenAfter(varTokenPtr);
+    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
+	    &first) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(tokenPtr);
+    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
+	    &last) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    end_indicator = 1; /* "end" means last element by default */
+    if (first == (int)TCL_INDEX_NONE) {
+	/* first == TCL_INDEX_NONE => Range after last element. */
+	first = TCL_INDEX_END; /* Insert at end where ... */
+	end_indicator = 0;     /* ... end means AFTER last element */
+	last = TCL_INDEX_NONE; /* Informs lreplace, nothing to replace */
+    }
+
+    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+	    &localIndex, &isScalar, 1);
+
+    /* Duplicate the variable name if it's been pushed. */
+    if (localIndex < 0) {
+	if (isScalar) {
+	    tempDepth = 0;
+	} else {
+	    tempDepth = 1;
+	}
+	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
+    }
+
+    /* Duplicate an array index if one's been pushed. */
+    if (!isScalar) {
+	if (localIndex < 0) {
+	    tempDepth = 1;
+	} else {
+	    tempDepth = parsePtr->numWords - 2;
+	}
+	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
+    }
+
+    /* Emit code to load the variable's value.  */
+    if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_LOAD_STK, envPtr);
+	} else {
+	    Emit14Inst(INST_LOAD_SCALAR, localIndex, envPtr);
+	}
+    } else {
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
+	} else {
+	    Emit14Inst(INST_LOAD_ARRAY, localIndex, envPtr);
+	}
+    }
+
+    for (i=4 ; i<parsePtr->numWords ; ++i) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, i);
+    }
+
+    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 3, envPtr);
+    TclEmitInt4(end_indicator, envPtr);
+    TclEmitInt4(first, envPtr);
+    TclEmitInt4(last, envPtr);
+    
+    /* Emit code to put the value back in the variable. */
+
+    if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_STORE_STK, envPtr);
+	} else {
+	    Emit14Inst(INST_STORE_SCALAR, localIndex, envPtr);
+	}
+    } else {
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
+	} else {
+	    Emit14Inst(INST_STORE_ARRAY, localIndex, envPtr);
+	}
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileLindexCmd --
  *
  *	Procedure called to compile the "lindex" command.
@@ -2908,75 +3026,6 @@ 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 first, last, i, end_indicator;
-
-    if (parsePtr->numWords < 4) {
-	return TCL_ERROR;
-    }
-    listTokenPtr = TokenAfter(parsePtr->tokenPtr);
-
-    tokenPtr = TokenAfter(listTokenPtr);
-    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
-	    &first) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    tokenPtr = TokenAfter(tokenPtr);
-    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
-	    &last) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    end_indicator = 1; /* "end" means last element by default */
-    if (first == (int)TCL_INDEX_NONE) {
-	/* first == TCL_INDEX_NONE => Range after last element. */
-	first = TCL_INDEX_END; /* Insert at end where ... */
-	end_indicator = 0;     /* ... end means AFTER last element */
-	last = TCL_INDEX_NONE; /* Informs lreplace, nothing to replace */
-    } else if (last == TCL_INDEX_NONE) {
-	/*
-	 * last == TCL_INDEX_NONE => last precedes first element
-	 * lreplace4 will treat this as nothing to delete
-	 * Nought to do, just here for clarity, will be optimized away
-	 */
-    } else {
-
-    }
-
-    CompileWord(envPtr, listTokenPtr, interp, 1);
-
-    for (i=4 ; i<parsePtr->numWords ; i++) {
-	tokenPtr = TokenAfter(tokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, i);
-    }
-
-    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 3, envPtr);
-    TclEmitInt4(end_indicator, envPtr);
-    TclEmitInt4(first, envPtr);
-    TclEmitInt4(last, envPtr);
-    return TCL_OK;
-}
-
-/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a67c8f9..5c977e5 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3759,6 +3759,9 @@ MODULE_SCOPE int	TclCompileLappendCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileLassignCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileLeditCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileLindexCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
diff --git a/tests/lreplace.test b/tests/lreplace.test
index 2952899..209c3d2 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -521,6 +521,7 @@ apply {{} {
 		foreach i $ins {
 		    set expected [list [catch {$lreplace $ls $a $b {*}$i} m] $m]
 		    set tester [list ledit ls $a $b {*}$i]
+		    #set script [list catch $tester m]
 		    set script [list catch $tester m]
 		    set script "list \[$script\] \$m"
 		    test ledit-6.[incr n] {ledit battery} -body \
-- 
cgit v0.12


From f768eb3bf2d09ebf310ed07f664dc114e1c1412d Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
Date: Thu, 3 Nov 2022 17:04:07 +0000
Subject: Rewrite lreplace4 implementation not to need extra immediate
 operands.

---
 generic/tclBasic.c      |   2 +-
 generic/tclCompCmdsGR.c | 210 +++++++++---------------------------------------
 generic/tclCompile.c    |  13 +--
 generic/tclCompile.h    |  10 ++-
 generic/tclExecute.c    | 129 ++++++++++++++++++-----------
 generic/tclInt.h        |   3 -
 6 files changed, 135 insertions(+), 232 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a1eb4cc..80dc416 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -310,7 +310,7 @@ static const CmdInfo builtInCmds[] = {
     {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
     {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
-    {"ledit",		Tcl_LeditObjCmd,	TclCompileLeditCmd,	NULL,	CMD_IS_SAFE},
+    {"ledit",		Tcl_LeditObjCmd,	NULL,	NULL,	CMD_IS_SAFE},
     {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
     {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
     {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index bf6288a..2681d01 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -1036,124 +1036,6 @@ TclCompileLassignCmd(
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileLeditCmd --
- *
- *	How to compile the "ledit" command. We only bother with the case
- *	where the index is constant.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileLeditCmd(
-    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, *varTokenPtr;
-    int localIndex;             /* Index of var in local var table. */
-    int isScalar;		/* Flag == 1 if scalar, 0 if array. */
-    int tempDepth;		/* Depth used for emitting one part of the
-				 * code burst. */
-    int first, last, i, end_indicator;
-
-    if (parsePtr->numWords < 4) {
-	return TCL_ERROR;
-    }
-    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-
-    tokenPtr = TokenAfter(varTokenPtr);
-    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
-	    &first) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    tokenPtr = TokenAfter(tokenPtr);
-    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
-	    &last) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    end_indicator = 1; /* "end" means last element by default */
-    if (first == (int)TCL_INDEX_NONE) {
-	/* first == TCL_INDEX_NONE => Range after last element. */
-	first = TCL_INDEX_END; /* Insert at end where ... */
-	end_indicator = 0;     /* ... end means AFTER last element */
-	last = TCL_INDEX_NONE; /* Informs lreplace, nothing to replace */
-    }
-
-    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
-	    &localIndex, &isScalar, 1);
-
-    /* Duplicate the variable name if it's been pushed. */
-    if (localIndex < 0) {
-	if (isScalar) {
-	    tempDepth = 0;
-	} else {
-	    tempDepth = 1;
-	}
-	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
-    }
-
-    /* Duplicate an array index if one's been pushed. */
-    if (!isScalar) {
-	if (localIndex < 0) {
-	    tempDepth = 1;
-	} else {
-	    tempDepth = parsePtr->numWords - 2;
-	}
-	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
-    }
-
-    /* Emit code to load the variable's value.  */
-    if (isScalar) {
-	if (localIndex < 0) {
-	    TclEmitOpcode(INST_LOAD_STK, envPtr);
-	} else {
-	    Emit14Inst(INST_LOAD_SCALAR, localIndex, envPtr);
-	}
-    } else {
-	if (localIndex < 0) {
-	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
-	} else {
-	    Emit14Inst(INST_LOAD_ARRAY, localIndex, envPtr);
-	}
-    }
-
-    for (i=4 ; i<parsePtr->numWords ; ++i) {
-	tokenPtr = TokenAfter(tokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, i);
-    }
-
-    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 3, envPtr);
-    TclEmitInt4(end_indicator, envPtr);
-    TclEmitInt4(first, envPtr);
-    TclEmitInt4(last, envPtr);
-    
-    /* Emit code to put the value back in the variable. */
-
-    if (isScalar) {
-	if (localIndex < 0) {
-	    TclEmitOpcode(INST_STORE_STK, envPtr);
-	} else {
-	    Emit14Inst(INST_STORE_SCALAR, localIndex, envPtr);
-	}
-    } else {
-	if (localIndex < 0) {
-	    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
-	} else {
-	    Emit14Inst(INST_STORE_ARRAY, localIndex, envPtr);
-	}
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclCompileLindexCmd --
  *
  *	Procedure called to compile the "lindex" command.
@@ -1473,42 +1355,34 @@ TclCompileLinsertCmd(
     CompileEnv *envPtr)		/* Holds the resulting instructions. */
 {
     DefineLineInformation;	/* TIP #280 */
-    Tcl_Token *tokenPtr, *listTokenPtr;
-    int idx, i;
+    Tcl_Token *tokenPtr;
+    int i;
 
     if (parsePtr->numWords < 3) {
 	return TCL_ERROR;
     }
-    listTokenPtr = TokenAfter(parsePtr->tokenPtr);
-
-    tokenPtr = TokenAfter(listTokenPtr);
-
-    /*
-     * 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) {
-	/* Not a constant index. */
-	return TCL_ERROR;
-    }
-
-    CompileWord(envPtr, listTokenPtr, interp, 1);
+    
+    /* Push list, insertion index onto the stack */
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 1);
+    tokenPtr = TokenAfter(tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 2);
 
+    /* Push new elements to be inserted */
     for (i=3 ; i<parsePtr->numWords ; i++) {
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr, interp, i);
     }
 
-    /* First operand is count of new elements */
-    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 2, envPtr);
-    TclEmitInt4(0, envPtr); /* "end" refers to position AFTER last element */
-    TclEmitInt4(idx, envPtr);/* Insertion point (also start of range to delete) */
-    TclEmitInt4(TCL_INDEX_NONE, envPtr); /* End of range to delete.
-					    TCL_INDEX_NONE => no deletions */
+    /* First operand is count of arguments */
+    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 1, envPtr);
+    /* 
+     * Second operand is bitmask
+     *  TCL_LREPLACE4_END_IS_LAST - end refers to last element
+     *  TCL_LREPLACE4_SINGLE_INDEX - second index is not present
+     *     indicating this is a pure insert
+     */
+    TclEmitInt1(TCL_LREPLACE4_SINGLE_INDEX, envPtr);
 
     return TCL_OK;
 }
@@ -1533,46 +1407,38 @@ TclCompileLreplaceCmd(
     CompileEnv *envPtr)		/* Holds the resulting instructions. */
 {
     DefineLineInformation;	/* TIP #280 */
-    Tcl_Token *tokenPtr, *listTokenPtr;
-    int first, last, i, end_indicator;
+    Tcl_Token *tokenPtr;
+    int i;
 
     if (parsePtr->numWords < 4) {
 	return TCL_ERROR;
     }
-    listTokenPtr = TokenAfter(parsePtr->tokenPtr);
-
-    tokenPtr = TokenAfter(listTokenPtr);
-    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
-	    &first) != TCL_OK) {
-	return TCL_ERROR;
-    }
 
+    /* Push list, first, last onto the stack */
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 1);
     tokenPtr = TokenAfter(tokenPtr);
-    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
-	    &last) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    end_indicator = 1; /* "end" means last element by default */
-    if (first == (int)TCL_INDEX_NONE) {
-	/* Special case: first == TCL_INDEX_NONE => Range after last element. */
-	first = TCL_INDEX_END; /* Insert at end where ... */
-	end_indicator = 0;     /* ... end means AFTER last element */
-	last = TCL_INDEX_NONE; /* Informs lreplace, nothing to replace */
-    }
-
-    CompileWord(envPtr, listTokenPtr, interp, 1);
+    CompileWord(envPtr, tokenPtr, interp, 2);
+    tokenPtr = TokenAfter(tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 3);
 
+    /* Push new elements to be inserted */
     for (i=4 ; i<parsePtr->numWords ; i++) {
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr, interp, i);
     }
 
-    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 3, envPtr);
-    TclEmitInt4(end_indicator, envPtr);
-    TclEmitInt4(first, envPtr);
-    TclEmitInt4(last, envPtr);
-    return TCL_OK;}
-
+    /* First operand is count of arguments */
+    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 1, envPtr);
+    /* 
+     * Second operand is bitmask
+     *  TCL_LREPLACE4_END_IS_LAST - end refers to last element
+     */
+    TclEmitInt1(TCL_LREPLACE4_END_IS_LAST, envPtr);
+
+    return TCL_OK;
+}
+
 /*
  *----------------------------------------------------------------------
  *
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 57e2d71..2dd0718 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -675,12 +675,13 @@ InstructionDesc const tclInstructionTable[] = {
 	/* String Less or equal:	push (stknext <= stktop) */
     {"strge",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* String Greater or equal:	push (stknext >= stktop) */
-    {"lreplace4",	  17,   INT_MIN,    4,	{OPERAND_UINT4, OPERAND_UINT4, OPERAND_INT4, OPERAND_INT4}},
-	/* Operands: number of arguments, end_indicator, firstIdx, lastIdx
-	 * end_indicator: 1 if "end" is treated as index of last element, 
-	 *                0 if "end" is position after last element
-	 * firstIdx,lastIdx: range of elements to delete
-	 * Stack: ... listobj new1 ... newN => ... newlistobj */
+    {"lreplace4",	  6,   INT_MIN,    2,	{OPERAND_UINT4, OPERAND_UINT1}},
+	/* Operands: number of arguments, flags
+	 * flags: Combination of TCL_LREPLACE4_* flags
+	 * Stack: ... listobj index1 ?index2? new1 ... newN => ... newlistobj 
+	 * where index2 is present only if TCL_LREPLACE_SINGLE_INDEX is not
+	 * set in flags.
+	 */
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 9633050..71ceede 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -848,7 +848,7 @@ typedef struct ByteCode {
 #define INST_STR_LE			193
 #define INST_STR_GE			194
 
-#define INST_LREPLACE4                   195
+#define INST_LREPLACE4			195
 
 /* The last opcode */
 #define LAST_INST_OPCODE		195
@@ -862,7 +862,7 @@ typedef struct ByteCode {
  * instruction.
  */
 
-#define MAX_INSTRUCTION_OPERANDS 4
+#define MAX_INSTRUCTION_OPERANDS 2
 
 typedef enum InstOperandType {
     OPERAND_NONE,
@@ -1685,6 +1685,12 @@ MODULE_SCOPE int	TclPushProcCallFrame(void *clientData,
 #define TCL_NO_ELEMENT 2	/* Do not push the array element. */
 
 /*
+ * Flags bits used by lreplace4 instruction
+ */
+#define TCL_LREPLACE4_END_IS_LAST  1 /* "end" refers to last element */
+#define TCL_LREPLACE4_SINGLE_INDEX 2 /* Second index absent (pure insert) */
+
+/*
  * DTrace probe macros (NOPs if DTrace support is not enabled).
  */
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2713093..a8d9d57 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5246,61 +5246,94 @@ TEBCresume(
 
     case INST_LREPLACE4:
 	{
-	    int firstIdx, lastIdx, numToDelete, numNewElems, end_indicator;
-	    opnd = TclGetInt4AtPtr(pc + 1);
-	    end_indicator = TclGetInt4AtPtr(pc + 5);
-	    firstIdx = TclGetInt4AtPtr(pc + 9);
-	    lastIdx = TclGetInt4AtPtr(pc + 13);
-	    numNewElems = opnd - 1;
-	    valuePtr = OBJ_AT_DEPTH(numNewElems);
-	    if (Tcl_ListObjLength(interp, valuePtr, &length) != TCL_OK) {
+	int numToDelete, numNewElems, end_indicator;
+	int haveSecondIndex, flags;
+	Tcl_Obj *fromIdxObj, *toIdxObj;
+	opnd = TclGetInt4AtPtr(pc + 1);
+	flags = TclGetInt1AtPtr(pc + 5);
+
+	/* Stack: ... listobj index1 ?index2? new1 ... newN */
+	valuePtr = OBJ_AT_DEPTH(opnd-1);
+
+	/* haveSecondIndex==0 => pure insert */
+	haveSecondIndex = (flags & TCL_LREPLACE4_SINGLE_INDEX) == 0;
+	numNewElems = opnd - 2 - haveSecondIndex;
+
+	/* end_indicator==1 => "end" is last element's index, 0=>index beyond */
+	end_indicator = (flags & TCL_LREPLACE4_END_IS_LAST) != 0;
+	fromIdxObj = OBJ_AT_DEPTH(opnd - 2);
+	toIdxObj = haveSecondIndex ? OBJ_AT_DEPTH(opnd - 3) : NULL;
+	if (Tcl_ListObjLength(interp, valuePtr, &length) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+
+	DECACHE_STACK_INFO();
+
+	if (TclGetIntForIndexM(
+		interp, fromIdxObj, length - end_indicator, &fromIdx)
+	    != TCL_OK) {
+	    CACHE_STACK_INFO();
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	if (fromIdx == TCL_INDEX_NONE) {
+	    fromIdx = 0;
+	}
+	else if (fromIdx > length) {
+	    fromIdx = length;
+	}
+	numToDelete = 0;
+	if (toIdxObj) {
+	    if (TclGetIntForIndexM(
+		    interp, toIdxObj, length - end_indicator, &toIdx)
+		!= TCL_OK) {
+		CACHE_STACK_INFO();
 		TRACE_ERROR(interp);
 		goto gotError;
 	    }
-	    firstIdx = TclIndexDecode(firstIdx, length-end_indicator);
-	    if (firstIdx == TCL_INDEX_NONE) {
-		firstIdx = 0;
-	    } else if (firstIdx > length) {
-		firstIdx = length;
-	    }
-	    numToDelete = 0;
-	    if (lastIdx != TCL_INDEX_NONE) {
-		lastIdx = TclIndexDecode(lastIdx, length - end_indicator);
-		if (lastIdx >= firstIdx) {
-		    numToDelete = lastIdx - firstIdx + 1;
-		}
+	    if (toIdx > length) {
+		toIdx = length;
 	    }
-	    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(17, 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(17, opnd-1, 0);
+	    if (toIdx >= fromIdx) {
+		numToDelete = toIdx - fromIdx + 1;
 	    }
 	}
 
+	CACHE_STACK_INFO();
+
+	if (Tcl_IsShared(valuePtr)) {
+	    objResultPtr = Tcl_DuplicateObj(valuePtr);
+	    if (Tcl_ListObjReplace(interp,
+				   objResultPtr,
+				   fromIdx,
+				   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(6, opnd, 1);
+	}
+	else {
+	    if (Tcl_ListObjReplace(interp,
+				   valuePtr,
+				   fromIdx,
+				   numToDelete,
+				   numNewElems,
+				   &OBJ_AT_DEPTH(numNewElems - 1))
+		!= TCL_OK) {
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+	    NEXT_INST_V(6, opnd - 1, 0);
+	}
+	}
+
 	/*
 	 *	   End of INST_LIST and related instructions.
 	 * -----------------------------------------------------------------
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 5c977e5..a67c8f9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3759,9 +3759,6 @@ MODULE_SCOPE int	TclCompileLappendCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileLassignCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-MODULE_SCOPE int	TclCompileLeditCmd(Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr, Command *cmdPtr,
-			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileLindexCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-- 
cgit v0.12