From 500515d2a5a964ee82f0e35f266ef05b65577c37 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Thu, 4 Nov 1993 04:03:35 +0000 Subject: [PATCH] Add hooks for the C back end to dump a description of the C code blocks that a band depends on, and to verify compatibility after a disk-restore. --- v7/src/microcode/bchdmp.c | 58 ++++++++++++---- v7/src/microcode/cmpint.c | 106 +++++++++++++++++++--------- v7/src/microcode/dump.c | 138 +++++++++++++++++++------------------ v7/src/microcode/fasdump.c | 107 +++++++++++++++------------- v7/src/microcode/fasl.h | 19 +++-- v7/src/microcode/fasload.c | 80 ++++++++++++++------- v7/src/microcode/load.c | 45 ++++++------ v8/src/microcode/cmpint.c | 106 +++++++++++++++++++--------- v8/src/microcode/fasl.h | 19 +++-- 9 files changed, 426 insertions(+), 252 deletions(-) diff --git a/v7/src/microcode/bchdmp.c b/v7/src/microcode/bchdmp.c index 1f6f3843d..2ddd80412 100644 --- a/v7/src/microcode/bchdmp.c +++ b/v7/src/microcode/bchdmp.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: bchdmp.c,v 9.73 1993/10/14 19:18:42 gjr Exp $ +$Id: bchdmp.c,v 9.74 1993/11/04 04:03:27 gjr Exp $ Copyright (c) 1987-1993 Massachusetts Institute of Technology @@ -744,6 +744,18 @@ DEFUN (dump_to_file, (root, fname), Primitive_GC (table_end - saved_free); } +#ifdef NATIVE_CODE_IS_C + + /* Cannot dump C compiled code. */ + + if (compiled_code_present_p) + { + fasdump_exit (0); + signal_error_from_primitive (ERR_COMPILED_CODE_ERROR); + } + +#endif /* NATIVE_CODE_IS_C */ + tsize = (table_end - table_start); hlength = ((sizeof (SCHEME_OBJECT)) * tsize); if (((lseek (dump_file, @@ -758,7 +770,7 @@ DEFUN (dump_to_file, (root, fname), hlength = ((sizeof (SCHEME_OBJECT)) * FASL_HEADER_LENGTH); prepare_dump_header (header, dumped_object, length, dumped_object, - 0, Constant_Space, tlength, tsize, + 0, Constant_Space, tlength, tsize, 0, 0, compiled_code_present_p, false); if (((lseek (dump_file, 0, 0)) == -1) || ((write (dump_file, ((char *) &header[0]), hlength)) != hlength)) @@ -839,7 +851,9 @@ DEFINE_PRIMITIVE ("PRIMITIVE-FASDUMP", Prim_prim_fasdump, 3, 3, 0) } } -extern SCHEME_OBJECT compiler_utilities; +extern SCHEME_OBJECT + compiler_utilities, + * EXFUN (cons_c_code_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)); /* (DUMP-BAND PROCEDURE FILE-NAME) Saves all of the heap and pure space on FILE-NAME. When the @@ -849,9 +863,14 @@ extern SCHEME_OBJECT compiler_utilities; DEFINE_PRIMITIVE ("DUMP-BAND", Prim_band_dump, 2, 2, 0) { - SCHEME_OBJECT Combination, *table_start, *table_end, *saved_free; - long table_length; - Boolean result; + SCHEME_OBJECT + Combination, * saved_free, + * prim_table_start, * prim_table_end, + * c_table_start, * c_table_end; + long + prim_table_length, + c_table_length; + Boolean result = false; PRIMITIVE_HEADER (2); Band_Dump_Permitted (); @@ -872,11 +891,18 @@ DEFINE_PRIMITIVE ("DUMP-BAND", Prim_band_dump, 2, 2, 0) (* Free) = (MAKE_POINTER_OBJECT (TC_LIST, (Free - 2))); Free ++; /* Some compilers are TOO clever about this and increment Free before calculating Free-2! */ - table_start = Free; - table_end = (cons_whole_primitive_table (Free, Heap_Top, &table_length)); - if (table_end >= Heap_Top) - result = false; - else + prim_table_start = Free; + prim_table_end = (cons_whole_primitive_table (prim_table_start, + Heap_Top, + &prim_table_length)); + if (prim_table_end >= Heap_Top) + goto done; + + c_table_start = prim_table_end; + c_table_end = (cons_c_code_table (c_table_start, Heap_Top, &c_table_length)); + if (c_table_end >= Heap_Top) + goto done; + { SCHEME_OBJECT * faligned_heap, * faligned_constant; CONST char * filename = ((CONST char *) (STRING_LOC ((ARG_REF (2)), 0))); @@ -901,13 +927,17 @@ DEFINE_PRIMITIVE ("DUMP-BAND", Prim_band_dump, 2, 2, 0) faligned_heap, ((long) (Free_Constant - faligned_constant)), faligned_constant, - table_start, table_length, - ((long) (table_end - table_start)), + prim_table_start, prim_table_length, + ((long) (prim_table_end - prim_table_start)), + c_table_start, c_table_length, + ((long) (c_table_end - c_table_start)), (compiler_utilities != SHARP_F), true)); OS_channel_close_noerror (dump_channel); - if (!result) + if (! result) OS_file_remove (filename); } + +done: Band_Dump_Exit_Hook (); Free = saved_free; PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (result)); diff --git a/v7/src/microcode/cmpint.c b/v7/src/microcode/cmpint.c index 8eee56323..a6eda50a0 100644 --- a/v7/src/microcode/cmpint.c +++ b/v7/src/microcode/cmpint.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: cmpint.c,v 1.75 1993/11/01 23:52:47 gjr Exp $ +$Id: cmpint.c,v 1.76 1993/11/04 04:03:35 gjr Exp $ Copyright (c) 1989-1993 Massachusetts Institute of Technology @@ -277,7 +277,11 @@ extern C_UTILITY SCHEME_OBJECT EXFUN (compiled_with_interrupt_mask, (unsigned long, SCHEME_OBJECT, unsigned long)), - EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT)); + EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT)), + * EXFUN (cons_c_code_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)); + +extern C_UTILITY Boolean + EXFUN (install_c_code_table, (SCHEME_OBJECT *, long)); extern C_UTILITY void EXFUN (compiler_initialize, (long fasl_p)), @@ -285,7 +289,7 @@ extern C_UTILITY void EXFUN (store_variable_cache, (SCHEME_OBJECT extension, SCHEME_OBJECT block, long offset)), EXFUN (compiled_entry_type, (SCHEME_OBJECT entry, long *buffer)), - EXFUN (declare_compiled_code_block, (SCHEME_OBJECT block)); + EXFUN (declare_compiled_code_block, (SCHEME_OBJECT block)); extern C_TO_SCHEME long EXFUN (enter_compiled_expression, (void)), @@ -3418,29 +3422,6 @@ DEFUN_VOID (compiler_reset_internal) #define COMPILER_UTILITIES_LENGTH ((2 * (TRAMPOLINE_ENTRY_SIZE + 1)) + 1) -C_UTILITY void -DEFUN (compiler_reset, - (new_block), - SCHEME_OBJECT new_block) -{ - /* Called after a disk restore */ - - if (((OBJECT_TYPE (new_block)) != TC_COMPILED_CODE_BLOCK) - || ((OBJECT_TYPE (MEMORY_REF (new_block, 0))) != TC_MANIFEST_NM_VECTOR) - || ((VECTOR_LENGTH (new_block)) != (COMPILER_UTILITIES_LENGTH - 1))) - { - extern void EXFUN (compiler_reset_error, (void)); - - compiler_reset_error (); - } - else - { - compiler_utilities = new_block; - compiler_reset_internal (); - } - return; -} - C_UTILITY void DEFUN (compiler_initialize, (fasl_p), long fasl_p) { @@ -3503,6 +3484,50 @@ DEFUN (compiler_initialize, (fasl_p), long fasl_p) return; } +C_UTILITY void +DEFUN (compiler_reset, + (new_block), + SCHEME_OBJECT new_block) +{ + /* Called after a disk restore */ + + if (((OBJECT_TYPE (new_block)) != TC_COMPILED_CODE_BLOCK) + || ((OBJECT_TYPE (MEMORY_REF (new_block, 0))) != TC_MANIFEST_NM_VECTOR) + || ((VECTOR_LENGTH (new_block)) != (COMPILER_UTILITIES_LENGTH - 1))) + { + extern void EXFUN (compiler_reset_error, (void)); + + compiler_reset_error (); + } + else + { + compiler_utilities = new_block; + compiler_reset_internal (); + } + return; +} + +#ifndef NATIVE_CODE_IS_C + +SCHEME_OBJECT * +DEFUN (cons_c_code_table, (start, limit, length), + SCHEME_OBJECT * start + AND SCHEME_OBJECT * limit + AND long * length) +{ + * length = 0; + return (start); +} + +Boolean +DEFUN (install_c_code_table, (table, length), + SCHEME_OBJECT * table AND long length) +{ + return (true); +} + +#endif /* NATIVE_CODE_IS_C */ + #else /* not HAS_COMPILER_SUPPORT */ /* Stubs for compiler utilities. @@ -3548,7 +3573,11 @@ extern SCHEME_OBJECT EXFUN (compiled_with_interrupt_mask, (unsigned long, SCHEME_OBJECT, unsigned long)), - EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT)); + EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT)), + * EXFUN (cons_c_code_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)); + +extern Boolean + EXFUN (install_c_code_table, (SCHEME_OBJECT *, long)); extern void EXFUN (compiler_reset, (SCHEME_OBJECT new_block)), @@ -3618,6 +3647,23 @@ DEFUN (compiled_with_stack_marker, (thunk), SCHEME_OBJECT thunk) signal_error_from_primitive (ERR_INAPPLICABLE_CONTINUATION); /*NOTREACHED*/ } + +SCHEME_OBJECT * +DEFUN (cons_c_code_table, (start, limit, length), + SCHEME_OBJECT * start + AND SCHEME_OBJECT * limit + AND long * length) +{ + * length = 0; + return (start); +} + +Boolean +DEFUN (install_c_code_table, (table, length), + SCHEME_OBJECT * table AND long length) +{ + return (true); +} /* Bad entry points. */ @@ -3786,16 +3832,12 @@ LOSING_RETURN_ADDRESS (comp_error_restart) /* NOP entry points */ void -DEFUN (compiler_reset, - (new_block), - SCHEME_OBJECT new_block) +DEFUN (compiler_reset, (new_block), SCHEME_OBJECT new_block) { extern void EXFUN (compiler_reset_error, (void)); if (new_block != SHARP_F) - { compiler_reset_error (); - } return; } diff --git a/v7/src/microcode/dump.c b/v7/src/microcode/dump.c index 99bf0c2bb..f69fc8590 100644 --- a/v7/src/microcode/dump.c +++ b/v7/src/microcode/dump.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: dump.c,v 9.36 1993/02/18 05:14:02 gjr Exp $ +$Id: dump.c,v 9.37 1993/11/04 04:03:02 gjr Exp $ Copyright (c) 1987-1993 Massachusetts Institute of Technology @@ -44,22 +44,23 @@ extern SCHEME_OBJECT #endif /* PSBMAP_H_INCLUDED */ void -DEFUN (prepare_dump_header, - (Buffer, Dumped_Object, - Heap_Count, Heap_Relocation, - Constant_Count, Constant_Relocation, - table_length, table_size, - cc_code_p, band_p), - SCHEME_OBJECT *Buffer AND - SCHEME_OBJECT *Dumped_Object AND - long Heap_Count AND - SCHEME_OBJECT *Heap_Relocation AND - long Constant_Count AND - SCHEME_OBJECT *Constant_Relocation AND - long table_length AND - long table_size AND - Boolean cc_code_p AND - Boolean band_p) +DEFUN (prepare_dump_header, (Buffer, Dumped_Object, + Heap_Count, Heap_Relocation, + Constant_Count, Constant_Relocation, + table_length, table_size, + cc_code_p, band_p), + SCHEME_OBJECT * Buffer + AND SCHEME_OBJECT * Dumped_Object + AND long Heap_Count + AND SCHEME_OBJECT * Heap_Relocation + AND long Constant_Count + AND SCHEME_OBJECT * Constant_Relocation + AND long prim_table_length + AND long prim_table_size + AND long c_table_length + AND long c_table_size + AND Boolean cc_code_p + AND Boolean band_p) { long i; @@ -97,12 +98,12 @@ DEFUN (prepare_dump_header, #else MAKE_POINTER_OBJECT (TC_BROKEN_HEART, Stack_Top); #endif /* USE_STACKLETS */ - + Buffer[FASL_Offset_Prim_Length] = - MAKE_OBJECT (TC_BROKEN_HEART, table_length); + MAKE_OBJECT (TC_BROKEN_HEART, prim_table_length); Buffer[FASL_Offset_Prim_Size] = - MAKE_OBJECT (TC_BROKEN_HEART, table_size); - + MAKE_OBJECT (TC_BROKEN_HEART, prim_table_size); + if (cc_code_p) { Buffer[FASL_Offset_Ci_Version] = @@ -121,11 +122,14 @@ DEFUN (prepare_dump_header, Buffer[FASL_Offset_Ut_Base] = SHARP_F; } + Buffer[FASL_Offset_C_Length] = + MAKE_OBJECT (TC_BROKEN_HEART, prim_table_length); + Buffer[FASL_Offset_C_Size] = + MAKE_OBJECT (TC_BROKEN_HEART, prim_table_size); + Buffer[FASL_Offset_Check_Sum] = SHARP_F; for (i = FASL_Offset_First_Free; i < FASL_HEADER_LENGTH; i++) - { Buffer[i] = SHARP_F; - } return; } @@ -133,19 +137,22 @@ extern unsigned long EXFUN (checksum_area, (unsigned long *, long, unsigned long)); Boolean -DEFUN (Write_File, - (Dumped_Object, Heap_Count, Heap_Relocation, - Constant_Count, Constant_Relocation, - table_start, table_length, table_size, - cc_code_p, band_p), - SCHEME_OBJECT *Dumped_Object +DEFUN (Write_File, (Dumped_Object, Heap_Count, Heap_Relocation, + Constant_Count, Constant_Relocation, + prim_table_start, prim_table_length, prim_table_size, + c_table_start, c_table_length, c_table_size, + cc_code_p, band_p), + SCHEME_OBJECT * Dumped_Object AND long Heap_Count - AND SCHEME_OBJECT *Heap_Relocation + AND SCHEME_OBJECT * Heap_Relocation AND long Constant_Count - AND SCHEME_OBJECT *Constant_Relocation - AND SCHEME_OBJECT *table_start - AND long table_length - AND long table_size + AND SCHEME_OBJECT * Constant_Relocation + AND SCHEME_OBJECT * prim_table_start + AND long prim_table_length + AND long prim_table_size + AND SCHEME_OBJECT * c_table_start + AND long c_table_length + AND long c_table_size AND Boolean cc_code_p AND Boolean band_p) { @@ -155,7 +162,9 @@ DEFUN (Write_File, prepare_dump_header (Buffer, Dumped_Object, Heap_Count, Heap_Relocation, Constant_Count, Constant_Relocation, - table_length, table_size, cc_code_p, band_p); + prim_table_length, prim_table_size, + c_table_length, c_table_size, + cc_code_p, band_p); /* This is not done in prepare_dump_header because it doesn't work when prepare_dump_header is invoked from bchdmp. @@ -177,43 +186,42 @@ DEFUN (Write_File, checksum = (checksum_area (((unsigned long *) Constant_Relocation), Constant_Count, checksum)); - checksum = (checksum_area (((unsigned long *) table_start), - table_size, + checksum = (checksum_area (((unsigned long *) prim_table_start), + prim_table_size, checksum)); + checksum = (checksum_area (((unsigned long *) c_table_start), + c_table_size, + checksum)); + Buffer[FASL_Offset_Check_Sum] = checksum; + + if ((Write_Data (FASL_HEADER_LENGTH, Buffer)) + != FASL_HEADER_LENGTH) + return (false); - if ((Write_Data (FASL_HEADER_LENGTH, Buffer)) != - FASL_HEADER_LENGTH) - { + if ((Heap_Count != 0) + && ((Write_Data (Heap_Count, Heap_Relocation)) + != Heap_Count)) return (false); - } - if (Heap_Count != 0) - { - if ((Write_Data (Heap_Count, Heap_Relocation)) != - Heap_Count) - { - return (false); - } - } - if (Constant_Count != 0) - { - if ((Write_Data (Constant_Count, Constant_Relocation)) != - Constant_Count) - { + + if ((Constant_Count != 0) + && ((Write_Data (Constant_Count, Constant_Relocation)) + != Constant_Count)) + return (false); + + if ((prim_table_size != 0) + && ((Write_Data (prim_table_size, prim_table_start)) + != prim_table_size)) return (false); - } - } - if (table_size != 0) - { - if ((Write_Data (table_size, table_start)) != - table_size) - { + + if ((c_table_size != 0) + && ((Write_Data (c_table_size, c_table_start)) + != c_table_size)) return (false); - } - } + return (true); } - + unsigned long DEFUN (checksum_area, (start, count, initial_value), register unsigned long * start @@ -224,9 +232,7 @@ DEFUN (checksum_area, (start, count, initial_value), value = initial_value; while ((--count) >= 0) - { value = (value ^ (*start++)); - } return (value); } diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c index 2410f9d71..a794e351e 100644 --- a/v7/src/microcode/fasdump.c +++ b/v7/src/microcode/fasdump.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: fasdump.c,v 9.57 1993/10/14 19:18:15 gjr Exp $ +$Id: fasdump.c,v 9.58 1993/11/04 04:03:07 gjr Exp $ Copyright (c) 1987-1993 Massachusetts Institute of Technology @@ -61,7 +61,8 @@ extern SCHEME_OBJECT * EXFUN (initialize_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *)), * EXFUN (cons_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)), * EXFUN (cons_whole_primitive_table, - (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)); + (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)), + * EXFUN (cons_c_code_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)); /* Some statics used freely in this file */ @@ -115,9 +116,7 @@ static CONST char * dump_file_name = ((char *) 0); { \ Transport_Compiled(); \ if ((mode == 2) && ((OBJECT_TYPE (*(To - 1))) == TC_ENVIRONMENT)) \ - { \ *(To - 1) = SHARP_F; \ - } \ } #define Dump_Compiled_Entry(label) \ @@ -155,7 +154,7 @@ DEFUN (DumpLoop, (Scan, mode), fast SCHEME_OBJECT * Scan AND int mode) { case TC_PRIMITIVE: case TC_PCOMB0: - *Scan = dump_renumber_primitive(*Scan); + * Scan = (dump_renumber_primitive (* Scan)); break; case TC_BROKEN_HEART: @@ -180,14 +179,14 @@ DEFUN (DumpLoop, (Scan, mode), fast SCHEME_OBJECT * Scan AND int mode) compiled_code_present_p = true; Dump_Compiled_Entry (after_entry); after_entry: - *Scan = Temp; + * Scan = Temp; break; case TC_MANIFEST_CLOSURE: { fast long count; - fast char *word_ptr; - SCHEME_OBJECT *area_end; + fast char * word_ptr; + SCHEME_OBJECT * area_end; compiled_code_present_p = true; START_CLOSURE_RELOCATION (Scan); @@ -242,8 +241,8 @@ DEFUN (DumpLoop, (Scan, mode), fast SCHEME_OBJECT * Scan AND int mode) case GLOBAL_OPERATOR_LINKAGE_KIND: { fast long count; - fast char *word_ptr; - SCHEME_OBJECT *end_scan; + fast char * word_ptr; + SCHEME_OBJECT * end_scan; START_OPERATOR_RELOCATION (Scan); count = (READ_OPERATOR_LINKAGE_COUNT (Temp)); @@ -376,9 +375,8 @@ DEFUN (Fasdump_Exit, (code, close_p), long code AND Boolean close_p) Fixes = Fixup; if (close_p) - { OS_channel_close_noerror (dump_channel); - } + result = true; while (Fixes != NewMemTop) { @@ -389,9 +387,8 @@ DEFUN (Fasdump_Exit, (code, close_p), long code AND Boolean close_p) } Fixup = Fixes; if ((close_p) && ((!result) || (code != PRIM_DONE))) - { OS_file_remove (dump_file_name); - } + dump_file_name = ((char *) 0); Fasdump_Exit_Hook (); if (!result) @@ -400,13 +397,9 @@ DEFUN (Fasdump_Exit, (code, close_p), long code AND Boolean close_p) /*NOTREACHED*/ } if (code == PRIM_DONE) - { return (SHARP_T); - } else if (code == PRIM_INTERRUPT) - { return (SHARP_F); - } else { signal_error_from_primitive (code); @@ -440,8 +433,8 @@ DEFINE_PRIMITIVE ("PRIMITIVE-FASDUMP", Prim_prim_fasdump, 3, 3, 0) Tchannel channel; Boolean arg_string_p; SCHEME_OBJECT Object, *New_Object, arg2, flag; - SCHEME_OBJECT *table_start, *table_end; - long Length, table_length; + SCHEME_OBJECT * prim_table_start, * prim_table_end; + long Length, prim_table_length; Boolean result; PRIMITIVE_HEADER (3); @@ -449,19 +442,15 @@ DEFINE_PRIMITIVE ("PRIMITIVE-FASDUMP", Prim_prim_fasdump, 3, 3, 0) arg2 = (ARG_REF (2)); arg_string_p = (STRING_P (arg2)); if (!arg_string_p) - { channel = (arg_channel (2)); - } flag = (ARG_REF (3)); compiled_code_present_p = false; - table_end = &Free[(Space_Before_GC ())]; - table_start = (initialize_primitive_table (Free, table_end)); - if (table_start >= table_end) - { - Primitive_GC (table_start - Free); - } + prim_table_end = &Free[(Space_Before_GC ())]; + prim_table_start = (initialize_primitive_table (Free, prim_table_end)); + if (prim_table_start >= prim_table_end) + Primitive_GC (prim_table_start - Free); Fasdump_Free_Calc (NewFree, NewMemTop, Orig_New_Free); Fixup = NewMemTop; @@ -482,28 +471,34 @@ DEFINE_PRIMITIVE ("PRIMITIVE-FASDUMP", Prim_prim_fasdump, 3, 3, 0) DUMPLOOP (New_Object, ((flag == SHARP_F) ? 0 : ((flag == SHARP_T) ? 1 : 2))); Length = (NewFree - New_Object); - table_start = NewFree; - table_end = (cons_primitive_table (NewFree, Fixup, &table_length)); - if (table_end >= Fixup) - { + prim_table_start = NewFree; + prim_table_end = (cons_primitive_table (NewFree, Fixup, &prim_table_length)); + if (prim_table_end >= Fixup) FASDUMP_INTERRUPT (); - } + +#ifdef NATIVE_CODE_IS_C + + /* Cannot dump C compiled code. */ + + if (compiled_code_present_p) + PRIMITIVE_RETURN (Fasdump_Exit (ERR_COMPILED_CODE_ERROR, false)); + +#endif /* NATIVE_CODE_IS_C */ if (arg_string_p) { channel = (OS_open_dump_file (dump_file_name)); if (channel == NO_CHANNEL) - { PRIMITIVE_RETURN (Fasdump_Exit (ERR_ARG_2_BAD_RANGE, false)); - } } dump_channel = channel; result = (Write_File (New_Object, Length, New_Object, 0, Constant_Space, - table_start, table_length, - ((long) (table_end - table_start)), + prim_table_start, prim_table_length, + ((long) (prim_table_end - prim_table_start)), + prim_table_end, 0, 0, compiled_code_present_p, false)); PRIMITIVE_RETURN (Fasdump_Exit ((result ? PRIM_DONE : PRIM_INTERRUPT), @@ -518,9 +513,14 @@ DEFINE_PRIMITIVE ("PRIMITIVE-FASDUMP", Prim_prim_fasdump, 3, 3, 0) DEFINE_PRIMITIVE ("DUMP-BAND", Prim_band_dump, 2, 2, 0) { - SCHEME_OBJECT Combination, *table_start, *table_end, *saved_free; - long table_length; - Boolean result; + SCHEME_OBJECT + Combination, * saved_free, + * prim_table_start, * prim_table_end, + * c_table_start, * c_table_end; + long + prim_table_length, + c_table_length; + Boolean result = false; PRIMITIVE_HEADER (2); Band_Dump_Permitted (); @@ -541,11 +541,18 @@ DEFINE_PRIMITIVE ("DUMP-BAND", Prim_band_dump, 2, 2, 0) (* Free) = (MAKE_POINTER_OBJECT (TC_LIST, (Free - 2))); Free ++; /* Some compilers are TOO clever about this and increment Free before calculating Free-2! */ - table_start = Free; - table_end = (cons_whole_primitive_table (Free, Heap_Top, &table_length)); - if (table_end >= Heap_Top) - result = false; - else + prim_table_start = Free; + prim_table_end = (cons_whole_primitive_table (prim_table_start, + Heap_Top, + &prim_table_length)); + if (prim_table_end >= Heap_Top) + goto done; + + c_table_start = prim_table_end; + c_table_end = (cons_c_code_table (c_table_start, Heap_Top, &c_table_length)); + if (c_table_end >= Heap_Top) + goto done; + { SCHEME_OBJECT * faligned_heap, * faligned_constant; CONST char * filename = ((CONST char *) (STRING_LOC ((ARG_REF (2)), 0))); @@ -570,13 +577,17 @@ DEFINE_PRIMITIVE ("DUMP-BAND", Prim_band_dump, 2, 2, 0) faligned_heap, ((long) (Free_Constant - faligned_constant)), faligned_constant, - table_start, table_length, - ((long) (table_end - table_start)), + prim_table_start, prim_table_length, + ((long) (prim_table_end - prim_table_start)), + c_table_start, c_table_length, + ((long) (c_table_end - c_table_start)), (compiler_utilities != SHARP_F), true)); OS_channel_close_noerror (dump_channel); - if (!result) + if (! result) OS_file_remove (filename); } + +done: Band_Dump_Exit_Hook (); Free = saved_free; PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (result)); diff --git a/v7/src/microcode/fasl.h b/v7/src/microcode/fasl.h index 65f73c09e..aa53ae9d4 100644 --- a/v7/src/microcode/fasl.h +++ b/v7/src/microcode/fasl.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: fasl.h,v 9.33 1993/02/15 02:51:22 gjr Exp $ +$Id: fasl.h,v 9.34 1993/11/04 04:02:49 gjr Exp $ Copyright (c) 1987-1993 Massachusetts Institute of Technology @@ -58,8 +58,10 @@ MIT in each case. */ #define FASL_Offset_Ci_Version 10 /* Version number for compiled code interface */ #define FASL_Offset_Ut_Base 11 /* Address of the utilities vector */ #define FASL_Offset_Check_Sum 12 /* Header and data checksum. */ +#define FASL_Offset_C_Length 13 /* Number of entries in the C code table */ +#define FASL_Offset_C_Size 14 /* Size of C code table in SCHEME_OBJECTs */ -#define FASL_Offset_First_Free 13 /* Used to clear header */ +#define FASL_Offset_First_Free 15 /* Used to clear header */ /* Aliases for backwards compatibility. */ @@ -77,6 +79,7 @@ MIT in each case. */ #define SUBVERSION_MASK ((ONE << SUBVERSION_LENGTH) - 1) #define The_Sub_Version(P) (((P) >> MACHINE_TYPE_LENGTH) & SUBVERSION_MASK) #define The_Version(P) (OBJECT_TYPE (P)) + #define Make_Version(V, S, M) \ MAKE_OBJECT ((V), ((((unsigned long) (S)) << MACHINE_TYPE_LENGTH) \ | (M))) \ @@ -85,10 +88,11 @@ MIT in each case. */ #define CI_VERSION(P) (((P) >> (DATUM_LENGTH / 2)) & CI_MASK) #define CI_PROCESSOR(P) ((P) & CI_MASK) #define CI_BAND_P(P) ((OBJECT_TYPE (P)) == TC_TRUE) + #define MAKE_CI_VERSION(Band_p, Version, Processor_Type) \ MAKE_OBJECT (((Band_p) ? TC_TRUE : TC_NULL), \ - ((((unsigned long) (Version)) << (DATUM_LENGTH / 2)) \ - | (Processor_Type))) \ + ((((unsigned long) (Version)) << (DATUM_LENGTH / 2)) \ + | (Processor_Type))) \ /* "Memorable" FASL versions -- ones where we modified something and want to remain backwards compatible. @@ -107,11 +111,12 @@ MIT in each case. */ #define FASL_MERGED_PRIMITIVES 7 #define FASL_INTERFACE_VERSION 8 #define FASL_NEW_BIGNUMS 9 +#define FASL_C_CODE 10 /* Current parameters. Always used on output. */ #define FASL_FORMAT_VERSION FASL_FORMAT_ADDED_STACK -#define FASL_SUBVERSION FASL_NEW_BIGNUMS +#define FASL_SUBVERSION FASL_C_CODE /* The definitions below correspond to the ones above. They usually @@ -120,11 +125,11 @@ MIT in each case. */ */ #ifndef FASL_READ_VERSION -#define FASL_READ_VERSION FASL_FORMAT_VERSION +#define FASL_READ_VERSION FASL_FORMAT_ADDED_STACK #endif #ifndef FASL_READ_SUBVERSION -#define FASL_READ_SUBVERSION FASL_SUBVERSION +#define FASL_READ_SUBVERSION FASL_NEW_BIGNUMS #endif /* These are for Bintopsb. diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c index 736f50f07..2880955e1 100644 --- a/v7/src/microcode/fasload.c +++ b/v7/src/microcode/fasload.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: fasload.c,v 9.73 1993/10/31 16:51:06 gjr Exp $ +$Id: fasload.c,v 9.74 1993/11/04 04:03:14 gjr Exp $ Copyright (c) 1987-1993 Massachusetts Institute of Technology @@ -65,11 +65,18 @@ extern char * Abort_Names []; extern SCHEME_OBJECT * load_renumber_table; extern SCHEME_OBJECT compiler_utilities; -extern SCHEME_OBJECT EXFUN (intern_symbol, (SCHEME_OBJECT)); -extern void EXFUN (install_primitive_table, (SCHEME_OBJECT *, long)); -extern void EXFUN (compiler_reset_error, (void)); -extern void EXFUN (compiler_initialize, (long)); -extern void EXFUN (compiler_reset, (SCHEME_OBJECT)); +extern SCHEME_OBJECT + EXFUN (intern_symbol, (SCHEME_OBJECT)); + +extern void + EXFUN (install_primitive_table, (SCHEME_OBJECT *, long)), + EXFUN (install_c_table, (SCHEME_OBJECT *, long)), + EXFUN (compiler_reset_error, (void)), + EXFUN (compiler_initialize, (long)), + EXFUN (compiler_reset, (SCHEME_OBJECT)); + +extern Boolean + EXFUN (install_c_code_table, (SCHEME_OBJECT *, long)); #ifndef FLUSH_I_CACHE_REGION # define FLUSH_I_CACHE_REGION(addr, nwords) NOP() @@ -136,7 +143,10 @@ DEFUN (read_channel_continue, (header, mode, repeat_p), SET_MEMTOP (Heap_Top); } - heap_length = (Heap_Count + Primitive_Table_Size + Primitive_Table_Length); + heap_length = (Heap_Count + + Primitive_Table_Size + + Primitive_Table_Length + + C_Code_Table_Size); if (GC_Check (heap_length)) { @@ -239,10 +249,13 @@ DEFUN (read_file_start, (file_name, from_band_load), return; } -static SCHEME_OBJECT * -DEFUN (read_file_end, (mode), int mode) +static void +DEFUN (read_file_end, (mode, prim_table_ptr, c_code_table_ptr), + int mode + AND SCHEME_OBJECT ** prim_table_ptr + AND SCHEME_OBJECT ** c_code_table_ptr) { - SCHEME_OBJECT *table, *ignore; + SCHEME_OBJECT * prim_table, * c_code_table, * ignore; extern unsigned long checksum_area (); if ((Load_Data (Heap_Count, ((char *) Free))) != Heap_Count) @@ -277,8 +290,8 @@ DEFUN (read_file_end, (mode), int mode) Free_Constant += Const_Count; SET_CONSTANT_TOP (); - table = Free; - if ((Load_Data (Primitive_Table_Size, ((char *) Free))) + prim_table = Free; + if ((Load_Data (Primitive_Table_Size, ((char *) prim_table))) != Primitive_Table_Size) { if (mode != MODE_CHANNEL) @@ -286,19 +299,38 @@ DEFUN (read_file_end, (mode), int mode) signal_error_from_primitive (ERR_IO_ERROR); } computed_checksum = - (checksum_area (((unsigned long *) Free), + (checksum_area (((unsigned long *) prim_table), Primitive_Table_Size, computed_checksum)); - NORMALIZE_REGION (((char *) table), Primitive_Table_Size); + NORMALIZE_REGION (((char *) prim_table), Primitive_Table_Size); Free += Primitive_Table_Size; + c_code_table = Free; + if ((C_Code_Table_Size != 0) + && ((Load_Data (C_Code_Table_Size, ((char *) c_code_table))) + != C_Code_Table_Size)) + { + if (mode != MODE_CHANNEL) + OS_channel_close_noerror (load_channel); + signal_error_from_primitive (ERR_IO_ERROR); + } + computed_checksum = + (checksum_area (((unsigned long *) c_code_table), + C_Code_Table_Size, + computed_checksum)); + NORMALIZE_REGION (((char *) c_code_table), C_Code_Table_Size); + Free += C_Code_Table_Size; + if (mode != MODE_CHANNEL) OS_channel_close_noerror (load_channel); - if ((computed_checksum != ((unsigned long) 0)) && - (dumped_checksum != SHARP_F)) + if ((computed_checksum != ((unsigned long) 0)) + && (dumped_checksum != SHARP_F)) signal_error_from_primitive (ERR_IO_ERROR); - return (table); + + * prim_table_ptr = prim_table; + * c_code_table_ptr = c_code_table; + return; } /* Statics used by Relocate, below */ @@ -657,9 +689,9 @@ static SCHEME_OBJECT DEFUN (load_file, (mode), int mode) { SCHEME_OBJECT - *Orig_Heap, - *Constant_End, *Orig_Constant, - *temp, *primitive_table; + * Orig_Heap, + * Constant_End, * Orig_Constant, + * temp, * primitive_table, * c_code_table; /* Read File */ @@ -672,7 +704,7 @@ DEFUN (load_file, (mode), int mode) ALIGN_FLOAT (Free); Orig_Heap = Free; Orig_Constant = Free_Constant; - primitive_table = (read_file_end (mode)); + read_file_end (mode, &primitive_table, &c_code_table); Constant_End = Free_Constant; heap_relocation = (COMPUTE_RELOCATION (Orig_Heap, Heap_Base)); @@ -692,7 +724,7 @@ DEFUN (load_file, (mode), int mode) automagically: the utilities vector is part of the band. */ - if ((!band_p) && (dumped_utilities != SHARP_F)) + if ((! band_p) && (dumped_utilities != SHARP_F)) { if (compiler_utilities == SHARP_F) signal_error_from_primitive (ERR_FASLOAD_COMPILED_MISMATCH); @@ -713,9 +745,11 @@ DEFUN (load_file, (mode), int mode) Setup_For_String_Inversion (); #endif - /* Setup the primitive table */ + /* Setup the primitive and C code tables */ install_primitive_table (primitive_table, Primitive_Table_Length); + if (! (install_c_code_table (c_code_table, C_Code_Table_Length))) + signal_error_from_primitive (ERR_FASLOAD_COMPILED_MISMATCH); if ((mode != MODE_BAND) || (heap_relocation != ((relocation_type) 0)) diff --git a/v7/src/microcode/load.c b/v7/src/microcode/load.c index 8d4516b94..c5de81548 100644 --- a/v7/src/microcode/load.c +++ b/v7/src/microcode/load.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: load.c,v 9.32 1993/06/24 07:08:53 gjr Exp $ +$Id: load.c,v 9.33 1993/11/04 04:02:56 gjr Exp $ -Copyright (c) 1987-92 Massachusetts Institute of Technology +Copyright (c) 1987-1993 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -74,6 +74,7 @@ static long Const_Base, Const_Count, Dumped_Heap_Top, Dumped_Constant_Top, Primitive_Table_Size, Primitive_Table_Length, + C_Code_Table_Size, C_Code_Table_Length, dumped_processor_type, dumped_interface_version; static unsigned long @@ -90,14 +91,10 @@ DEFUN_VOID (print_fasl_information) printf ("Machine = %ld; Version = %ld; Subversion = %ld\n", Machine_Type, Version, Sub_Version); if ((dumped_processor_type != 0) || (dumped_interface_version != 0)) - { printf ("Compiled code interface version = %ld; Processor type = %ld\n", dumped_interface_version, dumped_processor_type); - } if (band_p) - { printf ("The file contains a dumped image (band).\n"); - } printf ("\nRelocation Information:\n\n"); printf ("Heap Count = %ld; Heap Base = 0x%lx; Heap Top = 0x%lx\n", @@ -110,13 +107,10 @@ DEFUN_VOID (print_fasl_information) printf ("Dumped object at 0x%lx (as read from file)\n", Dumped_Object); printf ("Compiled code utilities vector = 0x%lx\n", dumped_utilities); if (Ext_Prim_Vector != SHARP_F) - { printf ("External primitives vector = 0x%lx\n", Ext_Prim_Vector); - } else - { printf ("Length of primitive table = %ld\n", Primitive_Table_Length); - } + printf ("Length of C table = %ld\n", C_Code_Table_Length); printf ("Checksum = 0x%lx\n", dumped_checksum); return; } @@ -128,9 +122,8 @@ DEFUN (initialize_variables_from_fasl_header, (buffer), SCHEME_OBJECT Pointer_Heap_Base, Pointer_Const_Base; if (buffer[FASL_Offset_Marker] != FASL_FILE_MARKER) - { return (FASL_FILE_NOT_FASL); - } + NORMALIZE_HEADER (buffer, (sizeof(buffer) / sizeof(SCHEME_OBJECT)), buffer[FASL_Offset_Heap_Base], @@ -160,8 +153,8 @@ DEFUN (initialize_variables_from_fasl_header, (buffer), } else { - Primitive_Table_Length = OBJECT_DATUM (buffer[FASL_Offset_Prim_Length]); - Primitive_Table_Size = OBJECT_DATUM (buffer[FASL_Offset_Prim_Size]); + Primitive_Table_Length = (OBJECT_DATUM (buffer[FASL_Offset_Prim_Length])); + Primitive_Table_Size = (OBJECT_DATUM (buffer[FASL_Offset_Prim_Size])); Ext_Prim_Vector = SHARP_F; } @@ -175,15 +168,24 @@ DEFUN (initialize_variables_from_fasl_header, (buffer), } else { - SCHEME_OBJECT temp; + SCHEME_OBJECT temp = buffer[FASL_Offset_Ci_Version]; - temp = buffer[FASL_Offset_Ci_Version]; - - band_p = CI_BAND_P(temp); - dumped_processor_type = CI_PROCESSOR(temp); - dumped_interface_version = CI_VERSION(temp); + band_p = (CI_BAND_P (temp)); + dumped_processor_type = (CI_PROCESSOR (temp)); + dumped_interface_version = (CI_VERSION (temp)); dumped_utilities = buffer[FASL_Offset_Ut_Base]; } + + if (Sub_Version < FASL_C_CODE) + { + C_Code_Table_Length = 0; + C_Code_Table_Size = 0; + } + else + { + C_Code_Table_Length = (OBJECT_DATUM (buffer[FASL_Offset_C_Length])); + C_Code_Table_Size = (OBJECT_DATUM (buffer[FASL_Offset_C_Length])); + } #ifndef INHIBIT_FASL_VERSION_CHECK /* The error messages here should be handled by the runtime system! */ @@ -252,7 +254,6 @@ DEFUN (initialize_variables_from_fasl_header, (buffer), (checksum_area (((unsigned long *) &buffer[0]), ((long) (FASL_HEADER_LENGTH)), ((unsigned long) 0))); - } #endif /* INHIBIT_CHECKSUMS */ @@ -267,9 +268,7 @@ DEFUN_VOID (Read_Header) if ((Load_Data (FASL_HEADER_LENGTH, header)) != FASL_HEADER_LENGTH) - { return (FASL_FILE_TOO_SHORT); - } return (initialize_variables_from_fasl_header (&header[0])); } diff --git a/v8/src/microcode/cmpint.c b/v8/src/microcode/cmpint.c index 8eee56323..a6eda50a0 100644 --- a/v8/src/microcode/cmpint.c +++ b/v8/src/microcode/cmpint.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: cmpint.c,v 1.75 1993/11/01 23:52:47 gjr Exp $ +$Id: cmpint.c,v 1.76 1993/11/04 04:03:35 gjr Exp $ Copyright (c) 1989-1993 Massachusetts Institute of Technology @@ -277,7 +277,11 @@ extern C_UTILITY SCHEME_OBJECT EXFUN (compiled_with_interrupt_mask, (unsigned long, SCHEME_OBJECT, unsigned long)), - EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT)); + EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT)), + * EXFUN (cons_c_code_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)); + +extern C_UTILITY Boolean + EXFUN (install_c_code_table, (SCHEME_OBJECT *, long)); extern C_UTILITY void EXFUN (compiler_initialize, (long fasl_p)), @@ -285,7 +289,7 @@ extern C_UTILITY void EXFUN (store_variable_cache, (SCHEME_OBJECT extension, SCHEME_OBJECT block, long offset)), EXFUN (compiled_entry_type, (SCHEME_OBJECT entry, long *buffer)), - EXFUN (declare_compiled_code_block, (SCHEME_OBJECT block)); + EXFUN (declare_compiled_code_block, (SCHEME_OBJECT block)); extern C_TO_SCHEME long EXFUN (enter_compiled_expression, (void)), @@ -3418,29 +3422,6 @@ DEFUN_VOID (compiler_reset_internal) #define COMPILER_UTILITIES_LENGTH ((2 * (TRAMPOLINE_ENTRY_SIZE + 1)) + 1) -C_UTILITY void -DEFUN (compiler_reset, - (new_block), - SCHEME_OBJECT new_block) -{ - /* Called after a disk restore */ - - if (((OBJECT_TYPE (new_block)) != TC_COMPILED_CODE_BLOCK) - || ((OBJECT_TYPE (MEMORY_REF (new_block, 0))) != TC_MANIFEST_NM_VECTOR) - || ((VECTOR_LENGTH (new_block)) != (COMPILER_UTILITIES_LENGTH - 1))) - { - extern void EXFUN (compiler_reset_error, (void)); - - compiler_reset_error (); - } - else - { - compiler_utilities = new_block; - compiler_reset_internal (); - } - return; -} - C_UTILITY void DEFUN (compiler_initialize, (fasl_p), long fasl_p) { @@ -3503,6 +3484,50 @@ DEFUN (compiler_initialize, (fasl_p), long fasl_p) return; } +C_UTILITY void +DEFUN (compiler_reset, + (new_block), + SCHEME_OBJECT new_block) +{ + /* Called after a disk restore */ + + if (((OBJECT_TYPE (new_block)) != TC_COMPILED_CODE_BLOCK) + || ((OBJECT_TYPE (MEMORY_REF (new_block, 0))) != TC_MANIFEST_NM_VECTOR) + || ((VECTOR_LENGTH (new_block)) != (COMPILER_UTILITIES_LENGTH - 1))) + { + extern void EXFUN (compiler_reset_error, (void)); + + compiler_reset_error (); + } + else + { + compiler_utilities = new_block; + compiler_reset_internal (); + } + return; +} + +#ifndef NATIVE_CODE_IS_C + +SCHEME_OBJECT * +DEFUN (cons_c_code_table, (start, limit, length), + SCHEME_OBJECT * start + AND SCHEME_OBJECT * limit + AND long * length) +{ + * length = 0; + return (start); +} + +Boolean +DEFUN (install_c_code_table, (table, length), + SCHEME_OBJECT * table AND long length) +{ + return (true); +} + +#endif /* NATIVE_CODE_IS_C */ + #else /* not HAS_COMPILER_SUPPORT */ /* Stubs for compiler utilities. @@ -3548,7 +3573,11 @@ extern SCHEME_OBJECT EXFUN (compiled_with_interrupt_mask, (unsigned long, SCHEME_OBJECT, unsigned long)), - EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT)); + EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT)), + * EXFUN (cons_c_code_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)); + +extern Boolean + EXFUN (install_c_code_table, (SCHEME_OBJECT *, long)); extern void EXFUN (compiler_reset, (SCHEME_OBJECT new_block)), @@ -3618,6 +3647,23 @@ DEFUN (compiled_with_stack_marker, (thunk), SCHEME_OBJECT thunk) signal_error_from_primitive (ERR_INAPPLICABLE_CONTINUATION); /*NOTREACHED*/ } + +SCHEME_OBJECT * +DEFUN (cons_c_code_table, (start, limit, length), + SCHEME_OBJECT * start + AND SCHEME_OBJECT * limit + AND long * length) +{ + * length = 0; + return (start); +} + +Boolean +DEFUN (install_c_code_table, (table, length), + SCHEME_OBJECT * table AND long length) +{ + return (true); +} /* Bad entry points. */ @@ -3786,16 +3832,12 @@ LOSING_RETURN_ADDRESS (comp_error_restart) /* NOP entry points */ void -DEFUN (compiler_reset, - (new_block), - SCHEME_OBJECT new_block) +DEFUN (compiler_reset, (new_block), SCHEME_OBJECT new_block) { extern void EXFUN (compiler_reset_error, (void)); if (new_block != SHARP_F) - { compiler_reset_error (); - } return; } diff --git a/v8/src/microcode/fasl.h b/v8/src/microcode/fasl.h index 65f73c09e..aa53ae9d4 100644 --- a/v8/src/microcode/fasl.h +++ b/v8/src/microcode/fasl.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: fasl.h,v 9.33 1993/02/15 02:51:22 gjr Exp $ +$Id: fasl.h,v 9.34 1993/11/04 04:02:49 gjr Exp $ Copyright (c) 1987-1993 Massachusetts Institute of Technology @@ -58,8 +58,10 @@ MIT in each case. */ #define FASL_Offset_Ci_Version 10 /* Version number for compiled code interface */ #define FASL_Offset_Ut_Base 11 /* Address of the utilities vector */ #define FASL_Offset_Check_Sum 12 /* Header and data checksum. */ +#define FASL_Offset_C_Length 13 /* Number of entries in the C code table */ +#define FASL_Offset_C_Size 14 /* Size of C code table in SCHEME_OBJECTs */ -#define FASL_Offset_First_Free 13 /* Used to clear header */ +#define FASL_Offset_First_Free 15 /* Used to clear header */ /* Aliases for backwards compatibility. */ @@ -77,6 +79,7 @@ MIT in each case. */ #define SUBVERSION_MASK ((ONE << SUBVERSION_LENGTH) - 1) #define The_Sub_Version(P) (((P) >> MACHINE_TYPE_LENGTH) & SUBVERSION_MASK) #define The_Version(P) (OBJECT_TYPE (P)) + #define Make_Version(V, S, M) \ MAKE_OBJECT ((V), ((((unsigned long) (S)) << MACHINE_TYPE_LENGTH) \ | (M))) \ @@ -85,10 +88,11 @@ MIT in each case. */ #define CI_VERSION(P) (((P) >> (DATUM_LENGTH / 2)) & CI_MASK) #define CI_PROCESSOR(P) ((P) & CI_MASK) #define CI_BAND_P(P) ((OBJECT_TYPE (P)) == TC_TRUE) + #define MAKE_CI_VERSION(Band_p, Version, Processor_Type) \ MAKE_OBJECT (((Band_p) ? TC_TRUE : TC_NULL), \ - ((((unsigned long) (Version)) << (DATUM_LENGTH / 2)) \ - | (Processor_Type))) \ + ((((unsigned long) (Version)) << (DATUM_LENGTH / 2)) \ + | (Processor_Type))) \ /* "Memorable" FASL versions -- ones where we modified something and want to remain backwards compatible. @@ -107,11 +111,12 @@ MIT in each case. */ #define FASL_MERGED_PRIMITIVES 7 #define FASL_INTERFACE_VERSION 8 #define FASL_NEW_BIGNUMS 9 +#define FASL_C_CODE 10 /* Current parameters. Always used on output. */ #define FASL_FORMAT_VERSION FASL_FORMAT_ADDED_STACK -#define FASL_SUBVERSION FASL_NEW_BIGNUMS +#define FASL_SUBVERSION FASL_C_CODE /* The definitions below correspond to the ones above. They usually @@ -120,11 +125,11 @@ MIT in each case. */ */ #ifndef FASL_READ_VERSION -#define FASL_READ_VERSION FASL_FORMAT_VERSION +#define FASL_READ_VERSION FASL_FORMAT_ADDED_STACK #endif #ifndef FASL_READ_SUBVERSION -#define FASL_READ_SUBVERSION FASL_SUBVERSION +#define FASL_READ_SUBVERSION FASL_NEW_BIGNUMS #endif /* These are for Bintopsb. -- 2.25.1