From b37696f4877f0632a700a15735cf3b3f585e13b7 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Mon, 27 Mar 1989 23:17:29 +0000 Subject: [PATCH] Trap recovery has been changed. The microcode attempts to determine how much state is valid and then saves all the pertinent information (pc, registers, etc) so that the context of the trap and the rest of the stack can be examined from scheme. Primitives for reading/setting/enabling the keyboard interrupt characters have been added. There is now a single C keyboard interrupt handler which dispatches according to the signal received and what the current handler is supposed to do. Scheme tty input has been rewritten for the NTH time. reader_context and reader_state structures have been merged. --- v7/src/microcode/bchmmg.c | 4 +- v7/src/microcode/bchpur.c | 7 ++- v7/src/microcode/bkpt.h | 4 +- v7/src/microcode/boot.c | 8 +-- v7/src/microcode/config.h | 43 ++++++++++----- v7/src/microcode/const.h | 3 +- v7/src/microcode/default.h | 11 ++-- v7/src/microcode/errors.h | 15 +++--- v7/src/microcode/fasload.c | 100 +++++++++++++++++++--------------- v7/src/microcode/fixobj.h | 79 +++++++++++++++------------ v7/src/microcode/hooks.c | 34 ++++++++---- v7/src/microcode/interp.c | 37 +++++++++++-- v7/src/microcode/interp.h | 10 ++-- v7/src/microcode/intrpt.h | 65 +++++++++++++++++++++- v7/src/microcode/memmag.c | 6 ++- v7/src/microcode/purify.c | 5 +- v7/src/microcode/purutl.c | 105 ++++++++++++++++++++++++++---------- v7/src/microcode/returns.h | 10 ++-- v7/src/microcode/sysprim.c | 17 +++++- v7/src/microcode/utabmd.scm | 11 ++-- v7/src/microcode/utils.c | 13 +++-- v7/src/microcode/version.h | 6 +-- v8/src/microcode/const.h | 3 +- v8/src/microcode/fixobj.h | 79 +++++++++++++++------------ v8/src/microcode/interp.c | 37 +++++++++++-- v8/src/microcode/returns.h | 10 ++-- v8/src/microcode/utabmd.scm | 11 ++-- v8/src/microcode/version.h | 6 +-- 28 files changed, 511 insertions(+), 228 deletions(-) diff --git a/v7/src/microcode/bchmmg.c b/v7/src/microcode/bchmmg.c index edc152f94..3e02a3603 100644 --- a/v7/src/microcode/bchmmg.c +++ b/v7/src/microcode/bchmmg.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/bchmmg.c,v 9.42 1988/08/15 20:36:24 cph Exp $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.43 1989/03/27 23:13:56 jinx Exp $ */ /* Memory management top level. Garbage collection to disk. @@ -862,12 +862,14 @@ DEFINE_PRIMITIVE ("GARBAGE-COLLECT", Prim_garbage_collect, 1, 1, 0) Microcode_Termination(TERM_GC_OUT_OF_SPACE); /*NOTREACHED*/ } + ENTER_CRITICAL_SECTION ("garbage collector"); gc_counter += 1; GC_Reserve = Get_Integer(Arg1); GC(EMPTY_LIST); CLEAR_INTERRUPT(INT_GC); Pop_Primitive_Frame(1); GC_Daemon_Proc = Get_Fixed_Obj_Slot(GC_Daemon); + RENAME_CRITICAL_SECTION ("garbage collector daemon"); if (GC_Daemon_Proc == SHARP_F) { Will_Push(CONTINUATION_SIZE); diff --git a/v7/src/microcode/bchpur.c b/v7/src/microcode/bchpur.c index 6df4b4c58..b36b2489b 100644 --- a/v7/src/microcode/bchpur.c +++ b/v7/src/microcode/bchpur.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.41 1988/08/15 20:36:35 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.42 1989/03/27 23:14:03 jinx Exp $ Copyright (c) 1987, 1988 Massachusetts Institute of Technology @@ -495,6 +495,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_primitive_purify, 3, 3, 0) Arg_3_Type(TC_FIXNUM); Touch_In_Primitive(Arg1, object); GC_Reserve = (Get_Integer (Arg3)); + ENTER_CRITICAL_SECTION ("purify"); { Pointer purify_result; Pointer words_free; @@ -510,12 +511,14 @@ DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_primitive_purify, 3, 3, 0) if (daemon == SHARP_F) { Val = result; + EXIT_CRITICAL_SECTION ({}); PRIMITIVE_ABORT(PRIM_POP_RETURN); /*NOTREACHED*/ } + RENAME_CRITICAL_SECTION ("purify daemon"); Will_Push(CONTINUATION_SIZE + (STACK_ENV_EXTRA_SLOTS + 1)); Store_Expression(result); - Store_Return(RC_RESTORE_VALUE); + Store_Return(RC_NORMAL_GC_DONE); Save_Cont(); Push(daemon); Push(STACK_FRAME_HEADER); diff --git a/v7/src/microcode/bkpt.h b/v7/src/microcode/bkpt.h index d1be99924..a34e64907 100644 --- a/v7/src/microcode/bkpt.h +++ b/v7/src/microcode/bkpt.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/bkpt.h,v 9.25 1988/08/15 20:37:43 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bkpt.h,v 9.26 1989/03/27 23:14:08 jinx Rel $ * * This file contains breakpoint utilities. * Disabled when not debugging the interpreter. @@ -96,7 +96,7 @@ void Clear_Perfinfo_Data() long Start_Time; Start_Time = Sys_Clock(); - Loc = Apply_Primitive(prim); + APPLY_PRIMITIVE(Loc, prim); perfinfo_data.primtime[PRIMITIVE_NUMBER(prim)] += (Sys_Clock() - Start_Time); Set_Time_Zone(Zone_Working); diff --git a/v7/src/microcode/boot.c b/v7/src/microcode/boot.c index 442fc7a72..44517ba42 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.53 1988/10/21 18:20:51 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.54 1989/03/27 23:14:13 jinx Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -51,7 +51,6 @@ MIT in each case. */ {-stack stack-size} {-constant constant-size} {-utabmd utab-filename} or {-utab utab-filename} - {-recover} {other arguments ignored by the core microcode} with filespec either {-band band-name} or {-fasl file-name} or @@ -172,8 +171,6 @@ Def_Number(key, nargs, args, def) extern Boolean Was_Scheme_Dumped; Boolean Was_Scheme_Dumped = false; -extern Boolean Recover_Automatically; -Boolean Recover_Automatically = false; Boolean inhibit_termination_messages; int Saved_Heap_Size; int Saved_Stack_Size; @@ -200,9 +197,6 @@ find_image_parameters(file_name, cold_load_p, supplied_p) *cold_load_p = false; *file_name = DEFAULT_BAND_NAME; - Recover_Automatically = - (Parse_Option("-recover", Saved_argc, Saved_argv, true) != NOT_THERE); - if (!Was_Scheme_Dumped) { Heap_Size = HEAP_SIZE; diff --git a/v7/src/microcode/config.h b/v7/src/microcode/config.h index c3ad10676..0172d4123 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.41 1989/02/19 17:51:33 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/config.h,v 9.42 1989/03/27 23:14:36 jinx Exp $ * * This file contains the configuration information and the information * given on the command line on Unix. @@ -217,6 +217,7 @@ typedef unsigned long Pointer; */ #ifdef pdp10 +#define MACHINE_TYPE "pdp10" #define Heap_In_Low_Memory #define CHAR_SIZE 36 / * Ugh! Supposedly fixed in newer Cs * / #define BELL '\007' @@ -224,6 +225,7 @@ typedef unsigned long Pointer; #endif #ifdef nu +#define MACHINE_TYPE "nu" #define Heap_In_Low_Memory #define CHAR_SIZE 8 #define USHORT_SIZE 16 @@ -247,6 +249,7 @@ typedef unsigned long Pointer; /* Amazingly unix and vms agree on all these */ +#define MACHINE_TYPE "vax" #define Heap_In_Low_Memory #define UNSIGNED_SHIFT #define VAX_BYTE_ORDER @@ -278,7 +281,7 @@ typedef unsigned long Pointer; #if (VMS_VERSION < 4) /* Pre version 4 VMS has no void type. */ #define void -#endif +#endif /* VMS_VERSION */ /* This eliminates a spurious warning from the C compiler. */ #define main_type @@ -301,7 +304,7 @@ if (value != 0) \ exit(value); \ longjmp(Exit_Point, NORMAL_EXIT) -#else /* not a vms, therefore unix */ +#else /* not VMS ie. unix */ /* Vax Unix C compiler bug */ @@ -312,10 +315,11 @@ longjmp(Exit_Point, NORMAL_EXIT) target = Make_Non_Pointer(TC_FIXNUM, For_Vaxes_Sake); \ } -#endif /* not vms */ +#endif /* VMS */ #endif /* vax */ #ifdef hp9000s200 /* and s300, pretty indistinguishable */ +#define MACHINE_TYPE "hp9000s200" #define Heap_In_Low_Memory #define UNSIGNED_SHIFT #define CHAR_SIZE 8 @@ -337,6 +341,7 @@ longjmp(Exit_Point, NORMAL_EXIT) #endif #ifdef hp9000s500 +#define MACHINE_TYPE "hp9000s500" /* An unfortunate fact of life on this machine: the C heap is in high memory thus Heap_In_Low_Memory is not defined and the whole thing runs slowly. *Sigh* @@ -373,15 +378,18 @@ longjmp(Exit_Point, NORMAL_EXIT) #define MAX_FLONUM_EXPONENT 1023 #ifdef sun4 +#define MACHINE_TYPE "sun4" #define FASL_INTERNAL_FORMAT FASL_SUN4 #define FLOATING_ALIGNMENT 0x7 /* Low 3 MBZ for float storage */ #endif #ifdef sun3 +#define MACHINE_TYPE "sun3" #define FASL_INTERNAL_FORMAT FASL_68020 #endif #ifndef FASL_INTERNAL_FORMAT +#define MACHINE_TYPE "sun2" #define FASL_INTERNAL_FORMAT FASL_68000 #endif @@ -397,6 +405,7 @@ longjmp(Exit_Point, NORMAL_EXIT) #endif #ifdef butterfly +#define MACHINE_TYPE "butterfly" #define Heap_In_Low_Memory #define CHAR_SIZE 8 #define USHORT_SIZE 16 @@ -412,6 +421,7 @@ longjmp(Exit_Point, NORMAL_EXIT) #endif #ifdef cyber180 +#define MACHINE_TYPE "cyber180" /* Word size is 64 bits. */ #define Heap_In_Low_Memory #define CHAR_SIZE 8 @@ -429,6 +439,7 @@ longjmp(Exit_Point, NORMAL_EXIT) #endif #ifdef celerity +#define MACHINE_TYPE "celerity" #define Heap_In_Low_Memory #define UNSIGNED_SHIFT #define CHAR_SIZE 8 @@ -446,6 +457,7 @@ longjmp(Exit_Point, NORMAL_EXIT) in the second MSBit. This is taken care of in object.h, and is still considered Heap_In_Low_Memory. */ +#define MACHINE_TYPE "hp9000s800" #define Heap_In_Low_Memory #define UNSIGNED_SHIFT #define CHAR_SIZE 8 @@ -462,6 +474,7 @@ longjmp(Exit_Point, NORMAL_EXIT) #endif #ifdef umax +#define MACHINE_TYPE "umax" #define Heap_In_Low_Memory #define UNSIGNED_SHIFT #define CHAR_SIZE 8 @@ -477,19 +490,21 @@ longjmp(Exit_Point, NORMAL_EXIT) #endif #ifdef pyr +#define MACHINE_TYPE "pyramid" #define Heap_In_Low_Memory #define UNSIGNED_SHIFT -#define CHAR_SIZE 8 -#define USHORT_SIZE 16 -#define ULONG_SIZE 32 -#define BELL '\007' -#define FASL_INTERNAL_FORMAT FASL_PYR -#define FLONUM_EXPT_SIZE 10 -#define FLONUM_MANTISSA_BITS 53 -#define MAX_FLONUM_EXPONENT 1023 +#define CHAR_SIZE 8 +#define USHORT_SIZE 16 +#define ULONG_SIZE 32 +#define BELL '\007' +#define FASL_INTERNAL_FORMAT FASL_PYR +#define FLONUM_EXPT_SIZE 10 +#define FLONUM_MANTISSA_BITS 53 +#define MAX_FLONUM_EXPONENT 1023 #endif #ifdef alliant +#define MACHINE_TYPE "alliant" #define Heap_In_Low_Memory #define UNSIGNED_SHIFT #define CHAR_SIZE 8 @@ -516,6 +531,10 @@ longjmp(Exit_Point, NORMAL_EXIT) #if (ULONG_SIZE == 32) #define b32 #endif + +#ifndef MACHINE_TYPE +#define MACHINE_TYPE "unknown" +#endif /* Default "segment" sizes */ diff --git a/v7/src/microcode/const.h b/v7/src/microcode/const.h index 5d129bc2c..ec1b4bcb1 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.29 1988/08/15 20:44:34 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/const.h,v 9.30 1989/03/27 23:14:42 jinx Exp $ * * Named constants used throughout the interpreter * @@ -167,6 +167,7 @@ MIT in each case. */ #define REGBLOCK_RETURN 6 #define REGBLOCK_LEXPR_ACTUALS 7 #define REGBLOCK_MINIMUM_LENGTH 8 +#define REGBLOCK_PRIMITIVE 9 /* Codes specifying how to start scheme at boot time. */ diff --git a/v7/src/microcode/default.h b/v7/src/microcode/default.h index 87e6aedc4..5b5fa9a53 100644 --- a/v7/src/microcode/default.h +++ b/v7/src/microcode/default.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/default.h,v 9.30 1988/08/09 19:27:45 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/default.h,v 9.31 1989/03/27 23:14:47 jinx Rel $ * * This file contains default definitions for some hooks which * various machines require. These machines define these hooks @@ -236,14 +236,17 @@ do \ /* Primitive calling code. */ #ifndef ENABLE_DEBUGGING_TOOLS -#define Apply_Primitive(N) Internal_Apply_Primitive(N) +#define APPLY_PRIMITIVE INTERNAL_APPLY_PRIMITIVE #else extern Pointer Apply_Primitive(); +#define APPLY_PRIMITIVE(Loc, N) \ +{ \ + Loc = Apply_Primitive(N); \ +} #endif #ifndef Metering_Apply_Primitive -#define Metering_Apply_Primitive(Loc, N) \ -Loc = Apply_Primitive(N) +#define Metering_Apply_Primitive APPLY_PRIMITIVE #endif #ifndef Eval_Ucode_Hook diff --git a/v7/src/microcode/errors.h b/v7/src/microcode/errors.h index 7a158182a..b0abb61b3 100644 --- a/v7/src/microcode/errors.h +++ b/v7/src/microcode/errors.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987, 1988 Massachusetts Institute of Technology +Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -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.31 1988/08/15 20:45:29 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/errors.h,v 9.32 1989/03/27 23:14:52 jinx Exp $ * * Error and termination code declarations. * @@ -173,7 +173,7 @@ MIT in each case. */ /* 0x37 */ "IO-ERROR", \ /* 0x38 */ "FASDUMP-ENVIRONMENT", \ /* 0x39 */ "FASLOAD-BAND", \ -/* 0x40 */ "FASLOAD-COMPILED-MISMATCH" \ +/* 0x3A */ "FASLOAD-COMPILED-MISMATCH" \ } /* Termination codes: the interpreter halts on these */ @@ -204,13 +204,14 @@ MIT in each case. */ #define TERM_TOUCH 0x17 #define TERM_SAVE_AND_EXIT 0x18 #define TERM_TRAP 0x19 +#define TERM_BAD_BACK_OUT 0x20 /* If you add any termination codes here, add them to the tables below as well! */ -#define MAX_TERMINATION 0x19 +#define MAX_TERMINATION 0x20 #define TERM_NAME_TABLE \ { \ @@ -239,7 +240,8 @@ MIT in each case. */ /* 0x16 */ "SIGNAL", \ /* 0x17 */ "TOUCH", \ /* 0x18 */ "SAVE-AND-EXIT", \ -/* 0x19 */ "TERM_TRAP" \ +/* 0x19 */ "TERM_TRAP", \ +/* 0x20 */ "BAD_BACK_OUT" \ } #define TERM_MESSAGE_TABLE \ @@ -269,5 +271,6 @@ MIT in each case. */ /* 0x16 */ "Unhandled signal received", \ /* 0x17 */ "Touch without futures support", \ /* 0x18 */ "Halt requested by external source", \ -/* 0x19 */ "User requested termination after trap" \ +/* 0x19 */ "User requested termination after trap", \ +/* 0x20 */ "Backing out of non-primitive" \ } diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c index 5a53878be..f083f47bc 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.38 1988/09/29 04:57:52 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.39 1989/03/27 23:14:58 jinx Exp $ The "fast loader" which reads in and relocates binary files and then interns symbols. It is called with one argument: the (character @@ -688,7 +688,10 @@ compiler_reset_error() */ #ifndef start_band_load -#define start_band_load() +#define start_band_load() \ +{ \ + ENTER_CRITICAL_SECTION ("band load"); \ +} #endif #ifndef end_band_load @@ -708,15 +711,17 @@ compiler_reset_error() } \ } \ } \ + EXIT_CRITICAL_SECTION ({}); \ } #endif - + DEFINE_PRIMITIVE ("LOAD-BAND", Prim_band_load, 1, 1, 0) { extern char *malloc(); extern strcpy(), free(); extern void compiler_reset(); extern Pointer compiler_utilities; + static void terminate_band_load(); jmp_buf swapped_buf, @@ -729,8 +734,9 @@ DEFINE_PRIMITIVE ("LOAD-BAND", Prim_band_load, 1, 1, 0) long temp, length; Pointer result, cutl; char *band_name; + Boolean load_file_failed; Primitive_1_Arg(); - + saved_free = Free; Free = Heap_Bottom; saved_memtop = MemTop; @@ -771,47 +777,21 @@ DEFINE_PRIMITIVE ("LOAD-BAND", Prim_band_load, 1, 1, 0) strcpy(band_name, Scheme_String_To_C_String(Arg1)); } - /* There is some jiggery-pokery going on here to make sure - that all returns from Fasload (including error exits) return to - the clean-up code before returning on up the C call stack. - */ - - saved_buf = Back_To_Eval; - temp = setjmp(swapped_buf); - if (temp != 0) - { - 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]); - } + load_file_failed = true; - if (band_name != ((char *) NULL)) - { - fprintf(stderr, "band-name = \"%s\".\n", band_name); - free(band_name); - } - end_band_load(false, true); - Back_To_Eval = saved_buf; - Microcode_Termination(TERM_DISK_RESTORE); - /*NOTREACHED*/ - } + UNWIND_PROTECT({ + result = load_file(true); + load_file_failed = false; + }, + { + if (load_file_failed) + { + terminate_band_load(UNWIND_PROTECT_value, + band_name); + /*NOTREACHED*/ + } + }); - Back_To_Eval = ((jmp_buf *) swapped_buf); - result = load_file(true); - Back_To_Eval = saved_buf; - if (reload_band_name != ((char *) NULL)) { free(reload_band_name); @@ -842,7 +822,7 @@ DEFINE_PRIMITIVE ("LOAD-BAND", Prim_band_load, 1, 1, 0) Store_Return(RC_END_OF_COMPUTATION); Store_Expression(NIL); Save_Cont(); - + Store_Expression(Vector_Ref(result, 0)); Store_Env(Make_Non_Pointer(GLOBAL_ENV, GO_TO_GLOBAL)); @@ -862,6 +842,38 @@ DEFINE_PRIMITIVE ("LOAD-BAND", Prim_band_load, 1, 1, 0) PRIMITIVE_ABORT(PRIM_DO_EXPRESSION); /*NOTREACHED*/ } + +static void +terminate_band_load(abort_value, band_name) + int abort_value; + char *band_name; +{ + extern char + * Error_Names[], + * Abort_Names[]; + + if (abort_value > 0) + { + fprintf(stderr, + "\nload-band: Error %d (%s) past the point of no return.\n", + abort_value, Error_Names[abort_value]); + } + else + { + fprintf(stderr, + "\nload-band: Abort %d (%s) past the point of no return.\n", + abort_value, Abort_Names[(-abort_value)-1]); + } + + if (band_name != ((char *) NULL)) + { + fprintf(stderr, "band-name = \"%s\".\n", band_name); + free(band_name); + } + end_band_load(false, true); + Microcode_Termination(TERM_DISK_RESTORE); + /*NOTREACHED*/ +} #ifdef BYTE_INVERSION diff --git a/v7/src/microcode/fixobj.h b/v7/src/microcode/fixobj.h index 3b2de14f1..2a559bdc9 100644 --- a/v7/src/microcode/fixobj.h +++ b/v7/src/microcode/fixobj.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987, 1988 Massachusetts Institute of Technology +Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,47 +30,56 @@ 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/fixobj.h,v 9.26 1988/08/15 20:47:07 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fixobj.h,v 9.27 1989/03/27 23:15:06 jinx Rel $ * * Declarations of user offsets into the Fixed Objects Vector. * This should correspond to the file UTABMD.SCM */ -#define Non_Object 0x00 /* Used for unassigned variables */ -#define System_Interrupt_Vector 0x01 /* Handlers for interrups */ -#define System_Error_Vector 0x02 /* Handlers for errors */ -#define OBArray 0x03 /* Array for interning symbols */ -#define Types_Vector 0x04 /* Type number -> Name map */ -#define Returns_Vector 0x05 /* Return code -> Name map */ -#define Primitives_Vector 0x06 /* Primitive code -> Name map */ -#define Errors_Vector 0x07 /* Error code -> Name map */ -#define Identification_Vector 0x08 /* ID Vector index -> name map */ -#define GC_Daemon 0x0B /* Procedure to run after GC */ -#define Trap_Handler 0x0C /* Continue after disaster */ -#define Stepper_State 0x0E /* NOT IMPLEMENTED YET */ -#define Fixed_Objects_Slots 0x0F /* Names of these slots */ -#define External_Primitives 0x10 /* Names of external prims */ -#define State_Space_Tag 0x11 /* Tag for state spaces */ -#define State_Point_Tag 0x12 /* Tag for state points */ -#define Dummy_History 0x13 /* Empty history structure */ -#define Bignum_One 0x14 /* Cache for bignum one */ -#define System_Scheduler 0x15 /* Scheduler for touched futures */ -#define Termination_Vector 0x16 /* Names for terminations */ -#define Termination_Proc_Vector 0x17 /* Handlers for terminations */ -#define Me_Myself 0x18 /* The actual shared vector */ -/* The next slot is used only in multiprocessor mode */ -#define The_Work_Queue 0x19 /* Where work is stored */ -/* These two slots are only used if logging futures */ -#define Future_Logger 0x1A /* Routine to log touched futures */ -#define Touched_Futures 0x1B /* Vector of touched futures */ +#define Non_Object 0x00 /* Used for unassigned variables. */ +#define System_Interrupt_Vector 0x01 /* Handlers for interrups. */ +#define System_Error_Vector 0x02 /* Handlers for errors. */ +#define OBArray 0x03 /* Array for interning symbols. */ +#define Types_Vector 0x04 /* Type number -> Name map. */ +#define Returns_Vector 0x05 /* Return code -> Name map. */ +#define Primitives_Vector 0x06 /* Primitive code -> Name map. */ +#define Errors_Vector 0x07 /* Error code -> Name map. */ +#define Identification_Vector 0x08 /* ID Vector index -> name map. */ +/* UNUSED slot 0x09 */ +/* UNUSED slot 0x0A */ +#define GC_Daemon 0x0B /* Procedure to run after GC. */ +#define Trap_Handler 0x0C /* Abort after disaster. */ +/* UNUSED slot 0x0D */ +#define Stepper_State 0x0E /* UNUSED in CScheme. */ +#define Fixed_Objects_Slots 0x0F /* Names of these slots. */ +/* UNUSED slot 0x10 used to be + External_Primitives Names of external prims. */ +#define State_Space_Tag 0x11 /* Tag for state spaces. */ +#define State_Point_Tag 0x12 /* Tag for state points. */ +#define Dummy_History 0x13 /* Empty history structure. */ +#define Bignum_One 0x14 /* Cache for bignum one. */ +#define System_Scheduler 0x15 /* MultiScheme: + Scheduler for touched futures. */ +#define Termination_Vector 0x16 /* Names for terminations. */ +#define Termination_Proc_Vector 0x17 /* Handlers for terminations. */ +#define Me_Myself 0x18 /* MultiScheme: + The shared fixed objects vector. */ +#define The_Work_Queue 0x19 /* MultiScheme: + Where work is stored. */ +#define Future_Logger 0x1A /* MultiScheme: When logging futures, + routine to log touched futures. */ +#define Touched_Futures 0x1B /* MultiScheme: When logging futures, + vector of touched futures. */ #define Precious_Objects 0x1C /* Objects that should not be lost! */ -#define Error_Procedure 0x1D /* User invoked error handler */ -#define Unsnapped_Link 0x1E /* Handler for call to compiled code */ -#define Utilities_Vector 0x1F /* ??? */ -#define Compiler_Err_Procedure 0x20 /* ??? */ +#define Error_Procedure 0x1D /* User invoked error handler. */ +#define Unsnapped_Link 0x1E /* UNUSED in CScheme. */ +#define Utilities_Vector 0x1F /* UNUSED in CScheme. */ +#define Compiler_Err_Procedure 0x20 /* User invoked error handler + from compiled code. */ #define Lost_Objects_Base 0x21 /* Free at the end of the "real" gc. */ -#define State_Space_Root 0x22 /* Root of state space */ -#define Primitive_Profiling_Table 0x23 /* Table of profile counts for primitives. */ +#define State_Space_Root 0x22 /* Root of state space. */ +#define Primitive_Profiling_Table 0x23 /* Table of profile counts for + primitives. */ #define NFixed_Objects 0x24 diff --git a/v7/src/microcode/hooks.c b/v7/src/microcode/hooks.c index 9344fb03b..69f0de265 100644 --- a/v7/src/microcode/hooks.c +++ b/v7/src/microcode/hooks.c @@ -1,6 +1,8 @@ /* -*-C-*- -Copyright (c) 1988 Massachusetts Institute of Technology +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/hooks.c,v 9.35 1989/03/27 23:15:12 jinx Exp $ + +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,8 +32,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/hooks.c,v 9.34 1988/12/08 10:48:14 cph Exp $ - * +/* * This file contains various hooks and handles which connect the * primitives with the main interpreter. */ @@ -265,19 +266,34 @@ DEFINE_PRIMITIVE ("NON-REENTRANT-CALL-WITH-CURRENT-CONTINUATION", Prim_non_reent /*NOTREACHED*/ } +/* (DISABLE-INTERRUPTS! INTERRUPTS) + Disables the interrupts specified by INTERRUPTS. These interrupts + will trigger when the corresponding bits are enabled by ENABLE-INTERRUPTS!, + SET-INTERRUPT-ENABLES!, WITH-INTERRUPT-MASK, or a throw. + See intrpt.h for more information on interrupts. +*/ +DEFINE_PRIMITIVE ("DISABLE-INTERRUPTS!", Prim_disable_interrupts, 1, 1, 0) +{ + long previous; + PRIMITIVE_HEADER (1); + + previous = (FETCH_INTERRUPT_MASK ()); + SET_INTERRUPT_MASK (previous & (~((arg_fixnum (1)) & INT_Mask))); + PRIMITIVE_RETURN (MAKE_SIGNED_FIXNUM (previous)); +} + /* (ENABLE-INTERRUPTS! INTERRUPTS) - Changes the enabled interrupt bits to bitwise-or of INTERRUPTS - and previous value of interrupts. Returns the previous value. - See MASK_INTERRUPT_ENABLES for more information on interrupts. + Enables the interrupts specified by INTERRUPTS. At the next interrupt + point, any pending interrupts which were previously disabled will trigger. + See intrpt.h for more information on interrupts. */ DEFINE_PRIMITIVE ("ENABLE-INTERRUPTS!", Prim_enable_interrupts, 1, 1, 0) { long previous; - Primitive_1_Arg (); + PRIMITIVE_HEADER (1); - Arg_1_Type (TC_FIXNUM); previous = (FETCH_INTERRUPT_MASK ()); - SET_INTERRUPT_MASK (((Get_Integer (Arg1)) & INT_Mask) | previous); + SET_INTERRUPT_MASK (previous | ((arg_fixnum (1)) & INT_Mask)); PRIMITIVE_RETURN (MAKE_SIGNED_FIXNUM (previous)); } diff --git a/v7/src/microcode/interp.c b/v7/src/microcode/interp.c index 87ae0d6ff..c5eb997db 100644 --- a/v7/src/microcode/interp.c +++ b/v7/src/microcode/interp.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -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/interp.c,v 9.47 1988/11/10 06:14:18 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.48 1989/03/27 23:15:19 jinx Exp $ * * This file contains the heart of the Scheme Scode * interpreter @@ -1296,13 +1296,36 @@ external_assignment_return: Import_Registers_Except_Val(); break; #endif - + case RC_HALT: Export_Registers(); Microcode_Termination(TERM_TERM_HANDLER); - + case RC_HARDWARE_TRAP: + { + /* This just reinvokes the handler */ + + Pointer info, handler; + info = (STACK_REF (0)); + + Save_Cont(); + if ((! (Valid_Fixed_Obj_Vector())) || + ((handler = (Get_Fixed_Obj_Slot(Trap_Handler))) == SHARP_F)) + { + fprintf(stderr, "There is no trap handler for recovery!\n"); + Microcode_Termination(TERM_TRAP); + /*NOTREACHED*/ + } + Will_Push(STACK_ENV_EXTRA_SLOTS + 2); + Push(info); + Push(handler); + Push(STACK_FRAME_HEADER + 1); + Pushed(); + goto Internal_Apply; + } + /* Internal_Apply, the core of the application mechanism. + Branch here to perform a function application. At this point the top of the stack contains an application frame @@ -1808,6 +1831,7 @@ return_from_compiled_code: Microcode_Termination(TERM_GC_OUT_OF_SPACE); } GC_Space_Needed = 0; + EXIT_CRITICAL_SECTION ({ Save_Cont(); Export_Registers(); }); End_GC_Hook(); break; @@ -1914,6 +1938,7 @@ Primitive_Internal_Apply: { Pointer GC_Daemon_Proc, Result; + RENAME_CRITICAL_SECTION ("purify pass 2"); Export_Registers(); Result = Purify_Pass_2(Fetch_Expression()); Import_Registers(); @@ -1923,14 +1948,17 @@ Primitive_Internal_Apply: There is no need to run the daemons, and we should let the runtime system know what happened. */ RESULT_OF_PURIFY (NIL); + EXIT_CRITICAL_SECTION ({ Export_Registers(); }); break; } GC_Daemon_Proc = Get_Fixed_Obj_Slot(GC_Daemon); if (GC_Daemon_Proc == NIL) { RESULT_OF_PURIFY (SHARP_T); + EXIT_CRITICAL_SECTION ({ Export_Registers(); }); break; } + RENAME_CRITICAL_SECTION( "purify daemon 2"); Store_Expression(NIL); Store_Return(RC_PURIFY_GC_2); Save_Cont(); @@ -1943,6 +1971,7 @@ Primitive_Internal_Apply: case RC_PURIFY_GC_2: RESULT_OF_PURIFY (SHARP_T); + EXIT_CRITICAL_SECTION ({ Export_Registers(); }); break; case RC_REPEAT_DISPATCH: diff --git a/v7/src/microcode/interp.h b/v7/src/microcode/interp.h index 63785a947..c633afa35 100644 --- a/v7/src/microcode/interp.h +++ b/v7/src/microcode/interp.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/interp.h,v 9.30 1988/08/15 20:50:22 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.h,v 9.31 1989/03/27 23:15:28 jinx Rel $ * * Macros used by the interpreter and some utilities. * @@ -260,8 +260,12 @@ MIT in each case. */ not implemented. */ -#define Internal_Apply_Primitive(primitive) \ -((*(Primitive_Procedure_Table[PRIMITIVE_TABLE_INDEX(primitive)]))()) +#define INTERNAL_APPLY_PRIMITIVE(loc, primitive) \ +{ \ + Regs[REGBLOCK_PRIMITIVE] = primitive; \ + loc = ((*(Primitive_Procedure_Table[PRIMITIVE_TABLE_INDEX(primitive)]))()); \ + Regs[REGBLOCK_PRIMITIVE] = NIL; \ +} /* This is only valid for implemented primitives. */ diff --git a/v7/src/microcode/intrpt.h b/v7/src/microcode/intrpt.h index ef4a14e82..6347d3a24 100644 --- a/v7/src/microcode/intrpt.h +++ b/v7/src/microcode/intrpt.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/intrpt.h,v 1.4 1988/08/15 20:50:33 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/intrpt.h,v 1.5 1989/03/27 23:15:34 jinx Exp $ * * Interrupt manipulation utilities. */ @@ -107,3 +107,66 @@ MIT in each case. */ /* Compatibility */ #define COMPILER_SET_MEMTOP() COMPILER_SETUP_INTERRUPT() + +/* Critical sections. + + There should be a stack of critical sections, each with a + queue of hooks. + */ + +extern char * critical_section_name; +extern Boolean critical_section_hook_p; +extern void (*critical_section_hook)(); + +#define DECLARE_CRITICAL_SECTION() \ + char * critical_section_name = ((char *) NULL); \ + Boolean critical_section_hook_p; \ + void (*critical_section_hook)() + +#define ENTER_CRITICAL_SECTION(name) \ +{ \ + critical_section_name = (name); \ +} + +#define RENAME_CRITICAL_SECTION(name) \ +{ \ + critical_section_name = (name); \ +} + +#define EXIT_CRITICAL_SECTION(code_if_hook) \ +{ \ + if (critical_section_hook_p) \ + { \ + code_if_hook; \ + { \ + char * name; \ + \ + name = critical_section_name; \ + critical_section_hook_p = false; \ + critical_section_name = ((char *) NULL); \ + critical_section_hook (name); \ + /*NOTREACHED*/ \ + } \ + } \ + else \ + { \ + critical_section_name = ((char *) NULL); \ + } \ +} + +#define SET_CRITICAL_SECTION_HOOK(hook) \ +{ \ + critical_section_hook = (hook); \ + critical_section_hook_p = true; \ +} + +#define CLEAR_CRITICAL_SECTION_HOOK() \ +{ \ + critical_section_hook_p = false; \ +} + +#define WITHIN_CRITICAL_SECTION_P() \ + (critical_section_name != ((char *) NULL)) + +#define CRITICAL_SECTION_NAME() \ + (critical_section_name) diff --git a/v7/src/microcode/memmag.c b/v7/src/microcode/memmag.c index e5bd4f7aa..d28c7b160 100644 --- a/v7/src/microcode/memmag.c +++ b/v7/src/microcode/memmag.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/memmag.c,v 9.35 1988/08/15 20:51:50 cph Exp $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/memmag.c,v 9.36 1989/03/27 23:15:41 jinx Exp $ */ /* Memory management top level. @@ -393,6 +393,7 @@ DEFINE_PRIMITIVE ("GARBAGE-COLLECT", Prim_garbage_collect, 1, 1, 0) Free, MemTop, Heap_Top); Microcode_Termination(TERM_NO_SPACE); } + ENTER_CRITICAL_SECTION ("garbage collector"); gc_counter += 1; GC_Reserve = Get_Integer(Arg1); GCFlip(); @@ -400,7 +401,8 @@ DEFINE_PRIMITIVE ("GARBAGE-COLLECT", Prim_garbage_collect, 1, 1, 0) CLEAR_INTERRUPT(INT_GC); Pop_Primitive_Frame(1); GC_Daemon_Proc = Get_Fixed_Obj_Slot(GC_Daemon); - if (GC_Daemon_Proc == NIL) + RENAME_CRITICAL_SECTION ("garbage collector daemon"); + if (GC_Daemon_Proc == SHARP_F) { Will_Push(CONTINUATION_SIZE); Store_Return(RC_NORMAL_GC_DONE); diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c index 3ab8e4c1f..22ef48cd3 100644 --- a/v7/src/microcode/purify.c +++ b/v7/src/microcode/purify.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/purify.c,v 9.36 1988/08/15 20:53:30 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.37 1989/03/27 23:15:46 jinx Exp $ * * This file contains the code that copies objects into pure * and constant space. @@ -515,6 +515,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_primitive_purify, 3, 3, 0) Touch_In_Primitive(Arg1, Object); GC_Reserve = (Get_Integer (Arg3)); + ENTER_CRITICAL_SECTION ("purify pass 1"); Purify_Result = Purify(Object, Arg2); Pop_Primitive_Frame(3); Daemon = Get_Fixed_Obj_Slot(GC_Daemon); @@ -522,6 +523,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_primitive_purify, 3, 3, 0) { Pointer words_free; + RENAME_CRITICAL_SECTION ("purify pass 2"); Purify_Result = Purify_Pass_2(Purify_Result); words_free = (Make_Unsigned_Fixnum (MemTop - Free)); Val = (Make_Pointer (TC_LIST, Free)); @@ -530,6 +532,7 @@ DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_primitive_purify, 3, 3, 0) PRIMITIVE_ABORT(PRIM_POP_RETURN); /*NOTREACHED*/ } + RENAME_CRITICAL_SECTION ("purify daemon 1"); Store_Expression(Purify_Result); Store_Return(RC_PURIFY_GC_1); Will_Push(CONTINUATION_SIZE + STACK_ENV_EXTRA_SLOTS + 1); diff --git a/v7/src/microcode/purutl.c b/v7/src/microcode/purutl.c index 929ea5ce2..84132c27e 100644 --- a/v7/src/microcode/purutl.c +++ b/v7/src/microcode/purutl.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987, 1988 Massachusetts Institute of Technology +Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -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/purutl.c,v 9.34 1988/08/15 20:53:42 cph Exp $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purutl.c,v 9.35 1989/03/27 23:15:52 jinx Exp $ */ /* Pure/Constant space utilities. */ @@ -39,7 +39,7 @@ MIT in each case. */ #include "gccode.h" #include "zones.h" -void +static void Update(From, To, Was, Will_Be) fast Pointer *From, *To, *Was, *Will_Be; { @@ -71,11 +71,24 @@ Update(From, To, Was, Will_Be) From = END_OPERATOR_LINKAGE_AREA(From, count); continue; } - + case TC_MANIFEST_CLOSURE: - count = READ_OPERATOR_LINKAGE_COUNT(*From); - From = END_OPERATOR_LINKAGE_AREA(From, count); - continue; + { + machine_word *start_ptr; + fast machine_word *word_ptr; + + From += 1; + word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(From); + start_ptr = word_ptr; + + while (VALID_MANIFEST_CLOSURE_ENTRY(word_ptr)) + { + word_ptr = NEXT_MANIFEST_CLOSURE_ENTRY(word_ptr); + } + From = MANIFEST_CLOSURE_END(word_ptr, start_ptr); + + continue; + } default: continue; @@ -135,7 +148,7 @@ Make_Impure(Object) case_Cell: Length = 1; break; - + case TC_LINKAGE_SECTION: case TC_MANIFEST_CLOSURE: case_compiled_entry_point: @@ -144,7 +157,7 @@ Make_Impure(Object) OBJECT_TYPE(Object)); Invalid_Type_Code(); } - + /* Add a copy of the object to the last constant block in memory. */ @@ -152,12 +165,15 @@ Make_Impure(Object) Obj_Address = Get_Pointer(Object); if (!Test_Pure_Space_Top(Constant_Address + Length)) - return NIL; + { + return (NIL); + } Block_Length = Get_Integer(*(Constant_Address-1)); Constant_Address -= 2; New_Address = Constant_Address; #ifdef FLOATING_ALIGNMENT + /* This should be done more cleanly, always align before doing a block, or something like it. -- JINX */ @@ -173,12 +189,16 @@ Make_Impure(Object) Length = Constant_Address - Start; } else + #endif + + { for (i = Length; --i >= 0; ) { *Constant_Address++ = *Obj_Address; *Obj_Address++ = Make_Non_Pointer(TC_MANIFEST_NM_VECTOR, i); } + } *Constant_Address++ = Make_Non_Pointer(TC_MANIFEST_SPECIAL_NM_VECTOR, 1); *Constant_Address++ = Make_Non_Pointer(END_OF_BLOCK, Block_Length + Length); *(New_Address + 2 - Block_Length) = @@ -193,9 +213,15 @@ Make_Impure(Object) Set_Pure_Top(); Terminate_Old_Stacklet(); Terminate_Constant_Space(End_Of_Area); + + ENTER_CRITICAL_SECTION ("impurify"); + Update(Heap_Bottom, Free, Obj_Address, New_Address); Update(Constant_Space, End_Of_Area, Obj_Address, New_Address); - return Make_Pointer(OBJECT_TYPE(Object), New_Address); + + EXIT_CRITICAL_SECTION ({}); + + return (Make_Pointer(OBJECT_TYPE(Object), New_Address)); } /* (PRIMITIVE-IMPURIFY OBJECT) @@ -210,35 +236,58 @@ DEFINE_PRIMITIVE ("PRIMITIVE-IMPURIFY", Prim_impurify, 1, 1, 0) Touch_In_Primitive(Arg1, Arg1); Result = Make_Impure(Arg1); if (Result != NIL) - return Result; + { + return (Result); + } Primitive_Error(ERR_IMPURIFY_OUT_OF_SPACE); /*NOTREACHED*/ } -Boolean -Pure_Test(Obj_Address) - fast Pointer *Obj_Address; +extern Pointer * find_constant_space_block(); + +Pointer * +find_constant_space_block(obj_address) + fast Pointer *obj_address; { - fast Pointer *Where; + fast Pointer *where, *low_constant; + #ifdef FLOATING_ALIGNMENT - fast Pointer Float_Align_Value; + fast Pointer float_align_value; - Float_Align_Value = Make_Non_Pointer(TC_MANIFEST_NM_VECTOR, 0); + float_align_value = Make_Non_Pointer(TC_MANIFEST_NM_VECTOR, 0); #endif - Where = Free_Constant-1; - while (Where >= Constant_Space) + low_constant = Constant_Space; + where = (Free_Constant - 1); + + while (where >= low_constant) { + #ifdef FLOATING_ALIGNMENT - while (*Where == Float_Align_Value) - Where -= 1; + while (*where == float_align_value) + where -= 1; #endif - Where -= 1 + Get_Integer(*Where); - if (Where <= Obj_Address) - return - ((Boolean) (Obj_Address <= (Where + 1 + Get_Integer(*(Where + 1))))); + + where -= (1 + Get_Integer(*where)); + if (where <= obj_address) + return (where); + } + return ((Pointer *) NULL); +} + +Boolean +Pure_Test(obj_address) + Pointer *obj_address; +{ + Pointer *block; + + block = find_constant_space_block (obj_address); + if (block == ((Pointer *) NULL)) + { + return (false); } - return ((Boolean) false); + return + ((Boolean) (obj_address <= (block + 1 + (Get_Integer(*(block + 1)))))); } /* (PURE? OBJECT) @@ -289,7 +338,7 @@ DEFINE_PRIMITIVE ("GET-NEXT-CONSTANT", Prim_get_next_constant, 0, 0, 0) { Pointer *Next_Address; - Next_Address = Free_Constant + 1; + Next_Address = (Free_Constant + 1); Primitive_0_Args(); return Make_Pointer(TC_ADDRESS, Next_Address); } diff --git a/v7/src/microcode/returns.h b/v7/src/microcode/returns.h index 39d671e09..797fd4359 100644 --- a/v7/src/microcode/returns.h +++ b/v7/src/microcode/returns.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987, 1988 Massachusetts Institute of Technology +Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -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.34 1988/10/26 20:01:08 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/returns.h,v 9.35 1989/03/27 23:16:00 jinx Rel $ * * Return codes. These are placed in Return when an * interpreter operation needs to operate in several @@ -124,10 +124,11 @@ MIT in each case. */ #define RC_COMP_UNASSIGNED_TRAP_RESTART 0x59 /* formerly RC_COMP_CACHE_ASSIGN_RESTART 0x5A */ #define RC_COMP_LINK_CACHES_RESTART 0x5B +#define RC_HARDWARE_TRAP 0x5C /* When adding return codes, add them to the table below as well! */ -#define MAX_RETURN_CODE 0x5B +#define MAX_RETURN_CODE 0x5C #define RETURN_NAME_TABLE \ { \ @@ -223,5 +224,6 @@ MIT in each case. */ /* 0x58 */ "COMPILER_SAFE_REFERENCE_TRAP_RESTART", \ /* 0x59 */ "COMPILER_UNASSIGNED_P_TRAP_RESTART", \ /* 0x5A */ "", \ -/* 0x5B */ "COMPILER_LINK_CACHES_RESTART" \ +/* 0x5B */ "COMPILER_LINK_CACHES_RESTART", \ +/* 0x5C */ "HARDWARE_TRAP" \ } diff --git a/v7/src/microcode/sysprim.c b/v7/src/microcode/sysprim.c index 613f372bf..fc5b241a1 100644 --- a/v7/src/microcode/sysprim.c +++ b/v7/src/microcode/sysprim.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/sysprim.c,v 9.31 1988/10/21 00:12:44 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/sysprim.c,v 9.32 1989/03/27 23:16:05 jinx Rel $ * * Random system primitives. Most are implemented in terms of * utilities in os.c @@ -238,3 +238,18 @@ DEFINE_PRIMITIVE ("GC-SPACE-STATUS", Prim_gc_space_status, 0, 0, 0) #endif /* USE_STACKLETS */ PRIMITIVE_RETURN (result); } + +DEFINE_PRIMITIVE ("SET-TRAP-STATE!", Prim_set_trap_state, 1, 1, 0) +{ + long result; + extern long OS_set_trap_state(); + PRIMITIVE_HEADER (1); + + result = (OS_set_trap_state (arg_nonnegative_integer (1))); + if (result < 0) + { + error_bad_range_arg (1); + /*NOTREACHED*/ + } + PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (result)); +} diff --git a/v7/src/microcode/utabmd.scm b/v7/src/microcode/utabmd.scm index 2df4b6f29..00c4e4797 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.46 1988/07/15 20:26:31 cph Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.47 1989/03/27 23:17:15 jinx Rel $ (declare (usual-integrations)) @@ -84,8 +84,8 @@ TOUCHED-FUTURES-VECTOR ;1B PRECIOUS-OBJECTS ;1C ERROR-PROCEDURE ;1D - UNSNAPPED-LINK ;1E - MICROCODE-UTILITIES-VECTOR ;1F + #F #| UNSNAPPED-LINK |# ;1E + #F #| MICROCODE-UTILITIES-VECTOR |# ;1F COMPILER-ERROR-PROCEDURE ;20 LOST-OBJECT-BASE ;21 STATE-SPACE-ROOT ;22 @@ -450,6 +450,7 @@ COMPILER-UNASSIGNED?-TRAP-RESTART ;59 #F ;5A COMPILER-LINK-CACHES-RESTART ;5B + HARDWARE-TRAP ;5C )) ;;; [] Errors @@ -546,6 +547,8 @@ SIGNAL ;16 TOUCH ;17 SAVE-AND-EXIT ;18 + TRAP ;19 + BAD-BACK-OUT ;20 )) (vector-set! (get-fixed-objects-vector) @@ -571,4 +574,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.46 1988/07/15 20:26:31 cph Exp $" \ No newline at end of file +"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.47 1989/03/27 23:17:15 jinx Rel $" \ No newline at end of file diff --git a/v7/src/microcode/utils.c b/v7/src/microcode/utils.c index 7787db3f4..ff582998b 100644 --- a/v7/src/microcode/utils.c +++ b/v7/src/microcode/utils.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/utils.c,v 9.39 1988/09/29 05:03:12 jinx Exp $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.40 1989/03/27 23:17:22 jinx Exp $ */ /* This file contains utilities for interrupts, errors, etc. */ @@ -189,7 +189,13 @@ Back_Out_Of_Primitive () * restarted and completes successfully. */ - primitive = Fetch_Expression(); + primitive = Regs[REGBLOCK_PRIMITIVE]; + if (OBJECT_TYPE(primitive) != TC_PRIMITIVE) + { + fprintf(stderr, + "\nBack_Out_Of_Primitive backing out when not in primitive!\n"); + Microcode_Termination(TERM_BAD_BACK_OUT); + } nargs = PRIMITIVE_N_ARGUMENTS(primitive); if (OBJECT_TYPE(Stack_Ref(nargs)) == TC_COMPILED_ENTRY) { @@ -202,6 +208,7 @@ Back_Out_Of_Primitive () Val = NIL; Store_Return(RC_INTERNAL_APPLY); Store_Expression(NIL); + Regs[REGBLOCK_PRIMITIVE] = NIL; return; } @@ -751,7 +758,7 @@ Apply_Primitive (primitive) Print_Primitive(primitive); } Saved_Stack = Stack_Pointer; - Result = Internal_Apply_Primitive(primitive); + Result = INTERNAL_APPLY_PRIMITIVE(primitive); if (Saved_Stack != Stack_Pointer) { diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index 97481f878..b3d9bb154 100644 --- a/v7/src/microcode/version.h +++ b/v7/src/microcode/version.h @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.69 1989/03/14 01:59:28 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.70 1989/03/27 23:17:29 jinx Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -46,7 +46,7 @@ MIT in each case. */ #define VERSION 10 #endif #ifndef SUBVERSION -#define SUBVERSION 69 +#define SUBVERSION 70 #endif #ifndef UCODE_TABLES_FILENAME diff --git a/v8/src/microcode/const.h b/v8/src/microcode/const.h index d2fe6008c..42942f0e6 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.29 1988/08/15 20:44:34 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/const.h,v 9.30 1989/03/27 23:14:42 jinx Exp $ * * Named constants used throughout the interpreter * @@ -167,6 +167,7 @@ MIT in each case. */ #define REGBLOCK_RETURN 6 #define REGBLOCK_LEXPR_ACTUALS 7 #define REGBLOCK_MINIMUM_LENGTH 8 +#define REGBLOCK_PRIMITIVE 9 /* Codes specifying how to start scheme at boot time. */ diff --git a/v8/src/microcode/fixobj.h b/v8/src/microcode/fixobj.h index 498c62857..17db147a8 100644 --- a/v8/src/microcode/fixobj.h +++ b/v8/src/microcode/fixobj.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987, 1988 Massachusetts Institute of Technology +Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -30,47 +30,56 @@ 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/fixobj.h,v 9.26 1988/08/15 20:47:07 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/fixobj.h,v 9.27 1989/03/27 23:15:06 jinx Rel $ * * Declarations of user offsets into the Fixed Objects Vector. * This should correspond to the file UTABMD.SCM */ -#define Non_Object 0x00 /* Used for unassigned variables */ -#define System_Interrupt_Vector 0x01 /* Handlers for interrups */ -#define System_Error_Vector 0x02 /* Handlers for errors */ -#define OBArray 0x03 /* Array for interning symbols */ -#define Types_Vector 0x04 /* Type number -> Name map */ -#define Returns_Vector 0x05 /* Return code -> Name map */ -#define Primitives_Vector 0x06 /* Primitive code -> Name map */ -#define Errors_Vector 0x07 /* Error code -> Name map */ -#define Identification_Vector 0x08 /* ID Vector index -> name map */ -#define GC_Daemon 0x0B /* Procedure to run after GC */ -#define Trap_Handler 0x0C /* Continue after disaster */ -#define Stepper_State 0x0E /* NOT IMPLEMENTED YET */ -#define Fixed_Objects_Slots 0x0F /* Names of these slots */ -#define External_Primitives 0x10 /* Names of external prims */ -#define State_Space_Tag 0x11 /* Tag for state spaces */ -#define State_Point_Tag 0x12 /* Tag for state points */ -#define Dummy_History 0x13 /* Empty history structure */ -#define Bignum_One 0x14 /* Cache for bignum one */ -#define System_Scheduler 0x15 /* Scheduler for touched futures */ -#define Termination_Vector 0x16 /* Names for terminations */ -#define Termination_Proc_Vector 0x17 /* Handlers for terminations */ -#define Me_Myself 0x18 /* The actual shared vector */ -/* The next slot is used only in multiprocessor mode */ -#define The_Work_Queue 0x19 /* Where work is stored */ -/* These two slots are only used if logging futures */ -#define Future_Logger 0x1A /* Routine to log touched futures */ -#define Touched_Futures 0x1B /* Vector of touched futures */ +#define Non_Object 0x00 /* Used for unassigned variables. */ +#define System_Interrupt_Vector 0x01 /* Handlers for interrups. */ +#define System_Error_Vector 0x02 /* Handlers for errors. */ +#define OBArray 0x03 /* Array for interning symbols. */ +#define Types_Vector 0x04 /* Type number -> Name map. */ +#define Returns_Vector 0x05 /* Return code -> Name map. */ +#define Primitives_Vector 0x06 /* Primitive code -> Name map. */ +#define Errors_Vector 0x07 /* Error code -> Name map. */ +#define Identification_Vector 0x08 /* ID Vector index -> name map. */ +/* UNUSED slot 0x09 */ +/* UNUSED slot 0x0A */ +#define GC_Daemon 0x0B /* Procedure to run after GC. */ +#define Trap_Handler 0x0C /* Abort after disaster. */ +/* UNUSED slot 0x0D */ +#define Stepper_State 0x0E /* UNUSED in CScheme. */ +#define Fixed_Objects_Slots 0x0F /* Names of these slots. */ +/* UNUSED slot 0x10 used to be + External_Primitives Names of external prims. */ +#define State_Space_Tag 0x11 /* Tag for state spaces. */ +#define State_Point_Tag 0x12 /* Tag for state points. */ +#define Dummy_History 0x13 /* Empty history structure. */ +#define Bignum_One 0x14 /* Cache for bignum one. */ +#define System_Scheduler 0x15 /* MultiScheme: + Scheduler for touched futures. */ +#define Termination_Vector 0x16 /* Names for terminations. */ +#define Termination_Proc_Vector 0x17 /* Handlers for terminations. */ +#define Me_Myself 0x18 /* MultiScheme: + The shared fixed objects vector. */ +#define The_Work_Queue 0x19 /* MultiScheme: + Where work is stored. */ +#define Future_Logger 0x1A /* MultiScheme: When logging futures, + routine to log touched futures. */ +#define Touched_Futures 0x1B /* MultiScheme: When logging futures, + vector of touched futures. */ #define Precious_Objects 0x1C /* Objects that should not be lost! */ -#define Error_Procedure 0x1D /* User invoked error handler */ -#define Unsnapped_Link 0x1E /* Handler for call to compiled code */ -#define Utilities_Vector 0x1F /* ??? */ -#define Compiler_Err_Procedure 0x20 /* ??? */ +#define Error_Procedure 0x1D /* User invoked error handler. */ +#define Unsnapped_Link 0x1E /* UNUSED in CScheme. */ +#define Utilities_Vector 0x1F /* UNUSED in CScheme. */ +#define Compiler_Err_Procedure 0x20 /* User invoked error handler + from compiled code. */ #define Lost_Objects_Base 0x21 /* Free at the end of the "real" gc. */ -#define State_Space_Root 0x22 /* Root of state space */ -#define Primitive_Profiling_Table 0x23 /* Table of profile counts for primitives. */ +#define State_Space_Root 0x22 /* Root of state space. */ +#define Primitive_Profiling_Table 0x23 /* Table of profile counts for + primitives. */ #define NFixed_Objects 0x24 diff --git a/v8/src/microcode/interp.c b/v8/src/microcode/interp.c index 11141c1c6..5c45b6f58 100644 --- a/v8/src/microcode/interp.c +++ b/v8/src/microcode/interp.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -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/interp.c,v 9.47 1988/11/10 06:14:18 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.48 1989/03/27 23:15:19 jinx Exp $ * * This file contains the heart of the Scheme Scode * interpreter @@ -1296,13 +1296,36 @@ external_assignment_return: Import_Registers_Except_Val(); break; #endif - + case RC_HALT: Export_Registers(); Microcode_Termination(TERM_TERM_HANDLER); - + case RC_HARDWARE_TRAP: + { + /* This just reinvokes the handler */ + + Pointer info, handler; + info = (STACK_REF (0)); + + Save_Cont(); + if ((! (Valid_Fixed_Obj_Vector())) || + ((handler = (Get_Fixed_Obj_Slot(Trap_Handler))) == SHARP_F)) + { + fprintf(stderr, "There is no trap handler for recovery!\n"); + Microcode_Termination(TERM_TRAP); + /*NOTREACHED*/ + } + Will_Push(STACK_ENV_EXTRA_SLOTS + 2); + Push(info); + Push(handler); + Push(STACK_FRAME_HEADER + 1); + Pushed(); + goto Internal_Apply; + } + /* Internal_Apply, the core of the application mechanism. + Branch here to perform a function application. At this point the top of the stack contains an application frame @@ -1808,6 +1831,7 @@ return_from_compiled_code: Microcode_Termination(TERM_GC_OUT_OF_SPACE); } GC_Space_Needed = 0; + EXIT_CRITICAL_SECTION ({ Save_Cont(); Export_Registers(); }); End_GC_Hook(); break; @@ -1914,6 +1938,7 @@ Primitive_Internal_Apply: { Pointer GC_Daemon_Proc, Result; + RENAME_CRITICAL_SECTION ("purify pass 2"); Export_Registers(); Result = Purify_Pass_2(Fetch_Expression()); Import_Registers(); @@ -1923,14 +1948,17 @@ Primitive_Internal_Apply: There is no need to run the daemons, and we should let the runtime system know what happened. */ RESULT_OF_PURIFY (NIL); + EXIT_CRITICAL_SECTION ({ Export_Registers(); }); break; } GC_Daemon_Proc = Get_Fixed_Obj_Slot(GC_Daemon); if (GC_Daemon_Proc == NIL) { RESULT_OF_PURIFY (SHARP_T); + EXIT_CRITICAL_SECTION ({ Export_Registers(); }); break; } + RENAME_CRITICAL_SECTION( "purify daemon 2"); Store_Expression(NIL); Store_Return(RC_PURIFY_GC_2); Save_Cont(); @@ -1943,6 +1971,7 @@ Primitive_Internal_Apply: case RC_PURIFY_GC_2: RESULT_OF_PURIFY (SHARP_T); + EXIT_CRITICAL_SECTION ({ Export_Registers(); }); break; case RC_REPEAT_DISPATCH: diff --git a/v8/src/microcode/returns.h b/v8/src/microcode/returns.h index 9c0e42f47..103ad5be0 100644 --- a/v8/src/microcode/returns.h +++ b/v8/src/microcode/returns.h @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987, 1988 Massachusetts Institute of Technology +Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -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.34 1988/10/26 20:01:08 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/returns.h,v 9.35 1989/03/27 23:16:00 jinx Rel $ * * Return codes. These are placed in Return when an * interpreter operation needs to operate in several @@ -124,10 +124,11 @@ MIT in each case. */ #define RC_COMP_UNASSIGNED_TRAP_RESTART 0x59 /* formerly RC_COMP_CACHE_ASSIGN_RESTART 0x5A */ #define RC_COMP_LINK_CACHES_RESTART 0x5B +#define RC_HARDWARE_TRAP 0x5C /* When adding return codes, add them to the table below as well! */ -#define MAX_RETURN_CODE 0x5B +#define MAX_RETURN_CODE 0x5C #define RETURN_NAME_TABLE \ { \ @@ -223,5 +224,6 @@ MIT in each case. */ /* 0x58 */ "COMPILER_SAFE_REFERENCE_TRAP_RESTART", \ /* 0x59 */ "COMPILER_UNASSIGNED_P_TRAP_RESTART", \ /* 0x5A */ "", \ -/* 0x5B */ "COMPILER_LINK_CACHES_RESTART" \ +/* 0x5B */ "COMPILER_LINK_CACHES_RESTART", \ +/* 0x5C */ "HARDWARE_TRAP" \ } diff --git a/v8/src/microcode/utabmd.scm b/v8/src/microcode/utabmd.scm index 72f9bbae4..f259004dd 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.46 1988/07/15 20:26:31 cph Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.47 1989/03/27 23:17:15 jinx Rel $ (declare (usual-integrations)) @@ -84,8 +84,8 @@ TOUCHED-FUTURES-VECTOR ;1B PRECIOUS-OBJECTS ;1C ERROR-PROCEDURE ;1D - UNSNAPPED-LINK ;1E - MICROCODE-UTILITIES-VECTOR ;1F + #F #| UNSNAPPED-LINK |# ;1E + #F #| MICROCODE-UTILITIES-VECTOR |# ;1F COMPILER-ERROR-PROCEDURE ;20 LOST-OBJECT-BASE ;21 STATE-SPACE-ROOT ;22 @@ -450,6 +450,7 @@ COMPILER-UNASSIGNED?-TRAP-RESTART ;59 #F ;5A COMPILER-LINK-CACHES-RESTART ;5B + HARDWARE-TRAP ;5C )) ;;; [] Errors @@ -546,6 +547,8 @@ SIGNAL ;16 TOUCH ;17 SAVE-AND-EXIT ;18 + TRAP ;19 + BAD-BACK-OUT ;20 )) (vector-set! (get-fixed-objects-vector) @@ -571,4 +574,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.46 1988/07/15 20:26:31 cph Exp $" \ No newline at end of file +"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.47 1989/03/27 23:17:15 jinx Rel $" \ No newline at end of file diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h index 7c878440f..7a79a8ba9 100644 --- a/v8/src/microcode/version.h +++ b/v8/src/microcode/version.h @@ -1,8 +1,8 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.69 1989/03/14 01:59:28 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.70 1989/03/27 23:17:29 jinx Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -46,7 +46,7 @@ MIT in each case. */ #define VERSION 10 #endif #ifndef SUBVERSION -#define SUBVERSION 69 +#define SUBVERSION 70 #endif #ifndef UCODE_TABLES_FILENAME -- 2.25.1