New fasl version to support ephemerons.

In the process, complete the transition to the STACK_END fasl format.

In the EPHEMERON fasl format, the fasl header has an extra field for
the number of ephemerons stored in the fasl, for which the fasloader
reserves space in ephemeron_array.

The fasdumper chooses between the C_CODE, STACK_END, or EPHEMERON
fasl format for maximum compatibility:

- If there are any ephemerons in the fasl, the fasdumper chooses the
  EPHEMERON format.  Older microcodes don't know about ephemerons and
  thus can't handle such fasls anyway.

- If dumping a band, the fasdumper chooses the STACK_END format,
  since the only differences between the C_CODE format and the
  STACK_END format matter only for bands.  Support for reading the
  STACK_END format was added in version 15 of the microcode; any
  newly created bands are not likely to be used in older microcodes
  than that anyway.

- Otherwise, the fasdumper chooses the C_CODE format, like before.

diff --git a/src/microcode/fasdump.c b/src/microcode/fasdump.c
index c6b004014b57a6b34bf722627f73aa4ed8fa01c4..37c0c6dd709eedb045fdd4406e22204b930b6f26 100644 (file)
--- a/src/microcode/fasdump.c
+++ b/src/microcode/fasdump.c
@@ -78,6 +78,7 @@ static fasl_header_t * fh;
 static env_mode_t current_env_mode;
 static prim_renumber_t * current_pr;
 static bool cc_seen_p;
+static unsigned long dumped_ephemeron_count;
 
 static gc_table_t * fasdump_table (void);
 static gc_handler_t handle_primitive;
@@ -87,6 +88,7 @@ static gc_handler_t handle_symbol;
 static gc_handler_t handle_broken_heart;
 static gc_handler_t handle_variable;
 static gc_handler_t handle_environment;
+static gc_handler_t handle_ephemeron;
 
 static gc_object_handler_t fasdump_cc_entry;
 static gc_precheck_from_t fasdump_precheck_from;
@@ -96,7 +98,8 @@ static void initialize_fixups (void);
 static void add_fixup (SCHEME_OBJECT *);
 static void run_fixups (void *);
 
-static void initialize_fasl_header (bool);
+static void initialize_fasl_header (bool, bool);
+static void finalize_fasl_header (unsigned long);
 static bool write_fasl_file
   (SCHEME_OBJECT *, SCHEME_OBJECT *, fasl_file_handle_t);
 \f
@@ -144,6 +147,7 @@ at by compiled code are ignored (and discarded).")
 
   new_heap_start = (get_newspace_ptr ());
   add_to_tospace (ARG_REF (1));
+  dumped_ephemeron_count = 0;
 
   transaction_begin ();                /* 2 */
 
@@ -166,8 +170,7 @@ at by compiled code are ignored (and discarded).")
 
   transaction_commit ();       /* 2 */
 
-  initialize_fasl_header (cc_seen_p);
-  (FASLHDR_BAND_P (fh)) = false;
+  initialize_fasl_header (cc_seen_p, false);
   (FASLHDR_CONSTANT_START (fh)) = new_heap_start;
   (FASLHDR_CONSTANT_END (fh)) = new_heap_start;
   (FASLHDR_HEAP_START (fh)) = new_heap_start;
@@ -175,6 +178,7 @@ at by compiled code are ignored (and discarded).")
   (FASLHDR_ROOT_POINTER (fh)) = new_heap_start;
   (FASLHDR_N_PRIMITIVES (fh)) = (current_pr->next_code);
   (FASLHDR_PRIMITIVE_TABLE_SIZE (fh)) = prim_table_length;
+  finalize_fasl_header (dumped_ephemeron_count);
 
   ok = ((write_fasl_header (fh, (ff_info . handle)))
        && (save_tospace (save_tospace_write, (&ff_info))));
@@ -340,7 +344,7 @@ fasdump_table (void)
       (GCT_ENTRY ((&table), TC_VARIABLE)) = handle_variable;
       (GCT_ENTRY ((&table), TC_ENVIRONMENT)) = handle_environment;
       (GCT_ENTRY ((&table), TC_WEAK_CONS)) = gc_handle_pair;
-      (GCT_ENTRY ((&table), TC_EPHEMERON)) = gc_handle_unaligned_vector;
+      (GCT_ENTRY ((&table), TC_EPHEMERON)) = handle_ephemeron;
 
       initialized_p = true;
     }
@@ -464,6 +468,13 @@ DEFINE_GC_HANDLER (handle_environment)
   (*scan) = (GC_HANDLE_VECTOR (object, false));
   return (scan + 1);
 }
+
+static
+DEFINE_GC_HANDLER (handle_ephemeron)
+{
+  dumped_ephemeron_count += 1;
+  return (gc_handle_unaligned_vector (scan, object));
+}
 \f
 typedef struct
 {
@@ -529,8 +540,7 @@ When the file is reloaded, PROCEDURE is called with an argument of #F.")
   CHECK_ARG (2, STRING_P);
 
   Primitive_GC_If_Needed (5);
-  initialize_fasl_header (true);
-  (FASLHDR_BAND_P (fh)) = true;
+  initialize_fasl_header (true, true);
   {
     SCHEME_OBJECT comb;
     SCHEME_OBJECT root;
@@ -576,6 +586,7 @@ When the file is reloaded, PROCEDURE is called with an argument of #F.")
       (FASLHDR_HEAP_END (fh)) = prim_table_start;
       (FASLHDR_CONSTANT_START (fh)) = constant_start;
       (FASLHDR_CONSTANT_END (fh)) = constant_alloc_next;
+      finalize_fasl_header (ephemeron_count);
 
       OS_file_remove_link (filename);
       if (!open_fasl_output_file (filename, (&handle)))
@@ -591,18 +602,24 @@ When the file is reloaded, PROCEDURE is called with an argument of #F.")
 }
 \f
 static void
-initialize_fasl_header (bool cc_p)
+initialize_fasl_header (bool cc_p, bool band_p)
 {
   fh = (&fasl_header);
-  (FASLHDR_VERSION (fh)) = OUTPUT_FASL_VERSION;
+  /* Provisionally set the version -- later, finalize_fasl_header will
+     change it to the EPHEMERON format if there were any ephemerons.
+     The difference between the older C_CODE format and the newer
+     STACK_END format applies only to bands.  */
+  (FASLHDR_VERSION (fh))
+    = (band_p ? FASL_VERSION_STACK_END : FASL_VERSION_C_CODE);
   (FASLHDR_ARCH (fh)) = CURRENT_FASL_ARCH;
+  (FASLHDR_BAND_P (fh)) = band_p;
 
 #ifdef HEAP_IN_LOW_MEMORY
   (FASLHDR_MEMORY_BASE (fh)) = 0;
 #else
   (FASLHDR_MEMORY_BASE (fh)) = memory_block_start;
 #endif
-  (FASLHDR_HEAP_RESERVED (fh)) = heap_reserved;
+  (FASLHDR_HEAP_RESERVED (fh)) = (band_p ? heap_reserved : 0);
 
   (FASLHDR_STACK_START (fh)) = stack_start;
   (FASLHDR_STACK_END (fh)) = stack_end;
@@ -623,6 +640,16 @@ initialize_fasl_header (bool cc_p)
   (FASLHDR_C_CODE_TABLE_SIZE (fh)) = 0;
 }
 
+static void
+finalize_fasl_header (unsigned long ephemeron_count)
+{
+  if (ephemeron_count != 0)
+    {
+      (FASLHDR_VERSION (fh)) = FASL_VERSION_EPHEMERONS;
+      (FASLHDR_EPHEMERON_COUNT (fh)) = ephemeron_count;
+    }
+}
+
 static bool
 write_fasl_file (SCHEME_OBJECT * prim_table_start,
                 SCHEME_OBJECT * c_code_table_start,

diff --git a/src/microcode/fasl.c b/src/microcode/fasl.c
index 34c4f5f9711fb5733580ee2e6e632e41e25effcd..43fa75f0905b02ab77e04f48407a601c7e16c0ff 100644 (file)
--- a/src/microcode/fasl.c
+++ b/src/microcode/fasl.c
@@ -192,6 +192,10 @@ encode_fasl_header (SCHEME_OBJECT * raw, fasl_header_t * h)
     = (MAKE_OBJECT (TC_BROKEN_HEART, (FASLHDR_C_CODE_TABLE_SIZE (h))));
 
   (raw[FASL_OFFSET_UT_BASE]) = (FASLHDR_UTILITIES_VECTOR (h));
+
+  if ((FASLHDR_VERSION (h)) >= FASL_VERSION_EPHEMERONS)
+    (raw[FASL_OFFSET_EPHEMERONS])
+      = (MAKE_OBJECT (TC_BROKEN_HEART, (FASLHDR_EPHEMERON_COUNT (h))));
 }
 \f
 static bool
@@ -226,7 +230,7 @@ decode_fasl_header (SCHEME_OBJECT * raw, fasl_header_t * h)
     (FASLHDR_HEAP_RESERVED (h))
       = (((FASLHDR_VERSION (h)) >= FASL_VERSION_STACK_END)
         ? (OBJECT_DATUM (raw[FASL_OFFSET_HEAP_RSVD]))
-        : 4500);
+        : 0);
 
     (FASLHDR_CONSTANT_START (h))
       = (fasl_object_address ((raw[FASL_OFFSET_CONST_BASE]), h));
@@ -282,6 +286,9 @@ decode_fasl_header (SCHEME_OBJECT * raw, fasl_header_t * h)
     }
     (__FASLHDR_UTILITIES_END (h)) = 0;
   }
+  if ((FASLHDR_VERSION (h)) >= FASL_VERSION_EPHEMERONS)
+    (FASLHDR_EPHEMERON_COUNT (h))
+      = (OBJECT_DATUM (raw[FASL_OFFSET_EPHEMERONS]));
   return (true);
 }
 

diff --git a/src/microcode/fasl.h b/src/microcode/fasl.h
index fde15c7598b7c5676723fa4335737473602e07a2..3945e0ebfc93224a0af1437f554d6caaa514e9ce 100644 (file)
--- a/src/microcode/fasl.h
+++ b/src/microcode/fasl.h
@@ -67,7 +67,8 @@ USA.
 #define FASL_OFFSET_C_SIZE     14      /* # of words in the C code table */
 #define FASL_OFFSET_MEM_BASE   15      /* Saved value of memory_base */
 #define FASL_OFFSET_STACK_SIZE 16      /* # of words in stack area */
-#define FASL_OFFSET_HEAP_RSVD   17     /* value of heap_reserved */
+#define FASL_OFFSET_HEAP_RSVD  17      /* value of heap_reserved */
+#define FASL_OFFSET_EPHEMERONS 18      /* # of ephemerons in fasl */
 \f
 /* Version information encoding */
 
@@ -102,18 +103,17 @@ typedef enum
   FASL_VERSION_INTERFACE_VERSION,
   FASL_VERSION_NEW_BIGNUMS,
   FASL_VERSION_C_CODE,
-  FASL_VERSION_STACK_END
+  FASL_VERSION_STACK_END,
+  FASL_VERSION_EPHEMERONS,
 } fasl_version_t;
 
 #define OLDEST_INPUT_FASL_VERSION FASL_VERSION_C_CODE
-#define NEWEST_INPUT_FASL_VERSION FASL_VERSION_STACK_END
+#define NEWEST_INPUT_FASL_VERSION FASL_VERSION_EPHEMERONS
 
-#if 0
-/* Temporarily disabled for testing.  */
-#define OUTPUT_FASL_VERSION FASL_VERSION_STACK_END
-#else
-#define OUTPUT_FASL_VERSION FASL_VERSION_C_CODE
-#endif
+/* Nothing uses this at the moment -- the fasdumper selects C_CODE for
+   non-bands, STACK_END if there are no ephemerons, or EPHEMERONS if
+   there is at least one ephemeron in the fasl.  */
+#define OUTPUT_FASL_VERSION FASL_VERSION_EPHEMERONS
 \f
 typedef struct
 {
@@ -138,6 +138,7 @@ typedef struct
   SCHEME_OBJECT utilities_vector;
   SCHEME_OBJECT * utilities_start;
   SCHEME_OBJECT * utilities_end;
+  unsigned long ephemeron_count;
 } fasl_header_t;
 
 #define FASLHDR_VERSION(h) ((h)->version)
@@ -161,6 +162,7 @@ typedef struct
 #define FASLHDR_UTILITIES_VECTOR(h) ((h)->utilities_vector)
 #define FASLHDR_UTILITIES_START(h) ((h)->utilities_start)
 #define __FASLHDR_UTILITIES_END(h) ((h)->utilities_end)
+#define FASLHDR_EPHEMERON_COUNT(h) ((h)->ephemeron_count)
 
 #define FASLHDR_UTILITIES_END(h) (faslhdr_utilities_end (h))
 

diff --git a/src/microcode/fasload.c b/src/microcode/fasload.c
index be871f01433e9030fcf30342094e2613ca7b531f..3e7cf3f406c42db5b36629c9a4d8ae6d2203af97 100644 (file)
--- a/src/microcode/fasload.c
+++ b/src/microcode/fasload.c
@@ -50,7 +50,10 @@ static SCHEME_OBJECT * new_prim_table;
 #define REQUIRED_HEAP(h)                                               \
   ((FASLHDR_HEAP_SIZE (h))                                             \
    + (FASLHDR_N_PRIMITIVES (h))                                                \
-   + (FASLHDR_PRIMITIVE_TABLE_SIZE (h)))
+   + (FASLHDR_PRIMITIVE_TABLE_SIZE (h))                                        \
+   + (((FASLHDR_VERSION (h)) >= FASL_VERSION_EPHEMERONS)               \
+      ? (VECTOR_DATA + (FASLHDR_EPHEMERON_COUNT (h)))                  \
+      : 0))
 
 struct load_band_termination_state
 {
@@ -68,7 +71,7 @@ static unsigned long reload_constant_size = 0;
 static void init_fasl_file (const char *, bool, fasl_file_handle_t *);
 static void close_fasl_file (void *);
 
-static SCHEME_OBJECT load_file (fasl_file_handle_t);
+static SCHEME_OBJECT load_file (fasl_file_handle_t, unsigned long);
 static void * read_from_file (void *, size_t, fasl_file_handle_t);
 static bool primitive_numbers_unchanged_p (SCHEME_OBJECT *);
 
@@ -120,7 +123,7 @@ that was dumped.")
     }
   failed_heap_length = 0;
 
-  result = (load_file (handle));
+  result = (load_file (handle, ephemeron_count));
   transaction_commit ();
   PRIMITIVE_RETURN (result);
 }
@@ -243,7 +246,8 @@ read_band_file (SCHEME_OBJECT s)
 
   init_fasl_file (file_name, true, (&handle));
   if (!allocations_ok_p ((FASLHDR_CONSTANT_SIZE (fh)),
-                        (REQUIRED_HEAP (fh))))
+                        (REQUIRED_HEAP (fh)),
+                        (FASLHDR_HEAP_RESERVED (fh))))
     signal_error_from_primitive (ERR_FASL_FILE_TOO_BIG);
 
   /* Now read the file into memory.  Past this point we can't abort
@@ -251,8 +255,9 @@ read_band_file (SCHEME_OBJECT s)
   ENTER_CRITICAL_SECTION ("band load");
   (state->no_return_p) = true;
 
-  reset_allocator_parameters (FASLHDR_CONSTANT_SIZE (fh));
-  result = (load_file (handle));
+  reset_allocator_parameters
+    ((FASLHDR_CONSTANT_SIZE (fh)), (FASLHDR_HEAP_RESERVED (fh)));
+  result = (load_file (handle, 0));
 
   /* Done -- we have the new image.  */
   transaction_commit ();
@@ -350,7 +355,7 @@ execute_reload_cleanups (void)
 }
 \f
 static SCHEME_OBJECT
-load_file (fasl_file_handle_t handle)
+load_file (fasl_file_handle_t handle, unsigned long prior_ephemeron_count)
 {
   new_heap_start = Free;
   new_constant_start = constant_alloc_next;
@@ -430,6 +435,13 @@ load_file (fasl_file_handle_t handle)
     }
 #endif
 
+  if ((FASLHDR_VERSION (fh)) >= FASL_VERSION_EPHEMERONS)
+    {
+      ephemeron_count
+       = (prior_ephemeron_count + (FASLHDR_EPHEMERON_COUNT (fh)));
+      ephemeron_array = (make_vector (ephemeron_count, SHARP_F, false));
+    }
+
   return
     (* ((SCHEME_OBJECT *)
        (relocate_address (FASLHDR_ROOT_POINTER (fh)))));

diff --git a/src/microcode/memmag.c b/src/microcode/memmag.c
index 3c7521c131bf95db9aafdbc53f5e129935c78f62..be686bc0783409b2309ce3928e5c21465eae68b2 100644 (file)
--- a/src/microcode/memmag.c
+++ b/src/microcode/memmag.c
@@ -139,7 +139,7 @@ setup_memory (unsigned long heap_size,
   saved_stack_size = stack_size;
   saved_constant_size = constant_size;
   saved_heap_size = heap_size;
-  reset_allocator_parameters (0);
+  reset_allocator_parameters (0, 0);
   initialize_gc (heap_size, (&heap_start), (&Free), allocate_tospace, abort_gc);
 }
 
@@ -151,20 +151,22 @@ reset_memory (void)
 }
 
 bool
-allocations_ok_p (unsigned long n_constant, unsigned long n_heap)
+allocations_ok_p (unsigned long n_constant,
+                 unsigned long n_heap,
+                 unsigned long n_reserved)
 {
   return
     ((memory_block_start
       + saved_stack_size
       + n_constant + CONSTANT_SPACE_FUDGE
-      + n_heap + DEFAULT_HEAP_RESERVED)
+      + n_heap + ((n_reserved == 0) ? DEFAULT_HEAP_RESERVED : n_reserved))
      < memory_block_end);
 }
 
 void
-reset_allocator_parameters (unsigned long n_constant)
+reset_allocator_parameters (unsigned long n_constant, unsigned long reserved)
 {
-  heap_reserved = DEFAULT_HEAP_RESERVED;
+  heap_reserved = ((reserved == 0) ? DEFAULT_HEAP_RESERVED : reserved);
   gc_space_needed = 0;
   SET_STACK_LIMITS (memory_block_start, saved_stack_size);
   constant_start = (memory_block_start + saved_stack_size);

diff --git a/src/microcode/memmag.h b/src/microcode/memmag.h
index 990f8cec28619f797620c48a1d5255458fb540b5..67e15d79ee4eaf62d9c238b8fde259be53c76249 100644 (file)
--- a/src/microcode/memmag.h
+++ b/src/microcode/memmag.h
@@ -83,8 +83,8 @@ USA.
 #  define CONSTANT_SPACE_FUDGE 128
 #endif
 
-extern bool allocations_ok_p (unsigned long, unsigned long);
-extern void reset_allocator_parameters (unsigned long);
+extern bool allocations_ok_p (unsigned long, unsigned long, unsigned long);
+extern void reset_allocator_parameters (unsigned long, unsigned long);
 extern bool object_in_heap_p (SCHEME_OBJECT);
 extern void std_gc_pt1 (void);
 extern void std_gc_pt2 (void);