From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 3 Jan 2019 03:19:54 +0000 (+0000)
Subject: Allow return_to_compiled_code to return to compiled entries.
X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~80^2~10
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=500ae9a5b856ddc8ea3ae03fa1d32b6efaa10de3;p=mit-scheme.git

Allow return_to_compiled_code to return to compiled entries.

The earlier compiled entry/return split left various utility calls
pushing compiled entries, rather than compiled return addresses, for
continuations on the stack -- notably interrupt routines, the linker
utility, and interpreter calls.

I arranged for these to all to use RETURN_TO_SCHEME_ENTRY (or
JUMP_TO_CC_ENTRY), but missed one spot: the continuations constructed
by STACK-FRAME->CONTINUATION, which use return_to_compiled_code,
which in turn expected a compiled return rather than a compiled entry
and choked.

The interrupt routines, linker utility, and interpreter calls should
all be adapted to take returns rather than entries (which is another
ABI-breaking flag day), but this will do for now.
---

diff --git a/src/microcode/cmpint.c b/src/microcode/cmpint.c
index 03fa95cae..cd5cedab8 100644
--- a/src/microcode/cmpint.c
+++ b/src/microcode/cmpint.c
@@ -459,28 +459,49 @@ DEFINE_SCHEME_ENTRY (apply_compiled_procedure)
   JUMP_TO_CC_ENTRY (procedure);
 }
 
+static bool
+compiled_continuation_p (insn_t * entry_addr)
+{
+  cc_entry_type_t cet;
+
+  if (read_cc_entry_type ((&cet), entry_addr))
+    return false;
+  if (! ((cet.marker == CET_CONTINUATION)
+	 || (cet.marker == CET_INTERNAL_CONTINUATION)
+	 || (cet.marker == CET_RETURN_TO_INTERPRETER)))
+    return false;
+  return true;
+}
+
 DEFINE_SCHEME_ENTRY (return_to_compiled_code)
 {
   RESTORE_LAST_RETURN_CODE ();
   {
     SCHEME_OBJECT cont = (STACK_POP ());
-    {
-      cc_entry_type_t cet;
-      if (! (CC_RETURN_P (cont)))
-	goto bad;
-      insn_t * ret_addr = (CC_RETURN_ADDRESS (cont));
-      insn_t * entry_addr = (CC_RETURN_ADDRESS_TO_ENTRY_ADDRESS (ret_addr));
-      if ((read_cc_entry_type ((&cet), entry_addr))
-	  || (! ((cet.marker == CET_CONTINUATION)
-		 || (cet.marker == CET_INTERNAL_CONTINUATION)
-		 || (cet.marker == CET_RETURN_TO_INTERPRETER))))
-	{
-bad:	  STACK_PUSH (cont);
-	  SAVE_CONT ();
-	  return (ERR_INAPPLICABLE_OBJECT);
-	}
-    }
-    JUMP_TO_CC_RETURN (cont);
+    /* Due to a mistake, continuations for microcode utilities are
+       represented as compiled entries.  Should fix eventually.  */
+    if (CC_RETURN_P (cont))
+      {
+	insn_t * ret_addr = (CC_RETURN_ADDRESS (cont));
+	insn_t * entry_addr =
+	  (CC_RETURN_ADDRESS_TO_ENTRY_ADDRESS (ret_addr));
+	if (!compiled_continuation_p (entry_addr))
+	  goto bad;
+	JUMP_TO_CC_RETURN (cont);
+      }
+    else if (CC_ENTRY_P (cont))
+      {
+	insn_t * entry_addr = (CC_ENTRY_ADDRESS (cont));
+	if (!compiled_continuation_p (entry_addr))
+	  goto bad;
+	JUMP_TO_CC_ENTRY (cont);
+      }
+    else
+      {
+bad:	STACK_PUSH (cont);
+	SAVE_CONT ();
+	return (ERR_INAPPLICABLE_OBJECT);
+      }
   }
 }