From e73066ccd0810c1cb2a2cd8af7cba3d13548f041 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Sat, 6 Feb 1988 20:43:29 +0000 Subject: [PATCH] 1. Fix bug in relocation of entries into the compiler utilities version. 2. Up the fasl version number. New format includes processor type, compiled code interface version and band/"file" flag. 3. Fasdump complains when dumping an environment. 4. Error code names and various other items have been moved to errors.h --- v7/src/microcode/bchdmp.c | 55 +++++--- v7/src/microcode/boot.c | 229 ++++++++++++++++++++------------- v7/src/microcode/config.h | 16 ++- v7/src/microcode/const.h | 17 ++- v7/src/microcode/dump.c | 47 +++++-- v7/src/microcode/errors.h | 144 +++++++++++++++++++-- v7/src/microcode/fasdump.c | 101 ++++++++++----- v7/src/microcode/fasl.h | 40 ++++-- v7/src/microcode/fasload.c | 126 ++++++++++++++----- v7/src/microcode/gccode.h | 58 +++++---- v7/src/microcode/load.c | 140 +++++++++++++++++---- v7/src/microcode/ppband.c | 9 +- v7/src/microcode/returns.h | 102 ++++++++++++++- v7/src/microcode/storage.c | 243 ++---------------------------------- v7/src/microcode/utabmd.scm | 7 +- v7/src/microcode/version.h | 4 +- v8/src/microcode/const.h | 17 ++- v8/src/microcode/fasl.h | 40 ++++-- v8/src/microcode/ppband.c | 9 +- v8/src/microcode/returns.h | 102 ++++++++++++++- v8/src/microcode/utabmd.scm | 7 +- v8/src/microcode/version.h | 4 +- 22 files changed, 995 insertions(+), 522 deletions(-) diff --git a/v7/src/microcode/bchdmp.c b/v7/src/microcode/bchdmp.c index 6a57cd526..2ec2204ce 100644 --- a/v7/src/microcode/bchdmp.c +++ b/v7/src/microcode/bchdmp.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/bchdmp.c,v 9.38 1987/12/04 22:13:25 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.39 1988/02/06 20:38:10 jinx Exp $ */ /* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag, purify, and fasdump, respectively, to provide garbage collection @@ -59,6 +59,7 @@ static Pointer fixup_buffer[GC_DISK_BUFFER_SIZE]; static Pointer *fixup_buffer_end = &fixup_buffer[GC_DISK_BUFFER_SIZE]; static Pointer *fixup; static fixup_count = 0; +static Boolean compiled_code_present_p; /* Utility macros. */ @@ -81,7 +82,9 @@ static fixup_count = 0; { \ To = dump_and_reset_free_buffer((To - free_buffer_top), &success); \ if (!success) \ - return false; \ + { \ + return (PRIM_INTERRUPT); \ + } \ } \ } @@ -109,7 +112,7 @@ static fixup_count = 0; { \ if ((fixup == fixup_buffer) && (!reset_fixes())) \ { \ - return false; \ + return (PRIM_INTERRUPT); \ } \ *--fixup = contents; \ *--fixup = ((Pointer) location); \ @@ -192,7 +195,7 @@ reset_fixes() /* A copy of GCLoop, with minor modifications. */ -Boolean +long dumploop(Scan, To_ptr, To_Address_ptr) fast Pointer *Scan; Pointer **To_ptr, **To_Address_ptr; @@ -229,7 +232,7 @@ dumploop(Scan, To_ptr, To_Address_ptr) Scan = (dump_and_reload_scan_buffer(0, &success) - 1); if (!success) { - return false; + return (PRIM_INTERRUPT); } continue; @@ -254,7 +257,7 @@ dumploop(Scan, To_ptr, To_Address_ptr) (overflow % GC_DISK_BUFFER_SIZE)) - 1); if (!success) { - return false; + return (PRIM_INTERRUPT); } break; } @@ -269,6 +272,7 @@ dumploop(Scan, To_ptr, To_Address_ptr) break; case_compiled_entry_point: + compiled_code_present_p = true; Old = Get_Pointer(Temp); Compiled_BH(true, continue); { @@ -279,10 +283,11 @@ dumploop(Scan, To_ptr, To_Address_ptr) copy_vector(&success); if (!success) { - return false; + return (PRIM_INTERRUPT); } *Saved_Old = New_Address; - *Scan = Relocate_Compiled(Temp, Get_Pointer(New_Address), Saved_Old); + *Scan = Relocate_Compiled(Temp, Get_Pointer(New_Address), + Saved_Old); continue; } @@ -343,16 +348,21 @@ dumploop(Scan, To_ptr, To_Address_ptr) case TC_BIG_FLONUM: /* Fall through */ #endif - case_Vector: + case TC_COMPILED_CODE_BLOCK: + case_Purify_Vector: fasdump_normal_setup(); Move_Vector: copy_vector(&success); if (!success) { - return false; + return (PRIM_INTERRUPT); } fasdump_normal_end(); + case TC_ENVIRONMENT: + /* Make fasdump fail */ + return (ERR_FASDUMP_ENVIRONMENT); + case TC_FUTURE: fasdump_normal_setup(); if (!(Future_Spliceable(Temp))) @@ -373,7 +383,7 @@ dumploop(Scan, To_ptr, To_Address_ptr) end_dumploop: *To_ptr = To; *To_Address_ptr = To_Address; - return (true); + return (PRIM_DONE); } /* (PRIMITIVE-FASDUMP object-to-dump file-name flag) @@ -391,7 +401,7 @@ end_dumploop: DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) { Boolean success; - long length, hlength, tlength, tsize; + long value, length, hlength, tlength, tsize; Pointer *dumped_object, *free_buffer; Pointer *table_start, *table_end, *table_top; Pointer header[FASL_HEADER_LENGTH]; @@ -406,6 +416,7 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) Primitive_Error(ERR_ARG_2_BAD_RANGE); } + compiled_code_present_p = false; success = true; real_gc_file = gc_file; gc_file = dump_file; @@ -432,11 +443,19 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) dumped_object = Free; Free += 1; - if (!dumploop((initialize_scan_buffer() + FASL_HEADER_LENGTH), - &free_buffer, &Free)) + value = dumploop((initialize_scan_buffer() + FASL_HEADER_LENGTH), + &free_buffer, &Free); + if (value != PRIM_DONE) { fasdump_exit(0); - PRIMITIVE_RETURN(NIL); + if (value == PRIM_INTERRUPT) + { + PRIMITIVE_RETURN(NIL); + } + else + { + Primitive_Error(value); + } } end_transport(&success); if (!success) @@ -467,7 +486,8 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) hlength = (sizeof(Pointer) * FASL_HEADER_LENGTH); prepare_dump_header(header, dumped_object, length, dumped_object, - 0, Constant_Space, tlength, tsize); + 0, Constant_Space, tlength, tsize, + compiled_code_present_p, false); if ((lseek(gc_file, 0, 0) == -1) || (write(gc_file, ((char *) &header[0]), hlength) != hlength)) { @@ -535,7 +555,8 @@ DEFINE_PRIMITIVE("DUMP-BAND", Prim_Band_Dump, 2) ((long) (Free_Constant - Constant_Space)), Constant_Space, table_start, table_length, - ((long) (table_end - table_start))); + ((long) (table_end - table_start)), + (compiler_utilities != NIL), true); } /* The and is short-circuit, so it must be done in this order. */ result = (Close_Dump_File() && result); diff --git a/v7/src/microcode/boot.c b/v7/src/microcode/boot.c index adf560a7a..3c48e0d40 100644 --- a/v7/src/microcode/boot.c +++ b/v7/src/microcode/boot.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.43 1987/12/04 22:14:06 jinx Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.44 1988/02/06 20:38:24 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -53,7 +53,9 @@ MIT in each case. */ {-utabmd utab-filename} or {-utab utab-filename} {other arguments ignored by the core microcode} - with filespec either {-band band-name} or {{-}fasl file-name} + with filespec either {-band band-name} or {-fasl file-name} or + -compiler. + arguments are optional, numbers are in 1K units. Default values are given above. The arguments in the long for may appear in any order on the command line. The allocation arguments (heap, stack, @@ -167,13 +169,120 @@ Def_Number(key, nargs, args, def) extern Boolean Was_Scheme_Dumped; Boolean Was_Scheme_Dumped = false; +int Saved_Heap_Size, Saved_Stack_Size, Saved_Constant_Size; + +void +usage(error_string) + char *error_string; +{ + fprintf(stderr, "%s: %s\n\n", Saved_argv[0], error_string); + exit(1); +} + +void +find_image_parameters(file_name, cold_load_p, supplied_p) + char **file_name; + Boolean *cold_load_p, *supplied_p; +{ + Boolean found_p; + int position; + + *cold_load_p = false; + *supplied_p = false; + *file_name = NULL; + if (!Was_Scheme_Dumped) + { + Heap_Size = HEAP_SIZE; + Stack_Size = STACK_SIZE; + Constant_Size = CONSTANT_SIZE; + } + else + { + Saved_Heap_Size = Heap_Size; + Saved_Stack_Size = Stack_Size; + Saved_Constant_Size = Constant_Size; + } + + if ((position = Parse_Option("-band", Saved_argc, Saved_argv, true)) != + NOT_THERE) + { + if (position == (Saved_argc - 1)) + { + usage("-band option requires a file name"); + } + if (*supplied_p) + { + usage("Multiple image parameters specified!"); + } + *supplied_p = true; + *file_name = Saved_argv[position + 1]; + } + + if ((position = Parse_Option("-fasl", Saved_argc, Saved_argv, true)) != + NOT_THERE) + { + if (position == (Saved_argc - 1)) + { + usage("-fasl option requires a file name"); + } + if (*supplied_p) + { + usage("Multiple image parameters specified!"); + } + *supplied_p = true; + *cold_load_p = true; + *file_name = Saved_argv[position + 1]; + } + + if ((position = Parse_Option("-compiler", Saved_argc, Saved_argv, true)) != + NOT_THERE) + { + if (*supplied_p) + { + usage("Multiple image parameters specified!"); + } + *supplied_p = true; + *file_name = DEFAULT_COMPILER_BAND; + Heap_Size = COMPILER_HEAP_SIZE; + Stack_Size = COMPILER_STACK_SIZE; + Constant_Size = COMPILER_CONSTANT_SIZE; + } + + if (!*supplied_p) + { + *file_name = DEFAULT_BAND_NAME; + } + + Heap_Size = + Def_Number("-heap", Saved_argc, Saved_argv, Heap_Size); + Stack_Size = + Def_Number("-stack", Saved_argc, Saved_argv, Stack_Size); + Constant_Size = + Def_Number("-constant", Saved_argc, Saved_argv, Constant_Size); + + if (Was_Scheme_Dumped && + ((Heap_Size != Saved_Heap_Size) || + (Stack_Size != Saved_Stack_Size) || + (Constant_Size != Saved_Constant_Size))) + { + fprintf(stderr, + "%s warning: Allocation parameters ignored.\n", + Saved_argv[0]); + Heap_Size = Saved_Heap_Size; + Stack_Size = Saved_Stack_Size; + Constant_Size = Saved_Constant_Size; + } + + return; +} + /* Exit is done in a different way on some operating systems (eg. VMS) */ Exit_Scheme_Declarations; forward void Start_Scheme(); extern void Clear_Memory(), Setup_Memory(), Reset_Memory(); - + /* THE MAIN PROGRAM */ @@ -183,116 +292,43 @@ main(argc, argv) int argc; char **argv; { - Boolean FASL_It; - char *File_Name; - int Saved_Heap_Size, Saved_Stack_Size, Saved_Constant_Size; + Boolean cold_load_p, supplied_p; + char *file_name; extern void compiler_initialize(); - FASL_It = false; - File_Name = NULL; - Saved_argc = argc; - Saved_argv = argv; Init_Exit_Scheme(); - if (argc > 2) - { - int position; - - if (((position = Parse_Option("-band", argc, argv, true)) - != NOT_THERE) && - (position != (argc-1))) - { - File_Name = argv[position+1]; - } - else if ((((position = Parse_Option("-fasl", argc, argv, true)) - != NOT_THERE) || - ((position = Parse_Option("fasl", argc, argv, true)) - != NOT_THERE)) && - (position != (argc-1))) - { - File_Name = argv[position + 1]; - FASL_It = true; - } - } - else if ((argc == 2) && (argv[1][0] != '-')) - { - File_Name = argv[1]; - } - - if (!Was_Scheme_Dumped) - { - Heap_Size = HEAP_SIZE; - Stack_Size = STACK_SIZE; - Constant_Size = CONSTANT_SIZE; - } - else - { - Saved_Heap_Size = Heap_Size; - Saved_Stack_Size = Stack_Size; - Saved_Constant_Size = Constant_Size; - } - - Heap_Size = Def_Number("-heap", argc, argv, Heap_Size); - Stack_Size = Def_Number("-stack", argc, argv, Stack_Size); - Constant_Size = Def_Number("-constant", argc, argv, Constant_Size); + Saved_argc = argc; + Saved_argv = argv; + find_image_parameters(&file_name, &cold_load_p, &supplied_p); if (Was_Scheme_Dumped) { - Boolean warned; - - warned = false; - printf("Executable Scheme"); - if ((Heap_Size != Saved_Heap_Size) || - (Stack_Size != Saved_Stack_Size) || - (Constant_Size != Saved_Constant_Size)) + printf("Executable Scheme Image\n"); + if (!supplied_p) { - printf(".\n"); - fprintf(stderr, -"Warning: Allocation parameters (heap, stack, and constant) ignored.\n"); - Heap_Size = Saved_Heap_Size; - Stack_Size = Saved_Stack_Size; - Constant_Size = Saved_Constant_Size; - warned = true; - } - if (File_Name == NULL) - { - if (!warned) - { - printf("; "); - } - printf("Microcode Version %d.%d\n", VERSION, SUBVERSION); + printf("Scheme Microcode Version %d.%d\n", VERSION, SUBVERSION); OS_Init(true); Enter_Interpreter(); } - -/* main continues on the next page */ - -/* main, continued */ - else { - if (!warned) - { - printf(".\n"); - } Clear_Memory(blocks(Heap_Size), blocks(Stack_Size), blocks(Constant_Size)); /* We are reloading from scratch anyway. */ Was_Scheme_Dumped = false; - Start_Scheme((FASL_It ? BOOT_FASLOAD : BOOT_LOAD_BAND), File_Name); + Start_Scheme((cold_load_p ? BOOT_FASLOAD : BOOT_LOAD_BAND), + file_name); } } - if (File_Name == NULL) - { - File_Name = DEFAULT_BAND_NAME; - } Command_Line_Hook(); Setup_Memory(blocks(Heap_Size), blocks(Stack_Size), blocks(Constant_Size)); - compiler_initialize((long) FASL_It); - Start_Scheme((FASL_It ? BOOT_FASLOAD : BOOT_LOAD_BAND), File_Name); + compiler_initialize((long) cold_load_p); + Start_Scheme((cold_load_p ? BOOT_FASLOAD : BOOT_LOAD_BAND), + file_name); } #define Default_Init_Fixed_Objects(Fixed_Objects) \ @@ -503,6 +539,7 @@ Microcode_Termination(code) { extern char *Term_Messages[]; Pointer Term_Vector; + Boolean abnormal_p; long value; if ((code != TERM_HALT) && @@ -555,19 +592,30 @@ Microcode_Termination(code) { case TERM_HALT: value = 0; + abnormal_p = false; break; case TERM_END_OF_COMPUTATION: Print_Expression(Val, "Final result"); putchar('\n'); value = 0; + abnormal_p = false; break; + case TERM_TRAP: + /* This claims not to be abnormal so that the user will + not be asked a second time about dumping core. + */ + value = 1; + abnormal_p = false; + break; + case TERM_NO_ERROR_HANDLER: /* This does not print a back trace because it was printed before getting here irrelevant of the state of Trace_On_Error. */ value = 1; + abnormal_p = true; break; case TERM_NON_EXISTENT_CONTINUATION: @@ -585,6 +633,7 @@ Microcode_Termination(code) default: normal_termination: value = 1; + abnormal_p = true; if (Trace_On_Error) { printf("\n\n**** Stack trace ****\n\n"); @@ -593,7 +642,7 @@ Microcode_Termination(code) break; } OS_Flush_Output_Buffer(); - OS_Quit(); + OS_Quit(abnormal_p); Reset_Memory(); Exit_Hook(); Exit_Scheme(value); diff --git a/v7/src/microcode/config.h b/v7/src/microcode/config.h index 3edc4cecf..27f2605d0 100644 --- a/v7/src/microcode/config.h +++ b/v7/src/microcode/config.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/config.h,v 9.33 1988/01/04 21:50:25 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/config.h,v 9.34 1988/02/06 20:39:26 jinx Rel $ * * This file contains the configuration information and the information * given on the command line on Unix. @@ -521,9 +521,23 @@ longjmp(Exit_Point, NORMAL_EXIT) #define STACK_SIZE 256 /* Default stacklet size */ #endif #endif + #ifndef CONSTANT_SIZE #define CONSTANT_SIZE 300 /* Default Kcells for constant */ #endif + #ifndef HEAP_SIZE #define HEAP_SIZE 250 /* Default Kcells for each heap */ #endif + +#ifndef COMPILER_STACK_SIZE +#define COMPILER_STACK_SIZE STACK_SIZE +#endif + +#ifndef COMPILER_HEAP_SIZE +#define COMPILER_HEAP_SIZE 400 +#endif + +#ifndef COMPILER_CONSTANT_SIZE +#define COMPILER_CONSTANT_SIZE 510 +#endif diff --git a/v7/src/microcode/const.h b/v7/src/microcode/const.h index 289142eae..98164b307 100644 --- a/v7/src/microcode/const.h +++ b/v7/src/microcode/const.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/const.h,v 9.26 1987/12/04 22:14:55 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/const.h,v 9.27 1988/02/06 20:39:40 jinx Exp $ * * Named constants used throughout the interpreter * @@ -104,10 +104,11 @@ MIT in each case. */ #define END_OF_BLOCK TC_FIXNUM #define CONSTANT_PART TC_TRUE #define PURE_PART TC_FALSE - + /* Primitive flow control codes: directs computation after * processing a primitive application. */ + #define PRIM_DONE -1 #define PRIM_DO_EXPRESSION -2 #define PRIM_APPLY -3 @@ -117,6 +118,18 @@ MIT in each case. */ #define PRIM_POP_RETURN -7 #define PRIM_TOUCH -8 +#define ABORT_NAME_TABLE \ +{ \ + /* -1 */ "DONE", \ + /* -2 */ "DO-EXPRESSION", \ + /* -3 */ "APPLY", \ + /* -4 */ "INTERRUPT", \ + /* -5 */ "NO-TRAP-EVAL", \ + /* -6 */ "NO-TRAP_APPLY", \ + /* -7 */ "POP-RETURN", \ + /* -8 */ "TOUCH" \ +} + /* Some numbers of parameters which mean something special */ #define LEXPR_PRIMITIVE_ARITY -1 diff --git a/v7/src/microcode/dump.c b/v7/src/microcode/dump.c index ac05bd604..bf648becf 100644 --- a/v7/src/microcode/dump.c +++ b/v7/src/microcode/dump.c @@ -30,34 +30,42 @@ 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/dump.c,v 9.25 1987/11/17 08:09:10 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dump.c,v 9.26 1988/02/06 20:39:50 jinx Rel $ * * This file contains common code for dumping internal format binary files. */ +extern Pointer compiler_utilities; +extern long compiler_interface_version, compiler_processor_type; + void prepare_dump_header(Buffer, Dumped_Object, Heap_Count, Heap_Relocation, Constant_Count, Constant_Relocation, - table_length, table_size) + table_length, table_size, + cc_code_p, band_p) Pointer *Buffer, *Dumped_Object, *Heap_Relocation, *Constant_Relocation; long Heap_Count, Constant_Count, table_length, table_size; + Boolean cc_code_p, band_p; { long i; #ifdef DEBUG + #ifndef Heap_In_Low_Memory fprintf(stderr, "\nMemory_Base = 0x%x\n", Memory_Base); -#endif +#endif /* Heap_In_Low_Memory */ + fprintf(stderr, "\nHeap_Relocation=0x%x, dumped as 0x%x\n", Heap_Relocation, Make_Pointer(TC_BROKEN_HEART, Heap_Relocation)); fprintf(stderr, "\nDumped object=0x%x, dumped as 0x%x\n", Dumped_Object, Make_Pointer(TC_BROKEN_HEART, Dumped_Object)); -#endif +#endif /* DEBUG */ + Buffer[FASL_Offset_Marker] = FASL_FILE_MARKER; Buffer[FASL_Offset_Heap_Count] = Make_Non_Pointer(TC_BROKEN_HEART, Heap_Count); @@ -73,26 +81,48 @@ prepare_dump_header(Buffer, Dumped_Object, Make_Version(FASL_FORMAT_VERSION, FASL_SUBVERSION, FASL_INTERNAL_FORMAT); Buffer[FASL_Offset_Stack_Top] = + #ifdef USE_STACKLETS Make_Pointer(TC_BROKEN_HEART, 0); /* Nothing in stack area */ #else Make_Pointer(TC_BROKEN_HEART, Stack_Top); -#endif +#endif /* USE_STACKLETS */ + Buffer[FASL_Offset_Prim_Length] = Make_Pointer(TC_BROKEN_HEART, table_length); Buffer[FASL_Offset_Prim_Size] = Make_Pointer(TC_BROKEN_HEART, table_size); + + if (cc_code_p) + { + Buffer[FASL_Offset_Ci_Version] = + MAKE_CI_VERSION(band_p, + compiler_interface_version, + compiler_processor_type); + Buffer[FASL_Offset_Ut_Base] = compiler_utilities; + } + else + { + /* If there is no compiled code in the file, + flag it as if dumped without compiler support, so + it can be loaded anywhere. + */ + Buffer[FASL_Offset_Ci_Version] = MAKE_CI_VERSION(band_p, 0, 0); + Buffer[FASL_Offset_Ut_Base] = NIL; + } + for (i = FASL_Offset_First_Free; i < FASL_HEADER_LENGTH; i++) { Buffer[i] = NIL; } return; } - + Boolean Write_File(Dumped_Object, Heap_Count, Heap_Relocation, Constant_Count, Constant_Relocation, - table_start, table_length, table_size) + table_start, table_length, table_size, + cc_code_p, band_p) Pointer *Dumped_Object, *Heap_Relocation, *Constant_Relocation, @@ -100,13 +130,14 @@ Write_File(Dumped_Object, Heap_Count, Heap_Relocation, long Heap_Count, Constant_Count, table_length, table_size; + Boolean cc_code_p, band_p; { Pointer Buffer[FASL_HEADER_LENGTH]; prepare_dump_header(Buffer, Dumped_Object, Heap_Count, Heap_Relocation, Constant_Count, Constant_Relocation, - table_length, table_size); + table_length, table_size, cc_code_p, band_p); if (Write_Data(FASL_HEADER_LENGTH, ((char *) Buffer)) != FASL_HEADER_LENGTH) { diff --git a/v7/src/microcode/errors.h b/v7/src/microcode/errors.h index 15d29ef37..18f465492 100644 --- a/v7/src/microcode/errors.h +++ b/v7/src/microcode/errors.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/errors.h,v 9.28 1987/12/13 21:59:11 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/errors.h,v 9.29 1988/02/06 20:40:00 jinx Exp $ * * Error and termination code declarations. * @@ -38,7 +38,7 @@ MIT in each case. */ /* All error and termination codes must be positive * to allow primitives to return either an error code - * or a primitive flow control value (see CONST.H) + * or a primitive flow control value (see const.h) */ #define ERR_BAD_ERROR_CODE 0x00 @@ -101,13 +101,80 @@ MIT in each case. */ #define ERR_BROKEN_VARIABLE_CACHE 0x35 #define ERR_WRONG_ARITY_PRIMITIVES 0x36 #define ERR_IO_ERROR 0x37 +#define ERR_FASDUMP_ENVIRONMENT 0x38 +#define ERR_FASLOAD_BAND 0x39 +#define ERR_FASLOAD_COMPILED_MISMATCH 0x3A /* - If you add any error codes here, remember to add them to - storage.c and utabmd.scm as well. + If you add any error codes here, add them to + the table below and to utabmd.scm as well. */ -#define MAX_ERROR 0x37 +#define MAX_ERROR 0x3A + +#define ERROR_NAME_TABLE \ +{ \ +/* 0x00 */ "BAD-ERROR-CODE", \ +/* 0x01 */ "UNBOUND-VARIABLE", \ +/* 0x02 */ "UNASSIGNED-VARIABLE", \ +/* 0x03 */ "INAPPLICABLE-OBJECT", \ +/* 0x04 */ "OUT-OF-HASH-NUMBERS", \ +/* 0x05 */ "ENVIRONMENT-CHAIN-TOO-DEEP", \ +/* 0x06 */ "BAD-FRAME", \ +/* 0x07 */ "BROKEN-COMPILED-VARIABLE", \ +/* 0x08 */ "UNDEFINED-USER-TYPE", \ +/* 0x09 */ "UNDEFINED-PRIMITIVE", \ +/* 0x0A */ "EXTERNAL-RETURN", \ +/* 0x0B */ "EXECUTE-MANIFEST-VECTOR", \ +/* 0x0C */ "WRONG-NUMBER-OF-ARGUMENTS", \ +/* 0x0D */ "ARG-1-WRONG-TYPE", \ +/* 0x0E */ "ARG-2-WRONG-TYPE", \ +/* 0x0F */ "ARG-3-WRONG-TYPE", \ +/* 0x10 */ "ARG-1-BAD-RANGE", \ +/* 0x11 */ "ARG-2-BAD-RANGE", \ +/* 0x12 */ "ARG-3-BAD-RANGE", \ +/* 0x13 */ "BAD-COMBINATION", \ +/* 0x14 */ "FASDUMP-OVERFLOW", \ +/* 0x15 */ "BAD-INTERRUPT-CODE", \ +/* 0x16 */ "NO-ERRORS", \ +/* 0x17 */ "FASL-FILE-TOO-BIG", \ +/* 0x18 */ "FASL-FILE-BAD-DATA", \ +/* 0x19 */ "IMPURIFY-OUT-OF-SPACE", \ +/* 0x1A */ "WRITE-INTO-PURE-SPACE", \ +/* 0x1B */ "LOSING-SPARE-HEAP", \ +/* 0x1C */ "NO-HASH-TABLE", \ +/* 0x1D */ "BAD-SET", \ +/* 0x1E */ "ARG-1-FAILED-COERCION", \ +/* 0x1F */ "ARG-2-FAILED-COERCION", \ +/* 0x20 */ "OUT-OF-FILE-HANDLES", \ +/* 0x21 */ "SHELL-DIED", \ +/* 0x22 */ "ARG-4-BAD-RANGE", \ +/* 0x23 */ "ARG-5-BAD-RANGE", \ +/* 0x24 */ "ARG-6-BAD-RANGE", \ +/* 0x25 */ "ARG-7-BAD-RANGE", \ +/* 0x26 */ "ARG-8-BAD-RANGE", \ +/* 0x27 */ "ARG-9-BAD-RANGE", \ +/* 0x28 */ "ARG-10-BAD-RANGE", \ +/* 0x29 */ "ARG-4-WRONG-TYPE", \ + \ +/* 0x2A */ "ARG-5-WRONG-TYPE", \ +/* 0x2B */ "ARG-6-WRONG-TYPE", \ +/* 0x2C */ "ARG-7-WRONG-TYPE", \ +/* 0x2D */ "ARG-8-WRONG-TYPE", \ +/* 0x2E */ "ARG-9-WRONG-TYPE", \ +/* 0x2F */ "ARG-10-WRONG-TYPE", \ +/* 0x30 */ "INAPPLICABLE-CONTINUATION", \ +/* 0x31 */ "COMPILED-CODE-ERROR", \ +/* 0x32 */ "FLOATING-OVERFLOW", \ +/* 0x33 */ "UNIMPLEMENTED-PRIMITIVE", \ +/* 0x34 */ "ILLEGAL-REFERENCE-TRAP", \ +/* 0x35 */ "BROKEN-VARIABLE-CACHE", \ +/* 0x36 */ "WRONG-ARITY-PRIMITIVES", \ +/* 0x37 */ "IO-ERROR", \ +/* 0x38 */ "FASDUMP-ENVIRONMENT", \ +/* 0x39 */ "FASLOAD-BAND", \ +/* 0x40 */ "FASLOAD-COMPILED-MISMATCH" \ +} /* Termination codes: the interpreter halts on these */ @@ -136,10 +203,71 @@ MIT in each case. */ #define TERM_SIGNAL 0x16 #define TERM_TOUCH 0x17 #define TERM_SAVE_AND_EXIT 0x18 +#define TERM_TRAP 0x19 /* - If you add any termination codes here, remember to add them to - storage.c as well. + If you add any termination codes here, add them to + the tables below as well! */ -#define MAX_TERMINATION 0x18 +#define MAX_TERMINATION 0x19 + +#define TERM_NAME_TABLE \ +{ \ +/* 0x00 */ "HALT", \ +/* 0x01 */ "DISK-RESTORE", \ +/* 0x02 */ "BROKEN-HEART", \ +/* 0x03 */ "NON-POINTER-RELOCATION", \ +/* 0x04 */ "BAD-ROOT", \ +/* 0x05 */ "NON-EXISTENT-CONTINUATION", \ +/* 0x06 */ "BAD-STACK", \ +/* 0x07 */ "STACK-OVERFLOW", \ +/* 0x08 */ "STACK-ALLOCATION-FAILED", \ +/* 0x09 */ "NO-ERROR-HANDLER", \ +/* 0x0A */ "NO-INTERRUPT-HANDLER", \ +/* 0x0B */ "UNIMPLEMENTED-CONTINUATION", \ +/* 0x0C */ "EXIT", \ +/* 0x0D */ "BAD-PRIMITIVE-DURING-ERROR", \ +/* 0x0E */ "EOF", \ +/* 0x0F */ "BAD-PRIMITIVE", \ +/* 0x10 */ "HANDLER", \ +/* 0x11 */ "END-OF-COMPUTATION", \ +/* 0x12 */ "INVALID-TYPE-CODE", \ +/* 0x13 */ "COMPILER-DEATH", \ +/* 0x14 */ "GC-OUT-OF-SPACE", \ +/* 0x15 */ "NO-SPACE", \ +/* 0x16 */ "SIGNAL", \ +/* 0x17 */ "TOUCH", \ +/* 0x18 */ "SAVE-AND-EXIT", \ +/* 0x19 */ "TERM_TRAP" \ +} + +#define TERM_MESSAGE_TABLE \ +{ \ +/* 0x00 */ "Moriturus te saluto", \ +/* 0x01 */ "Unrecoverable error while loading a band", \ +/* 0x02 */ "Broken heart encountered", \ +/* 0x03 */ "Non pointer relocation", \ +/* 0x04 */ "Cannot restore control state from band", \ +/* 0x05 */ "Nonexistent return code", \ +/* 0x06 */ "Control stack messed up", \ +/* 0x07 */ "Stack overflow: Maximum recursion depth exceeded", \ +/* 0x08 */ "Not enough space for stack!", \ +/* 0x09 */ "No error handler", \ +/* 0x0A */ "No interrupt handler", \ +/* 0x0B */ "Unimplemented return code", \ +/* 0x0C */ "Inconsistency detected", \ +/* 0x0D */ "Error during unknown primitive", \ +/* 0x0E */ "End of input stream reached", \ +/* 0x0F */ "Bad primitive invoked", \ +/* 0x10 */ "Termination handler returned", \ +/* 0x11 */ "End of computation", \ +/* 0x12 */ "Unknown type encountered", \ +/* 0x13 */ "Mismatch between compiled code and compiled code support", \ +/* 0x14 */ "Out of space after garbage collection", \ +/* 0x15 */ "Out of memory: Available memory exceeded", \ +/* 0x16 */ "Unhandled signal received", \ +/* 0x17 */ "Touch without futures support", \ +/* 0x18 */ "Halt requested by external source", \ +/* 0x19 */ "User requested termination after trap" \ +} diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c index b96140efd..eb366ebb2 100644 --- a/v7/src/microcode/fasdump.c +++ b/v7/src/microcode/fasdump.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/fasdump.c,v 9.32 1987/12/04 22:16:00 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.33 1988/02/06 20:40:12 jinx Exp $ This file contains code for fasdump and dump-band. */ @@ -52,7 +52,8 @@ extern Pointer /* Some statics used freely in this file */ -Pointer *NewFree, *NewMemTop, *Fixup, *Orig_New_Free; +static Pointer *NewFree, *NewMemTop, *Fixup, *Orig_New_Free; +static Boolean compiled_code_present_p; /* FASDUMP: @@ -98,7 +99,7 @@ Dump_Pointer(Fasdump_Setup_Pointer(Extra_Code, Normal_BH(false, continue))) #define FASDUMP_FIX_BUFFER 10 -Boolean +long DumpLoop(Scan, Dump_Mode) fast Pointer *Scan; int Dump_Mode; @@ -137,6 +138,7 @@ DumpLoop(Scan, Dump_Mode) break; case_compiled_entry_point: + compiled_code_present_p = true; Dump_Pointer(Fasdump_Setup_Pointer(Transport_Compiled(), Compiled_BH(false, continue))); @@ -181,9 +183,14 @@ DumpLoop(Scan, Dump_Mode) case TC_BIG_FLONUM: /* Fall through */ #endif - case_Vector: + case TC_COMPILED_CODE_BLOCK: + case_Purify_Vector: Setup_Pointer_for_Dump(Transport_Vector()); + case TC_ENVIRONMENT: + /* Make fasdump fail */ + return (ERR_FASDUMP_ENVIRONMENT); + case TC_FUTURE: Setup_Pointer_for_Dump(Transport_Future()); @@ -197,11 +204,28 @@ DumpLoop(Scan, Dump_Mode) } NewFree = To; Fixup = Fixes; - return true; + return (PRIM_DONE); +} + +#define DUMPLOOP(obj, code) \ +{ \ + long value; \ + \ + value = DumpLoop(obj, code); \ + if (value != PRIM_DONE) \ + { \ + PRIMITIVE_RETURN(Fasdump_Exit(value)); \ + } \ } -Boolean -Fasdump_Exit() +#define FASDUMP_INTERRUPT() \ +{ \ + PRIMITIVE_RETURN(Fasdump_Exit(PRIM_INTERRUPT)); \ +} + +Pointer +Fasdump_Exit(code) + long code; { Boolean result; fast Pointer *Fixes; @@ -217,7 +241,24 @@ Fasdump_Exit() } Fixup = Fixes; Fasdump_Exit_Hook(); - return result; + if (!result) + { + Primitive_Error(ERR_IO_ERROR); + /*NOTREACHED*/ + } + if (code == PRIM_DONE) + { + return (TRUTH); + } + else if (code == PRIM_INTERRUPT) + { + return (NIL); + } + else + { + Primitive_Error(code); + /*NOTREACHED*/ + } } /* (PRIMITIVE-FASDUMP object-to-dump file-name flag) @@ -238,12 +279,13 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) { Pointer Object, File_Name, Flag, *New_Object; Pointer *table_start, *table_end; - long Pure_Length, Length, table_length; + long Pure_Length, Length, table_length, value; Boolean result; Primitive_3_Args(); CHECK_ARG (2, STRING_P); + compiled_code_present_p = false; Object = Arg1; File_Name = Arg2; Flag = Arg3; @@ -283,6 +325,10 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) The primitive dumping mechanism will break, since dump_renumber_primitive is not being invoked by either phase. + + The special entry point relocation code depends on the fact that + fasdumped files (as opposed to bands) contain no constant space + segment. See fasload.c for further information. */ if (Flag == TRUTH) @@ -290,11 +336,7 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) Pointer *Addr_Of_New_Object; *New_Free++ = NIL; - if (!DumpLoop(New_Object, PURE_COPY)) - { - Fasdump_Exit(); - PRIMITIVE_RETURN(NIL); - } + DUMPLOOP(New_Object, PURE_COPY); #if false /* Can't align. */ Align_Float(NewFree); @@ -302,11 +344,7 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) Pure_Length = ((NewFree - New_Object) + 1); *NewFree++ = Make_Non_Pointer(TC_MANIFEST_SPECIAL_NM_VECTOR, 1); *NewFree++ = Make_Non_Pointer(CONSTANT_PART, Pure_Length); - if (!DumpLoop(New_Object, CONSTANT_COPY)) - { - Fasdump_Exit(); - PRIMITIVE_RETURN(NIL); - } + DUMPLOOP(New_Object, CONSTANT_COPY); Length = ((NewFree - New_Object) + 2); *NewFree++ = Make_Non_Pointer(TC_MANIFEST_SPECIAL_NM_VECTOR, 1); *NewFree++ = Make_Non_Pointer(END_OF_BLOCK, (Length - 1)); @@ -318,23 +356,19 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) table_end = cons_primitive_table(NewFree, Fixup, &table_length); if (table_end >= Fixup) { - Fasdump_Exit(); - PRIMITIVE_RETURN(NIL); + FASDUMP_INTERRUPT(); } result = Write_File(Addr_Of_New_Object, 0, 0, Length, New_Object, table_start, table_length, - ((long) (table_end - table_start))); + ((long) (table_end - table_start)), + compiled_code_present_p, false); } else #endif /* Dumping for reload into heap */ { - if (!DumpLoop(New_Object, NORMAL_GC)) - { - Fasdump_Exit(); - PRIMITIVE_RETURN(NIL); - } + DUMPLOOP(New_Object, NORMAL_GC); #if false /* Aligning might screw up some of the counters. */ Align_Float(NewFree); @@ -344,20 +378,19 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) table_end = cons_primitive_table(NewFree, Fixup, &table_length); if (table_end >= Fixup) { - Fasdump_Exit(); - PRIMITIVE_RETURN(NIL); + FASDUMP_INTERRUPT(); } result = Write_File(New_Object, Length, New_Object, 0, Constant_Space, table_start, table_length, - ((long) (table_end - table_start))); + ((long) (table_end - table_start)), + compiled_code_present_p, false); } /* The and is short-circuit, so it must be done in this order. */ - result = (Fasdump_Exit() && result); - PRIMITIVE_RETURN(result ? TRUTH : NIL); + PRIMITIVE_RETURN(Fasdump_Exit(result ? PRIM_DONE : PRIM_INTERRUPT)); } /* (DUMP-BAND PROCEDURE FILE-NAME) @@ -368,7 +401,6 @@ DEFINE_PRIMITIVE("PRIMITIVE-FASDUMP", Prim_Prim_Fasdump, 3) DEFINE_PRIMITIVE("DUMP-BAND", Prim_Band_Dump, 2) { - extern Pointer compiler_utilities; Pointer Combination, *table_start, *table_end, *saved_free; long Arg1Type, table_length; Boolean result; @@ -416,7 +448,8 @@ DEFINE_PRIMITIVE("DUMP-BAND", Prim_Band_Dump, 2) ((long) (Free_Constant - Constant_Space)), Constant_Space, table_start, table_length, - ((long) (table_end - table_start))); + ((long) (table_end - table_start)), + (compiler_utilities != NIL), true); } /* The and is short-circuit, so it must be done in this order. */ result = (Close_Dump_File() && result); diff --git a/v7/src/microcode/fasl.h b/v7/src/microcode/fasl.h index ecf1cd250..e4c0cd1bd 100644 --- a/v7/src/microcode/fasl.h +++ b/v7/src/microcode/fasl.h @@ -30,10 +30,12 @@ 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/fasl.h,v 9.25 1987/11/17 08:10:04 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasl.h,v 9.26 1988/02/06 20:40:26 jinx Exp $ Contains information relating to the format of FASL files. - Some information is contained in CONFIG.H. + The machine/opsys information is contained in config.h + The processor and compiled code version information is + contained in the appropriate cmp* file, or compiler.c */ extern long Load_Data(), Write_Data(); @@ -46,7 +48,7 @@ extern Boolean Open_Dump_File(), Close_Dump_File(); /* The FASL file has a header which begins as follows: */ #define FASL_HEADER_LENGTH 50 /* Scheme objects in header */ -#define FASL_OLD_LENGTH 8 /* Size of header earlier */ + #define FASL_Offset_Marker 0 /* Marker to indicate FASL format */ #define FASL_Offset_Heap_Count 1 /* Count of objects in heap */ #define FASL_Offset_Heap_Base 2 /* Address of heap when dumped */ @@ -57,8 +59,10 @@ extern Boolean Open_Dump_File(), Close_Dump_File(); #define FASL_Offset_Stack_Top 7 /* Top of stack when dumped */ #define FASL_Offset_Prim_Length 8 /* Number of entries in primitive table */ #define FASL_Offset_Prim_Size 9 /* Size of primitive table in Pointers */ +#define FASL_Offset_Ci_Version 10 /* Version number for compiled code interface */ +#define FASL_Offset_Ut_Base 11 /* Address of the utilities vector */ -#define FASL_Offset_First_Free 10 /* Used to clear header */ +#define FASL_Offset_First_Free 12 /* Used to clear header */ /* Aliases for backwards compatibility. */ @@ -67,16 +71,25 @@ extern Boolean Open_Dump_File(), Close_Dump_File(); /* Version information encoding */ -#define MACHINE_TYPE_LENGTH (POINTER_LENGTH/2) -#define MACHINE_TYPE_MASK ((1<> MACHINE_TYPE_LENGTH) & SUB_VERSION_MASK) -#define The_Version(P) Type_Code(P) +#define MACHINE_TYPE_LENGTH (POINTER_LENGTH / 2) +#define MACHINE_TYPE_MASK ((1 << MACHINE_TYPE_LENGTH) - 1) +#define The_Machine_Type(P) ((P) & MACHINE_TYPE_MASK) +#define SUBVERSION_LENGTH (MACHINE_TYPE_LENGTH - TYPE_CODE_LENGTH) +#define SUBVERSION_MASK ((1 << SUBVERSION_LENGTH) - 1) +#define The_Sub_Version(P) (((P) >> MACHINE_TYPE_LENGTH) & SUBVERSION_MASK) +#define The_Version(P) OBJECT_TYPE(P) #define Make_Version(V, S, M) \ Make_Non_Pointer((V), (((S) << MACHINE_TYPE_LENGTH) | (M))) +#define CI_MASK ((1 << (ADDRESS_LENGTH / 2)) - 1) +#define CI_VERSION(P) (((P) >> (ADDRESS_LENGTH / 2)) & CI_MASK) +#define CI_PROCESSOR(P) ((P) & CI_MASK) +#define CI_BAND_P(P) (OBJECT_TYPE(P) == TC_TRUE) +#define MAKE_CI_VERSION(Band_p, Version, Processor_Type) \ + Make_Non_Pointer(((Band_p) ? TC_TRUE : TC_NULL), \ + (((Version) << (ADDRESS_LENGTH / 2)) | \ + (Processor_Type))) + #define WRITE_FLAG "w" #define OPEN_FLAG "r" @@ -95,16 +108,17 @@ extern Boolean Open_Dump_File(), Close_Dump_File(); #define FASL_PADDED_STRINGS 5 #define FASL_REFERENCE_TRAP 6 #define FASL_MERGED_PRIMITIVES 7 +#define FASL_INTERFACE_VERSION 8 /* Current parameters. Always used on output. */ #define FASL_FORMAT_VERSION FASL_FORMAT_ADDED_STACK -#define FASL_SUBVERSION FASL_MERGED_PRIMITIVES +#define FASL_SUBVERSION FASL_INTERFACE_VERSION /* The definitions below correspond to the ones above. They usually have the same values. They differ when the format is changing: A - system is built which reads the old format, but dumps the new one. + system can be built which reads the old format, but dumps the new one. */ #define FASL_READ_VERSION FASL_FORMAT_VERSION diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c index 1b8cd23b2..9b494ef52 100644 --- a/v7/src/microcode/fasload.c +++ b/v7/src/microcode/fasload.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/fasload.c,v 9.32 1987/12/04 22:16:13 jinx Rel $ +/* $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 $ The "fast loader" which reads in and relocates binary files and then interns symbols. It is called with one argument: the (character @@ -53,7 +53,7 @@ long read_file_start(name) Pointer name; { - long heap_length; + long value, heap_length; Boolean file_opened; if (Type_Code(name) != TC_CHARACTER_STRING) @@ -73,10 +73,24 @@ read_file_start(name) return (ERR_ARG_1_BAD_RANGE); } - if (!Read_Header()) + value = Read_Header(); + if (value != FASL_FILE_FINE) { Close_Dump_File(); - return (ERR_FASL_FILE_BAD_DATA); + switch (value) + { + /* These may want to be separated further. */ + case FASL_FILE_TOO_SHORT: + case FASL_FILE_NOT_FASL: + case FASL_FILE_BAD_MACHINE: + case FASL_FILE_BAD_VERSION: + case FASL_FILE_BAD_SUBVERSION: + return (ERR_FASL_FILE_BAD_DATA); + + case FASL_FILE_BAD_PROCESSOR: + case FASL_FILE_BAD_INTERFACE: + return (ERR_FASLOAD_COMPILED_MISMATCH); + } } if (File_Load_Debug) @@ -157,7 +171,10 @@ read_file_end() /* Statics used by Relocate, below */ -relocation_type Heap_Relocation, Const_Reloc, Stack_Relocation; +relocation_type + heap_relocation, + const_relocation, + stack_relocation; /* Relocate a pointer as read in from the file. If the pointer used to point into the heap, relocate it into the heap. If it used to @@ -177,15 +194,15 @@ Relocate(P) if ((P >= Heap_Base) && (P < Dumped_Heap_Top)) { - Result = (Pointer *) (P + Heap_Relocation); + Result = ((Pointer *) (P + heap_relocation)); } else if ((P >= Const_Base) && (P < Dumped_Constant_Top)) { - Result = (Pointer *) (P + Const_Reloc); + Result = ((Pointer *) (P + const_relocation)); } - else if (P < Dumped_Stack_Top) + else if ((P >= Dumped_Constant_Top) && (P < Dumped_Stack_Top)) { - Result = (Pointer *) (P + Stack_Relocation); + Result = ((Pointer *) (P + stack_relocation)); } else { @@ -212,34 +229,34 @@ Relocate(P) #define Relocate_Into(Loc, P) \ { \ - if ((P) < Const_Base) \ + if ((P) < Dumped_Heap_Top) \ { \ - (Loc) = ((Pointer *) ((P) + Heap_Relocation)); \ + (Loc) = ((Pointer *) ((P) + heap_relocation)); \ } \ else if ((P) < Dumped_Constant_Top) \ { \ - (Loc) = ((Pointer *) ((P) + Const_Reloc)); \ + (Loc) = ((Pointer *) ((P) + const_relocation)); \ } \ else \ { \ - (Loc) = ((Pointer *) ((P) + Stack_Relocation)); \ + (Loc) = ((Pointer *) ((P) + stack_relocation)); \ } \ } #ifndef Conditional_Bug -#define Relocate(P) \ - ((P < Const_Base) ? \ - ((Pointer *) (P + Heap_Relocation)) : \ - ((P < Dumped_Constant_Top) ? \ - ((Pointer *) (P + Const_Reloc)) : \ - ((Pointer *) (P + Stack_Relocation)))) +#define Relocate(P) \ +((P < Const_Base) ? \ + ((Pointer *) (P + heap_relocation)) : \ + ((P < Dumped_Constant_Top) ? \ + ((Pointer *) (P + const_relocation)) : \ + ((Pointer *) (P + stack_relocation)))) #else /* Conditional_Bug */ static Pointer *Relocate_Temp; -#define Relocate(P) \ +#define Relocate(P) \ (Relocate_Into(Relocate_Temp, P), Relocate_Temp) #endif /* Conditional_Bug */ @@ -259,7 +276,7 @@ Relocate_Block(Next_Pointer, Stop_At) if (Reloc_Debug) { fprintf(stderr, - "Relocation beginning, block=0x%x, length=0x%x, end=0x%x.\n", + "Relocation beginning, block = 0x%x, length = 0x%x, end = 0x%x.\n", Next_Pointer, (Stop_At - Next_Pointer) - 1, Stop_At); } while (Next_Pointer < Stop_At) @@ -405,9 +422,42 @@ load_file(from_band_load) Orig_Constant = Free_Constant; primitive_table = read_file_end(); Constant_End = Free_Constant; - Heap_Relocation = ((relocation_type) Orig_Heap) - Heap_Base; - Const_Reloc = ((relocation_type) Orig_Constant) - Const_Base; - Stack_Relocation = ((relocation_type) Stack_Top) - Dumped_Stack_Top; + heap_relocation = ((relocation_type) Orig_Heap) - Heap_Base; + + /* + Magic! + The relocation of compiled code entry points depends on the fact + that fasdump never dumps a constant section. + + If the file is not a band, any pointers into constant space are + pointers into the compiler utilities vector. const_relocation is + computed appropriately. + + Otherwise (the file is a band, and only bands can contain constant + space segments) the utilities vector stuff is relocated + automagically: the utilities vector is part of the band. + */ + + if ((!band_p) && (dumped_utilities != NIL)) + { + extern Pointer compiler_utilities; + + if (compiler_utilities == NIL) + { + Primitive_Error(ERR_FASLOAD_COMPILED_MISMATCH); + } + + const_relocation = (((relocation_type) Get_Pointer(compiler_utilities)) - + Datum(dumped_utilities)); + Dumped_Constant_Top = + C_To_Scheme(Nth_Vector_Loc(dumped_utilities, + (1 + Vector_Length(compiler_utilities)))); + } + else + { + const_relocation = (((relocation_type) Orig_Constant) - Const_Base); + } + stack_relocation = ((relocation_type) Stack_Top) - Dumped_Stack_Top; #ifdef BYTE_INVERSION Setup_For_String_Inversion(); @@ -421,9 +471,9 @@ load_file(from_band_load) if (Reloc_Debug) { - printf("Heap_relocation = %d = %x; Const_Reloc = %d = %x\n", - Heap_Relocation, Heap_Relocation, - Const_Reloc, Const_Reloc); + printf("heap_relocation = %d = %x; const_relocation = %d = %x\n", + heap_relocation, heap_relocation, + const_relocation, const_relocation); } /* @@ -469,6 +519,10 @@ DEFINE_PRIMITIVE("BINARY-FASLOAD", Prim_Binary_Fasload, 1) Primitive_1_Arg(); result = read_file_start(Arg1); + if (band_p) + { + Primitive_Error(ERR_FASLOAD_BAND); + } if (result != PRIM_DONE) { if (result == PRIM_INTERRUPT) @@ -581,9 +635,21 @@ DEFINE_PRIMITIVE("LOAD-BAND", Prim_Band_Load, 1) temp = setjmp(swapped_buf); if (temp != 0) { - fprintf(stderr, - "\nload-band: Error %d past the point of no return.\n", - temp); + extern char *Error_Names[], *Abort_Names[]; + + if (temp > 0) + { + fprintf(stderr, + "\nload-band: Error %d (%s) past the point of no return.\n", + temp, Error_Names[temp]); + } + else + { + fprintf(stderr, + "\nload-band: Abort %d (%s) past the point of no return.\n", + temp, Abort_Names[(-temp)-1]); + } + if (band_name != ((char *) NULL)) { fprintf(stderr, "band-name = \"%s\".\n", band_name); diff --git a/v7/src/microcode/gccode.h b/v7/src/microcode/gccode.h index 3135448c8..eab2df076 100644 --- a/v7/src/microcode/gccode.h +++ b/v7/src/microcode/gccode.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/gccode.h,v 9.31 1987/11/17 08:11:46 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.32 1988/02/06 20:40:56 jinx Exp $ * * This file contains the macros for use in code which does GC-like * loops over memory. It is only included in a few files, unlike @@ -238,17 +238,24 @@ Pointer_End() #else In_Fasdump -#define Real_Transport_Vector() \ -{ Pointer *Saved_Scan = Scan; \ - Scan = To + 1 + Get_Integer(*Old); \ - if (Scan >= Fixes) \ - { Scan = Saved_Scan; \ - NewFree = To; \ - Fixup = Fixes; \ - return false; \ - } \ - while (To != Scan) *To++ = *Old++; \ - Scan = Saved_Scan; \ +#define Real_Transport_Vector() \ +{ \ + Pointer *Saved_Scan; \ + \ + Saved_Scan = Scan; \ + Scan = To + 1 + Get_Integer(*Old); \ + if (Scan >= Fixes) \ + { \ + Scan = Saved_Scan; \ + NewFree = To; \ + Fixup = Fixes; \ + return (PRIM_INTERRUPT); \ + } \ + while (To != Scan) \ + { \ + *To++ = *Old++; \ + } \ + Scan = Saved_Scan; \ } #endif @@ -309,18 +316,21 @@ extern Pointer Weak_Chain; there is enough space to remember the fixup. */ -#define Fasdump_Setup_Pointer(Extra_Code, BH_Code) \ -BH_Code; \ -/* It must be transported to New Space */ \ -New_Address = (Make_Broken_Heart(C_To_Scheme(To))); \ -if ((Fixes - To) < FASDUMP_FIX_BUFFER) \ -{ NewFree = To; \ - Fixup = Fixes; \ - return false; \ -} \ -*--Fixes = *Old; \ -*--Fixes = C_To_Scheme(Old); \ -Extra_Code; \ +#define Fasdump_Setup_Pointer(Extra_Code, BH_Code) \ +BH_Code; \ + \ +/* It must be transported to New Space */ \ + \ +New_Address = (Make_Broken_Heart(C_To_Scheme(To))); \ +if ((Fixes - To) < FASDUMP_FIX_BUFFER) \ +{ \ + NewFree = To; \ + Fixup = Fixes; \ + return (PRIM_INTERRUPT); \ +} \ +*--Fixes = *Old; \ +*--Fixes = C_To_Scheme(Old); \ +Extra_Code; \ continue /* Undefine Symbols */ diff --git a/v7/src/microcode/load.c b/v7/src/microcode/load.c index a5def289d..91f03f80c 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.24 1987/11/17 08:14:00 jinx Rel $ +/* $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 $ * * This file contains common code for reading internal * format binary files. @@ -39,22 +39,34 @@ MIT in each case. */ #include "fasl.h" +#define FASL_FILE_FINE 0 +#define FASL_FILE_TOO_SHORT 1 +#define FASL_FILE_NOT_FASL 2 +#define FASL_FILE_BAD_MACHINE 3 +#define FASL_FILE_BAD_VERSION 4 +#define FASL_FILE_BAD_SUBVERSION 5 +#define FASL_FILE_BAD_PROCESSOR 6 +#define FASL_FILE_BAD_INTERFACE 7 + #ifndef BYTE_INVERSION #define NORMALIZE_HEADER(header, size, base, count) #define NORMALIZE_REGION(region, size) -#else +#else /* BYTE_INVERSION */ void Byte_Invert_Region(), Byte_Invert_Header(); #define NORMALIZE_HEADER Byte_Invert_Header #define NORMALIZE_REGION Byte_Invert_Region -#endif +#endif /* BYTE_INVERSION */ /* Static storage for some shared variables */ +static Boolean + band_p; + static long Version, Sub_Version, Machine_Type, Dumped_Object, @@ -62,11 +74,14 @@ static long Const_Base, Const_Count, Dumped_Heap_Top, Dumped_Constant_Top, Dumped_Stack_Top, - Primitive_Table_Size, Primitive_Table_Length; + Primitive_Table_Size, Primitive_Table_Length, + dumped_processor_type, dumped_interface_version; -static Pointer Ext_Prim_Vector; +static Pointer + Ext_Prim_Vector, + dumped_utilities; -Boolean +long Read_Header() { Pointer Buffer[FASL_HEADER_LENGTH]; @@ -75,11 +90,11 @@ Read_Header() if (Load_Data(FASL_HEADER_LENGTH, ((char *) Buffer)) != FASL_HEADER_LENGTH) { - return (false); + return (FASL_FILE_TOO_SHORT); } if (Buffer[FASL_Offset_Marker] != FASL_FILE_MARKER) { - return (false); + return (FASL_FILE_NOT_FASL); } NORMALIZE_HEADER(Buffer, (sizeof(Buffer) / sizeof(Pointer)), @@ -114,40 +129,110 @@ Read_Header() Primitive_Table_Size = Get_Integer(Buffer[FASL_Offset_Prim_Size]); Ext_Prim_Vector = NIL; } + + if (Sub_Version < FASL_INTERFACE_VERSION) + { + /* This may be all wrong, but... */ + band_p = false; + dumped_processor_type = 0; + dumped_interface_version = 0; + dumped_utilities = NIL; + } + else + { + Pointer temp; + + temp = Buffer[FASL_Offset_Ci_Version]; + + band_p = CI_BAND_P(temp); + dumped_processor_type = CI_PROCESSOR(temp); + dumped_interface_version = CI_VERSION(temp); + dumped_utilities = Buffer[FASL_Offset_Ut_Base]; + } + if (Reloc_or_Load_Debug) { - printf("\nHeap_Count = %d; Heap_Base = %x; Dumped_Heap_Top = %x\n", + 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("C_Count = %d; C_Base = %x, Dumped_C_Top = %x\n", + printf("Const Count = %ld; Const Base = 0x%lx, Dumped Constant Top = 0x%lx\n", Const_Count, Const_Base, Dumped_Constant_Top); - printf("Dumped_S_Top = %x, Ext_Prim_Vector = 0x%08x\n", + printf("Dumped Stack Top = 0x%lx, Ext Prim Vector = 0x%lx\n", Dumped_Stack_Top, Ext_Prim_Vector); - printf("Dumped Object (as read from file) = %x\n", Dumped_Object); - printf("Length of primitive table = %d\n", Primitive_Table_Length); - } + 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 -#ifdef BYTE_INVERSION - if ((Version != FASL_READ_VERSION) || - (Sub_Version != FASL_READ_SUBVERSION)) -#else + + /* The error messages here should be handled by the runtime system! */ + if ((Version != FASL_READ_VERSION) || - (Sub_Version != FASL_READ_SUBVERSION) || - (Machine_Type != FASL_INTERNAL_FORMAT)) +#ifndef BYTE_INVERSION + (Machine_Type != FASL_INTERNAL_FORMAT) || #endif + (Sub_Version < FASL_READ_SUBVERSION) || + (Sub_Version > FASL_SUBVERSION)) { + fprintf(stderr, "\nread_file:\n"); fprintf(stderr, - "\nread_file: FASL File Version %4d Subversion %4d Machine Type %4d.\n", + "FASL File: Version %4d Subversion %4d Machine Type %4d.\n", Version, Sub_Version , Machine_Type); fprintf(stderr, - " Expected: Version %4d Subversion %4d Machine Type %4d.\n", - FASL_READ_VERSION, FASL_READ_SUBVERSION, FASL_INTERNAL_FORMAT); + "Expected: Version %4d Subversion %4d Machine Type %4d.\n", + FASL_READ_VERSION, FASL_READ_SUBVERSION, FASL_INTERNAL_FORMAT); - return (false); + return ((Machine_Type != FASL_INTERNAL_FORMAT) ? + FASL_FILE_BAD_MACHINE : + ((Version != FASL_READ_VERSION) ? + FASL_FILE_BAD_VERSION : + FASL_FILE_BAD_SUBVERSION)); } -#endif - return (true); +#endif /* INHIBIT_FASL_VERSION_CHECK */ + +#ifndef INHIBIT_COMPILED_VERSION_CHECK + + /* Is the compiled code "loadable" here? */ + + { + extern long compiler_processor_type, compiler_interface_version; + + if (((dumped_processor_type != 0) && + (dumped_processor_type != compiler_processor_type)) || + ((dumped_interface_version != 0) && + (dumped_interface_version != compiler_interface_version))) + { + 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); + return (((dumped_processor_type != 0) && + (dumped_processor_type != compiler_processor_type)) ? + FASL_FILE_BAD_PROCESSOR : + FASL_FILE_BAD_INTERFACE); + } + } + +#endif /* INHIBIT_COMPILED_VERSION_CHECK */ + + return (FASL_FILE_FINE); } #ifdef BYTE_INVERSION @@ -189,4 +274,5 @@ Byte_Invert_Region(Region, Size) return; } -#endif +#endif /* BYTE_INVERSION */ + diff --git a/v7/src/microcode/ppband.c b/v7/src/microcode/ppband.c index dee22293b..97fc7cd5d 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.29 1987/11/17 08:04:37 jinx Rel $ +/* $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 $ * * Dumps Scheme FASL in user-readable form . */ @@ -80,6 +80,7 @@ Close_Dump_File() } #define Reloc_or_Load_Debug true +#define INHIBIT_COMPILED_VERSION_CHECK #include "fasl.h" #include "load.c" @@ -366,14 +367,14 @@ main(argc, argv) if (argc == 1) { - if (!Read_Header()) + if (Read_Header() != FASL_FILE_FINE) { fprintf(stderr, "%s: Input does not appear to be in correct FASL format.\n", argv[0]); exit(1); } - printf("Dumped object at 0x%lx\n", Relocate(Dumped_Object)); + printf("Dumped object (relocated) at 0x%lx\n", Relocate(Dumped_Object)); } else { @@ -382,7 +383,7 @@ main(argc, argv) sscanf(argv[1], "%x", &Heap_Base); sscanf(argv[2], "%x", &Const_Base); sscanf(argv[3], "%d", &Heap_Count); - printf("Heap Base = 0x%08lx; Constant Base = 0x%08lx; Heap Count = %ld\n", + printf("Heap Base = 0x%lx; Constant Base = 0x%lx; Heap Count = %ld\n", Heap_Base, Const_Base, Heap_Count); } diff --git a/v7/src/microcode/returns.h b/v7/src/microcode/returns.h index 4b3aeb40c..89eaeab98 100644 --- a/v7/src/microcode/returns.h +++ b/v7/src/microcode/returns.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/returns.h,v 9.29 1987/11/04 20:02:48 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/returns.h,v 9.30 1988/02/06 20:41:26 jinx Exp $ * * Return codes. These are placed in Return when an * interpreter operation needs to operate in several @@ -124,6 +124,102 @@ MIT in each case. */ #define RC_COMP_UNASSIGNED_TRAP_RESTART 0x59 #define RC_COMP_CACHE_ASSIGN_RESTART 0x5A -#define MAX_RETURN_CODE 0x5A +/* When adding return codes, add them to the table below as well! */ -/* When adding return codes, don't forget to update storage.c too. */ +#define MAX_RETURN_CODE 0x5A + +#define RETURN_NAME_TABLE \ +{ \ +/* 0x00 */ "END_OF_COMPUTATION", \ +/* 0x01 */ "JOIN_STACKLETS", \ +/* 0x02 */ "RESTORE_CONTINUATION", \ +/* 0x03 */ "INTERNAL_APPLY", \ +/* 0x04 */ "BAD_INTERRUPT_CONTINUE", \ +/* 0x05 */ "RESTORE_HISTORY", \ +/* 0x06 */ "INVOKE_STACK_THREAD", \ +/* 0x07 */ "RESTART_EXECUTION", \ +/* 0x08 */ "EXECUTE_ASSIGNMENT_FINISH", \ +/* 0x09 */ "EXECUTE_DEFINITION_FINISH", \ +/* 0x0A */ "EXECUTE_ACCESS_FINISH", \ +/* 0x0b */ "EXECUTE_IN_PACKAGE_CONTINUE", \ +/* 0x0C */ "SEQ_2_DO_2", \ +/* 0x0d */ "SEQ_3_DO_2", \ +/* 0x0E */ "SEQ_3_DO_3", \ +/* 0x0f */ "CONDITIONAL_DECIDE", \ +/* 0x10 */ "DISJUNCTION_DECIDE", \ +/* 0x11 */ "COMB_1_PROCEDURE", \ +/* 0x12 */ "COMB_APPLY_FUNCTION", \ +/* 0x13 */ "COMB_2_FIRST_OPERAND", \ +/* 0x14 */ "COMB_2_PROCEDURE", \ +/* 0x15 */ "COMB_SAVE_VALUE", \ +/* 0x16 */ "PCOMB1_APPLY", \ +/* 0x17 */ "PCOMB2_DO_1", \ +/* 0x18 */ "PCOMB2_APPLY", \ +/* 0x19 */ "PCOMB3_DO_2", \ +/* 0x1A */ "PCOMB3_DO_1", \ +/* 0x1B */ "PCOMB3_APPLY", \ +/* 0x1C */ "SNAP_NEED_THUNK", \ +/* 0x1D */ "", \ +/* 0x1E */ "", \ +/* 0x1F */ "", \ +/* 0x20 */ "NORMAL_GC_DONE", \ +/* 0x21 */ "COMPLETE_GC_DONE", \ +/* 0x22 */ "PURIFY_GC_1", \ +/* 0x23 */ "PURIFY_GC_2", \ +/* 0x24 */ "AFTER_MEMORY_UPDATE", \ +/* 0x25 */ "RESTARTABLE_EXIT", \ +/* 0x26 */ "", \ +/* 0x27 */ "", \ + \ +/* 0x28 */ "", \ +/* 0x29 */ "", \ +/* 0x2A */ "RETURN_TRAP_POINT", \ +/* 0x2B */ "RESTORE_STEPPER", \ +/* 0x2C */ "RESTORE_TO_STATE_POINT", \ +/* 0x2D */ "MOVE_TO_ADJACENT_POINT", \ +/* 0x2E */ "RESTORE_VALUE", \ +/* 0x2F */ "RESTORE_DONT_COPY_HISTORY", \ +/* 0x30 */ "", \ +/* 0x31 */ "", \ +/* 0x32 */ "", \ +/* 0x33 */ "", \ +/* 0x34 */ "", \ +/* 0x35 */ "", \ +/* 0x36 */ "", \ +/* 0x37 */ "", \ +/* 0x38 */ "", \ +/* 0x39 */ "", \ +/* 0x3A */ "", \ +/* 0x3B */ "", \ +/* 0x3C */ "", \ +/* 0x3D */ "", \ +/* 0x3E */ "", \ +/* 0x3F */ "", \ +/* 0x40 */ "POP_RETURN_ERROR", \ +/* 0x41 */ "EVAL_ERROR", \ +/* 0x42 */ "REPEAT_PRIMITIVE", \ +/* 0x43 */ "COMPILER_INTERRUPT_RESTART", \ +/* 0x44 */ "", \ +/* 0x45 */ "RESTORE_INT_MASK", \ +/* 0x46 */ "HALT", \ +/* 0x47 */ "FINISH_GLOBAL_INT", \ +/* 0x48 */ "REPEAT_DISPATCH", \ +/* 0x49 */ "GC_CHECK", \ +/* 0x4A */ "RESTORE_FLUIDS", \ +/* 0x4B */ "COMPILER_LOOKUP_APPLY_RESTART", \ +/* 0x4C */ "COMPILER_ACCESS_RESTART", \ +/* 0x4D */ "COMPILER_UNASSIGNED_P_RESTART", \ +/* 0x4E */ "COMPILER_UNBOUND_P_RESTART", \ +/* 0x4F */ "COMPILER_DEFINITION_RESTART", \ +/* 0x50 */ "COMPILER_LEXPR_GC_RESTART", \ +/* 0x51 */ "COMPILER_SAFE_REFERENCE_RESTART", \ +/* 0x52 */ "COMPILER_CACHE_LOOKUP_RESTART", \ +/* 0x53 */ "COMPILER_LOOKUP_TRAP_RESTART", \ +/* 0x54 */ "COMPILER_ASSIGNMENT_TRAP_RESTART", \ +/* 0x55 */ "COMPILER_CACHE_OPERATOR_RESTART", \ +/* 0x56 */ "COMPILER_OPERATOR_REFERENCE_TRAP_RESTART", \ +/* 0x57 */ "COMPILER_CACHE_REFERENCE_APPLY_RESTART", \ +/* 0x58 */ "COMPILER_SAFE_REFERENCE_TRAP_RESTART", \ +/* 0x59 */ "COMPILER_UNASSIGNED_P_TRAP_RESTART", \ +/* 0x5A */ "COMPILER_CACHE_ASSIGNMENT_RESTART" \ +} diff --git a/v7/src/microcode/storage.c b/v7/src/microcode/storage.c index 86961f413..2fa769fef 100644 --- a/v7/src/microcode/storage.c +++ b/v7/src/microcode/storage.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/storage.c,v 9.40 1987/12/13 21:59:30 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/storage.c,v 9.41 1988/02/06 20:41:41 jinx Exp $ This file defines the storage for global variables for the Scheme Interpreter. */ @@ -151,240 +151,21 @@ char *CONT_PRINT_EXPR_MESSAGE = "Save_Cont, expression"; char *RESTORE_CONT_RETURN_MESSAGE = "Restore_Cont, return code"; char *RESTORE_CONT_EXPR_MESSAGE = "Restore_Cont, expression"; -static char No_Name[] = ""; - -char *Return_Names[] = { -/* 0x00 */ "END_OF_COMPUTATION", -/* 0x01 */ "JOIN_STACKLETS", -/* 0x02 */ "RESTORE_CONTINUATION", -/* 0x03 */ "INTERNAL_APPLY", -/* 0x04 */ "BAD_INTERRUPT_CONTINUE", -/* 0x05 */ "RESTORE_HISTORY", -/* 0x06 */ "INVOKE_STACK_THREAD", -/* 0x07 */ "RESTART_EXECUTION", -/* 0x08 */ "EXECUTE_ASSIGNMENT_FINISH", -/* 0x09 */ "EXECUTE_DEFINITION_FINISH", -/* 0x0A */ "EXECUTE_ACCESS_FINISH", -/* 0x0b */ "EXECUTE_IN_PACKAGE_CONTINUE", -/* 0x0C */ "SEQ_2_DO_2", -/* 0x0d */ "SEQ_3_DO_2", -/* 0x0E */ "SEQ_3_DO_3", -/* 0x0f */ "CONDITIONAL_DECIDE", -/* 0x10 */ "DISJUNCTION_DECIDE", -/* 0x11 */ "COMB_1_PROCEDURE", -/* 0x12 */ "COMB_APPLY_FUNCTION", -/* 0x13 */ "COMB_2_FIRST_OPERAND", -/* 0x14 */ "COMB_2_PROCEDURE", -/* 0x15 */ "COMB_SAVE_VALUE", -/* 0x16 */ "PCOMB1_APPLY", -/* 0x17 */ "PCOMB2_DO_1", -/* 0x18 */ "PCOMB2_APPLY", -/* 0x19 */ "PCOMB3_DO_2", -/* 0x1A */ "PCOMB3_DO_1", -/* 0x1B */ "PCOMB3_APPLY", -/* 0x1C */ "SNAP_NEED_THUNK", -/* 0x1D */ No_Name, -/* 0x1E */ No_Name, -/* 0x1F */ No_Name, -/* 0x20 */ "NORMAL_GC_DONE", -/* 0x21 */ "COMPLETE_GC_DONE", -/* 0x22 */ "PURIFY_GC_1", -/* 0x23 */ "PURIFY_GC_2", -/* 0x24 */ "AFTER_MEMORY_UPDATE", -/* 0x25 */ "RESTARTABLE_EXIT", -/* 0x26 */ No_Name, -/* 0x27 */ No_Name, - -/* 0x28 */ No_Name, -/* 0x29 */ No_Name, -/* 0x2A */ "RETURN_TRAP_POINT", -/* 0x2B */ "RESTORE_STEPPER", -/* 0x2C */ "RESTORE_TO_STATE_POINT", -/* 0x2D */ "MOVE_TO_ADJACENT_POINT", -/* 0x2E */ "RESTORE_VALUE", -/* 0x2F */ "RESTORE_DONT_COPY_HISTORY", -/* 0x30 */ No_Name, -/* 0x31 */ No_Name, -/* 0x32 */ No_Name, -/* 0x33 */ No_Name, -/* 0x34 */ No_Name, -/* 0x35 */ No_Name, -/* 0x36 */ No_Name, -/* 0x37 */ No_Name, -/* 0x38 */ No_Name, -/* 0x39 */ No_Name, -/* 0x3A */ No_Name, -/* 0x3B */ No_Name, -/* 0x3C */ No_Name, -/* 0x3D */ No_Name, -/* 0x3E */ No_Name, -/* 0x3F */ No_Name, -/* 0x40 */ "POP_RETURN_ERROR", -/* 0x41 */ "EVAL_ERROR", -/* 0x42 */ "REPEAT_PRIMITIVE", -/* 0x43 */ "COMPILER_INTERRUPT_RESTART", -/* 0x44 */ No_Name, -/* 0x45 */ "RESTORE_INT_MASK", -/* 0x46 */ "HALT", -/* 0x47 */ "FINISH_GLOBAL_INT", -/* 0x48 */ "REPEAT_DISPATCH", -/* 0x49 */ "GC_CHECK", -/* 0x4A */ "RESTORE_FLUIDS", -/* 0x4B */ "COMPILER_LOOKUP_APPLY_RESTART", -/* 0x4C */ "COMPILER_ACCESS_RESTART", -/* 0x4D */ "COMPILER_UNASSIGNED_P_RESTART", -/* 0x4E */ "COMPILER_UNBOUND_P_RESTART", -/* 0x4F */ "COMPILER_DEFINITION_RESTART", -/* 0x50 */ "COMPILER_LEXPR_GC_RESTART", -/* 0x51 */ "COMPILER_SAFE_REFERENCE_RESTART", -/* 0x52 */ "COMPILER_CACHE_LOOKUP_RESTART", -/* 0x53 */ "COMPILER_LOOKUP_TRAP_RESTART", -/* 0x54 */ "COMPILER_ASSIGNMENT_TRAP_RESTART", -/* 0x55 */ "COMPILER_CACHE_OPERATOR_RESTART", -/* 0x56 */ "COMPILER_OPERATOR_REFERENCE_TRAP_RESTART", -/* 0x57 */ "COMPILER_CACHE_REFERENCE_APPLY_RESTART", -/* 0x58 */ "COMPILER_SAFE_REFERENCE_TRAP_RESTART", -/* 0x59 */ "COMPILER_UNASSIGNED_P_TRAP_RESTART", -/* 0x5A */ "COMPILER_CACHE_ASSIGNMENT_RESTART" -}; - -#if (MAX_RETURN_CODE != 0x5A) -/* Cause an error */ -#include "Inconsistency: returns.h and storage.c (Return code table)" -#endif +/* Interpreter code name and message tables */ long MAX_RETURN = MAX_RETURN_CODE; - + +extern char *Return_Names[]; +char *Return_Names[] = RETURN_NAME_TABLE; /* in returns.h */ + +extern char *Abort_Names[]; +char *Abort_Names[] = ABORT_NAME_TABLE; /* in const.h */ + extern char *Error_Names[]; +char *Error_Names[] = ERROR_NAME_TABLE; /* in errors.h */ -char *Error_Names[] = { -/* 0x00 */ "BAD-ERROR-CODE", -/* 0x01 */ "UNBOUND-VARIABLE", -/* 0x02 */ "UNASSIGNED-VARIABLE", -/* 0x03 */ "INAPPLICABLE-OBJECT", -/* 0x04 */ "OUT-OF-HASH-NUMBERS", -/* 0x05 */ "ENVIRONMENT-CHAIN-TOO-DEEP", -/* 0x06 */ "BAD-FRAME", -/* 0x07 */ "BROKEN-COMPILED-VARIABLE", -/* 0x08 */ "UNDEFINED-USER-TYPE", -/* 0x09 */ "UNDEFINED-PRIMITIVE", -/* 0x0A */ "EXTERNAL-RETURN", -/* 0x0B */ "EXECUTE-MANIFEST-VECTOR", -/* 0x0C */ "WRONG-NUMBER-OF-ARGUMENTS", -/* 0x0D */ "ARG-1-WRONG-TYPE", -/* 0x0E */ "ARG-2-WRONG-TYPE", -/* 0x0F */ "ARG-3-WRONG-TYPE", -/* 0x10 */ "ARG-1-BAD-RANGE", -/* 0x11 */ "ARG-2-BAD-RANGE", -/* 0x12 */ "ARG-3-BAD-RANGE", -/* 0x13 */ "BAD-COMBINATION", -/* 0x14 */ "FASDUMP-OVERFLOW", -/* 0x15 */ "BAD-INTERRUPT-CODE", -/* 0x16 */ "NO-ERRORS", -/* 0x17 */ "FASL-FILE-TOO-BIG", -/* 0x18 */ "FASL-FILE-BAD-DATA", -/* 0x19 */ "IMPURIFY-OUT-OF-SPACE", -/* 0x1A */ "WRITE-INTO-PURE-SPACE", -/* 0x1B */ "LOSING-SPARE-HEAP", -/* 0x1C */ "NO-HASH-TABLE", -/* 0x1D */ "BAD-SET", -/* 0x1E */ "ARG-1-FAILED-COERCION", -/* 0x1F */ "ARG-2-FAILED-COERCION", -/* 0x20 */ "OUT-OF-FILE-HANDLES", -/* 0x21 */ "SHELL-DIED", -/* 0x22 */ "ARG-4-BAD-RANGE", -/* 0x23 */ "ARG-5-BAD-RANGE", -/* 0x24 */ "ARG-6-BAD-RANGE", -/* 0x25 */ "ARG-7-BAD-RANGE", -/* 0x26 */ "ARG-8-BAD-RANGE", -/* 0x27 */ "ARG-9-BAD-RANGE", -/* 0x28 */ "ARG-10-BAD-RANGE", -/* 0x29 */ "ARG-4-WRONG-TYPE", - -/* 0x2A */ "ARG-5-WRONG-TYPE", -/* 0x2B */ "ARG-6-WRONG-TYPE", -/* 0x2C */ "ARG-7-WRONG-TYPE", -/* 0x2D */ "ARG-8-WRONG-TYPE", -/* 0x2E */ "ARG-9-WRONG-TYPE", -/* 0x2F */ "ARG-10-WRONG-TYPE", -/* 0x30 */ "INAPPLICABLE-CONTINUATION", -/* 0x31 */ "COMPILED-CODE-ERROR", -/* 0x32 */ "FLOATING-OVERFLOW", -/* 0x33 */ "UNIMPLEMENTED-PRIMITIVE", -/* 0x34 */ "ILLEGAL-REFERENCE-TRAP", -/* 0x35 */ "BROKEN-VARIABLE-CACHE", -/* 0x36 */ "WRONG-ARITY-PRIMITIVES", -/* 0x37 */ "IO-ERROR" -}; - -#if (MAX_ERROR != 0x37) -/* Cause an error */ -#include "Inconsistency: errors.h and storage.c (Error code table)" -#endif - extern char *Term_Names[]; +char *Term_Names[] = TERM_NAME_TABLE; /* in errors.h */ -char *Term_Names[] = { -/* 0x00 */ "HALT", -/* 0x01 */ "DISK-RESTORE", -/* 0x02 */ "BROKEN-HEART", -/* 0x03 */ "NON-POINTER-RELOCATION", -/* 0x04 */ "BAD-ROOT", -/* 0x05 */ "NON-EXISTENT-CONTINUATION", -/* 0x06 */ "BAD-STACK", -/* 0x07 */ "STACK-OVERFLOW", -/* 0x08 */ "STACK-ALLOCATION-FAILED", -/* 0x09 */ "NO-ERROR-HANDLER", -/* 0x0A */ "NO-INTERRUPT-HANDLER", -/* 0x0B */ "UNIMPLEMENTED-CONTINUATION", -/* 0x0C */ "EXIT", -/* 0x0D */ "BAD-PRIMITIVE-DURING-ERROR", -/* 0x0E */ "EOF", -/* 0x0F */ "BAD-PRIMITIVE", -/* 0x10 */ "HANDLER", -/* 0x11 */ "END-OF-COMPUTATION", -/* 0x12 */ "INVALID-TYPE-CODE", -/* 0x13 */ "COMPILER-DEATH", -/* 0x14 */ "GC-OUT-OF-SPACE", -/* 0x15 */ "NO-SPACE", -/* 0x16 */ "SIGNAL", -/* 0x17 */ "TOUCH", -/* 0x18 */ "SAVE-AND-EXIT" -}; - -/* If you change this table, change the Term_Messages table below as well. */ - -#if (MAX_TERMINATION != 0x18) -/* Cause an error */ -#include "Inconsistency: errors.h and storage.c (Termination code table)" -#endif - extern char *Term_Messages[]; - -char *Term_Messages[] = { -/* 0x00 */ "Moriturus te saluto", -/* 0x01 */ "Unrecoverable error while loading a band", -/* 0x02 */ "Broken heart encountered", -/* 0x03 */ "Non pointer relocation", -/* 0x04 */ "Cannot restore control state from band", -/* 0x05 */ "Nonexistent return code", -/* 0x06 */ "Control stack messed up", -/* 0x07 */ "Stack overflow: Maximum recursion depth exceeded", -/* 0x08 */ "Not enough space for stack!", -/* 0x09 */ "No error handler", -/* 0x0A */ "No interrupt handler", -/* 0x0B */ "Unimplemented return code", -/* 0x0C */ "Inconsistency detected", -/* 0x0D */ "Error during unknown primitive", -/* 0x0E */ "End of input stream reached", -/* 0x0F */ "Bad primitive invoked", -/* 0x10 */ "Termination handler returned", -/* 0x11 */ "End of computation", -/* 0x12 */ "Unknown type encountered", -/* 0x13 */ "Mismatch between compiled code and compiled code support", -/* 0x14 */ "Out of space after garbage collection", -/* 0x15 */ "Out of memory: Available memory exceeded", -/* 0x16 */ "Unhandled signal received", -/* 0x17 */ "Touch without futures support", -/* 0x18 */ "Halt requested by external source" -}; +char *Term_Messages[] = TERM_MESSAGE_TABLE; /* in errors.h */ diff --git a/v7/src/microcode/utabmd.scm b/v7/src/microcode/utabmd.scm index 398e8729d..d8d747b95 100644 --- a/v7/src/microcode/utabmd.scm +++ b/v7/src/microcode/utabmd.scm @@ -37,7 +37,7 @@ ;;;; Machine Dependent Type Tables -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.40 1987/12/13 22:47:00 cph Rel $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.41 1988/02/06 20:43:02 jinx Exp $ (declare (usual-integrations)) @@ -511,6 +511,9 @@ BROKEN-VARIABLE-CACHE ;35 WRONG-ARITY-PRIMITIVES ;36 IO-ERROR ;37 + FASDUMP-ENVIRONMENT ;38 + FASLOAD-BAND ;39 + FASLOAD-COMPILED-MISMATCH ;3A )) ;;; [] Terminations @@ -566,4 +569,4 @@ ;;; This identification string is saved by the system. -"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.40 1987/12/13 22:47:00 cph Rel $" \ No newline at end of file +"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.41 1988/02/06 20:43:02 jinx Exp $" \ No newline at end of file diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index 929184e61..a4d4aeeb5 100644 --- a/v7/src/microcode/version.h +++ b/v7/src/microcode/version.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/version.h,v 10.19 1988/01/04 22:26:40 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.20 1988/02/06 20:43:29 jinx Exp $ This file contains version information for the microcode. */ @@ -46,7 +46,7 @@ This file contains version information for the microcode. */ #define VERSION 10 #endif #ifndef SUBVERSION -#define SUBVERSION 19 +#define SUBVERSION 20 #endif #ifndef UCODE_TABLES_FILENAME diff --git a/v8/src/microcode/const.h b/v8/src/microcode/const.h index ba201fa1c..6c51a4204 100644 --- a/v8/src/microcode/const.h +++ b/v8/src/microcode/const.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/const.h,v 9.26 1987/12/04 22:14:55 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/const.h,v 9.27 1988/02/06 20:39:40 jinx Exp $ * * Named constants used throughout the interpreter * @@ -104,10 +104,11 @@ MIT in each case. */ #define END_OF_BLOCK TC_FIXNUM #define CONSTANT_PART TC_TRUE #define PURE_PART TC_FALSE - + /* Primitive flow control codes: directs computation after * processing a primitive application. */ + #define PRIM_DONE -1 #define PRIM_DO_EXPRESSION -2 #define PRIM_APPLY -3 @@ -117,6 +118,18 @@ MIT in each case. */ #define PRIM_POP_RETURN -7 #define PRIM_TOUCH -8 +#define ABORT_NAME_TABLE \ +{ \ + /* -1 */ "DONE", \ + /* -2 */ "DO-EXPRESSION", \ + /* -3 */ "APPLY", \ + /* -4 */ "INTERRUPT", \ + /* -5 */ "NO-TRAP-EVAL", \ + /* -6 */ "NO-TRAP_APPLY", \ + /* -7 */ "POP-RETURN", \ + /* -8 */ "TOUCH" \ +} + /* Some numbers of parameters which mean something special */ #define LEXPR_PRIMITIVE_ARITY -1 diff --git a/v8/src/microcode/fasl.h b/v8/src/microcode/fasl.h index f166af1eb..efd0989c9 100644 --- a/v8/src/microcode/fasl.h +++ b/v8/src/microcode/fasl.h @@ -30,10 +30,12 @@ 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/fasl.h,v 9.25 1987/11/17 08:10:04 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/fasl.h,v 9.26 1988/02/06 20:40:26 jinx Exp $ Contains information relating to the format of FASL files. - Some information is contained in CONFIG.H. + The machine/opsys information is contained in config.h + The processor and compiled code version information is + contained in the appropriate cmp* file, or compiler.c */ extern long Load_Data(), Write_Data(); @@ -46,7 +48,7 @@ extern Boolean Open_Dump_File(), Close_Dump_File(); /* The FASL file has a header which begins as follows: */ #define FASL_HEADER_LENGTH 50 /* Scheme objects in header */ -#define FASL_OLD_LENGTH 8 /* Size of header earlier */ + #define FASL_Offset_Marker 0 /* Marker to indicate FASL format */ #define FASL_Offset_Heap_Count 1 /* Count of objects in heap */ #define FASL_Offset_Heap_Base 2 /* Address of heap when dumped */ @@ -57,8 +59,10 @@ extern Boolean Open_Dump_File(), Close_Dump_File(); #define FASL_Offset_Stack_Top 7 /* Top of stack when dumped */ #define FASL_Offset_Prim_Length 8 /* Number of entries in primitive table */ #define FASL_Offset_Prim_Size 9 /* Size of primitive table in Pointers */ +#define FASL_Offset_Ci_Version 10 /* Version number for compiled code interface */ +#define FASL_Offset_Ut_Base 11 /* Address of the utilities vector */ -#define FASL_Offset_First_Free 10 /* Used to clear header */ +#define FASL_Offset_First_Free 12 /* Used to clear header */ /* Aliases for backwards compatibility. */ @@ -67,16 +71,25 @@ extern Boolean Open_Dump_File(), Close_Dump_File(); /* Version information encoding */ -#define MACHINE_TYPE_LENGTH (POINTER_LENGTH/2) -#define MACHINE_TYPE_MASK ((1<> MACHINE_TYPE_LENGTH) & SUB_VERSION_MASK) -#define The_Version(P) Type_Code(P) +#define MACHINE_TYPE_LENGTH (POINTER_LENGTH / 2) +#define MACHINE_TYPE_MASK ((1 << MACHINE_TYPE_LENGTH) - 1) +#define The_Machine_Type(P) ((P) & MACHINE_TYPE_MASK) +#define SUBVERSION_LENGTH (MACHINE_TYPE_LENGTH - TYPE_CODE_LENGTH) +#define SUBVERSION_MASK ((1 << SUBVERSION_LENGTH) - 1) +#define The_Sub_Version(P) (((P) >> MACHINE_TYPE_LENGTH) & SUBVERSION_MASK) +#define The_Version(P) OBJECT_TYPE(P) #define Make_Version(V, S, M) \ Make_Non_Pointer((V), (((S) << MACHINE_TYPE_LENGTH) | (M))) +#define CI_MASK ((1 << (ADDRESS_LENGTH / 2)) - 1) +#define CI_VERSION(P) (((P) >> (ADDRESS_LENGTH / 2)) & CI_MASK) +#define CI_PROCESSOR(P) ((P) & CI_MASK) +#define CI_BAND_P(P) (OBJECT_TYPE(P) == TC_TRUE) +#define MAKE_CI_VERSION(Band_p, Version, Processor_Type) \ + Make_Non_Pointer(((Band_p) ? TC_TRUE : TC_NULL), \ + (((Version) << (ADDRESS_LENGTH / 2)) | \ + (Processor_Type))) + #define WRITE_FLAG "w" #define OPEN_FLAG "r" @@ -95,16 +108,17 @@ extern Boolean Open_Dump_File(), Close_Dump_File(); #define FASL_PADDED_STRINGS 5 #define FASL_REFERENCE_TRAP 6 #define FASL_MERGED_PRIMITIVES 7 +#define FASL_INTERFACE_VERSION 8 /* Current parameters. Always used on output. */ #define FASL_FORMAT_VERSION FASL_FORMAT_ADDED_STACK -#define FASL_SUBVERSION FASL_MERGED_PRIMITIVES +#define FASL_SUBVERSION FASL_INTERFACE_VERSION /* The definitions below correspond to the ones above. They usually have the same values. They differ when the format is changing: A - system is built which reads the old format, but dumps the new one. + system can be built which reads the old format, but dumps the new one. */ #define FASL_READ_VERSION FASL_FORMAT_VERSION diff --git a/v8/src/microcode/ppband.c b/v8/src/microcode/ppband.c index 8c1601d7f..a1891f74b 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.29 1987/11/17 08:04:37 jinx Rel $ +/* $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 $ * * Dumps Scheme FASL in user-readable form . */ @@ -80,6 +80,7 @@ Close_Dump_File() } #define Reloc_or_Load_Debug true +#define INHIBIT_COMPILED_VERSION_CHECK #include "fasl.h" #include "load.c" @@ -366,14 +367,14 @@ main(argc, argv) if (argc == 1) { - if (!Read_Header()) + if (Read_Header() != FASL_FILE_FINE) { fprintf(stderr, "%s: Input does not appear to be in correct FASL format.\n", argv[0]); exit(1); } - printf("Dumped object at 0x%lx\n", Relocate(Dumped_Object)); + printf("Dumped object (relocated) at 0x%lx\n", Relocate(Dumped_Object)); } else { @@ -382,7 +383,7 @@ main(argc, argv) sscanf(argv[1], "%x", &Heap_Base); sscanf(argv[2], "%x", &Const_Base); sscanf(argv[3], "%d", &Heap_Count); - printf("Heap Base = 0x%08lx; Constant Base = 0x%08lx; Heap Count = %ld\n", + printf("Heap Base = 0x%lx; Constant Base = 0x%lx; Heap Count = %ld\n", Heap_Base, Const_Base, Heap_Count); } diff --git a/v8/src/microcode/returns.h b/v8/src/microcode/returns.h index 4977d87b9..e86a086ff 100644 --- a/v8/src/microcode/returns.h +++ b/v8/src/microcode/returns.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/returns.h,v 9.29 1987/11/04 20:02:48 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/returns.h,v 9.30 1988/02/06 20:41:26 jinx Exp $ * * Return codes. These are placed in Return when an * interpreter operation needs to operate in several @@ -124,6 +124,102 @@ MIT in each case. */ #define RC_COMP_UNASSIGNED_TRAP_RESTART 0x59 #define RC_COMP_CACHE_ASSIGN_RESTART 0x5A -#define MAX_RETURN_CODE 0x5A +/* When adding return codes, add them to the table below as well! */ -/* When adding return codes, don't forget to update storage.c too. */ +#define MAX_RETURN_CODE 0x5A + +#define RETURN_NAME_TABLE \ +{ \ +/* 0x00 */ "END_OF_COMPUTATION", \ +/* 0x01 */ "JOIN_STACKLETS", \ +/* 0x02 */ "RESTORE_CONTINUATION", \ +/* 0x03 */ "INTERNAL_APPLY", \ +/* 0x04 */ "BAD_INTERRUPT_CONTINUE", \ +/* 0x05 */ "RESTORE_HISTORY", \ +/* 0x06 */ "INVOKE_STACK_THREAD", \ +/* 0x07 */ "RESTART_EXECUTION", \ +/* 0x08 */ "EXECUTE_ASSIGNMENT_FINISH", \ +/* 0x09 */ "EXECUTE_DEFINITION_FINISH", \ +/* 0x0A */ "EXECUTE_ACCESS_FINISH", \ +/* 0x0b */ "EXECUTE_IN_PACKAGE_CONTINUE", \ +/* 0x0C */ "SEQ_2_DO_2", \ +/* 0x0d */ "SEQ_3_DO_2", \ +/* 0x0E */ "SEQ_3_DO_3", \ +/* 0x0f */ "CONDITIONAL_DECIDE", \ +/* 0x10 */ "DISJUNCTION_DECIDE", \ +/* 0x11 */ "COMB_1_PROCEDURE", \ +/* 0x12 */ "COMB_APPLY_FUNCTION", \ +/* 0x13 */ "COMB_2_FIRST_OPERAND", \ +/* 0x14 */ "COMB_2_PROCEDURE", \ +/* 0x15 */ "COMB_SAVE_VALUE", \ +/* 0x16 */ "PCOMB1_APPLY", \ +/* 0x17 */ "PCOMB2_DO_1", \ +/* 0x18 */ "PCOMB2_APPLY", \ +/* 0x19 */ "PCOMB3_DO_2", \ +/* 0x1A */ "PCOMB3_DO_1", \ +/* 0x1B */ "PCOMB3_APPLY", \ +/* 0x1C */ "SNAP_NEED_THUNK", \ +/* 0x1D */ "", \ +/* 0x1E */ "", \ +/* 0x1F */ "", \ +/* 0x20 */ "NORMAL_GC_DONE", \ +/* 0x21 */ "COMPLETE_GC_DONE", \ +/* 0x22 */ "PURIFY_GC_1", \ +/* 0x23 */ "PURIFY_GC_2", \ +/* 0x24 */ "AFTER_MEMORY_UPDATE", \ +/* 0x25 */ "RESTARTABLE_EXIT", \ +/* 0x26 */ "", \ +/* 0x27 */ "", \ + \ +/* 0x28 */ "", \ +/* 0x29 */ "", \ +/* 0x2A */ "RETURN_TRAP_POINT", \ +/* 0x2B */ "RESTORE_STEPPER", \ +/* 0x2C */ "RESTORE_TO_STATE_POINT", \ +/* 0x2D */ "MOVE_TO_ADJACENT_POINT", \ +/* 0x2E */ "RESTORE_VALUE", \ +/* 0x2F */ "RESTORE_DONT_COPY_HISTORY", \ +/* 0x30 */ "", \ +/* 0x31 */ "", \ +/* 0x32 */ "", \ +/* 0x33 */ "", \ +/* 0x34 */ "", \ +/* 0x35 */ "", \ +/* 0x36 */ "", \ +/* 0x37 */ "", \ +/* 0x38 */ "", \ +/* 0x39 */ "", \ +/* 0x3A */ "", \ +/* 0x3B */ "", \ +/* 0x3C */ "", \ +/* 0x3D */ "", \ +/* 0x3E */ "", \ +/* 0x3F */ "", \ +/* 0x40 */ "POP_RETURN_ERROR", \ +/* 0x41 */ "EVAL_ERROR", \ +/* 0x42 */ "REPEAT_PRIMITIVE", \ +/* 0x43 */ "COMPILER_INTERRUPT_RESTART", \ +/* 0x44 */ "", \ +/* 0x45 */ "RESTORE_INT_MASK", \ +/* 0x46 */ "HALT", \ +/* 0x47 */ "FINISH_GLOBAL_INT", \ +/* 0x48 */ "REPEAT_DISPATCH", \ +/* 0x49 */ "GC_CHECK", \ +/* 0x4A */ "RESTORE_FLUIDS", \ +/* 0x4B */ "COMPILER_LOOKUP_APPLY_RESTART", \ +/* 0x4C */ "COMPILER_ACCESS_RESTART", \ +/* 0x4D */ "COMPILER_UNASSIGNED_P_RESTART", \ +/* 0x4E */ "COMPILER_UNBOUND_P_RESTART", \ +/* 0x4F */ "COMPILER_DEFINITION_RESTART", \ +/* 0x50 */ "COMPILER_LEXPR_GC_RESTART", \ +/* 0x51 */ "COMPILER_SAFE_REFERENCE_RESTART", \ +/* 0x52 */ "COMPILER_CACHE_LOOKUP_RESTART", \ +/* 0x53 */ "COMPILER_LOOKUP_TRAP_RESTART", \ +/* 0x54 */ "COMPILER_ASSIGNMENT_TRAP_RESTART", \ +/* 0x55 */ "COMPILER_CACHE_OPERATOR_RESTART", \ +/* 0x56 */ "COMPILER_OPERATOR_REFERENCE_TRAP_RESTART", \ +/* 0x57 */ "COMPILER_CACHE_REFERENCE_APPLY_RESTART", \ +/* 0x58 */ "COMPILER_SAFE_REFERENCE_TRAP_RESTART", \ +/* 0x59 */ "COMPILER_UNASSIGNED_P_TRAP_RESTART", \ +/* 0x5A */ "COMPILER_CACHE_ASSIGNMENT_RESTART" \ +} diff --git a/v8/src/microcode/utabmd.scm b/v8/src/microcode/utabmd.scm index 8cee1e066..4546f4db2 100644 --- a/v8/src/microcode/utabmd.scm +++ b/v8/src/microcode/utabmd.scm @@ -37,7 +37,7 @@ ;;;; Machine Dependent Type Tables -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.40 1987/12/13 22:47:00 cph Rel $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.41 1988/02/06 20:43:02 jinx Exp $ (declare (usual-integrations)) @@ -511,6 +511,9 @@ BROKEN-VARIABLE-CACHE ;35 WRONG-ARITY-PRIMITIVES ;36 IO-ERROR ;37 + FASDUMP-ENVIRONMENT ;38 + FASLOAD-BAND ;39 + FASLOAD-COMPILED-MISMATCH ;3A )) ;;; [] Terminations @@ -566,4 +569,4 @@ ;;; This identification string is saved by the system. -"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.40 1987/12/13 22:47:00 cph Rel $" \ No newline at end of file +"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.41 1988/02/06 20:43:02 jinx Exp $" \ No newline at end of file diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h index f32c32db5..0ff5327bb 100644 --- a/v8/src/microcode/version.h +++ b/v8/src/microcode/version.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/version.h,v 10.19 1988/01/04 22:26:40 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.20 1988/02/06 20:43:29 jinx Exp $ This file contains version information for the microcode. */ @@ -46,7 +46,7 @@ This file contains version information for the microcode. */ #define VERSION 10 #endif #ifndef SUBVERSION -#define SUBVERSION 19 +#define SUBVERSION 20 #endif #ifndef UCODE_TABLES_FILENAME -- 2.25.1