From 4402cae44685a3ca1b3c0c4bf9c5d0680195a0e8 Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
Date: Sat, 22 Apr 2023 10:04:53 +0000
Subject: Use TclListObjRange in lassign for performance reasons

---
 generic/tclCmdIL.c   | 17 +++++++++++++++--
 generic/tclExecute.c | 10 +++++-----
 generic/tclInt.h     |  4 ++--
 generic/tclListObj.c |  3 ++-
 4 files changed, 24 insertions(+), 10 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index f6d3df3..383cec4 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2326,6 +2326,7 @@ Tcl_LassignObjCmd(
     Tcl_Obj *listCopyPtr;
     Tcl_Obj **listObjv;		/* The contents of the list. */
     Tcl_Size listObjc;		/* The length of the list. */
+    Tcl_Size origListObjc;	/* Original length */
     int code = TCL_OK;
 
     if (objc < 2) {
@@ -2337,8 +2338,10 @@ Tcl_LassignObjCmd(
     if (listCopyPtr == NULL) {
 	return TCL_ERROR;
     }
+    Tcl_IncrRefCount(listCopyPtr); /* Important! fs */
 
     TclListObjGetElementsM(NULL, listCopyPtr, &listObjc, &listObjv);
+    origListObjc = listObjc;
 
     objc -= 2;
     objv += 2;
@@ -2366,7 +2369,13 @@ Tcl_LassignObjCmd(
     }
 
     if (code == TCL_OK && listObjc > 0) {
-	Tcl_SetObjResult(interp, Tcl_NewListObj(listObjc, listObjv));
+	Tcl_Obj *resultObjPtr = TclListObjRange(
+	    interp, listCopyPtr, origListObjc - listObjc, origListObjc - 1);
+	if (resultObjPtr == NULL) {
+	    code = TCL_ERROR;
+	} else {
+	    Tcl_SetObjResult(interp, resultObjPtr);
+	}
     }
 
     Tcl_DecrRefCount(listCopyPtr);
@@ -2759,7 +2768,11 @@ Tcl_LrangeObjCmd(
 	    return TCL_ERROR;
 	}
     } else {
-	Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
+	Tcl_Obj *resultObj = TclListObjRange(interp, objv[1], first, last);
+	if (resultObj == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, resultObj);
     }
     return TCL_OK;
 }
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 7f431bd..e3b85b4 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5154,12 +5154,12 @@ TEBCresume(
 
 	if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
 	    objResultPtr = TclArithSeriesObjRange(interp, valuePtr, fromIdx, toIdx);
-	    if (objResultPtr == NULL) {
-		TRACE_ERROR(interp);
-		goto gotError;
-	    }
 	} else {
-	    objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
+	    objResultPtr = TclListObjRange(interp, valuePtr, fromIdx, toIdx);
+	}
+	if (objResultPtr == NULL) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
 
 	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
diff --git a/generic/tclInt.h b/generic/tclInt.h
index c073f42..1481b5c 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3249,8 +3249,8 @@ MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
 MODULE_SCOPE int	TclListObjAppendElements(Tcl_Interp *interp,
 			    Tcl_Obj *toObj, int elemCount,
 			    Tcl_Obj *const elemObjv[]);
-MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Obj *listPtr, int fromIdx,
-			    int toIdx);
+MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Interp *interp, Tcl_Obj *listPtr,
+			    int fromIdx, int toIdx);
 MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
 MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 811bd0f..a850695 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1602,6 +1602,7 @@ ListRepRange(
 
 Tcl_Obj *
 TclListObjRange(
+    Tcl_Interp *interp,		/* May be NULL. Used for error messages */
     Tcl_Obj *listObj,		/* List object to take a range from. */
     Tcl_Size rangeStart,	/* Index of first element to include. */
     Tcl_Size rangeEnd)		/* Index of last element to include. */
@@ -1610,7 +1611,7 @@ TclListObjRange(
     ListRep resultRep;
 
     int isShared;
-    if (TclListObjGetRep(NULL, listObj, &listRep) != TCL_OK)
+    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)
 	return NULL;
 
     isShared = Tcl_IsShared(listObj);
-- 
cgit v0.12


From f14ee8d1bb0f076e919df01cbdd9059e1e5b9a93 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sat, 22 Apr 2023 17:55:36 +0000
Subject: Fix [203792a48c]: Avoid signed integer overflow in Utf32ToUtfProc()

---
 generic/tclEncoding.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 774485d..647ed68 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -2774,9 +2774,9 @@ Utf32ToUtfProc(
 
 	int prev = ch;
 	if (flags & TCL_ENCODING_LE) {
-	    ch = (src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
+	    ch = (unsigned int)(src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
 	} else {
-	    ch = (src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF);
+	    ch = (unsigned int)(src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF);
 	}
 	if (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) {
 	    /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */
-- 
cgit v0.12