Eliminate requirement that fasload files have the same

HEAP_IN_LOW_MEMORY state as the microcode loading them.

diff --git a/v7/src/microcode/fasl.c b/v7/src/microcode/fasl.c
index 3b6528e8dcd55a72f9c78349290aaee908ebc610..69a5ba42d2d5e7d176096ae06cbee6e5712aa5b2 100644 (file)
--- a/v7/src/microcode/fasl.c
+++ b/v7/src/microcode/fasl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: fasl.c,v 11.1 2007/04/22 16:31:22 cph Exp $
+$Id: fasl.c,v 11.2 2007/06/14 13:31:21 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -32,7 +32,6 @@ USA.
 
 static void encode_fasl_header (SCHEME_OBJECT *, fasl_header_t *);
 static bool decode_fasl_header (SCHEME_OBJECT *, fasl_header_t *);
-static SCHEME_OBJECT * faslobj_address (SCHEME_OBJECT, fasl_header_t *);
 \f
 bool
 open_fasl_output_file (const char * filename, fasl_file_handle_t * handle_r)
@@ -103,13 +102,7 @@ check_fasl_version (fasl_header_t * fh)
   return
     ((((FASLHDR_VERSION (fh)) >= OLDEST_INPUT_FASL_VERSION)
       && ((FASLHDR_VERSION (fh)) <= NEWEST_INPUT_FASL_VERSION))
-     ? ((((FASLHDR_ARCH (fh)) == CURRENT_FASL_ARCH)
-#ifdef HEAP_IN_LOW_MEMORY
-        && ((FASLHDR_MEMORY_BASE (fh)) == 0)
-#else
-        && ((FASLHDR_MEMORY_BASE (fh)) != 0)
-#endif
-        )
+     ? (((FASLHDR_ARCH (fh)) == CURRENT_FASL_ARCH)
        ? FASL_FILE_FINE
        : FASL_FILE_BAD_MACHINE)
      : FASL_FILE_BAD_VERSION);
@@ -225,10 +218,10 @@ decode_fasl_header (SCHEME_OBJECT * raw, fasl_header_t * h)
     (FASLHDR_MEMORY_BASE (h)) = fasl_memory_base;
 
     (FASLHDR_ROOT_POINTER (h))
-      = (faslobj_address ((raw[FASL_OFFSET_DUMPED_OBJ]), h));
+      = (fasl_object_address ((raw[FASL_OFFSET_DUMPED_OBJ]), h));
 
     (FASLHDR_HEAP_START (h))
-      = (faslobj_address ((raw[FASL_OFFSET_HEAP_BASE]), h));
+      = (fasl_object_address ((raw[FASL_OFFSET_HEAP_BASE]), h));
     (FASLHDR_HEAP_END (h))
       = ((FASLHDR_HEAP_START (h))
         + (OBJECT_DATUM (raw[FASL_OFFSET_HEAP_SIZE])));
@@ -238,7 +231,7 @@ decode_fasl_header (SCHEME_OBJECT * raw, fasl_header_t * h)
         : 4500);
 
     (FASLHDR_CONSTANT_START (h))
-      = (faslobj_address ((raw[FASL_OFFSET_CONST_BASE]), h));
+      = (fasl_object_address ((raw[FASL_OFFSET_CONST_BASE]), h));
     (FASLHDR_CONSTANT_END (h))
       = ((FASLHDR_CONSTANT_START (h))
         + (OBJECT_DATUM (raw[FASL_OFFSET_CONST_SIZE])));
@@ -246,7 +239,7 @@ decode_fasl_header (SCHEME_OBJECT * raw, fasl_header_t * h)
     if ((FASLHDR_VERSION (h)) >= FASL_VERSION_STACK_END)
       {
        (FASLHDR_STACK_START (h))
-         = (faslobj_address ((raw[FASL_OFFSET_STACK_START]), h));
+         = (fasl_object_address ((raw[FASL_OFFSET_STACK_START]), h));
        (FASLHDR_STACK_END (h))
          = ((FASLHDR_STACK_START (h))
             + (OBJECT_DATUM (raw[FASL_OFFSET_STACK_SIZE])));
@@ -257,7 +250,7 @@ decode_fasl_header (SCHEME_OBJECT * raw, fasl_header_t * h)
         the maximum address.  */
       {
        (FASLHDR_STACK_END (h))
-         = (faslobj_address ((raw[FASL_OFFSET_STACK_START]), h));
+         = (fasl_object_address ((raw[FASL_OFFSET_STACK_START]), h));
        /* If !HEAP_IN_LOW_MEMORY then fasl_memory_base is the right
           value.  Otherwise, fasl_memory_base is zero and that is at
           least guaranteed to encompass the whole stack.  */
@@ -284,7 +277,7 @@ decode_fasl_header (SCHEME_OBJECT * raw, fasl_header_t * h)
       else
        {
          SCHEME_OBJECT fuv
-           = (OBJECT_NEW_ADDRESS (ruv, (faslobj_address (ruv, h))));
+           = (OBJECT_NEW_ADDRESS (ruv, (fasl_object_address (ruv, h))));
          (FASLHDR_UTILITIES_VECTOR (h)) = fuv;
          (FASLHDR_UTILITIES_START (h)) = (OBJECT_ADDRESS (fuv));
        }
@@ -294,13 +287,51 @@ decode_fasl_header (SCHEME_OBJECT * raw, fasl_header_t * h)
   return (true);
 }
 
-static SCHEME_OBJECT *
-faslobj_address (SCHEME_OBJECT o, fasl_header_t * h)
+SCHEME_OBJECT *
+fasl_object_address (SCHEME_OBJECT o, fasl_header_t * h)
 {
-  return
-    (((FASLHDR_MEMORY_BASE (h)) == 0)
-     ? (OBJECT_ADDRESS (o))
-     : ((FASLHDR_MEMORY_BASE (h)) + (OBJECT_DATUM (o))));
+  if ((FASLHDR_MEMORY_BASE (h)) != 0)
+    return ((FASLHDR_MEMORY_BASE (h)) + (OBJECT_DATUM (o)));
+  if ((FASLHDR_ARCH (h)) == CURRENT_FASL_ARCH)
+    return (OBJECT_ADDRESS (o));
+  abort ();
+  return (0);
+}
+
+insn_t *
+fasl_cc_address (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_ENTRY_ADDRESS (o));
+  abort ();
+  return (0);
+}
+
+SCHEME_OBJECT
+fasl_raw_address_to_object (unsigned int type,
+                           SCHEME_OBJECT * address,
+                           fasl_header_t * h)
+{
+  if ((FASLHDR_MEMORY_BASE (h)) != 0)
+    return (MAKE_OBJECT (type, (address - (FASLHDR_MEMORY_BASE (h)))));
+  if ((FASLHDR_ARCH (h)) == CURRENT_FASL_ARCH)
+    return (MAKE_POINTER_OBJECT (type, address));
+  abort ();
+  return (UNSPECIFIC);
+}
+
+SCHEME_OBJECT
+fasl_raw_address_to_cc_entry (insn_t * address, fasl_header_t * h)
+{
+  if ((FASLHDR_MEMORY_BASE (h)) != 0)
+    return (MAKE_OBJECT (TC_COMPILED_ENTRY,
+                        (address - ((insn_t *) (FASLHDR_MEMORY_BASE (h))))));
+  if ((FASLHDR_ARCH (h)) == CURRENT_FASL_ARCH)
+    return (MAKE_CC_ENTRY (address));
+  abort ();
+  return (UNSPECIFIC);
 }
 
 SCHEME_OBJECT *

diff --git a/v7/src/microcode/fasl.h b/v7/src/microcode/fasl.h
index 3cdc03910050962bd67d057ca3bc7d86a704964b..1061c4014657c2b80716eaa51be7c4b226c33bcc 100644 (file)
--- a/v7/src/microcode/fasl.h
+++ b/v7/src/microcode/fasl.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: fasl.h,v 9.44 2007/04/22 16:31:22 cph Exp $
+$Id: fasl.h,v 9.45 2007/06/14 13:31:27 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -34,6 +34,7 @@ USA.
 #define SCM_FASL_H 1
 
 #include "object.h"
+#include "cmpint.h"
 
 #if (SIZEOF_UNSIGNED_LONG == 4)
 #  define FASL_FILE_MARKER 0xFAFAFAFAUL
@@ -199,6 +200,11 @@ extern bool open_fasl_input_file (const char *, fasl_file_handle_t *);
 extern bool close_fasl_input_file (fasl_file_handle_t);
 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 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 *);
 extern SCHEME_OBJECT * faslhdr_utilities_end (fasl_header_t *);
 extern fasl_read_status_t check_fasl_version (fasl_header_t *);
 extern fasl_read_status_t check_fasl_cc_version

diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c
index d892e669d24c6e4d852e3a4cffc1a5b0aa7386d2..5b655d36d7d042775304da7c5be5f5b3232f625f 100644 (file)
--- a/v7/src/microcode/fasload.c
+++ b/v7/src/microcode/fasload.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: fasload.c,v 9.103 2007/06/06 19:42:40 cph Exp $
+$Id: fasload.c,v 9.104 2007/06/14 13:31:33 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -79,10 +79,8 @@ 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;
-#ifndef HEAP_IN_LOW_MEMORY
 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;
-#endif
 static void * relocate_address (void *);
 
 static gc_table_t * intern_block_table (void);
@@ -146,10 +144,10 @@ init_fasl_file (const char * file_name, bool band_p,
     {
       outf_error ("\nBad version in FASL File: %s\n", file_name);
       outf_error
-       ("File has: Version %4u Architecture %4u.\n",
+       ("File has: version %u architecture %u.\n",
         (FASLHDR_VERSION (fh)), (FASLHDR_ARCH (fh)));
       outf_error
-       ("Expected:  Version between %4u and %4u Architecture %4u.\n",
+       ("Expected: version between %u and %u architecture %u.\n",
         OLDEST_INPUT_FASL_VERSION,
         NEWEST_INPUT_FASL_VERSION,
         CURRENT_FASL_ARCH);
@@ -165,10 +163,10 @@ init_fasl_file (const char * file_name, bool band_p,
     {
       outf_error ("\nBad compiled-code version in FASL File: %s\n", file_name);
       outf_error
-       ("File has: compiled-code interface %4u; architecture %4u.\n",
+       ("File has: compiled-code interface %u; architecture %u.\n",
         (FASLHDR_CC_VERSION (fh)), (FASLHDR_CC_ARCH (fh)));
       outf_error
-       ("Expected:  compiled code interface %4u; architecture %4u.\n",
+       ("Expected: compiled-code interface %u; architecture %u.\n",
         compiler_interface_version, compiler_processor_type);
       signal_error_from_primitive (ERR_FASLOAD_COMPILED_MISMATCH);
     }
@@ -472,10 +470,8 @@ relocate_block_table (void)
       (GCT_TUPLE (&table)) = fasload_tuple;
       (GCT_VECTOR (&table)) = fasload_vector;
       (GCT_CC_ENTRY (&table)) = fasload_cc_entry;
-#ifndef HEAP_IN_LOW_MEMORY
       (GCT_RAW_ADDRESS_TO_OBJECT (&table)) = fasload_raw_address_to_object;
       (GCT_RAW_ADDRESS_TO_CC_ENTRY (&table)) = fasload_raw_address_to_cc_entry;
-#endif
 
       (GCT_ENTRY ((&table), TC_WEAK_CONS)) = gc_handle_pair;
       (GCT_ENTRY ((&table), TC_PRIMITIVE)) = handle_primitive;
@@ -499,34 +495,21 @@ DEFINE_GC_HANDLER (handle_primitive)
   return (scan + 1);
 }
 
-#ifdef HEAP_IN_LOW_MEMORY
-
-#define OLD_ADDRESS OBJECT_ADDRESS
-#define OLD_CC_ADDRESS CC_ENTRY_ADDRESS
-
-#else
-
-#define OLD_ADDRESS(object)                                            \
-  ((FASLHDR_MEMORY_BASE (fh)) + (OBJECT_DATUM (object)))
-
-#define OLD_CC_ADDRESS(object)                                         \
-  (((insn_t *) (FASLHDR_MEMORY_BASE (fh))) + (OBJECT_DATUM (object)))
+#define OLD_ADDRESS(object) (fasl_object_address ((object), (fh)))
+#define OLD_CC_ADDRESS(object) (fasl_cc_address ((object), (fh)))
 
 static SCHEME_OBJECT
 fasload_raw_address_to_object (unsigned int type, SCHEME_OBJECT * address)
 {
-  return (MAKE_OBJECT (type, (address - (FASLHDR_MEMORY_BASE (fh)))));
+  return (fasl_raw_address_to_object (type, address, fh));
 }
 
-SCHEME_OBJECT
+static SCHEME_OBJECT
 fasload_raw_address_to_cc_entry (insn_t * address)
 {
-  return (MAKE_OBJECT (TC_COMPILED_ENTRY,
-                      (address - ((insn_t *) (FASLHDR_MEMORY_BASE (fh))))));
+  return (fasl_raw_address_to_cc_entry (address, fh));
 }
 
-#endif /* !HEAP_IN_LOW_MEMORY */
-
 #define RELOCATE_OBJECT(object)                                                \
   (OBJECT_NEW_ADDRESS ((object),                                       \
                       ((SCHEME_OBJECT *)                               \