From 58684988e5c45e6cf0e43e42f8139b97a4712811 Mon Sep 17 00:00:00 2001
From: Jessica Clarke <jrtc27@jrtc27.com>
Date: Fri, 12 Aug 2022 22:34:23 +0100
Subject: [PATCH 6/8] tclExecute: Fix for CHERI by not violating object
 allocation bounds

This is needed to support CHERI, and thus Arm's experimental Morello
prototype, where pointers are implemented using unforgeable capabilities
that include bounds and permissions metadata to provide fine-grained
spatial and referential memory safety, as well as revocation by sweeping
memory to provide heap temporal memory safety.

In the case that GrowEvaluationStack allocates a new stack, subtracting
TD is strictly UB, since pointer subtraction is only defined within an
object, not between objects. However, the bigger issue is that this is
then added to TD-derived pointers to get equivalent pointers into the
new stack, as well as reconstruct the new TD, but this is UB as pointer
addition is only defined when the result is within the same object (or
one-past-the-end). CHERI detects this and faults trying to update
catchTop since the (hidden) dereference of TD is outside the bounds of
the original TD's allocation.

Fix this by deriving pointers from the new allocation, not the old one.
---
 generic/tclExecute.c | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index eccf0e1ee..52d13b93f 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2663,7 +2663,8 @@ TEBCresume(
 
     case INST_EXPAND_STKTOP: {
 	size_t i;
-	ptrdiff_t moved;
+	TEBCdata *newTD;
+	ptrdiff_t oldCatchTopOff, oldTosPtrOff;
 
 	/*
 	 * Make sure that the element at stackTop is a list; if not, just
@@ -2692,19 +2693,21 @@ TEBCresume(
 		    + codePtr->maxStackDepth /* Beyond the original max */
 		    - CURR_DEPTH;	/* Relative to where we are */
 	    DECACHE_STACK_INFO();
-	    moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1)
-		    - (Tcl_Obj **) TD;
-	    if (moved) {
+	    oldCatchTopOff = catchTop - initCatchTop;
+	    oldTosPtrOff = tosPtr - initTosPtr;
+	    newTD = (TEBCdata *)
+		    GrowEvaluationStack(iPtr->execEnvPtr, length, 1);
+	    if (newTD != TD) {
 		/*
 		 * Change the global data to point to the new stack: move the
 		 * TEBCdataPtr TD, recompute the position of every other
 		 * stack-allocated parameter, update the stack pointers.
 		 */
 
-		TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);
+		TD = newTD;
 
-		catchTop += moved;
-		tosPtr += moved;
+		catchTop = initCatchTop + oldCatchTopOff;
+		tosPtr = initTosPtr + oldTosPtrOff;
 	    }
 	}
 
-- 
2.34.GIT

