From 586119b4b5a08e510f3dd14e918d188d844757c0 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Wed, 10 Feb 1988 15:44:07 +0000 Subject: [PATCH] 1) Update Psbtobin, Bintopsb, and Ppband to take care of compiled code versions. 2) Make Psbtobin and Bintopsb use a new programmable command line parser. --- v7/src/microcode/bintopsb.c | 442 +++++++++++++++++++++++------------- v7/src/microcode/fasload.c | 26 +-- v7/src/microcode/load.c | 70 +++--- v7/src/microcode/ppband.c | 6 +- v7/src/microcode/psbmap.h | 211 ++++++----------- v7/src/microcode/psbtobin.c | 160 +++++++------ v8/src/microcode/bintopsb.c | 442 +++++++++++++++++++++++------------- v8/src/microcode/ppband.c | 6 +- v8/src/microcode/psbmap.h | 211 ++++++----------- v8/src/microcode/psbtobin.c | 160 +++++++------ 10 files changed, 928 insertions(+), 806 deletions(-) diff --git a/v7/src/microcode/bintopsb.c b/v7/src/microcode/bintopsb.c index 5b5bf2190..1812e0ce1 100644 --- a/v7/src/microcode/bintopsb.c +++ b/v7/src/microcode/bintopsb.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bintopsb.c,v 9.32 1988/01/04 18:58:17 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bintopsb.c,v 9.33 1988/02/10 15:41:50 jinx Exp $ * * This File contains the code to translate internal format binary * files to portable format. @@ -39,11 +39,10 @@ MIT in each case. */ /* IO definitions */ -#define Internal_File Input_File -#define Portable_File Output_File - #include "psbmap.h" #include "trap.h" +#define internal_file input_file +#define portable_file output_file long Load_Data(Count, To_Where) @@ -52,13 +51,11 @@ Load_Data(Count, To_Where) { extern int fread(); - return (fread(To_Where, sizeof(Pointer), Count, Internal_File)); + return (fread(To_Where, sizeof(Pointer), Count, internal_file)); } -#define Reloc_or_Load_Debug false - -#include "fasl.h" #define INHIBIT_FASL_VERSION_CHECK +#define INHIBIT_COMPILED_VERSION_CHECK #include "load.c" #include "bltdef.h" @@ -79,7 +76,8 @@ extern int strlen(); /* This is in some libraries but not others */ -static char punctuation[] = "'\",<.>/?;:{}[]|`~=+-_()*&^%$#@!"; +static char + punctuation[] = "'\",<.>/?;:{}[]|`~=+-_()*&^%$#@!"; Boolean ispunct(c) @@ -110,11 +108,12 @@ ispunct(c) static Boolean shuffle_bytes_p = false, + allow_nmv_p = false, upgrade_traps_p = false, upgrade_primitives_p = false, upgrade_lengths_p = false, allow_compiled_p = false, - allow_nmv_p = false; + upgrade_compiled_p = false; static long Heap_Relocation, Constant_Relocation, @@ -124,7 +123,8 @@ static long static Pointer *Mem_Base, *Free_Objects, *Free_Cobjects, - *compiled_entry_table, *compiled_entry_pointer, *compiled_entry_table_end, + *compiled_entry_table, *compiled_entry_pointer, + *compiled_entry_table_end, *primitive_table, *primitive_table_end; static long @@ -136,7 +136,7 @@ static long #define OUT(s) \ { \ - fprintf(Portable_File, (s)); \ + fprintf(portable_file, (s)); \ break; \ } @@ -158,15 +158,15 @@ print_a_char(c, name) default: if ((isalpha(c)) || (isdigit(c)) || (ispunct(c))) { - putc(c, Portable_File); + putc(c, portable_file); } else { fprintf(stderr, "%s: %s: File may not be portable: c = 0x%x\n", - Program_Name, name, ((int) c)); + program_name, name, ((int) c)); /* This does not follow C conventions, but eliminates ambiguity */ - fprintf(Portable_File, "\X%x ", ((int) c)); + fprintf(portable_file, "\X%x ", ((int) c)); } } return; @@ -177,7 +177,7 @@ print_a_char(c, name) Old_Address += (Rel); \ Old_Contents = *Old_Address; \ \ - if (Type_Code(Old_Contents) == TC_BROKEN_HEART) \ + if (OBJECT_TYPE(Old_Contents) == TC_BROKEN_HEART) \ { \ Mem_Base[(Scn)] = Make_New_Pointer((Code), Old_Contents); \ } \ @@ -264,23 +264,23 @@ print_a_fixnum(val) { temp = temp >> 1; } - fprintf(Portable_File, "%02x %c ", + fprintf(portable_file, "%02x %c ", TC_FIXNUM, (val < 0 ? '-' : '+')); if (val == 0) { - fprintf(Portable_File, "0\n"); + fprintf(portable_file, "0\n"); } else { - fprintf(Portable_File, "%ld ", size_in_bits); + fprintf(portable_file, "%ld ", size_in_bits); temp = ((val < 0) ? -val : val); while (temp != 0) { - fprintf(Portable_File, "%01lx", (temp & 0xf)); + fprintf(portable_file, "%01lx", (temp & 0xf)); temp = temp >> 4; } - fprintf(Portable_File, "\n"); + fprintf(portable_file, "\n"); } return; } @@ -290,7 +290,7 @@ print_a_string_internal(len, string) fast long len; fast char *string; { - fprintf(Portable_File, "%ld ", len); + fprintf(portable_file, "%ld ", len); if (shuffle_bytes_p) { while(len > 0) @@ -319,7 +319,7 @@ print_a_string_internal(len, string) print_a_char(*string++, "print_a_string"); } } - putc('\n', Portable_File); + putc('\n', portable_file); return; } @@ -333,7 +333,7 @@ print_a_string(from) maxlen = pointer_to_char((Get_Integer(*from++)) - 1); len = STRING_LENGTH_TO_LONG(*from++); - fprintf(Portable_File, + fprintf(portable_file, "%02x %ld ", TC_CHARACTER_STRING, (compact_p ? len : maxlen)); @@ -347,7 +347,7 @@ print_a_primitive(arity, length, name) long arity, length; char *name; { - fprintf(Portable_File, "%ld ", arity); + fprintf(portable_file, "%ld ", arity); print_a_string_internal(length, name); return; } @@ -364,7 +364,7 @@ print_a_bignum(from) temp = LEN(the_number); if (temp == 0) { - fprintf(Portable_File, "%02x + 0\n", + fprintf(portable_file, "%02x + 0\n", (compact_p ? TC_FIXNUM : TC_BIG_FIXNUM)); } else @@ -379,7 +379,7 @@ print_a_bignum(from) temp = temp >> 1; } - fprintf(Portable_File, "%02x %c %ld ", + fprintf(portable_file, "%02x %c %ld ", (compact_p ? TC_FIXNUM : TC_BIG_FIXNUM), (NEG_BIGNUM(the_number) ? '-' : '+'), size_in_bits); @@ -400,17 +400,17 @@ print_a_bignum(from) size_in_bits > 3; size_in_bits -= 4) { - fprintf(Portable_File, "%01lx", (temp & 0xf)); + fprintf(portable_file, "%01lx", (temp & 0xf)); temp = temp >> 4; } } if (size_in_bits > 0) { - fprintf(Portable_File, "%01lx\n", (temp & 0xf)); + fprintf(portable_file, "%01lx\n", (temp & 0xf)); } else { - fprintf(Portable_File, "\n"); + fprintf(portable_file, "\n"); } } return; @@ -428,11 +428,11 @@ print_a_bit_string(from) the_bit_string = Make_Pointer(TC_BIT_STRING, from); bits_remaining = bit_string_length(the_bit_string); - fprintf(Portable_File, "%02x %ld", TC_BIT_STRING, bits_remaining); + fprintf(portable_file, "%02x %ld", TC_BIT_STRING, bits_remaining); if (bits_remaining != 0) { - fprintf(Portable_File, " "); + fprintf(portable_file, " "); scan = bit_string_low_ptr(the_bit_string); for (leftover_bits = 0; bits_remaining > 0; @@ -452,7 +452,7 @@ print_a_bit_string(from) leftover_bits += ((bits_remaining > POINTER_LENGTH) ? (POINTER_LENGTH - 4) : (bits_remaining - 4)); - fprintf(Portable_File, "%01lx", (accumulator & 0xf)); + fprintf(portable_file, "%01lx", (accumulator & 0xf)); } else { @@ -463,16 +463,16 @@ print_a_bit_string(from) for(accumulator = next_word; leftover_bits >= 4; leftover_bits -= 4) { - fprintf(Portable_File, "%01lx", (accumulator & 0xf)); + fprintf(portable_file, "%01lx", (accumulator & 0xf)); accumulator = accumulator >> 4; } } if (leftover_bits != 0) { - fprintf(Portable_File, "%01lx", (accumulator & 0xf)); + fprintf(portable_file, "%01lx", (accumulator & 0xf)); } } - fprintf(Portable_File, "\n"); + fprintf(portable_file, "\n"); return; } @@ -485,12 +485,12 @@ print_a_flonum(val) int expt; extern double frexp(); - fprintf(Portable_File, "%02x %c ", + fprintf(portable_file, "%02x %c ", TC_BIG_FLONUM, ((val < 0.0) ? '-' : '+')); if (val == 0.0) { - fprintf(Portable_File, "0\n"); + fprintf(portable_file, "0\n"); return; } mant = frexp(((val < 0.0) ? -val : val), &expt); @@ -504,7 +504,7 @@ print_a_flonum(val) if (temp >= 1.0) temp -= 1.0; } - fprintf(Portable_File, "%ld %ld ", expt, size_in_bits); + fprintf(portable_file, "%ld %ld ", expt, size_in_bits); for (size_in_bits = hex_digits(size_in_bits); size_in_bits > 0; @@ -523,9 +523,9 @@ print_a_flonum(val) digit += 1; } } - fprintf(Portable_File, "%01x", digit); + fprintf(portable_file, "%01x", digit); } - putc('\n', Portable_File); + putc('\n', portable_file); return; } @@ -536,14 +536,15 @@ print_a_flonum(val) Old_Address += (Rel); \ Old_Contents = *Old_Address; \ \ - if (Type_Code(Old_Contents) == TC_BROKEN_HEART) \ + if (OBJECT_TYPE(Old_Contents) == TC_BROKEN_HEART) \ { \ - Mem_Base[(Scn)] = Make_New_Pointer(Type_Code(This), Old_Contents); \ + Mem_Base[(Scn)] = Make_New_Pointer(OBJECT_TYPE(This), \ + Old_Contents); \ } \ else \ { \ *Old_Address++ = Make_Non_Pointer(TC_BROKEN_HEART, (Fre)); \ - Mem_Base[(Scn)] = Make_Non_Pointer(Type_Code(This), (Fre)); \ + Mem_Base[(Scn)] = Make_Non_Pointer(OBJECT_TYPE(This), (Fre)); \ Mem_Base[(Fre)++] = Old_Contents; \ } \ } @@ -553,14 +554,15 @@ print_a_flonum(val) Old_Address += (Rel); \ Old_Contents = *Old_Address; \ \ - if (Type_Code(Old_Contents) == TC_BROKEN_HEART) \ + if (OBJECT_TYPE(Old_Contents) == TC_BROKEN_HEART) \ { \ - Mem_Base[(Scn)] = Make_New_Pointer(Type_Code(This), Old_Contents); \ + Mem_Base[(Scn)] = Make_New_Pointer(OBJECT_TYPE(This), \ + Old_Contents); \ } \ else \ { \ *Old_Address++ = Make_Non_Pointer(TC_BROKEN_HEART, (Fre)); \ - Mem_Base[(Scn)] = Make_Non_Pointer(Type_Code(This), (Fre)); \ + Mem_Base[(Scn)] = Make_Non_Pointer(OBJECT_TYPE(This), (Fre)); \ Mem_Base[(Fre)++] = Old_Contents; \ Mem_Base[(Fre)++] = *Old_Address++; \ } \ @@ -571,14 +573,15 @@ print_a_flonum(val) Old_Address += (Rel); \ Old_Contents = *Old_Address; \ \ - if (Type_Code(Old_Contents) == TC_BROKEN_HEART) \ + if (OBJECT_TYPE(Old_Contents) == TC_BROKEN_HEART) \ { \ - Mem_Base[(Scn)] = Make_New_Pointer(Type_Code(This), Old_Contents); \ + Mem_Base[(Scn)] = Make_New_Pointer(OBJECT_TYPE(This), \ + Old_Contents); \ } \ else \ { \ *Old_Address++ = Make_Non_Pointer(TC_BROKEN_HEART, (Fre)); \ - Mem_Base[(Scn)] = Make_Non_Pointer(Type_Code(This), (Fre)); \ + Mem_Base[(Scn)] = Make_Non_Pointer(OBJECT_TYPE(This), (Fre)); \ Mem_Base[(Fre)++] = Old_Contents; \ Mem_Base[(Fre)++] = *Old_Address++; \ Mem_Base[(Fre)++] = *Old_Address++; \ @@ -590,14 +593,15 @@ print_a_flonum(val) Old_Address += (Rel); \ Old_Contents = *Old_Address; \ \ - if (Type_Code(Old_Contents) == TC_BROKEN_HEART) \ + if (OBJECT_TYPE(Old_Contents) == TC_BROKEN_HEART) \ { \ - Mem_Base[(Scn)] = Make_New_Pointer(Type_Code(This), Old_Contents); \ + Mem_Base[(Scn)] = Make_New_Pointer(OBJECT_TYPE(This), \ + Old_Contents); \ } \ else \ { \ *Old_Address++ = Make_Non_Pointer(TC_BROKEN_HEART, (Fre)); \ - Mem_Base[(Scn)] = Make_Non_Pointer(Type_Code(This), (Fre)); \ + Mem_Base[(Scn)] = Make_Non_Pointer(OBJECT_TYPE(This), (Fre)); \ Mem_Base[(Fre)++] = Old_Contents; \ Mem_Base[(Fre)++] = *Old_Address++; \ Mem_Base[(Fre)++] = *Old_Address++; \ @@ -635,7 +639,7 @@ print_a_flonum(val) } \ } -#define Do_Compiled_Entry(COde, Rel, Fre, Scn, Obj, FObj) \ +#define Do_Compiled_Entry(Code, Rel, Fre, Scn, Obj, FObj) \ { \ long offset; \ Pointer *saved; \ @@ -672,65 +676,119 @@ print_a_flonum(val) #define Do_Pointer(Scn, Action) \ { \ + long the_datum; \ + \ Old_Address = Get_Pointer(This); \ - if (Datum(This) < Const_Base) \ + the_datum = OBJECT_DATUM(This); \ + if ((the_datum >= Heap_Base) && \ + (the_datum < Dumped_Heap_Top)) \ { \ Action(HEAP_CODE, Heap_Relocation, Free, \ Scn, Objects, Free_Objects); \ } \ - else if (Datum(This) < Dumped_Constant_Top) \ + \ + /* \ + \ + Currently constant space is not supported \ + \ + else if ((the_datum >= Const_Base) && \ + (the_datum < Dumped_Constant_Top)) \ { \ Action(CONSTANT_CODE, Constant_Relocation, Free_Constant, \ Scn, Constant_Objects, Free_Cobjects); \ } \ + \ + */ \ + \ else \ { \ - fprintf(stderr, \ - "%s: File is not portable: Pointer to stack.\n", \ - Program_Name); \ - quit(1); \ + out_of_range_pointer(This); \ } \ (Scn) += 1; \ break; \ } -/* Primitive upgrading code. */ - -#define PRIMITIVE_UPGRADE_SPACE 2048 -static Pointer *internal_renumber_table; -static Pointer *external_renumber_table; -static Pointer *external_prim_name_table; -static Boolean found_ext_prims = false; +void +out_of_range_pointer(ptr) + Pointer ptr; +{ + fprintf(stderr, + "%s: The input file is not portable: Out of range pointer.\n", + program_name); + fprintf(stderr, "Heap_Base = 0x%lx;\tHeap_Top = 0x%lx\n", + Heap_Base, Dumped_Heap_Top); + fprintf(stderr, "Const_Base = 0x%lx;\tConst_Top = 0x%lx\n", + Const_Base, Dumped_Constant_Top); + fprintf(stderr, "ptr = 0x%02x|0x%lx\n", + OBJECT_TYPE(ptr), OBJECT_DATUM(ptr)); + quit(1); +} Pointer * relocate(object) Pointer object; { + long the_datum; Pointer *result; - result = (Get_Pointer(object) + ((Datum(object) < Const_Base) ? - Heap_Relocation : - Constant_Relocation)); + + result = Get_Pointer(object); + the_datum = OBJECT_DATUM(object); + + if ((the_datum >= Heap_Base) && + (the_datum < Dumped_Heap_Top)) + { + result += Heap_Relocation; + } + +#if false + + /* Currently constant space is not supported */ + + else if (( the_datum >= Const_Base) && + (the_datum < Dumped_Constant_Top)) + { + result += Constant_Relocation; + } + +#endif /* false */ + + else + { + out_of_range_pointer(object); + } return (result); } + +/* Primitive upgrading code. */ + +#define PRIMITIVE_UPGRADE_SPACE 2048 + +static Pointer + *internal_renumber_table, + *external_renumber_table, + *external_prim_name_table; + +static Boolean + found_ext_prims = false; Pointer upgrade_primitive(prim) Pointer prim; { - long datum, type, new_type, code; + long the_datum, the_type, new_type, code; Pointer new; - datum = OBJECT_DATUM(prim); - type = OBJECT_TYPE(prim); - if (type != TC_PRIMITIVE_EXTERNAL) + the_datum = OBJECT_DATUM(prim); + the_type = OBJECT_TYPE(prim); + if (the_type != TC_PRIMITIVE_EXTERNAL) { - code = datum; - new_type = type; + code = the_datum; + new_type = the_type; } else { found_ext_prims = true; - code = (datum + (MAX_BUILTIN_PRIMITIVE + 1)); + code = (the_datum + (MAX_BUILTIN_PRIMITIVE + 1)); new_type = TC_PRIMITIVE; } @@ -746,15 +804,16 @@ upgrade_primitive(prim) internal_renumber_table[code] = new; external_renumber_table[Primitive_Table_Length] = prim; Primitive_Table_Length += 1; - if (type == TC_PRIMITIVE_EXTERNAL) + if (the_type == TC_PRIMITIVE_EXTERNAL) { NPChars += - STRING_LENGTH_TO_LONG((((Pointer *) (external_prim_name_table[datum])) + STRING_LENGTH_TO_LONG((((Pointer *) + (external_prim_name_table[the_datum])) [STRING_LENGTH])); } else { - NPChars += strlen(builtin_prim_name_table[datum]); + NPChars += strlen(builtin_prim_name_table[the_datum]); } return (new); } @@ -801,10 +860,10 @@ setup_primitive_upgrade(Heap) length += (MAX_BUILTIN_PRIMITIVE + 1); if (length > PRIMITIVE_UPGRADE_SPACE) { - fprintf(stderr, "%s: Too many primitives.\n", Program_Name); + fprintf(stderr, "%s: Too many primitives.\n", program_name); fprintf(stderr, "Increase PRIMITIVE_UPGRADE_SPACE and recompile %s.\n", - Program_Name); + program_name); quit(1); } for (count = 0; count < length; count += 1) @@ -833,7 +892,8 @@ Process_Area(Code, Area, Bound, Obj, FObj) This = Mem_Base[*Area]; #ifdef PRIMITIVE_EXTERNAL_REUSED - if (upgrade_primitives_p && (Type_Code(This) == TC_PRIMITIVE_EXTERNAL)) + if (upgrade_primitives_p && + (OBJECT_TYPE(This) == TC_PRIMITIVE_EXTERNAL)) { Mem_Base[*Area] = upgrade_primitive(This); *Area += 1; @@ -875,7 +935,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) else if (!allow_nmv_p) { fprintf(stderr, "%s: File is not portable: NMH found\n", - Program_Name); + program_name); } *Area += (1 + OBJECT_DATUM(This)); break; @@ -885,7 +945,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) if (OBJECT_DATUM(This) != 0) { fprintf(stderr, "%s: Broken Heart found in scan.\n", - Program_Name); + program_name); quit(1); } *Area += 1; @@ -897,7 +957,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) { fprintf(stderr, "%s: File contains compiled code.\n", - Program_Name); + program_name); quit(1); } Do_Pointer(*Area, Do_Compiled_Entry); @@ -905,7 +965,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) case TC_STACK_ENVIRONMENT: fprintf(stderr, "%s: File contains stack environments.\n", - Program_Name); + program_name); quit(1); case TC_FIXNUM: @@ -930,7 +990,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) { long kind; - kind = Datum(This); + kind = OBJECT_DATUM(This); if (upgrade_traps_p) { @@ -949,7 +1009,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) } fprintf(stderr, "%s: Bad old unassigned object. 0x%x.\n", - Program_Name, This); + program_name, This); quit(1); } if (kind <= TRAP_MAX_IMMEDIATE) @@ -987,14 +1047,14 @@ Process_Area(Code, Area, Bound, Obj, FObj) { fprintf(stderr, "%s: Cannot upgrade environments.\n", - Program_Name); + program_name); quit(1); } /* Fall through */ case TC_FUTURE: case_simple_Vector: - if (Type_Code(This) == TC_BIT_STRING) + if (OBJECT_TYPE(This) == TC_BIT_STRING) { Do_Pointer(*Area, Do_Bit_String); } @@ -1006,7 +1066,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) default: Bad_Type: fprintf(stderr, "%s: Unknown Type Code 0x%x found.\n", - Program_Name, Type_Code(This)); + program_name, OBJECT_TYPE(This)); quit(1); } } @@ -1021,7 +1081,7 @@ print_external_objects(from, count) { while (--count >= 0) { - switch(Type_Code(*from)) + switch(OBJECT_TYPE(*from)) { case TC_FIXNUM: { @@ -1053,7 +1113,7 @@ print_external_objects(from, count) break; case TC_CHARACTER: - fprintf(Portable_File, "%02x %03x\n", + fprintf(portable_file, "%02x %03x\n", TC_CHARACTER, (*from & MASK_EXTNDD_CHAR)); from += 1; break; @@ -1061,7 +1121,7 @@ print_external_objects(from, count) default: fprintf(stderr, "%s: Bad Object to print externally %lx\n", - Program_Name, *from); + program_name, *from); quit(1); } } @@ -1072,38 +1132,38 @@ void print_objects(from, to) fast Pointer *from, *to; { - fast long datum, type; + fast long the_datum, the_type; while(from < to) { - type = OBJECT_TYPE(*from); - datum = OBJECT_DATUM(*from); + the_type = OBJECT_TYPE(*from); + the_datum = OBJECT_DATUM(*from); from += 1; - if (type == TC_MANIFEST_NM_VECTOR) + if (the_type == TC_MANIFEST_NM_VECTOR) { - fprintf(Portable_File, "%02x %lx\n", type, datum); - while (--datum >= 0) + fprintf(portable_file, "%02x %lx\n", the_type, the_datum); + while (--the_datum >= 0) { - fprintf(Portable_File, "%lx\n", ((unsigned long) *from++)); + fprintf(portable_file, "%lx\n", ((unsigned long) *from++)); } } - else if (type == TC_COMPILED_EXPRESSION) + else if (the_type == TC_COMPILED_EXPRESSION) { Pointer base; long offset; - Sign_Extend(compiled_entry_table[datum], offset); - base = compiled_entry_table[datum + 1]; + Sign_Extend(compiled_entry_table[the_datum], offset); + base = compiled_entry_table[the_datum + 1]; - fprintf(Portable_File, "%02x %lx %02x %lx\n", + fprintf(portable_file, "%02x %lx %02x %lx\n", TC_COMPILED_EXPRESSION, offset, OBJECT_TYPE(base), OBJECT_DATUM(base)); } else { - fprintf(Portable_File, "%02x %lx\n", type, datum); + fprintf(portable_file, "%02x %lx\n", the_type, the_datum); } } return; @@ -1125,7 +1185,7 @@ when(what, message) if (what) { fprintf(stderr, "%s: Inconsistency: %s!\n", - Program_Name, (message)); + program_name, (message)); quit(1); } return; @@ -1133,8 +1193,8 @@ when(what, message) #define PRINT_HEADER(name, format, obj) \ { \ - fprintf(Portable_File, (format), (obj)); \ - fprintf(Portable_File, "\n"); \ + fprintf(portable_file, (format), (obj)); \ + fprintf(portable_file, "\n"); \ fprintf(stderr, "%s: ", (name)); \ fprintf(stderr, (format), (obj)); \ fprintf(stderr, "\n"); \ @@ -1148,8 +1208,8 @@ when(what, message) #define PRINT_HEADER(name, format, obj) \ { \ - fprintf(Portable_File, (format), (obj)); \ - fprintf(Portable_File, "\n"); \ + fprintf(portable_file, (format), (obj)); \ + fprintf(portable_file, "\n"); \ } #endif /* DEBUG */ @@ -1164,11 +1224,11 @@ do_it() /* Load the Data */ - if (!Read_Header()) + if (Read_Header() != FASL_FILE_FINE) { fprintf(stderr, - "%s: Input file does not appear to be in FASL format.\n", - Program_Name); + "%s: Input file does not appear to be in an appropriate format.\n", + program_name); quit(1); } @@ -1179,7 +1239,7 @@ do_it() ((Machine_Type != FASL_INTERNAL_FORMAT) && (!shuffle_bytes_p))) { - fprintf(stderr, "%s:\n", Program_Name); + fprintf(stderr, "%s:\n", program_name); fprintf(stderr, "FASL File Version %ld Subversion %ld Machine Type %ld\n", Version, Sub_Version , Machine_Type); @@ -1188,23 +1248,56 @@ do_it() FASL_READ_VERSION, FASL_READ_SUBVERSION, FASL_INTERNAL_FORMAT); quit(1); } + + if ((((compiler_processor_type != 0) && + (dumped_processor_type != 0) && + (compiler_processor_type != dumped_processor_type)) || + ((compiler_interface_version != 0) && + (dumped_interface_version != 0) && + (compiler_interface_version != dumped_interface_version))) && + (!upgrade_compiled_p)) + { + fprintf(stderr, "\nread_file:\n"); + fprintf(stderr, + "FASL File: compiled code interface %4d; processor %4d.\n", + dumped_interface_version, dumped_processor_type); + fprintf(stderr, + "Expected: compiled code interface %4d; processor %4d.\n", + compiler_interface_version, compiler_processor_type); + quit(1); + } + if (compiler_processor_type != 0) + { + dumped_processor_type = compiler_processor_type; + } + if (compiler_interface_version != 0) + { + dumped_interface_version = compiler_interface_version; + } - /* Constant Space not currently supported */ + /* Constant Space and bands not currently supported */ + + if (band_p) + { + fprintf(stderr, "%s: Input file is a band.\n", program_name); + quit(1); + } if (Const_Count != 0) { fprintf(stderr, "%s: Input file has a constant space area.\n", - Program_Name); + program_name); quit(1); } + allow_compiled_p = (allow_compiled_p || upgrade_compiled_p); allow_nmv_p = (allow_nmv_p || allow_compiled_p); if (null_nmv_p && allow_nmv_p) { fprintf(stderr, "%s: NMVs are both allowed and to be nulled out!\n", - Program_Name); + program_name); quit(1); } @@ -1216,6 +1309,26 @@ do_it() upgrade_traps_p = (Sub_Version < FASL_REFERENCE_TRAP); upgrade_primitives_p = (Sub_Version < FASL_MERGED_PRIMITIVES); upgrade_lengths_p = upgrade_primitives_p; + + DEBUGGING(fprintf(stderr, + "Dumped Heap Base = 0x%08x\n", + Heap_Base)); + + DEBUGGING(fprintf(stderr, + "Dumped Constant Base = 0x%08x\n", + Const_Base)); + + DEBUGGING(fprintf(stderr, + "Dumped Constant Top = 0x%08x\n", + Dumped_Constant_Top)); + + DEBUGGING(fprintf(stderr, + "Heap Count = %6d\n", + Heap_Count)); + + DEBUGGING(fprintf(stderr, + "Constant Count = %6d\n", + Const_Count)); { long Size; @@ -1237,7 +1350,7 @@ do_it() { fprintf(stderr, "%s: Memory Allocation Failed. Size = %ld Scheme Pointers\n", - Program_Name, Size); + program_name, Size); quit(1); } } @@ -1246,31 +1359,10 @@ do_it() Initial_Align_Float(Heap); Load_Data(Heap_Count, &Heap[0]); Load_Data(Const_Count, &Heap[Heap_Count]); - Load_Data(Primitive_Table_Size, &Heap[Heap_Count + Const_Count]); - Heap_Relocation = &Heap[0] - Get_Pointer(Heap_Base); - Constant_Relocation = &Heap[Heap_Count] - Get_Pointer(Const_Base); - - DEBUGGING(fprintf(stderr, - "Dumped Heap Base = 0x%08x\n", - Heap_Base)); - - DEBUGGING(fprintf(stderr, - "Dumped Constant Base = 0x%08x\n", - Const_Base)); - - DEBUGGING(fprintf(stderr, - "Dumped Constant Top = 0x%08x\n", - Dumped_Constant_Top)); - - DEBUGGING(fprintf(stderr, - "Heap Count = %6d\n", - Heap_Count)); - - DEBUGGING(fprintf(stderr, - "Constant Count = %6d\n", - Const_Count)); + Heap_Relocation = ((&Heap[0]) - (Get_Pointer(Heap_Base))); + Constant_Relocation = ((&Heap[Heap_Count]) - (Get_Pointer(Const_Base))); - /* Determine primitive information. */ + /* Setup compiled code and primitive tables. */ compiled_entry_table = &Heap[Heap_Count + Const_Count]; compiled_entry_pointer = compiled_entry_table; @@ -1291,6 +1383,7 @@ do_it() fast Pointer *table; fast long count, char_count; + Load_Data(Primitive_Table_Size, primitive_table); for (char_count = 0, count = Primitive_Table_Length, table = primitive_table; @@ -1369,7 +1462,7 @@ do_it() if (found_ext_prims) { - fprintf(stderr, "%s:\n", Program_Name); + fprintf(stderr, "%s:\n", program_name); fprintf(stderr, "NOTE: The arity of some primitives is not known.\n"); fprintf(stderr, " The portable file has %ld as their arity.\n", UNKNOWN_PRIMITIVE_ARITY); @@ -1410,6 +1503,20 @@ do_it() PRINT_HEADER("Number of primitives", "%ld", Primitive_Table_Length); PRINT_HEADER("Number of characters in primitives", "%ld", NPChars); + + if (!compiled_p) + { + dumped_processor_type = 0; + dumped_interface_version = 0; + } + + PRINT_HEADER("CPU type", "%ld", dumped_processor_type); + PRINT_HEADER("Compiled code interface version", "%ld", + dumped_interface_version); +#if false + PRINT_HEADER("Compiler utilities vector", "%ld", + OBJECT_DATUM(dumped_utilities)); +#endif /* External Objects */ @@ -1440,31 +1547,31 @@ do_it() { Pointer obj; fast Pointer *table; - fast long count, datum; + fast long count, the_datum; for (count = Primitive_Table_Length, table = external_renumber_table; --count >= 0;) { obj = *table++; - datum = OBJECT_DATUM(obj); + the_datum = OBJECT_DATUM(obj); if (OBJECT_TYPE(obj) == TC_PRIMITIVE_EXTERNAL) { Pointer *strobj; - strobj = ((Pointer *) (external_prim_name_table[datum])); + strobj = ((Pointer *) (external_prim_name_table[the_datum])); print_a_primitive(((long) UNKNOWN_PRIMITIVE_ARITY), (STRING_LENGTH_TO_LONG(strobj[STRING_LENGTH])), ((char *) &strobj[STRING_CHARS])); } else { - char *string; + char *str; - string = builtin_prim_name_table[datum]; - print_a_primitive(((long) builtin_prim_arity_table[datum]), - ((long) strlen(string)), - string); + str = builtin_prim_name_table[the_datum]; + print_a_primitive(((long) builtin_prim_arity_table[the_datum]), + ((long) strlen(str)), + str); } } } @@ -1490,22 +1597,33 @@ do_it() /* Top Level */ -/* The boolean value here is what value to store when the option is present. */ +Boolean ci_version_sup_p, ci_processor_sup_p; -static struct Option_Struct Options[] = - {{"Do_Not_Compact", false, &compact_p}, - {"Null_Out_NMVs", true, &null_nmv_p}, - {"Swap_Bytes", true, &shuffle_bytes_p}, - {"Allow_Compiled", true, &allow_compiled_p}, - {"Allow_NMVs", true, &allow_nmv_p}}; +/* The boolean value here is what value to store when the option is present. */ -static int Noptions = 5; +static struct keyword_struct + options[] = { + KEYWORD("swap_bytes", &shuffle_bytes_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("compact", &compact_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("null_nmv", &null_nmv_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("allow_nmv", &allow_nmv_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("allow_cc", &allow_compiled_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("upgrade_cc", &upgrade_compiled_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("ci_version", &compiler_interface_version, INT_KYWRD, "%ld", + &ci_version_sup_p), + KEYWORD("ci_processor", &compiler_processor_type, INT_KYWRD, "%ld", + &ci_processor_sup_p), + OUTPUT_KEYWORD(), + INPUT_KEYWORD(), + END_KEYWORD() + }; main(argc, argv) int argc; char *argv[]; { - Setup_Program(argc, argv, Noptions, Options); + parse_keywords(argc, argv, options, false); + setup_io(); do_it(); quit(0); } diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c index 9b494ef52..dd3ba6636 100644 --- a/v7/src/microcode/fasload.c +++ b/v7/src/microcode/fasload.c @@ -30,23 +30,18 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.33 1988/02/06 20:40:36 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.34 1988/02/10 15:43:35 jinx Exp $ The "fast loader" which reads in and relocates binary files and then interns symbols. It is called with one argument: the (character string) name of a file to load. It is called as a primitive, and returns a single object read in. */ - + #include "scheme.h" #include "primitive.h" #include "gccode.h" #include "trap.h" - -#define CCheck_or_Reloc_Debug Or2(Consistency_Check, Reloc_Debug) -#define Reloc_or_Load_Debug Or2(Reloc_Debug, File_Load_Debug) - -#include "fasl.h" #include "load.c" long @@ -56,7 +51,7 @@ read_file_start(name) long value, heap_length; Boolean file_opened; - if (Type_Code(name) != TC_CHARACTER_STRING) + if (OBJECT_TYPE(name) != TC_CHARACTER_STRING) { return (ERR_ARG_1_WRONG_TYPE); } @@ -91,12 +86,11 @@ read_file_start(name) case FASL_FILE_BAD_INTERFACE: return (ERR_FASLOAD_COMPILED_MISMATCH); } - } - - if (File_Load_Debug) + } + + if (Or2(Reloc_Debug, File_Load_Debug)) { - printf("\nMachine type %d, Version %d, Subversion %d\n", - Machine_Type, Version, Sub_Version); + print_fasl_information(); } if (!Test_Pure_Space_Top(Free_Constant + Const_Count)) @@ -127,7 +121,7 @@ read_file_end() Align_Float(Free); #endif - if (Load_Data(Heap_Count, ((char *) Free)) != Heap_Count) + if ((Load_Data(Heap_Count, ((char *) Free))) != Heap_Count) { Close_Dump_File(); Primitive_Error(ERR_IO_ERROR); @@ -135,7 +129,7 @@ read_file_end() NORMALIZE_REGION(((char *) Free), Heap_Count); Free += Heap_Count; - if (Load_Data(Const_Count, ((char *) Free_Constant)) != Const_Count) + if ((Load_Data(Const_Count, ((char *) Free_Constant))) != Const_Count) { Close_Dump_File(); Primitive_Error(ERR_IO_ERROR); @@ -144,7 +138,7 @@ read_file_end() Free_Constant += Const_Count; table = Free; - if (Load_Data(Primitive_Table_Size, ((char *) Free)) != + if ((Load_Data(Primitive_Table_Size, ((char *) Free))) != Primitive_Table_Size) { Close_Dump_File(); diff --git a/v7/src/microcode/load.c b/v7/src/microcode/load.c index 91f03f80c..fff994826 100644 --- a/v7/src/microcode/load.c +++ b/v7/src/microcode/load.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/load.c,v 9.25 1988/02/06 20:41:11 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/load.c,v 9.26 1988/02/10 15:43:53 jinx Rel $ * * This file contains common code for reading internal * format binary files. @@ -68,12 +68,11 @@ static Boolean band_p; static long - Version, Sub_Version, Machine_Type, - Dumped_Object, + Machine_Type, Version, Sub_Version, + Dumped_Object, Dumped_Stack_Top, Heap_Base, Heap_Count, Const_Base, Const_Count, Dumped_Heap_Top, Dumped_Constant_Top, - Dumped_Stack_Top, Primitive_Table_Size, Primitive_Table_Length, dumped_processor_type, dumped_interface_version; @@ -81,6 +80,43 @@ static Pointer Ext_Prim_Vector, dumped_utilities; +void +print_fasl_information() +{ + printf("FASL File Information:\n\n"); + 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", + Heap_Count, Heap_Base, Dumped_Heap_Top); + printf("Const Count = %ld; Const Base = 0x%lx; Const Top = 0x%lx\n", + Const_Count, Const_Base, Dumped_Constant_Top); + printf("Stack Top = 0x%lx\n", Dumped_Stack_Top); + + printf("\nDumped Objects:\n\n"); + 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 != NIL) + { + printf("External primitives vector = 0x%lx\n", Ext_Prim_Vector); + } + else + { + printf("Length of primitive table = %ld\n", Primitive_Table_Length); + } + return; +} + long Read_Header() { @@ -149,32 +185,6 @@ Read_Header() dumped_interface_version = CI_VERSION(temp); dumped_utilities = Buffer[FASL_Offset_Ut_Base]; } - - if (Reloc_or_Load_Debug) - { - printf("FASL File Information:\n\n"); - printf("Machine = %ld; Version = %ld; Subversion = %ld\n", - Machine_Type, Version, Sub_Version); - printf("Dumped processor type = %ld; Dumped interface version = %ld\n", - dumped_processor_type, dumped_interface_version); - 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; Dumped Heap Top = 0x%lx\n", - Heap_Count, Heap_Base, Dumped_Heap_Top); - printf("Const Count = %ld; Const Base = 0x%lx, Dumped Constant Top = 0x%lx\n", - Const_Count, Const_Base, Dumped_Constant_Top); - printf("Dumped Stack Top = 0x%lx, Ext Prim Vector = 0x%lx\n", - Dumped_Stack_Top, Ext_Prim_Vector); - - printf("\nDumped Objects:\n\n"); - printf("Length of primitive table = %ld\n", Primitive_Table_Length); - printf("Dumped utilities = 0x%lx\n", dumped_utilities); - printf("Dumped Object (as read from file) = 0x%lx\n", Dumped_Object); - } #ifndef INHIBIT_FASL_VERSION_CHECK diff --git a/v7/src/microcode/ppband.c b/v7/src/microcode/ppband.c index 97fc7cd5d..a258fd14c 100644 --- a/v7/src/microcode/ppband.c +++ b/v7/src/microcode/ppband.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/ppband.c,v 9.30 1988/02/06 20:37:50 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/ppband.c,v 9.31 1988/02/10 15:42:58 jinx Exp $ * * Dumps Scheme FASL in user-readable form . */ @@ -79,10 +79,7 @@ Close_Dump_File() exit(1); } -#define Reloc_or_Load_Debug true #define INHIBIT_COMPILED_VERSION_CHECK - -#include "fasl.h" #include "load.c" #ifdef Heap_In_Low_Memory @@ -374,6 +371,7 @@ main(argc, argv) argv[0]); exit(1); } + print_fasl_information(); printf("Dumped object (relocated) at 0x%lx\n", Relocate(Dumped_Object)); } else diff --git a/v7/src/microcode/psbmap.h b/v7/src/microcode/psbmap.h index 1f2889b1c..0a0f97399 100644 --- a/v7/src/microcode/psbmap.h +++ b/v7/src/microcode/psbmap.h @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbmap.h,v 9.25 1987/11/23 04:55:56 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbmap.h,v 9.26 1988/02/10 15:44:07 jinx Rel $ * * This file contains macros and declarations for Bintopsb.c * and Psbtobin.c @@ -41,9 +41,9 @@ MIT in each case. */ from the included files. */ -#include #define fast register +#include #include "config.h" #include "object.h" #include "bignum.h" @@ -60,7 +60,7 @@ extern double frexp(), ldexp(); #include "missing.c" #endif -#define PORTABLE_VERSION 4 +#define PORTABLE_VERSION 5 /* Number of objects which, when traced recursively, point at all other objects dumped. Currently only the dumped object. @@ -113,12 +113,14 @@ extern double frexp(), ldexp(); #define NULL_NMV_P (1 << 1) #define COMPILED_P (1 << 2) #define NMV_P (1 << 3) +#define BAND_P (1 << 4) #define MAKE_FLAGS() \ ((compact_p ? COMPACT_P : 0) | \ (null_nmv_p ? NULL_NMV_P : 0) | \ (compiled_p ? COMPILED_P : 0) | \ - (nmv_p ? NMV_P : 0)) + (nmv_p ? NMV_P : 0) | \ + (band_p ? BAND_P : 0)) #define READ_FLAGS(f) \ { \ @@ -126,6 +128,7 @@ extern double frexp(), ldexp(); null_nmv_p = ((f) & NULL_NMV_P); \ compiled_p = ((f) & COMPILED_P); \ nmv_p = ((f) & NMV_P); \ + band_p = ((f) & BAND_P); \ } /* @@ -153,185 +156,99 @@ static Boolean nmv_p = false; static Pointer *Memory_Base; #endif -static FILE *Input_File, *Output_File; +static long + compiler_processor_type = 0, + compiler_interface_version = 0; -static char *Program_Name; +static Pointer + compiler_utilities = NIL; -/* Argument List Parsing */ +/* Utilities */ -struct Option_Struct -{ - char *name; - Boolean value; - Boolean *ptr; -}; +static char + *input_file_name = "-", + *output_file_name = "-"; + +FILE *input_file, *output_file; Boolean strequal(s1, s2) - fast char *s1, *s2; + register char *s1, *s2; { - while (*s1 != '\0') + for ( ; *s1 != '\0'; s1++, s2++) { - if (*s1++ != *s2++) + if (*s1 != *s2) { - return false; + return (false); } } return (*s2 == '\0'); } - -char * -Find_Options(argc, argv, Noptions, Options) - int argc; - char **argv; - int Noptions; - struct Option_Struct Options[]; -{ - for ( ; --argc >= 0; argv++) - { - char *this; - int n; - - this = *argv; - for (n = 0; - ((n < Noptions) && (!strequal(this, Options[n].name))); - n++) - {}; - if (n >= Noptions) - { - return (this); - } - *(Options[n].ptr) = Options[n].value; - } - return (NULL); -} -/* Usage information */ - void -Print_Options(n, options, where) - int n; - struct Option_Struct *options; - FILE *where; +setup_io() { - if (--n < 0) + if (strequal(input_file_name, "-")) { - return; + input_file = stdin; } - fprintf(where, "[%s]", options->name); - options += 1; - for (; --n >= 0; options += 1) + else { - fprintf(where, " [%s]", options->name); + input_file = fopen(input_file_name, "r"); + if (input_file == ((FILE *) NULL)) + { + fprintf(stderr, "%s: failed to open %s for input.\n", + input_file_name); + exit(1); + } } - return; -} -void -Print_Usage_and_Exit(noptions, options, io_options) - int noptions; - struct Option_Struct *options; - char *io_options; -{ - fprintf(stderr, "usage: %s%s%s", - Program_Name, - (((io_options == NULL) || - (io_options[0] == '\0')) ? "" : " "), - io_options); - if (noptions != 0) + if (strequal(output_file_name, "-")) { - putc(' ', stderr); - Print_Options(noptions, options, stderr); + output_file = stdout; } - putc('\n', stderr); - exit(1); -} - -/* Top level of program */ - -/* When debugging force arguments on command line */ - -#ifdef DEBUG -#undef unix -#endif - -#ifdef unix - -/* On unix use io redirection */ - -void -Setup_Program(argc, argv, Noptions, Options) - int argc; - char *argv[]; - int Noptions; - struct Option_Struct *Options; -{ - Program_Name = argv[0]; - Input_File = stdin; - Output_File = stdout; - if (((argc - 1) > Noptions) || - (Find_Options((argc - 1), &argv[1], Noptions, Options) != NULL)) + else { - Print_Usage_and_Exit(Noptions, Options, ""); + output_file = fopen(output_file_name, "w"); + if (output_file == ((FILE *) NULL)) + { + fprintf(stderr, "%s: failed to open %s for output.\n", + output_file_name); + fclose(input_file); + exit(1); + } } return; } -#define quit exit - -#else /* not unix */ - -/* Otherwise use command line arguments */ - -void -Setup_Program(argc, argv, Noptions, Options) - int argc; - char *argv[]; - int Noptions; - struct Option_Struct *Options; -{ - Program_Name = argv[0]; - if ((argc < 3) || - ((argc - 3) > Noptions) || - (Find_Options((argc - 3), &argv[3], Noptions, Options) != NULL)) - { - Print_Usage_and_Exit(Noptions, Options, "input_file output_file"); - } - Input_File = ((strequal(argv[1], "-")) ? - stdin : - fopen(argv[1], "r")); - if (Input_File == NULL) - { - perror("Open failed."); - exit(1); - } - Output_File = ((strequal(argv[2], "-")) ? - stdout : - fopen(argv[2], "w")); - if (Output_File == NULL) - { - perror("Open failed."); - fclose(Input_File); - exit(1); - } - fprintf(stderr, "%s: Reading from %s, writing to %s.\n", - Program_Name, argv[1], argv[2]); - return; -} - void quit(code) int code; { - fclose(Input_File); - fclose(Output_File); - /* VMS brain dammage */ + fclose(input_file); + fclose(output_file); +#ifdef vms + /* This assumes that it is only invoked with 0 in tail recursive psn. */ if (code != 0) { exit(code); } - return; + else + { + return; + } +#else /* not vms */ + exit(code); +#endif /*vms */ } + +/* Include the command line parser */ + +#define boolean Boolean +#include "comlin.c" -#endif /* unix */ +#define INPUT_KEYWORD() \ +KEYWORD("input", &input_file_name, STRING_KYWRD, SFRMT, NULL) +#define OUTPUT_KEYWORD() \ +KEYWORD("output", &output_file_name, STRING_KYWRD, SFRMT, NULL) diff --git a/v7/src/microcode/psbtobin.c b/v7/src/microcode/psbtobin.c index a4d5ad173..d9a53a596 100644 --- a/v7/src/microcode/psbtobin.c +++ b/v7/src/microcode/psbtobin.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbtobin.c,v 9.31 1988/01/04 18:55:54 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbtobin.c,v 9.32 1988/02/10 15:43:12 jinx Exp $ * * This File contains the code to translate portable format binary * files to internal format. @@ -39,12 +39,12 @@ MIT in each case. */ /* Cheap renames */ -#define Portable_File Input_File -#define Internal_File Output_File - #include "psbmap.h" +#define portable_file input_file +#define internal_file output_file static Boolean + band_p = false; allow_compiled_p = false, allow_nmv_p = false; @@ -71,7 +71,8 @@ Write_Data(Count, From_Where) { extern int fwrite(); - return (fwrite(((char *) From_Where), sizeof(Pointer), Count, Internal_File)); + return (fwrite(((char *) From_Where), sizeof(Pointer), + Count, internal_file)); } #include "fasl.h" @@ -83,9 +84,9 @@ inconsistency() /* Provide some context (2 lines). */ char yow[100]; - fgets(&yow[0], 100, Portable_File); + fgets(&yow[0], 100, portable_file); fprintf(stderr, "%s\n", &yow[0]); - fgets(&yow[0], 100, Portable_File); + fgets(&yow[0], 100, portable_file); fprintf(stderr, "%s\n", &yow[0]); quit(1); @@ -99,12 +100,12 @@ read_a_char() { fast char C; - C = getc(Portable_File); + C = getc(portable_file); if (C != '\\') { OUT(C); } - C = getc(Portable_File); + C = getc(portable_file); switch(C) { case 'n': OUT('\n'); @@ -118,9 +119,9 @@ read_a_char() fprintf(stderr, "%s: File is not Portable. Character Code Found.\n", - Program_Name); - fscanf(Portable_File, "%ld", &Code); - getc(Portable_File); /* Space */ + program_name); + fscanf(portable_file, "%ld", &Code); + getc(portable_file); /* Space */ OUT(Code); } case '\\': OUT('\\'); @@ -134,11 +135,11 @@ read_a_string_internal(To, maxlen) long maxlen; { long ilen, Pointer_Count; - fast char *string; + fast char *str; fast long len; - string = ((char *) (&To[STRING_CHARS])); - fscanf(Portable_File, "%ld", &ilen); + str = ((char *) (&To[STRING_CHARS])); + fscanf(portable_file, "%ld", &ilen); len = ilen; if (maxlen == -1) @@ -157,12 +158,12 @@ read_a_string_internal(To, maxlen) /* Space */ - getc(Portable_File); + getc(portable_file); while (--len >= 0) { - *string++ = ((char) read_a_char()); + *str++ = ((char) read_a_char()); } - *string = '\0'; + *str = '\0'; return (To + Pointer_Count); } @@ -173,7 +174,7 @@ read_a_string(To, Slot) long maxlen; *Slot = Make_Pointer(TC_CHARACTER_STRING, To); - fscanf(Portable_File, "%ld", &maxlen); + fscanf(portable_file, "%ld", &maxlen); return (read_a_string_internal(To, maxlen)); } @@ -190,7 +191,7 @@ read_a_string(To, Slot) #define read_hex_digit(var) \ { \ - fscanf(Portable_File, "%1lx", &var); \ + fscanf(portable_file, "%1lx", &var); \ } #else @@ -208,7 +209,7 @@ read_hex_digit_procedure() long digit; int c; - while ((c = fgetc(Portable_File)) == ' ') + while ((c = fgetc(portable_file)) == ' ') {}; digit = ((c >= 'a') ? (c - 'a' + 10) : ((c >= 'A') ? (c - 'A' + 10) @@ -228,9 +229,9 @@ read_an_integer(The_Type, To, Slot) Boolean negative; long size_in_bits; - getc(Portable_File); /* Space */ - negative = ((getc(Portable_File)) == '-'); - fscanf(Portable_File, "%ld", &size_in_bits); + getc(portable_file); /* Space */ + negative = ((getc(portable_file)) == '-'); + fscanf(portable_file, "%ld", &size_in_bits); if ((size_in_bits <= fixnum_to_bits) && (The_Type == TC_FIXNUM)) { @@ -276,7 +277,7 @@ read_an_integer(The_Type, To, Slot) { fprintf(stderr, "%s: Fixnum too large, coercing to bignum.\n", - Program_Name); + program_name); } size = bits_to_bigdigit(size_in_bits); ndigits = hex_digits(size_in_bits); @@ -312,7 +313,7 @@ read_a_bit_string(To, Slot) long size_in_bits, size_in_words; Pointer the_bit_string; - fscanf(Portable_File, "%ld", &size_in_bits); + fscanf(portable_file, "%ld", &size_in_bits); size_in_words = (1 + bits_to_pointers (size_in_bits)); the_bit_string = Make_Pointer(TC_BIT_STRING, To); @@ -393,11 +394,11 @@ read_a_flonum() long size_in_bits, exponent; fast double Result; - getc(Portable_File); /* Space */ - negative = ((getc(Portable_File)) == '-'); + getc(portable_file); /* Space */ + negative = ((getc(portable_file)) == '-'); VMS_BUG(exponent = 0); VMS_BUG(size_in_bits = 0); - fscanf(Portable_File, "%ld %ld", &exponent, &size_in_bits); + fscanf(portable_file, "%ld %ld", &exponent, &size_in_bits); if (size_in_bits == 0) { Result = 0.0; @@ -407,11 +408,11 @@ read_a_flonum() { /* Skip over mantissa */ - while (getc(Portable_File) != '\n') + while (getc(portable_file) != '\n') {}; fprintf(stderr, "%s: Floating point exponent too %s!\n", - Program_Name, + program_name, ((exponent < 0) ? "small" : "large")); Result = ((exponent < 0) ? dflmin() : dflmax()); } @@ -425,9 +426,9 @@ read_a_flonum() { fprintf(stderr, "%s: Some precision may be lost.", - Program_Name); + program_name); } - getc(Portable_File); /* Space */ + getc(portable_file); /* Space */ for (ndigits = hex_digits(size_in_bits), Result = 0.0, Normalization = (1.0 / 16.0); @@ -456,7 +457,7 @@ Read_External(N, Table, To) while (Table < Until) { - fscanf(Portable_File, "%2x", &The_Type); + fscanf(portable_file, "%2x", &The_Type); switch(The_Type) { case TC_CHARACTER_STRING: @@ -476,9 +477,9 @@ Read_External(N, Table, To) { long the_char_code; - getc(Portable_File); /* Space */ + getc(portable_file); /* Space */ VMS_BUG(the_char_code = 0); - fscanf( Portable_File, "%3lx", &the_char_code); + fscanf( portable_file, "%3lx", &the_char_code); *Table++ = Make_Non_Pointer( TC_CHARACTER, the_char_code); continue; } @@ -498,7 +499,7 @@ Read_External(N, Table, To) default: fprintf(stderr, "%s: Unknown external object found; Type = 0x%02x\n", - Program_Name, The_Type); + program_name, The_Type); inconsistency(); /*NOTREACHED*/ } @@ -552,7 +553,7 @@ Relocate_Objects(From, N, disp) default: fprintf(stderr, "%s: Unknown External Object Reference with Type 0x%02x", - Program_Name, + program_name, Type_Code(*From)); inconsistency(); } @@ -610,7 +611,7 @@ Read_Pointers_and_Relocate(N, To) { VMS_BUG(The_Type = 0); VMS_BUG(The_Datum = 0); - fscanf(Portable_File, "%2x %lx", &The_Type, &The_Datum); + fscanf(portable_file, "%2x %lx", &The_Type, &The_Datum); switch(The_Type) { case CONSTANT_CODE: @@ -631,7 +632,7 @@ Read_Pointers_and_Relocate(N, To) while (--count >= 0) { VMS_BUG(*To = 0); - fscanf(Portable_File, "%lx", To++); + fscanf(portable_file, "%lx", To++); } } continue; @@ -641,7 +642,7 @@ Read_Pointers_and_Relocate(N, To) Pointer *temp; long base_type, base_datum; - fscanf(Portable_File, "%02x %lx", &base_type, &base_datum); + fscanf(portable_file, "%02x %lx", &base_type, &base_datum); temp = Relocate(base_datum); *To++ = Make_Pointer(base_type, ((Pointer *) (&(((char *) temp)[The_Datum])))); @@ -651,7 +652,7 @@ Read_Pointers_and_Relocate(N, To) case TC_BROKEN_HEART: if (The_Datum != 0) { - fprintf(stderr, "%s: Broken Heart Found\n", Program_Name); + fprintf(stderr, "%s: Broken Heart Found\n", program_name); inconsistency(); } /* fall through */ @@ -694,7 +695,7 @@ read_primitives(how_many, where) while (--how_many >= 0) { - fscanf(Portable_File, "%ld", &arity); + fscanf(portable_file, "%ld", &arity); if (arity == ((long) UNKNOWN_PRIMITIVE_ARITY)) { primitive_warn = true; @@ -784,7 +785,7 @@ when(what, message) if (what) { fprintf(stderr, "%s: Inconsistency: %s!\n", - Program_Name, (message)); + program_name, (message)); quit(1); } return; @@ -792,7 +793,7 @@ when(what, message) #define READ_HEADER(string, format, value) \ { \ - fscanf(Input_File, format, &(value)); \ + fscanf(portable_file, format, &(value)); \ fprintf(stderr, "%s: ", (string)); \ fprintf(stderr, (format), (value)); \ fprintf(stderr, "\n"); \ @@ -806,11 +807,21 @@ when(what, message) #define READ_HEADER(string, format, value) \ { \ - fscanf(Input_File, format, &(value)); \ + if (fscanf(portable_file, format, &(value)) == EOF) \ + { \ + short_header_read(); \ + } \ } #endif /* DEBUG */ +void +short_header_read() +{ + fprintf(stderr, "%s: Header is not complete!\n", program_name); + quit(1); +} + long Read_Header_and_Allocate() { @@ -826,6 +837,7 @@ Read_Header_and_Allocate() if (Portable_Version != PORTABLE_VERSION) { + fprintf(stderr, "%s: Portable version mismatch:\n", program_name); fprintf(stderr, "Portable File Version %4d\n", Portable_Version); fprintf(stderr, "Expected: Version %4d\n", PORTABLE_VERSION); quit(1); @@ -838,11 +850,12 @@ Read_Header_and_Allocate() if ((Version != FASL_FORMAT_VERSION) || (Sub_Version != FASL_SUBVERSION)) { + fprintf(stderr, "%s: Binary version mismatch:\n", program_name); fprintf(stderr, - "Portable File Version %4d Subversion %4d Binary Version %4d\n", + "Portable File Version %4d; Binary Version %4d; Subversion %4d\n", Portable_Version, Version, Sub_Version); fprintf(stderr, - "Expected: Version %4d Subversion %4d Binary Version %4d\n", + "Expected: Version %4d; Binary Version %4d; Subversion %4d\n", PORTABLE_VERSION, FASL_FORMAT_VERSION, FASL_SUBVERSION); quit(1); } @@ -856,18 +869,18 @@ Read_Header_and_Allocate() { if (compiled_p) { - fprintf(stderr, - "%s: Portable file contains \"invalid\" compiled code.\n", - Program_Name); + fprintf(stderr, "%s: %s\n", program_name, + "Portable file contains \"non-portable\" compiled code."); } else { - fprintf(stderr, - "%s: Portable file contains \"random\" non-marked vectors.\n", - Program_Name); + fprintf(stderr, "%s: %s\n", program_name, + "Portable file contains \"unexpected\" non-marked vectors."); } - fprintf(stderr, "Portable File Machine %4d\n", Machine); - fprintf(stderr, "Expected: Machine %4d\n", FASL_INTERNAL_FORMAT); + fprintf(stderr, "Machine specified in the portable file: %4d\n", + Machine); + fprintf(stderr, "Machine Expected: %4d\n", + FASL_INTERNAL_FORMAT); quit(1); } @@ -896,6 +909,13 @@ Read_Header_and_Allocate() READ_HEADER("Primitive Table Length", "%ld", Primitive_Table_Length); READ_HEADER("Number of characters in primitives", "%ld", NPChars); + READ_HEADER("CPU type", "%ld", compiler_processor_type); + READ_HEADER("Compiled code interface version", "%ld", + compiler_interface_version); +#if false + READ_HEADER("Compiler utilities vector", "%ld", compiler_utilities); +#endif + Size = (6 + /* SNMV */ HEAP_BUFFER_SPACE + Heap_Count + Heap_Objects + @@ -916,7 +936,7 @@ Read_Header_and_Allocate() { fprintf(stderr, "%s: Memory Allocation Failed. Size = %ld Scheme Pointers\n", - Program_Name, Size); + program_name, Size); quit(1); } Heap += HEAP_BUFFER_SPACE; @@ -1004,7 +1024,7 @@ do_it() if (primitive_warn) { - fprintf(stderr, "%s:\n", Program_Name); + fprintf(stderr, "%s:\n", program_name); fprintf(stderr, "NOTE: The binary file contains primitives with unknown arity.\n"); } @@ -1043,7 +1063,8 @@ do_it() (Free - Heap_Base), Heap_Base, 0, Stack_Top, primitive_table, Primitive_Table_Length, - ((long) (primitive_table_end - primitive_table))); + ((long) (primitive_table_end - primitive_table)), + compiled_p, band_p); } else { @@ -1068,12 +1089,13 @@ do_it() (Free - Heap_Base), Heap_Base, Total_Length, (Pure_Base - 2), primitive_table, Primitive_Table_Length, - ((long) (primitive_table_end - primitive_table))); + ((long) (primitive_table_end - primitive_table)), + compiled_p, band_p); } } if (!result) { - fprintf(stderr, "%s: Error writing the output file.\n", Program_Name); + fprintf(stderr, "%s: Error writing the output file.\n", program_name); quit(1); } return; @@ -1081,17 +1103,21 @@ do_it() /* Top level */ -static struct Option_Struct Options[] = - {{"Allow_Compiled", true, &allow_compiled_p}, - {"Allow_NMVs", true, &allow_nmv_p}}; - -static int Noptions = 2; +static struct keyword_struct + options[] = { + KEYWORD("allow_nmv", &allow_nmv_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("allow_cc", &allow_compiled_p, BOOLEAN_KYWRD, BFRMT, NULL), + OUTPUT_KEYWORD(), + INPUT_KEYWORD(), + END_KEYWORD() + }; main(argc, argv) int argc; char *argv[]; { - Setup_Program(argc, argv, Noptions, Options); + parse_keywords(argc, argv, options, false); + setup_io(); do_it(); quit(0); } diff --git a/v8/src/microcode/bintopsb.c b/v8/src/microcode/bintopsb.c index b7e06a957..e46dacccb 100644 --- a/v8/src/microcode/bintopsb.c +++ b/v8/src/microcode/bintopsb.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/bintopsb.c,v 9.32 1988/01/04 18:58:17 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/bintopsb.c,v 9.33 1988/02/10 15:41:50 jinx Exp $ * * This File contains the code to translate internal format binary * files to portable format. @@ -39,11 +39,10 @@ MIT in each case. */ /* IO definitions */ -#define Internal_File Input_File -#define Portable_File Output_File - #include "psbmap.h" #include "trap.h" +#define internal_file input_file +#define portable_file output_file long Load_Data(Count, To_Where) @@ -52,13 +51,11 @@ Load_Data(Count, To_Where) { extern int fread(); - return (fread(To_Where, sizeof(Pointer), Count, Internal_File)); + return (fread(To_Where, sizeof(Pointer), Count, internal_file)); } -#define Reloc_or_Load_Debug false - -#include "fasl.h" #define INHIBIT_FASL_VERSION_CHECK +#define INHIBIT_COMPILED_VERSION_CHECK #include "load.c" #include "bltdef.h" @@ -79,7 +76,8 @@ extern int strlen(); /* This is in some libraries but not others */ -static char punctuation[] = "'\",<.>/?;:{}[]|`~=+-_()*&^%$#@!"; +static char + punctuation[] = "'\",<.>/?;:{}[]|`~=+-_()*&^%$#@!"; Boolean ispunct(c) @@ -110,11 +108,12 @@ ispunct(c) static Boolean shuffle_bytes_p = false, + allow_nmv_p = false, upgrade_traps_p = false, upgrade_primitives_p = false, upgrade_lengths_p = false, allow_compiled_p = false, - allow_nmv_p = false; + upgrade_compiled_p = false; static long Heap_Relocation, Constant_Relocation, @@ -124,7 +123,8 @@ static long static Pointer *Mem_Base, *Free_Objects, *Free_Cobjects, - *compiled_entry_table, *compiled_entry_pointer, *compiled_entry_table_end, + *compiled_entry_table, *compiled_entry_pointer, + *compiled_entry_table_end, *primitive_table, *primitive_table_end; static long @@ -136,7 +136,7 @@ static long #define OUT(s) \ { \ - fprintf(Portable_File, (s)); \ + fprintf(portable_file, (s)); \ break; \ } @@ -158,15 +158,15 @@ print_a_char(c, name) default: if ((isalpha(c)) || (isdigit(c)) || (ispunct(c))) { - putc(c, Portable_File); + putc(c, portable_file); } else { fprintf(stderr, "%s: %s: File may not be portable: c = 0x%x\n", - Program_Name, name, ((int) c)); + program_name, name, ((int) c)); /* This does not follow C conventions, but eliminates ambiguity */ - fprintf(Portable_File, "\X%x ", ((int) c)); + fprintf(portable_file, "\X%x ", ((int) c)); } } return; @@ -177,7 +177,7 @@ print_a_char(c, name) Old_Address += (Rel); \ Old_Contents = *Old_Address; \ \ - if (Type_Code(Old_Contents) == TC_BROKEN_HEART) \ + if (OBJECT_TYPE(Old_Contents) == TC_BROKEN_HEART) \ { \ Mem_Base[(Scn)] = Make_New_Pointer((Code), Old_Contents); \ } \ @@ -264,23 +264,23 @@ print_a_fixnum(val) { temp = temp >> 1; } - fprintf(Portable_File, "%02x %c ", + fprintf(portable_file, "%02x %c ", TC_FIXNUM, (val < 0 ? '-' : '+')); if (val == 0) { - fprintf(Portable_File, "0\n"); + fprintf(portable_file, "0\n"); } else { - fprintf(Portable_File, "%ld ", size_in_bits); + fprintf(portable_file, "%ld ", size_in_bits); temp = ((val < 0) ? -val : val); while (temp != 0) { - fprintf(Portable_File, "%01lx", (temp & 0xf)); + fprintf(portable_file, "%01lx", (temp & 0xf)); temp = temp >> 4; } - fprintf(Portable_File, "\n"); + fprintf(portable_file, "\n"); } return; } @@ -290,7 +290,7 @@ print_a_string_internal(len, string) fast long len; fast char *string; { - fprintf(Portable_File, "%ld ", len); + fprintf(portable_file, "%ld ", len); if (shuffle_bytes_p) { while(len > 0) @@ -319,7 +319,7 @@ print_a_string_internal(len, string) print_a_char(*string++, "print_a_string"); } } - putc('\n', Portable_File); + putc('\n', portable_file); return; } @@ -333,7 +333,7 @@ print_a_string(from) maxlen = pointer_to_char((Get_Integer(*from++)) - 1); len = STRING_LENGTH_TO_LONG(*from++); - fprintf(Portable_File, + fprintf(portable_file, "%02x %ld ", TC_CHARACTER_STRING, (compact_p ? len : maxlen)); @@ -347,7 +347,7 @@ print_a_primitive(arity, length, name) long arity, length; char *name; { - fprintf(Portable_File, "%ld ", arity); + fprintf(portable_file, "%ld ", arity); print_a_string_internal(length, name); return; } @@ -364,7 +364,7 @@ print_a_bignum(from) temp = LEN(the_number); if (temp == 0) { - fprintf(Portable_File, "%02x + 0\n", + fprintf(portable_file, "%02x + 0\n", (compact_p ? TC_FIXNUM : TC_BIG_FIXNUM)); } else @@ -379,7 +379,7 @@ print_a_bignum(from) temp = temp >> 1; } - fprintf(Portable_File, "%02x %c %ld ", + fprintf(portable_file, "%02x %c %ld ", (compact_p ? TC_FIXNUM : TC_BIG_FIXNUM), (NEG_BIGNUM(the_number) ? '-' : '+'), size_in_bits); @@ -400,17 +400,17 @@ print_a_bignum(from) size_in_bits > 3; size_in_bits -= 4) { - fprintf(Portable_File, "%01lx", (temp & 0xf)); + fprintf(portable_file, "%01lx", (temp & 0xf)); temp = temp >> 4; } } if (size_in_bits > 0) { - fprintf(Portable_File, "%01lx\n", (temp & 0xf)); + fprintf(portable_file, "%01lx\n", (temp & 0xf)); } else { - fprintf(Portable_File, "\n"); + fprintf(portable_file, "\n"); } } return; @@ -428,11 +428,11 @@ print_a_bit_string(from) the_bit_string = Make_Pointer(TC_BIT_STRING, from); bits_remaining = bit_string_length(the_bit_string); - fprintf(Portable_File, "%02x %ld", TC_BIT_STRING, bits_remaining); + fprintf(portable_file, "%02x %ld", TC_BIT_STRING, bits_remaining); if (bits_remaining != 0) { - fprintf(Portable_File, " "); + fprintf(portable_file, " "); scan = bit_string_low_ptr(the_bit_string); for (leftover_bits = 0; bits_remaining > 0; @@ -452,7 +452,7 @@ print_a_bit_string(from) leftover_bits += ((bits_remaining > POINTER_LENGTH) ? (POINTER_LENGTH - 4) : (bits_remaining - 4)); - fprintf(Portable_File, "%01lx", (accumulator & 0xf)); + fprintf(portable_file, "%01lx", (accumulator & 0xf)); } else { @@ -463,16 +463,16 @@ print_a_bit_string(from) for(accumulator = next_word; leftover_bits >= 4; leftover_bits -= 4) { - fprintf(Portable_File, "%01lx", (accumulator & 0xf)); + fprintf(portable_file, "%01lx", (accumulator & 0xf)); accumulator = accumulator >> 4; } } if (leftover_bits != 0) { - fprintf(Portable_File, "%01lx", (accumulator & 0xf)); + fprintf(portable_file, "%01lx", (accumulator & 0xf)); } } - fprintf(Portable_File, "\n"); + fprintf(portable_file, "\n"); return; } @@ -485,12 +485,12 @@ print_a_flonum(val) int expt; extern double frexp(); - fprintf(Portable_File, "%02x %c ", + fprintf(portable_file, "%02x %c ", TC_BIG_FLONUM, ((val < 0.0) ? '-' : '+')); if (val == 0.0) { - fprintf(Portable_File, "0\n"); + fprintf(portable_file, "0\n"); return; } mant = frexp(((val < 0.0) ? -val : val), &expt); @@ -504,7 +504,7 @@ print_a_flonum(val) if (temp >= 1.0) temp -= 1.0; } - fprintf(Portable_File, "%ld %ld ", expt, size_in_bits); + fprintf(portable_file, "%ld %ld ", expt, size_in_bits); for (size_in_bits = hex_digits(size_in_bits); size_in_bits > 0; @@ -523,9 +523,9 @@ print_a_flonum(val) digit += 1; } } - fprintf(Portable_File, "%01x", digit); + fprintf(portable_file, "%01x", digit); } - putc('\n', Portable_File); + putc('\n', portable_file); return; } @@ -536,14 +536,15 @@ print_a_flonum(val) Old_Address += (Rel); \ Old_Contents = *Old_Address; \ \ - if (Type_Code(Old_Contents) == TC_BROKEN_HEART) \ + if (OBJECT_TYPE(Old_Contents) == TC_BROKEN_HEART) \ { \ - Mem_Base[(Scn)] = Make_New_Pointer(Type_Code(This), Old_Contents); \ + Mem_Base[(Scn)] = Make_New_Pointer(OBJECT_TYPE(This), \ + Old_Contents); \ } \ else \ { \ *Old_Address++ = Make_Non_Pointer(TC_BROKEN_HEART, (Fre)); \ - Mem_Base[(Scn)] = Make_Non_Pointer(Type_Code(This), (Fre)); \ + Mem_Base[(Scn)] = Make_Non_Pointer(OBJECT_TYPE(This), (Fre)); \ Mem_Base[(Fre)++] = Old_Contents; \ } \ } @@ -553,14 +554,15 @@ print_a_flonum(val) Old_Address += (Rel); \ Old_Contents = *Old_Address; \ \ - if (Type_Code(Old_Contents) == TC_BROKEN_HEART) \ + if (OBJECT_TYPE(Old_Contents) == TC_BROKEN_HEART) \ { \ - Mem_Base[(Scn)] = Make_New_Pointer(Type_Code(This), Old_Contents); \ + Mem_Base[(Scn)] = Make_New_Pointer(OBJECT_TYPE(This), \ + Old_Contents); \ } \ else \ { \ *Old_Address++ = Make_Non_Pointer(TC_BROKEN_HEART, (Fre)); \ - Mem_Base[(Scn)] = Make_Non_Pointer(Type_Code(This), (Fre)); \ + Mem_Base[(Scn)] = Make_Non_Pointer(OBJECT_TYPE(This), (Fre)); \ Mem_Base[(Fre)++] = Old_Contents; \ Mem_Base[(Fre)++] = *Old_Address++; \ } \ @@ -571,14 +573,15 @@ print_a_flonum(val) Old_Address += (Rel); \ Old_Contents = *Old_Address; \ \ - if (Type_Code(Old_Contents) == TC_BROKEN_HEART) \ + if (OBJECT_TYPE(Old_Contents) == TC_BROKEN_HEART) \ { \ - Mem_Base[(Scn)] = Make_New_Pointer(Type_Code(This), Old_Contents); \ + Mem_Base[(Scn)] = Make_New_Pointer(OBJECT_TYPE(This), \ + Old_Contents); \ } \ else \ { \ *Old_Address++ = Make_Non_Pointer(TC_BROKEN_HEART, (Fre)); \ - Mem_Base[(Scn)] = Make_Non_Pointer(Type_Code(This), (Fre)); \ + Mem_Base[(Scn)] = Make_Non_Pointer(OBJECT_TYPE(This), (Fre)); \ Mem_Base[(Fre)++] = Old_Contents; \ Mem_Base[(Fre)++] = *Old_Address++; \ Mem_Base[(Fre)++] = *Old_Address++; \ @@ -590,14 +593,15 @@ print_a_flonum(val) Old_Address += (Rel); \ Old_Contents = *Old_Address; \ \ - if (Type_Code(Old_Contents) == TC_BROKEN_HEART) \ + if (OBJECT_TYPE(Old_Contents) == TC_BROKEN_HEART) \ { \ - Mem_Base[(Scn)] = Make_New_Pointer(Type_Code(This), Old_Contents); \ + Mem_Base[(Scn)] = Make_New_Pointer(OBJECT_TYPE(This), \ + Old_Contents); \ } \ else \ { \ *Old_Address++ = Make_Non_Pointer(TC_BROKEN_HEART, (Fre)); \ - Mem_Base[(Scn)] = Make_Non_Pointer(Type_Code(This), (Fre)); \ + Mem_Base[(Scn)] = Make_Non_Pointer(OBJECT_TYPE(This), (Fre)); \ Mem_Base[(Fre)++] = Old_Contents; \ Mem_Base[(Fre)++] = *Old_Address++; \ Mem_Base[(Fre)++] = *Old_Address++; \ @@ -635,7 +639,7 @@ print_a_flonum(val) } \ } -#define Do_Compiled_Entry(COde, Rel, Fre, Scn, Obj, FObj) \ +#define Do_Compiled_Entry(Code, Rel, Fre, Scn, Obj, FObj) \ { \ long offset; \ Pointer *saved; \ @@ -672,65 +676,119 @@ print_a_flonum(val) #define Do_Pointer(Scn, Action) \ { \ + long the_datum; \ + \ Old_Address = Get_Pointer(This); \ - if (Datum(This) < Const_Base) \ + the_datum = OBJECT_DATUM(This); \ + if ((the_datum >= Heap_Base) && \ + (the_datum < Dumped_Heap_Top)) \ { \ Action(HEAP_CODE, Heap_Relocation, Free, \ Scn, Objects, Free_Objects); \ } \ - else if (Datum(This) < Dumped_Constant_Top) \ + \ + /* \ + \ + Currently constant space is not supported \ + \ + else if ((the_datum >= Const_Base) && \ + (the_datum < Dumped_Constant_Top)) \ { \ Action(CONSTANT_CODE, Constant_Relocation, Free_Constant, \ Scn, Constant_Objects, Free_Cobjects); \ } \ + \ + */ \ + \ else \ { \ - fprintf(stderr, \ - "%s: File is not portable: Pointer to stack.\n", \ - Program_Name); \ - quit(1); \ + out_of_range_pointer(This); \ } \ (Scn) += 1; \ break; \ } -/* Primitive upgrading code. */ - -#define PRIMITIVE_UPGRADE_SPACE 2048 -static Pointer *internal_renumber_table; -static Pointer *external_renumber_table; -static Pointer *external_prim_name_table; -static Boolean found_ext_prims = false; +void +out_of_range_pointer(ptr) + Pointer ptr; +{ + fprintf(stderr, + "%s: The input file is not portable: Out of range pointer.\n", + program_name); + fprintf(stderr, "Heap_Base = 0x%lx;\tHeap_Top = 0x%lx\n", + Heap_Base, Dumped_Heap_Top); + fprintf(stderr, "Const_Base = 0x%lx;\tConst_Top = 0x%lx\n", + Const_Base, Dumped_Constant_Top); + fprintf(stderr, "ptr = 0x%02x|0x%lx\n", + OBJECT_TYPE(ptr), OBJECT_DATUM(ptr)); + quit(1); +} Pointer * relocate(object) Pointer object; { + long the_datum; Pointer *result; - result = (Get_Pointer(object) + ((Datum(object) < Const_Base) ? - Heap_Relocation : - Constant_Relocation)); + + result = Get_Pointer(object); + the_datum = OBJECT_DATUM(object); + + if ((the_datum >= Heap_Base) && + (the_datum < Dumped_Heap_Top)) + { + result += Heap_Relocation; + } + +#if false + + /* Currently constant space is not supported */ + + else if (( the_datum >= Const_Base) && + (the_datum < Dumped_Constant_Top)) + { + result += Constant_Relocation; + } + +#endif /* false */ + + else + { + out_of_range_pointer(object); + } return (result); } + +/* Primitive upgrading code. */ + +#define PRIMITIVE_UPGRADE_SPACE 2048 + +static Pointer + *internal_renumber_table, + *external_renumber_table, + *external_prim_name_table; + +static Boolean + found_ext_prims = false; Pointer upgrade_primitive(prim) Pointer prim; { - long datum, type, new_type, code; + long the_datum, the_type, new_type, code; Pointer new; - datum = OBJECT_DATUM(prim); - type = OBJECT_TYPE(prim); - if (type != TC_PRIMITIVE_EXTERNAL) + the_datum = OBJECT_DATUM(prim); + the_type = OBJECT_TYPE(prim); + if (the_type != TC_PRIMITIVE_EXTERNAL) { - code = datum; - new_type = type; + code = the_datum; + new_type = the_type; } else { found_ext_prims = true; - code = (datum + (MAX_BUILTIN_PRIMITIVE + 1)); + code = (the_datum + (MAX_BUILTIN_PRIMITIVE + 1)); new_type = TC_PRIMITIVE; } @@ -746,15 +804,16 @@ upgrade_primitive(prim) internal_renumber_table[code] = new; external_renumber_table[Primitive_Table_Length] = prim; Primitive_Table_Length += 1; - if (type == TC_PRIMITIVE_EXTERNAL) + if (the_type == TC_PRIMITIVE_EXTERNAL) { NPChars += - STRING_LENGTH_TO_LONG((((Pointer *) (external_prim_name_table[datum])) + STRING_LENGTH_TO_LONG((((Pointer *) + (external_prim_name_table[the_datum])) [STRING_LENGTH])); } else { - NPChars += strlen(builtin_prim_name_table[datum]); + NPChars += strlen(builtin_prim_name_table[the_datum]); } return (new); } @@ -801,10 +860,10 @@ setup_primitive_upgrade(Heap) length += (MAX_BUILTIN_PRIMITIVE + 1); if (length > PRIMITIVE_UPGRADE_SPACE) { - fprintf(stderr, "%s: Too many primitives.\n", Program_Name); + fprintf(stderr, "%s: Too many primitives.\n", program_name); fprintf(stderr, "Increase PRIMITIVE_UPGRADE_SPACE and recompile %s.\n", - Program_Name); + program_name); quit(1); } for (count = 0; count < length; count += 1) @@ -833,7 +892,8 @@ Process_Area(Code, Area, Bound, Obj, FObj) This = Mem_Base[*Area]; #ifdef PRIMITIVE_EXTERNAL_REUSED - if (upgrade_primitives_p && (Type_Code(This) == TC_PRIMITIVE_EXTERNAL)) + if (upgrade_primitives_p && + (OBJECT_TYPE(This) == TC_PRIMITIVE_EXTERNAL)) { Mem_Base[*Area] = upgrade_primitive(This); *Area += 1; @@ -875,7 +935,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) else if (!allow_nmv_p) { fprintf(stderr, "%s: File is not portable: NMH found\n", - Program_Name); + program_name); } *Area += (1 + OBJECT_DATUM(This)); break; @@ -885,7 +945,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) if (OBJECT_DATUM(This) != 0) { fprintf(stderr, "%s: Broken Heart found in scan.\n", - Program_Name); + program_name); quit(1); } *Area += 1; @@ -897,7 +957,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) { fprintf(stderr, "%s: File contains compiled code.\n", - Program_Name); + program_name); quit(1); } Do_Pointer(*Area, Do_Compiled_Entry); @@ -905,7 +965,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) case TC_STACK_ENVIRONMENT: fprintf(stderr, "%s: File contains stack environments.\n", - Program_Name); + program_name); quit(1); case TC_FIXNUM: @@ -930,7 +990,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) { long kind; - kind = Datum(This); + kind = OBJECT_DATUM(This); if (upgrade_traps_p) { @@ -949,7 +1009,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) } fprintf(stderr, "%s: Bad old unassigned object. 0x%x.\n", - Program_Name, This); + program_name, This); quit(1); } if (kind <= TRAP_MAX_IMMEDIATE) @@ -987,14 +1047,14 @@ Process_Area(Code, Area, Bound, Obj, FObj) { fprintf(stderr, "%s: Cannot upgrade environments.\n", - Program_Name); + program_name); quit(1); } /* Fall through */ case TC_FUTURE: case_simple_Vector: - if (Type_Code(This) == TC_BIT_STRING) + if (OBJECT_TYPE(This) == TC_BIT_STRING) { Do_Pointer(*Area, Do_Bit_String); } @@ -1006,7 +1066,7 @@ Process_Area(Code, Area, Bound, Obj, FObj) default: Bad_Type: fprintf(stderr, "%s: Unknown Type Code 0x%x found.\n", - Program_Name, Type_Code(This)); + program_name, OBJECT_TYPE(This)); quit(1); } } @@ -1021,7 +1081,7 @@ print_external_objects(from, count) { while (--count >= 0) { - switch(Type_Code(*from)) + switch(OBJECT_TYPE(*from)) { case TC_FIXNUM: { @@ -1053,7 +1113,7 @@ print_external_objects(from, count) break; case TC_CHARACTER: - fprintf(Portable_File, "%02x %03x\n", + fprintf(portable_file, "%02x %03x\n", TC_CHARACTER, (*from & MASK_EXTNDD_CHAR)); from += 1; break; @@ -1061,7 +1121,7 @@ print_external_objects(from, count) default: fprintf(stderr, "%s: Bad Object to print externally %lx\n", - Program_Name, *from); + program_name, *from); quit(1); } } @@ -1072,38 +1132,38 @@ void print_objects(from, to) fast Pointer *from, *to; { - fast long datum, type; + fast long the_datum, the_type; while(from < to) { - type = OBJECT_TYPE(*from); - datum = OBJECT_DATUM(*from); + the_type = OBJECT_TYPE(*from); + the_datum = OBJECT_DATUM(*from); from += 1; - if (type == TC_MANIFEST_NM_VECTOR) + if (the_type == TC_MANIFEST_NM_VECTOR) { - fprintf(Portable_File, "%02x %lx\n", type, datum); - while (--datum >= 0) + fprintf(portable_file, "%02x %lx\n", the_type, the_datum); + while (--the_datum >= 0) { - fprintf(Portable_File, "%lx\n", ((unsigned long) *from++)); + fprintf(portable_file, "%lx\n", ((unsigned long) *from++)); } } - else if (type == TC_COMPILED_EXPRESSION) + else if (the_type == TC_COMPILED_EXPRESSION) { Pointer base; long offset; - Sign_Extend(compiled_entry_table[datum], offset); - base = compiled_entry_table[datum + 1]; + Sign_Extend(compiled_entry_table[the_datum], offset); + base = compiled_entry_table[the_datum + 1]; - fprintf(Portable_File, "%02x %lx %02x %lx\n", + fprintf(portable_file, "%02x %lx %02x %lx\n", TC_COMPILED_EXPRESSION, offset, OBJECT_TYPE(base), OBJECT_DATUM(base)); } else { - fprintf(Portable_File, "%02x %lx\n", type, datum); + fprintf(portable_file, "%02x %lx\n", the_type, the_datum); } } return; @@ -1125,7 +1185,7 @@ when(what, message) if (what) { fprintf(stderr, "%s: Inconsistency: %s!\n", - Program_Name, (message)); + program_name, (message)); quit(1); } return; @@ -1133,8 +1193,8 @@ when(what, message) #define PRINT_HEADER(name, format, obj) \ { \ - fprintf(Portable_File, (format), (obj)); \ - fprintf(Portable_File, "\n"); \ + fprintf(portable_file, (format), (obj)); \ + fprintf(portable_file, "\n"); \ fprintf(stderr, "%s: ", (name)); \ fprintf(stderr, (format), (obj)); \ fprintf(stderr, "\n"); \ @@ -1148,8 +1208,8 @@ when(what, message) #define PRINT_HEADER(name, format, obj) \ { \ - fprintf(Portable_File, (format), (obj)); \ - fprintf(Portable_File, "\n"); \ + fprintf(portable_file, (format), (obj)); \ + fprintf(portable_file, "\n"); \ } #endif /* DEBUG */ @@ -1164,11 +1224,11 @@ do_it() /* Load the Data */ - if (!Read_Header()) + if (Read_Header() != FASL_FILE_FINE) { fprintf(stderr, - "%s: Input file does not appear to be in FASL format.\n", - Program_Name); + "%s: Input file does not appear to be in an appropriate format.\n", + program_name); quit(1); } @@ -1179,7 +1239,7 @@ do_it() ((Machine_Type != FASL_INTERNAL_FORMAT) && (!shuffle_bytes_p))) { - fprintf(stderr, "%s:\n", Program_Name); + fprintf(stderr, "%s:\n", program_name); fprintf(stderr, "FASL File Version %ld Subversion %ld Machine Type %ld\n", Version, Sub_Version , Machine_Type); @@ -1188,23 +1248,56 @@ do_it() FASL_READ_VERSION, FASL_READ_SUBVERSION, FASL_INTERNAL_FORMAT); quit(1); } + + if ((((compiler_processor_type != 0) && + (dumped_processor_type != 0) && + (compiler_processor_type != dumped_processor_type)) || + ((compiler_interface_version != 0) && + (dumped_interface_version != 0) && + (compiler_interface_version != dumped_interface_version))) && + (!upgrade_compiled_p)) + { + fprintf(stderr, "\nread_file:\n"); + fprintf(stderr, + "FASL File: compiled code interface %4d; processor %4d.\n", + dumped_interface_version, dumped_processor_type); + fprintf(stderr, + "Expected: compiled code interface %4d; processor %4d.\n", + compiler_interface_version, compiler_processor_type); + quit(1); + } + if (compiler_processor_type != 0) + { + dumped_processor_type = compiler_processor_type; + } + if (compiler_interface_version != 0) + { + dumped_interface_version = compiler_interface_version; + } - /* Constant Space not currently supported */ + /* Constant Space and bands not currently supported */ + + if (band_p) + { + fprintf(stderr, "%s: Input file is a band.\n", program_name); + quit(1); + } if (Const_Count != 0) { fprintf(stderr, "%s: Input file has a constant space area.\n", - Program_Name); + program_name); quit(1); } + allow_compiled_p = (allow_compiled_p || upgrade_compiled_p); allow_nmv_p = (allow_nmv_p || allow_compiled_p); if (null_nmv_p && allow_nmv_p) { fprintf(stderr, "%s: NMVs are both allowed and to be nulled out!\n", - Program_Name); + program_name); quit(1); } @@ -1216,6 +1309,26 @@ do_it() upgrade_traps_p = (Sub_Version < FASL_REFERENCE_TRAP); upgrade_primitives_p = (Sub_Version < FASL_MERGED_PRIMITIVES); upgrade_lengths_p = upgrade_primitives_p; + + DEBUGGING(fprintf(stderr, + "Dumped Heap Base = 0x%08x\n", + Heap_Base)); + + DEBUGGING(fprintf(stderr, + "Dumped Constant Base = 0x%08x\n", + Const_Base)); + + DEBUGGING(fprintf(stderr, + "Dumped Constant Top = 0x%08x\n", + Dumped_Constant_Top)); + + DEBUGGING(fprintf(stderr, + "Heap Count = %6d\n", + Heap_Count)); + + DEBUGGING(fprintf(stderr, + "Constant Count = %6d\n", + Const_Count)); { long Size; @@ -1237,7 +1350,7 @@ do_it() { fprintf(stderr, "%s: Memory Allocation Failed. Size = %ld Scheme Pointers\n", - Program_Name, Size); + program_name, Size); quit(1); } } @@ -1246,31 +1359,10 @@ do_it() Initial_Align_Float(Heap); Load_Data(Heap_Count, &Heap[0]); Load_Data(Const_Count, &Heap[Heap_Count]); - Load_Data(Primitive_Table_Size, &Heap[Heap_Count + Const_Count]); - Heap_Relocation = &Heap[0] - Get_Pointer(Heap_Base); - Constant_Relocation = &Heap[Heap_Count] - Get_Pointer(Const_Base); - - DEBUGGING(fprintf(stderr, - "Dumped Heap Base = 0x%08x\n", - Heap_Base)); - - DEBUGGING(fprintf(stderr, - "Dumped Constant Base = 0x%08x\n", - Const_Base)); - - DEBUGGING(fprintf(stderr, - "Dumped Constant Top = 0x%08x\n", - Dumped_Constant_Top)); - - DEBUGGING(fprintf(stderr, - "Heap Count = %6d\n", - Heap_Count)); - - DEBUGGING(fprintf(stderr, - "Constant Count = %6d\n", - Const_Count)); + Heap_Relocation = ((&Heap[0]) - (Get_Pointer(Heap_Base))); + Constant_Relocation = ((&Heap[Heap_Count]) - (Get_Pointer(Const_Base))); - /* Determine primitive information. */ + /* Setup compiled code and primitive tables. */ compiled_entry_table = &Heap[Heap_Count + Const_Count]; compiled_entry_pointer = compiled_entry_table; @@ -1291,6 +1383,7 @@ do_it() fast Pointer *table; fast long count, char_count; + Load_Data(Primitive_Table_Size, primitive_table); for (char_count = 0, count = Primitive_Table_Length, table = primitive_table; @@ -1369,7 +1462,7 @@ do_it() if (found_ext_prims) { - fprintf(stderr, "%s:\n", Program_Name); + fprintf(stderr, "%s:\n", program_name); fprintf(stderr, "NOTE: The arity of some primitives is not known.\n"); fprintf(stderr, " The portable file has %ld as their arity.\n", UNKNOWN_PRIMITIVE_ARITY); @@ -1410,6 +1503,20 @@ do_it() PRINT_HEADER("Number of primitives", "%ld", Primitive_Table_Length); PRINT_HEADER("Number of characters in primitives", "%ld", NPChars); + + if (!compiled_p) + { + dumped_processor_type = 0; + dumped_interface_version = 0; + } + + PRINT_HEADER("CPU type", "%ld", dumped_processor_type); + PRINT_HEADER("Compiled code interface version", "%ld", + dumped_interface_version); +#if false + PRINT_HEADER("Compiler utilities vector", "%ld", + OBJECT_DATUM(dumped_utilities)); +#endif /* External Objects */ @@ -1440,31 +1547,31 @@ do_it() { Pointer obj; fast Pointer *table; - fast long count, datum; + fast long count, the_datum; for (count = Primitive_Table_Length, table = external_renumber_table; --count >= 0;) { obj = *table++; - datum = OBJECT_DATUM(obj); + the_datum = OBJECT_DATUM(obj); if (OBJECT_TYPE(obj) == TC_PRIMITIVE_EXTERNAL) { Pointer *strobj; - strobj = ((Pointer *) (external_prim_name_table[datum])); + strobj = ((Pointer *) (external_prim_name_table[the_datum])); print_a_primitive(((long) UNKNOWN_PRIMITIVE_ARITY), (STRING_LENGTH_TO_LONG(strobj[STRING_LENGTH])), ((char *) &strobj[STRING_CHARS])); } else { - char *string; + char *str; - string = builtin_prim_name_table[datum]; - print_a_primitive(((long) builtin_prim_arity_table[datum]), - ((long) strlen(string)), - string); + str = builtin_prim_name_table[the_datum]; + print_a_primitive(((long) builtin_prim_arity_table[the_datum]), + ((long) strlen(str)), + str); } } } @@ -1490,22 +1597,33 @@ do_it() /* Top Level */ -/* The boolean value here is what value to store when the option is present. */ +Boolean ci_version_sup_p, ci_processor_sup_p; -static struct Option_Struct Options[] = - {{"Do_Not_Compact", false, &compact_p}, - {"Null_Out_NMVs", true, &null_nmv_p}, - {"Swap_Bytes", true, &shuffle_bytes_p}, - {"Allow_Compiled", true, &allow_compiled_p}, - {"Allow_NMVs", true, &allow_nmv_p}}; +/* The boolean value here is what value to store when the option is present. */ -static int Noptions = 5; +static struct keyword_struct + options[] = { + KEYWORD("swap_bytes", &shuffle_bytes_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("compact", &compact_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("null_nmv", &null_nmv_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("allow_nmv", &allow_nmv_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("allow_cc", &allow_compiled_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("upgrade_cc", &upgrade_compiled_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("ci_version", &compiler_interface_version, INT_KYWRD, "%ld", + &ci_version_sup_p), + KEYWORD("ci_processor", &compiler_processor_type, INT_KYWRD, "%ld", + &ci_processor_sup_p), + OUTPUT_KEYWORD(), + INPUT_KEYWORD(), + END_KEYWORD() + }; main(argc, argv) int argc; char *argv[]; { - Setup_Program(argc, argv, Noptions, Options); + parse_keywords(argc, argv, options, false); + setup_io(); do_it(); quit(0); } diff --git a/v8/src/microcode/ppband.c b/v8/src/microcode/ppband.c index a1891f74b..c0c0247df 100644 --- a/v8/src/microcode/ppband.c +++ b/v8/src/microcode/ppband.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/ppband.c,v 9.30 1988/02/06 20:37:50 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/ppband.c,v 9.31 1988/02/10 15:42:58 jinx Exp $ * * Dumps Scheme FASL in user-readable form . */ @@ -79,10 +79,7 @@ Close_Dump_File() exit(1); } -#define Reloc_or_Load_Debug true #define INHIBIT_COMPILED_VERSION_CHECK - -#include "fasl.h" #include "load.c" #ifdef Heap_In_Low_Memory @@ -374,6 +371,7 @@ main(argc, argv) argv[0]); exit(1); } + print_fasl_information(); printf("Dumped object (relocated) at 0x%lx\n", Relocate(Dumped_Object)); } else diff --git a/v8/src/microcode/psbmap.h b/v8/src/microcode/psbmap.h index 310f17e93..f849dfede 100644 --- a/v8/src/microcode/psbmap.h +++ b/v8/src/microcode/psbmap.h @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbmap.h,v 9.25 1987/11/23 04:55:56 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbmap.h,v 9.26 1988/02/10 15:44:07 jinx Rel $ * * This file contains macros and declarations for Bintopsb.c * and Psbtobin.c @@ -41,9 +41,9 @@ MIT in each case. */ from the included files. */ -#include #define fast register +#include #include "config.h" #include "object.h" #include "bignum.h" @@ -60,7 +60,7 @@ extern double frexp(), ldexp(); #include "missing.c" #endif -#define PORTABLE_VERSION 4 +#define PORTABLE_VERSION 5 /* Number of objects which, when traced recursively, point at all other objects dumped. Currently only the dumped object. @@ -113,12 +113,14 @@ extern double frexp(), ldexp(); #define NULL_NMV_P (1 << 1) #define COMPILED_P (1 << 2) #define NMV_P (1 << 3) +#define BAND_P (1 << 4) #define MAKE_FLAGS() \ ((compact_p ? COMPACT_P : 0) | \ (null_nmv_p ? NULL_NMV_P : 0) | \ (compiled_p ? COMPILED_P : 0) | \ - (nmv_p ? NMV_P : 0)) + (nmv_p ? NMV_P : 0) | \ + (band_p ? BAND_P : 0)) #define READ_FLAGS(f) \ { \ @@ -126,6 +128,7 @@ extern double frexp(), ldexp(); null_nmv_p = ((f) & NULL_NMV_P); \ compiled_p = ((f) & COMPILED_P); \ nmv_p = ((f) & NMV_P); \ + band_p = ((f) & BAND_P); \ } /* @@ -153,185 +156,99 @@ static Boolean nmv_p = false; static Pointer *Memory_Base; #endif -static FILE *Input_File, *Output_File; +static long + compiler_processor_type = 0, + compiler_interface_version = 0; -static char *Program_Name; +static Pointer + compiler_utilities = NIL; -/* Argument List Parsing */ +/* Utilities */ -struct Option_Struct -{ - char *name; - Boolean value; - Boolean *ptr; -}; +static char + *input_file_name = "-", + *output_file_name = "-"; + +FILE *input_file, *output_file; Boolean strequal(s1, s2) - fast char *s1, *s2; + register char *s1, *s2; { - while (*s1 != '\0') + for ( ; *s1 != '\0'; s1++, s2++) { - if (*s1++ != *s2++) + if (*s1 != *s2) { - return false; + return (false); } } return (*s2 == '\0'); } - -char * -Find_Options(argc, argv, Noptions, Options) - int argc; - char **argv; - int Noptions; - struct Option_Struct Options[]; -{ - for ( ; --argc >= 0; argv++) - { - char *this; - int n; - - this = *argv; - for (n = 0; - ((n < Noptions) && (!strequal(this, Options[n].name))); - n++) - {}; - if (n >= Noptions) - { - return (this); - } - *(Options[n].ptr) = Options[n].value; - } - return (NULL); -} -/* Usage information */ - void -Print_Options(n, options, where) - int n; - struct Option_Struct *options; - FILE *where; +setup_io() { - if (--n < 0) + if (strequal(input_file_name, "-")) { - return; + input_file = stdin; } - fprintf(where, "[%s]", options->name); - options += 1; - for (; --n >= 0; options += 1) + else { - fprintf(where, " [%s]", options->name); + input_file = fopen(input_file_name, "r"); + if (input_file == ((FILE *) NULL)) + { + fprintf(stderr, "%s: failed to open %s for input.\n", + input_file_name); + exit(1); + } } - return; -} -void -Print_Usage_and_Exit(noptions, options, io_options) - int noptions; - struct Option_Struct *options; - char *io_options; -{ - fprintf(stderr, "usage: %s%s%s", - Program_Name, - (((io_options == NULL) || - (io_options[0] == '\0')) ? "" : " "), - io_options); - if (noptions != 0) + if (strequal(output_file_name, "-")) { - putc(' ', stderr); - Print_Options(noptions, options, stderr); + output_file = stdout; } - putc('\n', stderr); - exit(1); -} - -/* Top level of program */ - -/* When debugging force arguments on command line */ - -#ifdef DEBUG -#undef unix -#endif - -#ifdef unix - -/* On unix use io redirection */ - -void -Setup_Program(argc, argv, Noptions, Options) - int argc; - char *argv[]; - int Noptions; - struct Option_Struct *Options; -{ - Program_Name = argv[0]; - Input_File = stdin; - Output_File = stdout; - if (((argc - 1) > Noptions) || - (Find_Options((argc - 1), &argv[1], Noptions, Options) != NULL)) + else { - Print_Usage_and_Exit(Noptions, Options, ""); + output_file = fopen(output_file_name, "w"); + if (output_file == ((FILE *) NULL)) + { + fprintf(stderr, "%s: failed to open %s for output.\n", + output_file_name); + fclose(input_file); + exit(1); + } } return; } -#define quit exit - -#else /* not unix */ - -/* Otherwise use command line arguments */ - -void -Setup_Program(argc, argv, Noptions, Options) - int argc; - char *argv[]; - int Noptions; - struct Option_Struct *Options; -{ - Program_Name = argv[0]; - if ((argc < 3) || - ((argc - 3) > Noptions) || - (Find_Options((argc - 3), &argv[3], Noptions, Options) != NULL)) - { - Print_Usage_and_Exit(Noptions, Options, "input_file output_file"); - } - Input_File = ((strequal(argv[1], "-")) ? - stdin : - fopen(argv[1], "r")); - if (Input_File == NULL) - { - perror("Open failed."); - exit(1); - } - Output_File = ((strequal(argv[2], "-")) ? - stdout : - fopen(argv[2], "w")); - if (Output_File == NULL) - { - perror("Open failed."); - fclose(Input_File); - exit(1); - } - fprintf(stderr, "%s: Reading from %s, writing to %s.\n", - Program_Name, argv[1], argv[2]); - return; -} - void quit(code) int code; { - fclose(Input_File); - fclose(Output_File); - /* VMS brain dammage */ + fclose(input_file); + fclose(output_file); +#ifdef vms + /* This assumes that it is only invoked with 0 in tail recursive psn. */ if (code != 0) { exit(code); } - return; + else + { + return; + } +#else /* not vms */ + exit(code); +#endif /*vms */ } + +/* Include the command line parser */ + +#define boolean Boolean +#include "comlin.c" -#endif /* unix */ +#define INPUT_KEYWORD() \ +KEYWORD("input", &input_file_name, STRING_KYWRD, SFRMT, NULL) +#define OUTPUT_KEYWORD() \ +KEYWORD("output", &output_file_name, STRING_KYWRD, SFRMT, NULL) diff --git a/v8/src/microcode/psbtobin.c b/v8/src/microcode/psbtobin.c index 64daed2dd..b93630e99 100644 --- a/v8/src/microcode/psbtobin.c +++ b/v8/src/microcode/psbtobin.c @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbtobin.c,v 9.31 1988/01/04 18:55:54 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbtobin.c,v 9.32 1988/02/10 15:43:12 jinx Exp $ * * This File contains the code to translate portable format binary * files to internal format. @@ -39,12 +39,12 @@ MIT in each case. */ /* Cheap renames */ -#define Portable_File Input_File -#define Internal_File Output_File - #include "psbmap.h" +#define portable_file input_file +#define internal_file output_file static Boolean + band_p = false; allow_compiled_p = false, allow_nmv_p = false; @@ -71,7 +71,8 @@ Write_Data(Count, From_Where) { extern int fwrite(); - return (fwrite(((char *) From_Where), sizeof(Pointer), Count, Internal_File)); + return (fwrite(((char *) From_Where), sizeof(Pointer), + Count, internal_file)); } #include "fasl.h" @@ -83,9 +84,9 @@ inconsistency() /* Provide some context (2 lines). */ char yow[100]; - fgets(&yow[0], 100, Portable_File); + fgets(&yow[0], 100, portable_file); fprintf(stderr, "%s\n", &yow[0]); - fgets(&yow[0], 100, Portable_File); + fgets(&yow[0], 100, portable_file); fprintf(stderr, "%s\n", &yow[0]); quit(1); @@ -99,12 +100,12 @@ read_a_char() { fast char C; - C = getc(Portable_File); + C = getc(portable_file); if (C != '\\') { OUT(C); } - C = getc(Portable_File); + C = getc(portable_file); switch(C) { case 'n': OUT('\n'); @@ -118,9 +119,9 @@ read_a_char() fprintf(stderr, "%s: File is not Portable. Character Code Found.\n", - Program_Name); - fscanf(Portable_File, "%ld", &Code); - getc(Portable_File); /* Space */ + program_name); + fscanf(portable_file, "%ld", &Code); + getc(portable_file); /* Space */ OUT(Code); } case '\\': OUT('\\'); @@ -134,11 +135,11 @@ read_a_string_internal(To, maxlen) long maxlen; { long ilen, Pointer_Count; - fast char *string; + fast char *str; fast long len; - string = ((char *) (&To[STRING_CHARS])); - fscanf(Portable_File, "%ld", &ilen); + str = ((char *) (&To[STRING_CHARS])); + fscanf(portable_file, "%ld", &ilen); len = ilen; if (maxlen == -1) @@ -157,12 +158,12 @@ read_a_string_internal(To, maxlen) /* Space */ - getc(Portable_File); + getc(portable_file); while (--len >= 0) { - *string++ = ((char) read_a_char()); + *str++ = ((char) read_a_char()); } - *string = '\0'; + *str = '\0'; return (To + Pointer_Count); } @@ -173,7 +174,7 @@ read_a_string(To, Slot) long maxlen; *Slot = Make_Pointer(TC_CHARACTER_STRING, To); - fscanf(Portable_File, "%ld", &maxlen); + fscanf(portable_file, "%ld", &maxlen); return (read_a_string_internal(To, maxlen)); } @@ -190,7 +191,7 @@ read_a_string(To, Slot) #define read_hex_digit(var) \ { \ - fscanf(Portable_File, "%1lx", &var); \ + fscanf(portable_file, "%1lx", &var); \ } #else @@ -208,7 +209,7 @@ read_hex_digit_procedure() long digit; int c; - while ((c = fgetc(Portable_File)) == ' ') + while ((c = fgetc(portable_file)) == ' ') {}; digit = ((c >= 'a') ? (c - 'a' + 10) : ((c >= 'A') ? (c - 'A' + 10) @@ -228,9 +229,9 @@ read_an_integer(The_Type, To, Slot) Boolean negative; long size_in_bits; - getc(Portable_File); /* Space */ - negative = ((getc(Portable_File)) == '-'); - fscanf(Portable_File, "%ld", &size_in_bits); + getc(portable_file); /* Space */ + negative = ((getc(portable_file)) == '-'); + fscanf(portable_file, "%ld", &size_in_bits); if ((size_in_bits <= fixnum_to_bits) && (The_Type == TC_FIXNUM)) { @@ -276,7 +277,7 @@ read_an_integer(The_Type, To, Slot) { fprintf(stderr, "%s: Fixnum too large, coercing to bignum.\n", - Program_Name); + program_name); } size = bits_to_bigdigit(size_in_bits); ndigits = hex_digits(size_in_bits); @@ -312,7 +313,7 @@ read_a_bit_string(To, Slot) long size_in_bits, size_in_words; Pointer the_bit_string; - fscanf(Portable_File, "%ld", &size_in_bits); + fscanf(portable_file, "%ld", &size_in_bits); size_in_words = (1 + bits_to_pointers (size_in_bits)); the_bit_string = Make_Pointer(TC_BIT_STRING, To); @@ -393,11 +394,11 @@ read_a_flonum() long size_in_bits, exponent; fast double Result; - getc(Portable_File); /* Space */ - negative = ((getc(Portable_File)) == '-'); + getc(portable_file); /* Space */ + negative = ((getc(portable_file)) == '-'); VMS_BUG(exponent = 0); VMS_BUG(size_in_bits = 0); - fscanf(Portable_File, "%ld %ld", &exponent, &size_in_bits); + fscanf(portable_file, "%ld %ld", &exponent, &size_in_bits); if (size_in_bits == 0) { Result = 0.0; @@ -407,11 +408,11 @@ read_a_flonum() { /* Skip over mantissa */ - while (getc(Portable_File) != '\n') + while (getc(portable_file) != '\n') {}; fprintf(stderr, "%s: Floating point exponent too %s!\n", - Program_Name, + program_name, ((exponent < 0) ? "small" : "large")); Result = ((exponent < 0) ? dflmin() : dflmax()); } @@ -425,9 +426,9 @@ read_a_flonum() { fprintf(stderr, "%s: Some precision may be lost.", - Program_Name); + program_name); } - getc(Portable_File); /* Space */ + getc(portable_file); /* Space */ for (ndigits = hex_digits(size_in_bits), Result = 0.0, Normalization = (1.0 / 16.0); @@ -456,7 +457,7 @@ Read_External(N, Table, To) while (Table < Until) { - fscanf(Portable_File, "%2x", &The_Type); + fscanf(portable_file, "%2x", &The_Type); switch(The_Type) { case TC_CHARACTER_STRING: @@ -476,9 +477,9 @@ Read_External(N, Table, To) { long the_char_code; - getc(Portable_File); /* Space */ + getc(portable_file); /* Space */ VMS_BUG(the_char_code = 0); - fscanf( Portable_File, "%3lx", &the_char_code); + fscanf( portable_file, "%3lx", &the_char_code); *Table++ = Make_Non_Pointer( TC_CHARACTER, the_char_code); continue; } @@ -498,7 +499,7 @@ Read_External(N, Table, To) default: fprintf(stderr, "%s: Unknown external object found; Type = 0x%02x\n", - Program_Name, The_Type); + program_name, The_Type); inconsistency(); /*NOTREACHED*/ } @@ -552,7 +553,7 @@ Relocate_Objects(From, N, disp) default: fprintf(stderr, "%s: Unknown External Object Reference with Type 0x%02x", - Program_Name, + program_name, Type_Code(*From)); inconsistency(); } @@ -610,7 +611,7 @@ Read_Pointers_and_Relocate(N, To) { VMS_BUG(The_Type = 0); VMS_BUG(The_Datum = 0); - fscanf(Portable_File, "%2x %lx", &The_Type, &The_Datum); + fscanf(portable_file, "%2x %lx", &The_Type, &The_Datum); switch(The_Type) { case CONSTANT_CODE: @@ -631,7 +632,7 @@ Read_Pointers_and_Relocate(N, To) while (--count >= 0) { VMS_BUG(*To = 0); - fscanf(Portable_File, "%lx", To++); + fscanf(portable_file, "%lx", To++); } } continue; @@ -641,7 +642,7 @@ Read_Pointers_and_Relocate(N, To) Pointer *temp; long base_type, base_datum; - fscanf(Portable_File, "%02x %lx", &base_type, &base_datum); + fscanf(portable_file, "%02x %lx", &base_type, &base_datum); temp = Relocate(base_datum); *To++ = Make_Pointer(base_type, ((Pointer *) (&(((char *) temp)[The_Datum])))); @@ -651,7 +652,7 @@ Read_Pointers_and_Relocate(N, To) case TC_BROKEN_HEART: if (The_Datum != 0) { - fprintf(stderr, "%s: Broken Heart Found\n", Program_Name); + fprintf(stderr, "%s: Broken Heart Found\n", program_name); inconsistency(); } /* fall through */ @@ -694,7 +695,7 @@ read_primitives(how_many, where) while (--how_many >= 0) { - fscanf(Portable_File, "%ld", &arity); + fscanf(portable_file, "%ld", &arity); if (arity == ((long) UNKNOWN_PRIMITIVE_ARITY)) { primitive_warn = true; @@ -784,7 +785,7 @@ when(what, message) if (what) { fprintf(stderr, "%s: Inconsistency: %s!\n", - Program_Name, (message)); + program_name, (message)); quit(1); } return; @@ -792,7 +793,7 @@ when(what, message) #define READ_HEADER(string, format, value) \ { \ - fscanf(Input_File, format, &(value)); \ + fscanf(portable_file, format, &(value)); \ fprintf(stderr, "%s: ", (string)); \ fprintf(stderr, (format), (value)); \ fprintf(stderr, "\n"); \ @@ -806,11 +807,21 @@ when(what, message) #define READ_HEADER(string, format, value) \ { \ - fscanf(Input_File, format, &(value)); \ + if (fscanf(portable_file, format, &(value)) == EOF) \ + { \ + short_header_read(); \ + } \ } #endif /* DEBUG */ +void +short_header_read() +{ + fprintf(stderr, "%s: Header is not complete!\n", program_name); + quit(1); +} + long Read_Header_and_Allocate() { @@ -826,6 +837,7 @@ Read_Header_and_Allocate() if (Portable_Version != PORTABLE_VERSION) { + fprintf(stderr, "%s: Portable version mismatch:\n", program_name); fprintf(stderr, "Portable File Version %4d\n", Portable_Version); fprintf(stderr, "Expected: Version %4d\n", PORTABLE_VERSION); quit(1); @@ -838,11 +850,12 @@ Read_Header_and_Allocate() if ((Version != FASL_FORMAT_VERSION) || (Sub_Version != FASL_SUBVERSION)) { + fprintf(stderr, "%s: Binary version mismatch:\n", program_name); fprintf(stderr, - "Portable File Version %4d Subversion %4d Binary Version %4d\n", + "Portable File Version %4d; Binary Version %4d; Subversion %4d\n", Portable_Version, Version, Sub_Version); fprintf(stderr, - "Expected: Version %4d Subversion %4d Binary Version %4d\n", + "Expected: Version %4d; Binary Version %4d; Subversion %4d\n", PORTABLE_VERSION, FASL_FORMAT_VERSION, FASL_SUBVERSION); quit(1); } @@ -856,18 +869,18 @@ Read_Header_and_Allocate() { if (compiled_p) { - fprintf(stderr, - "%s: Portable file contains \"invalid\" compiled code.\n", - Program_Name); + fprintf(stderr, "%s: %s\n", program_name, + "Portable file contains \"non-portable\" compiled code."); } else { - fprintf(stderr, - "%s: Portable file contains \"random\" non-marked vectors.\n", - Program_Name); + fprintf(stderr, "%s: %s\n", program_name, + "Portable file contains \"unexpected\" non-marked vectors."); } - fprintf(stderr, "Portable File Machine %4d\n", Machine); - fprintf(stderr, "Expected: Machine %4d\n", FASL_INTERNAL_FORMAT); + fprintf(stderr, "Machine specified in the portable file: %4d\n", + Machine); + fprintf(stderr, "Machine Expected: %4d\n", + FASL_INTERNAL_FORMAT); quit(1); } @@ -896,6 +909,13 @@ Read_Header_and_Allocate() READ_HEADER("Primitive Table Length", "%ld", Primitive_Table_Length); READ_HEADER("Number of characters in primitives", "%ld", NPChars); + READ_HEADER("CPU type", "%ld", compiler_processor_type); + READ_HEADER("Compiled code interface version", "%ld", + compiler_interface_version); +#if false + READ_HEADER("Compiler utilities vector", "%ld", compiler_utilities); +#endif + Size = (6 + /* SNMV */ HEAP_BUFFER_SPACE + Heap_Count + Heap_Objects + @@ -916,7 +936,7 @@ Read_Header_and_Allocate() { fprintf(stderr, "%s: Memory Allocation Failed. Size = %ld Scheme Pointers\n", - Program_Name, Size); + program_name, Size); quit(1); } Heap += HEAP_BUFFER_SPACE; @@ -1004,7 +1024,7 @@ do_it() if (primitive_warn) { - fprintf(stderr, "%s:\n", Program_Name); + fprintf(stderr, "%s:\n", program_name); fprintf(stderr, "NOTE: The binary file contains primitives with unknown arity.\n"); } @@ -1043,7 +1063,8 @@ do_it() (Free - Heap_Base), Heap_Base, 0, Stack_Top, primitive_table, Primitive_Table_Length, - ((long) (primitive_table_end - primitive_table))); + ((long) (primitive_table_end - primitive_table)), + compiled_p, band_p); } else { @@ -1068,12 +1089,13 @@ do_it() (Free - Heap_Base), Heap_Base, Total_Length, (Pure_Base - 2), primitive_table, Primitive_Table_Length, - ((long) (primitive_table_end - primitive_table))); + ((long) (primitive_table_end - primitive_table)), + compiled_p, band_p); } } if (!result) { - fprintf(stderr, "%s: Error writing the output file.\n", Program_Name); + fprintf(stderr, "%s: Error writing the output file.\n", program_name); quit(1); } return; @@ -1081,17 +1103,21 @@ do_it() /* Top level */ -static struct Option_Struct Options[] = - {{"Allow_Compiled", true, &allow_compiled_p}, - {"Allow_NMVs", true, &allow_nmv_p}}; - -static int Noptions = 2; +static struct keyword_struct + options[] = { + KEYWORD("allow_nmv", &allow_nmv_p, BOOLEAN_KYWRD, BFRMT, NULL), + KEYWORD("allow_cc", &allow_compiled_p, BOOLEAN_KYWRD, BFRMT, NULL), + OUTPUT_KEYWORD(), + INPUT_KEYWORD(), + END_KEYWORD() + }; main(argc, argv) int argc; char *argv[]; { - Setup_Program(argc, argv, Noptions, Options); + parse_keywords(argc, argv, options, false); + setup_io(); do_it(); quit(0); } -- 2.25.1