From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 17 Sep 2019 06:13:44 +0000 (-0700)
Subject: Teach fasload about cc_return objects.
X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~51
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3684c24a43bc74a5c0882d1c054f22e31290f3d0;p=mit-scheme.git

Teach fasload about cc_return objects.

Otherwise fasload gets SIGSEGV when the memory addresses are different.
---

diff --git a/src/microcode/fasl.c b/src/microcode/fasl.c
index 32f2055fe..2a794e904 100644
--- a/src/microcode/fasl.c
+++ b/src/microcode/fasl.c
@@ -317,6 +317,17 @@ fasl_cc_address (SCHEME_OBJECT o, fasl_header_t * h)
   return (0);
 }
 
+insn_t *
+fasl_cc_return (SCHEME_OBJECT o, fasl_header_t * h)
+{
+  if ((FASLHDR_MEMORY_BASE (h)) != 0)
+    return (((insn_t *) (FASLHDR_MEMORY_BASE (h))) + (OBJECT_DATUM (o)));
+  if ((FASLHDR_ARCH (h)) == CURRENT_FASL_ARCH)
+    return (CC_RETURN_ADDRESS (o));
+  abort ();
+  return (0);
+}
+
 SCHEME_OBJECT
 fasl_raw_address_to_object (unsigned int type,
 			    SCHEME_OBJECT * address,
diff --git a/src/microcode/fasl.h b/src/microcode/fasl.h
index 3580d927e..2e923b831 100644
--- a/src/microcode/fasl.h
+++ b/src/microcode/fasl.h
@@ -203,6 +203,7 @@ extern bool read_fasl_header (fasl_header_t *, fasl_file_handle_t);
 extern bool read_from_fasl_file (void *, size_t, fasl_file_handle_t);
 extern SCHEME_OBJECT * fasl_object_address (SCHEME_OBJECT, fasl_header_t *);
 extern insn_t * fasl_cc_address (SCHEME_OBJECT, fasl_header_t *);
+extern insn_t * fasl_cc_return (SCHEME_OBJECT, fasl_header_t *);
 extern SCHEME_OBJECT fasl_raw_address_to_object
   (unsigned int, SCHEME_OBJECT *, fasl_header_t *);
 extern SCHEME_OBJECT fasl_raw_address_to_cc_entry (insn_t *, fasl_header_t *);
diff --git a/src/microcode/fasload.c b/src/microcode/fasload.c
index 632b1ff28..2754f5638 100644
--- a/src/microcode/fasload.c
+++ b/src/microcode/fasload.c
@@ -78,6 +78,7 @@ static gc_handler_t handle_primitive;
 static gc_tuple_handler_t fasload_tuple;
 static gc_vector_handler_t fasload_vector;
 static gc_object_handler_t fasload_cc_entry;
+static gc_object_handler_t fasload_cc_return;
 static gc_raw_address_to_object_t fasload_raw_address_to_object;
 static gc_raw_address_to_cc_entry_t fasload_raw_address_to_cc_entry;
 static void * relocate_address (void *);
@@ -490,6 +491,7 @@ relocate_block_table (void)
       (GCT_TUPLE (&table)) = fasload_tuple;
       (GCT_VECTOR (&table)) = fasload_vector;
       (GCT_CC_ENTRY (&table)) = fasload_cc_entry;
+      (GCT_CC_RETURN (&table)) = fasload_cc_return;
       (GCT_RAW_ADDRESS_TO_OBJECT (&table)) = fasload_raw_address_to_object;
       (GCT_RAW_ADDRESS_TO_CC_ENTRY (&table)) = fasload_raw_address_to_cc_entry;
 
@@ -517,6 +519,7 @@ DEFINE_GC_HANDLER (handle_primitive)
 
 #define OLD_ADDRESS(object) (fasl_object_address ((object), (fh)))
 #define OLD_CC_ADDRESS(object) (fasl_cc_address ((object), (fh)))
+#define OLD_CC_RETURN(object) (fasl_cc_return ((object), (fh)))
 
 static SCHEME_OBJECT
 fasload_raw_address_to_object (unsigned int type, SCHEME_OBJECT * address)
@@ -559,6 +562,18 @@ DEFINE_GC_OBJECT_HANDLER (fasload_cc_entry)
 #endif
 }
 
+static
+DEFINE_GC_OBJECT_HANDLER (fasload_cc_return)
+{
+#ifdef CC_SUPPORT_P
+  return
+    (CC_RETURN_NEW_ADDRESS (object,
+			    (relocate_address (OLD_CC_RETURN (object)))));
+#else
+  return (object);
+#endif
+}
+
 /* Relocate an address as read in from the file.  The address is
    examined to see what region of memory it belongs in.  */