diff --git a/vm/callstack.c b/vm/callstack.c
index 4644a4e86a..a4b7945c9f 100644
--- a/vm/callstack.c
+++ b/vm/callstack.c
@@ -1,5 +1,7 @@
 #include "master.h"
 
+/* This code is very ugly. Perhaps unavoidably so. */
+
 /* called before entry into Factor code. */
 F_FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom)
 {
@@ -183,11 +185,31 @@ DEFINE_PRIMITIVE(callstack_to_array)
 	dpush(tag_object(array));
 }
 
+F_STACK_FRAME *innermost_stack_frame(F_CALLSTACK *callstack)
+{
+#ifdef CALLSTACK_UP_P
+	CELL top = (CELL)(callstack + 1);
+	CELL bottom = top + untag_fixnum_fast(callstack->length);
+	CELL base = callstack->bottom;
+	CELL delta = (bottom - base);
+
+	F_STACK_FRAME *frame = (F_STACK_FRAME *)bottom - 1;
+
+	while(frame >= (F_STACK_FRAME *)top
+		&& REBASE_FRAME_SUCCESSOR(frame,delta) >= (F_STACK_FRAME *)top)
+		frame = REBASE_FRAME_SUCCESSOR(frame,delta);
+
+	return frame;
+#else
+	return FIRST_STACK_FRAME(callstack);
+#endif
+}
+
 /* Some primitives implementing a limited form of callstack mutation.
 Used by the single stepper. */
 DEFINE_PRIMITIVE(innermost_stack_frame_quot)
 {
-	F_STACK_FRAME *inner = FIRST_STACK_FRAME(
+	F_STACK_FRAME *inner = innermost_stack_frame(
 		untag_callstack(dpop()));
 	type_check(QUOTATION_TYPE,frame_executing(inner));
 
@@ -196,7 +218,7 @@ DEFINE_PRIMITIVE(innermost_stack_frame_quot)
 
 DEFINE_PRIMITIVE(innermost_stack_frame_scan)
 {
-	F_STACK_FRAME *inner = FIRST_STACK_FRAME(
+	F_STACK_FRAME *inner = innermost_stack_frame(
 		untag_callstack(dpop()));
 	type_check(QUOTATION_TYPE,frame_executing(inner));
 
@@ -217,13 +239,19 @@ DEFINE_PRIMITIVE(set_innermost_stack_frame_quot)
 	UNREGISTER_UNTAGGED(quot);
 	UNREGISTER_ROOT(callstack);
 
-	F_STACK_FRAME *inner = FIRST_STACK_FRAME(
+	F_STACK_FRAME *inner = innermost_stack_frame(
 		untag_callstack(callstack));
 	type_check(QUOTATION_TYPE,frame_executing(inner));
 
 
 	CELL scan = inner->scan - inner->array;
+
+#ifdef CALLSTACK_UP_P
+	F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(inner,delta);
+	CELL offset = *(XT *)(next + 1) - inner->xt;
+#else
 	CELL offset = inner->return_address - inner->xt;
+#endif
 
 	inner->array = quot->array;
 	inner->scan = quot->array + scan;
@@ -231,7 +259,6 @@ DEFINE_PRIMITIVE(set_innermost_stack_frame_quot)
 	inner->xt = quot->xt;
 
 #ifdef CALLSTACK_UP_P
-	F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(frame,delta);
 	*(XT *)(next + 1) = quot->xt + offset;
 #else
 	inner->return_address = quot->xt + offset;