From: Chris Hanson Date: Thu, 14 Jun 2007 13:31:33 +0000 (+0000) Subject: Eliminate requirement that fasload files have the same X-Git-Tag: 20090517-FFI~531 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ef1a580bf7d6c124f553029f3eb964b01860212e;p=mit-scheme.git 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 3b6528e8d..69a5ba42d 100644 --- 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 *); 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 3cdc03910..1061c4014 100644 --- 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 d892e669d..5b655d36d 100644 --- 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 *) \