From: Taylor R Campbell Date: Sat, 4 Sep 2010 05:10:17 +0000 (+0000) Subject: New fasl version to support ephemerons. X-Git-Tag: 20101212-Gtk~65 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4d5a689dc34dda582b80682a0d939b3cff9c7811;p=mit-scheme.git 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 c6b004014..37c0c6dd7 100644 --- 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); @@ -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)); +} 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.") } 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 34c4f5f97..43fa75f09 100644 --- 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)))); } 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 fde15c759..3945e0ebf 100644 --- 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 */ /* 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 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 be871f014..3e7cf3f40 100644 --- 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) } 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 3c7521c13..be686bc07 100644 --- 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 990f8cec2..67e15d79e 100644 --- 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);