From 09c6f5fdb09acfb9b258ffd8c61d46540d2e6843 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Sat, 12 Mar 1988 16:08:44 +0000 Subject: [PATCH] Change the representation of compiled procedures and other entries: They are now just the address of an instruction with a gc offset preceding the instruction and an arity/type word preceding that. Compiled closures are done by creating a tiny fake compiled code block which jumps to the right place and sets up the free variables for reference. Uuo style links are now just jump instructions to the correct address. All relocators have been updated to reflect this change. Variable caches have no type code. The relocators know about this. Incorporate JRM's fix to signal to close interrupt gap in hp-ux. New types: TC_COMPILED_ENTRY TC_MANIFEST_CLOSURE TC_LINKAGE_SECTION --- v7/src/microcode/comutl.c | 61 +++----- v7/src/microcode/const.h | 6 +- v7/src/microcode/errors.h | 4 +- v7/src/microcode/fasdump.c | 109 ++++++++++++-- v7/src/microcode/fasload.c | 110 ++++++++++---- v7/src/microcode/gccode.h | 289 ++++++++++++++++++++++-------------- v7/src/microcode/gcloop.c | 166 ++++++++++++++++----- v7/src/microcode/gctype.c | 8 +- v7/src/microcode/interp.c | 110 +++++++++----- v7/src/microcode/purify.c | 186 ++++++++++++++++++----- v7/src/microcode/purutl.c | 45 +++++- v7/src/microcode/returns.h | 22 +-- v7/src/microcode/types.h | 14 +- v7/src/microcode/utabmd.scm | 23 +-- v7/src/microcode/utils.c | 5 +- v7/src/microcode/version.h | 4 +- v8/src/microcode/const.h | 6 +- v8/src/microcode/gctype.c | 8 +- v8/src/microcode/interp.c | 110 +++++++++----- v8/src/microcode/returns.h | 22 +-- v8/src/microcode/types.h | 14 +- v8/src/microcode/utabmd.scm | 23 +-- v8/src/microcode/version.h | 4 +- 23 files changed, 922 insertions(+), 427 deletions(-) diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c index f5c0f4028..6466a2416 100644 --- a/v7/src/microcode/comutl.c +++ b/v7/src/microcode/comutl.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.10 1987/12/09 22:35:43 jinx Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.11 1988/03/12 16:04:26 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -36,46 +36,14 @@ MIT in each case. */ #include "scheme.h" #include "primitive.h" -#include "gccode.h" extern Pointer *compiled_entry_to_block_address(); extern long compiled_entry_to_block_offset(); +extern void compiled_entry_type(); -#define COMPILED_CODE_ADDRESS_P(object) \ - (((OBJECT_TYPE (object)) == TC_COMPILED_EXPRESSION) || \ - ((OBJECT_TYPE (object)) == TC_RETURN_ADDRESS)) +#define COMPILED_CODE_ADDRESS_P(object) \ + ((OBJECT_TYPE (object)) == TC_COMPILED_ENTRY) -Pointer * -compiled_entry_to_block_address(ce) - Pointer ce; -{ -#ifdef Get_Compiled_Block - - Pointer *block; - - block = Get_Pointer(ce); - Get_Compiled_Block(block, block); - return block; - -#else - - error_external_return(); - /*NOTREACHED*/ - -#endif -} - -long -compiled_entry_to_block_offset(ce) - Pointer ce; -{ - Pointer *address; - - address = Get_Pointer(ce); - return (((unsigned long) address) - - ((unsigned long) compiled_entry_to_block_address(address))); -} - DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->BLOCK", Prim_comp_code_address_block, 1) { @@ -87,7 +55,8 @@ DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->BLOCK", PRIMITIVE_RETURN (Make_Pointer (TC_COMPILED_CODE_BLOCK, address)); } -DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->OFFSET", Prim_comp_code_address_offset, 1) +DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->OFFSET", + Prim_comp_code_address_offset, 1) { long offset; Primitive_1_Arg (); @@ -113,3 +82,21 @@ DEFINE_PRIMITIVE("STACK-TOP-ADDRESS", Prim_Stack_Top_Address, 0) PRIMITIVE_RETURN (MAKE_SIGNED_FIXNUM(STACK_TOP_TO_DATUM())); } + +DEFINE_PRIMITIVE("COMPILED-ENTRY-KIND", Prim_Compiled_Entry_Type, 1) +{ + fast Pointer *temp; + Pointer result; + PRIMITIVE_HEADER(1); + + CHECK_ARG (1, COMPILED_CODE_ADDRESS_P); + + Primitive_GC_If_Needed(3); + temp = Free; + Free = &temp[3]; + compiled_entry_type(ARG_REF(1), temp); + temp[0] = MAKE_UNSIGNED_FIXNUM(((long) temp[0])); + temp[1] = MAKE_SIGNED_FIXNUM(((long) temp[1])); + temp[2] = MAKE_SIGNED_FIXNUM(((long) temp[2])); + PRIMITIVE_RETURN (Make_Pointer(TC_HUNK3, temp)); +} diff --git a/v7/src/microcode/const.h b/v7/src/microcode/const.h index 98164b307..11e6be05b 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.27 1988/02/06 20:39:40 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/const.h,v 9.28 1988/03/12 16:04:43 jinx Rel $ * * Named constants used throughout the interpreter * @@ -117,6 +117,7 @@ MIT in each case. */ #define PRIM_NO_TRAP_APPLY -6 #define PRIM_POP_RETURN -7 #define PRIM_TOUCH -8 +#define PRIM_APPLY_INTERRUPT -9 #define ABORT_NAME_TABLE \ { \ @@ -127,7 +128,8 @@ MIT in each case. */ /* -5 */ "NO-TRAP-EVAL", \ /* -6 */ "NO-TRAP_APPLY", \ /* -7 */ "POP-RETURN", \ - /* -8 */ "TOUCH" \ + /* -8 */ "TOUCH", \ + /* -9 */ "APPLY-INTERRUPT" \ } /* Some numbers of parameters which mean something special */ diff --git a/v7/src/microcode/errors.h b/v7/src/microcode/errors.h index 18f465492..90a8f0908 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.29 1988/02/06 20:40:00 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/errors.h,v 9.30 1988/03/12 16:04:57 jinx Rel $ * * Error and termination code declarations. * @@ -60,7 +60,7 @@ MIT in each case. */ #define ERR_ARG_1_BAD_RANGE 0x10 #define ERR_ARG_2_BAD_RANGE 0x11 #define ERR_ARG_3_BAD_RANGE 0x12 -/* #define ERR_BAD_COMBINATION 0x13 */ +#define ERR_BAD_COMBINATION 0x13 /* #define ERR_FASDUMP_OVERFLOW 0x14 */ #define ERR_BAD_INTERRUPT_CODE 0x15 /* Not generated */ /* #define ERR_NO_ERRORS 0x16 */ diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c index 28aa5730e..aa4f58fd4 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.35 1988/02/20 06:17:33 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.36 1988/03/12 16:05:10 jinx Exp $ This file contains code for fasdump and dump-band. */ @@ -84,12 +84,18 @@ static Boolean compiled_code_present_p; contents (e) To_Pointer is now NewFree. */ +#define Setup_Pointer_for_Dump(Extra_Code) \ +Dump_Pointer(Fasdump_Setup_Pointer(Extra_Code, Normal_BH(false, continue))) + #define Dump_Pointer(Code) \ Old = Get_Pointer(Temp); \ Code -#define Setup_Pointer_for_Dump(Extra_Code) \ -Dump_Pointer(Fasdump_Setup_Pointer(Extra_Code, Normal_BH(false, continue))) +#define Dump_Compiled_Entry() \ +{ \ + Dump_Pointer(Fasdump_Setup_Pointer(Transport_Compiled(), \ + Compiled_BH(false, continue))); \ +} /* Dump_Mode is currently a fossil. It should be resurrected. */ @@ -97,6 +103,10 @@ Dump_Pointer(Fasdump_Setup_Pointer(Extra_Code, Normal_BH(false, continue))) and 2 for the Fixup. */ +#define NORMAL_GC 0 +#define PURE_COPY 1 +#define CONSTANT_COPY 2 + #define FASDUMP_FIX_BUFFER 10 long @@ -139,14 +149,82 @@ DumpLoop(Scan, Dump_Mode) case TC_STACK_ENVIRONMENT: case_Fasload_Non_Pointer: break; + + /* Compiled code relocation. */ - case_compiled_entry_point: + case TC_LINKAGE_SECTION: + { compiled_code_present_p = true; - Dump_Pointer(Fasdump_Setup_Pointer(Transport_Compiled(), - Compiled_BH(false, continue))); + if (READ_LINKAGE_KIND(Temp) != OPERATOR_LINKAGE_KIND) + { + /* Assumes that all others are objects of type TC_QUAD without + their type codes. + */ + + fast long count; + + Scan++; + for (count = READ_CACHE_LINKAGE_COUNT(Temp); + --count >= 0; + Scan += 1) + { + Temp = *Scan; + Setup_Pointer_for_Dump(Transport_Quadruple()); + } + Scan -= 1; + break; + } + else + { + fast long count; + fast machine_word *word_ptr; + Pointer *end_scan; + + count = READ_OPERATOR_LINKAGE_COUNT(Temp); + word_ptr = FIRST_OPERATOR_LINKAGE_ENTRY(Scan); + end_scan = END_OPERATOR_LINKAGE_AREA(Scan, count); + + while(--count >= 0) + { + Scan = ((Pointer *) word_ptr); + word_ptr = NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr); + Temp = *Scan; + Dump_Compiled_Entry(); + } + Scan = end_scan; + break; + } + } + + case TC_MANIFEST_CLOSURE: + { + machine_word *start_ptr; + fast machine_word *word_ptr; + Pointer *saved_scan; + + saved_scan = ++Scan; + word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(Scan); + start_ptr = word_ptr; + + while (VALID_MANIFEST_CLOSURE_ENTRY(word_ptr)) + { + Scan = MANIFEST_CLOSURE_ENTRY_ADDRESS(word_ptr); + word_ptr = NEXT_MANIFEST_CLOSURE_ENTRY(word_ptr); + Temp = *Scan; + Dump_Compiled_Entry(); + } + Scan = saved_scan + MANIFEST_CLOSURE_SIZE(word_ptr, start_ptr); + break; + } + case_compiled_entry_point: + compiled_code_present_p = true; + Dump_Compiled_Entry(); + break; + case_Cell: Setup_Pointer_for_Dump(Transport_Cell()); + break; case TC_REFERENCE_TRAP: if (OBJECT_DATUM(Temp) <= TRAP_MAX_IMMEDIATE) @@ -159,18 +237,23 @@ DumpLoop(Scan, Dump_Mode) case TC_WEAK_CONS: case_Fasdump_Pair: Setup_Pointer_for_Dump(Transport_Pair()); + break; case TC_INTERNED_SYMBOL: Setup_Pointer_for_Dump(Fasdump_Symbol(Make_Broken_Heart(0))); + break; case TC_UNINTERNED_SYMBOL: Setup_Pointer_for_Dump(Fasdump_Symbol(UNBOUND_OBJECT)); + break; case_Triple: Setup_Pointer_for_Dump(Transport_Triple()); + break; case TC_VARIABLE: Setup_Pointer_for_Dump(Fasdump_Variable()); + break; /* DumpLoop continues on the next page */ @@ -178,17 +261,18 @@ DumpLoop(Scan, Dump_Mode) case_Quadruple: Setup_Pointer_for_Dump(Transport_Quadruple()); + break; -#ifdef FLOATING_ALIGNMENT - case TC_BIG_FLONUM: - Setup_Pointer_for_Dump(Transport_Flonum()); -#else case TC_BIG_FLONUM: - /* Fall through */ -#endif + Setup_Pointer_for_Dump({ + Transport_Flonum(); + break; + }); + case TC_COMPILED_CODE_BLOCK: case_Purify_Vector: Setup_Pointer_for_Dump(Transport_Vector()); + break; case TC_ENVIRONMENT: /* Make fasdump fail */ @@ -196,6 +280,7 @@ DumpLoop(Scan, Dump_Mode) case TC_FUTURE: Setup_Pointer_for_Dump(Transport_Future()); + break; default: sprintf(gc_death_message_buffer, diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c index dd3ba6636..541b733e6 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.34 1988/02/10 15:43:35 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.35 1988/03/12 16:05:26 jinx Exp $ The "fast loader" which reads in and relocates binary files and then interns symbols. It is called with one argument: the (character @@ -262,71 +262,131 @@ static Pointer *Relocate_Temp; */ void -Relocate_Block(Next_Pointer, Stop_At) - fast Pointer *Next_Pointer, *Stop_At; +Relocate_Block(Scan, Stop_At) + fast Pointer *Scan, *Stop_At; { extern Pointer *load_renumber_table; + fast Pointer Temp; + fast long address; if (Reloc_Debug) { fprintf(stderr, - "Relocation beginning, block = 0x%x, length = 0x%x, end = 0x%x.\n", - Next_Pointer, (Stop_At - Next_Pointer) - 1, Stop_At); + "\nRelocate_Block: block = 0x%x, length = 0x%x, end = 0x%x.\n", + Scan, ((Stop_At - Scan) - 1), Stop_At); } - while (Next_Pointer < Stop_At) - { - fast Pointer Temp; - Temp = *Next_Pointer; + while (Scan < Stop_At) + { + Temp = *Scan; Switch_by_GC_Type(Temp) { case TC_BROKEN_HEART: case TC_MANIFEST_SPECIAL_NM_VECTOR: case_Fasload_Non_Pointer: - Next_Pointer += 1; + Scan += 1; break; case TC_PRIMITIVE: - *Next_Pointer++ = load_renumber_table[PRIMITIVE_NUMBER(Temp)]; + *Scan++ = load_renumber_table[PRIMITIVE_NUMBER(Temp)]; break; case TC_PCOMB0: - *Next_Pointer++ = + *Scan++ = Make_Non_Pointer(TC_PCOMB0, load_renumber_table[PRIMITIVE_NUMBER(Temp)]); break; case TC_MANIFEST_NM_VECTOR: - Next_Pointer += Get_Integer(Temp)+1; + Scan += (Get_Integer(Temp) + 1); break; + + case TC_LINKAGE_SECTION: + { + if (READ_LINKAGE_KIND(Temp) != OPERATOR_LINKAGE_KIND) + { + /* Assumes that all others are objects of type TC_QUAD without + their type codes. + */ + + fast long count; + + Scan++; + for (count = READ_CACHE_LINKAGE_COUNT(Temp); + --count >= 0; + ) + { + address = ((long) *Scan); + *Scan++ = ((Pointer) Relocate(address)); + } + break; + } + else + { + fast long count; + fast machine_word *word_ptr; + Pointer *end_scan; + + count = READ_OPERATOR_LINKAGE_COUNT(Temp); + word_ptr = FIRST_OPERATOR_LINKAGE_ENTRY(Scan); + end_scan = END_OPERATOR_LINKAGE_AREA(Scan, count); + + while(--count >= 0) + { + Scan = ((Pointer *) word_ptr); + word_ptr = NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr); + address = ((long) *Scan); + *Scan = ((Pointer) Relocate(address)); + } + Scan = &end_scan[1]; + break; + } + } + + case TC_MANIFEST_CLOSURE: + { + machine_word *start_ptr; + fast machine_word *word_ptr; + Pointer *saved_scan; + + saved_scan = ++Scan; + word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(Scan); + start_ptr = word_ptr; + + while (VALID_MANIFEST_CLOSURE_ENTRY(word_ptr)) + { + Scan = MANIFEST_CLOSURE_ENTRY_ADDRESS(word_ptr); + word_ptr = NEXT_MANIFEST_CLOSURE_ENTRY(word_ptr); + address = ((long) *Scan); + *Scan = ((Pointer) Relocate(address)); + } + Scan = saved_scan + (1 + MANIFEST_CLOSURE_SIZE(word_ptr, start_ptr)); + break; + } #ifdef BYTE_INVERSION case TC_CHARACTER_STRING: - String_Inversion(Relocate(Datum(Temp))); + String_Inversion(Relocate(OBJECT_DATUM(Temp))); goto normal_pointer; #endif case TC_REFERENCE_TRAP: - if (Datum(Temp) <= TRAP_MAX_IMMEDIATE) + if (OBJECT_DATUM(Temp) <= TRAP_MAX_IMMEDIATE) { - Next_Pointer += 1; + Scan += 1; break; } /* It is a pointer, fall through. */ /* Compiled entry points and stack environments work automagically. */ /* This should be more strict. */ - default: - { -normal_pointer: - { - fast long Next; - Next = Datum(Temp); - *Next_Pointer++ = Make_Pointer(Type_Code(Temp), Relocate(Next)); - } + default: + normal_pointer: + address = OBJECT_DATUM(Temp); + *Scan++ = Make_Pointer(OBJECT_TYPE(Temp), Relocate(address)); + break; } - } } return; } diff --git a/v7/src/microcode/gccode.h b/v7/src/microcode/gccode.h index a9ceb95aa..744c58ea6 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.34 1988/02/20 06:17:48 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.35 1988/03/12 16:05:46 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 @@ -72,11 +72,12 @@ extern char gc_death_message_buffer[]; TC_MANIFEST_NM_VECTOR TC_MANIFEST_SPECIAL_NM_VECTOR TC_REFERENCE_TRAP + TC_MANIFEST_CLOSURE + TC_LINKAGE_SECTION */ #define case_compiled_entry_point \ - case TC_COMPILED_EXPRESSION: \ - case TC_RETURN_ADDRESS \ + case TC_COMPILED_ENTRY #define case_Cell \ case TC_CELL @@ -101,7 +102,6 @@ extern char gc_death_message_buffer[]; case TC_IN_PACKAGE: \ case TC_LEXPR: \ case TC_DISJUNCTION: \ - case TC_COMPILED_PROCEDURE: \ case TC_COMPLEX: \ case TC_ENTITY: \ case TC_RATNUM @@ -159,72 +159,88 @@ extern char gc_death_message_buffer[]; /* Macros for the garbage collector and related programs. */ -#define NORMAL_GC 0 -#define PURE_COPY 1 -#define CONSTANT_COPY 2 - /* Pointer setup for the GC Type handlers. */ +#define GC_Consistency_Check(In_GC) \ +{ \ + if And2(In_GC, Consistency_Check) \ + { \ + if ((Old >= Highest_Allocated_Address) || (Old < Heap)) \ + { \ + sprintf(gc_death_message_buffer, \ + "setup_internal: out of range pointer (0x%lx)", \ + Temp); \ + gc_death(TERM_EXIT, gc_death_message_buffer, Scan, To); \ + /*NOTREACHED*/ \ + } \ + } \ +} + /* Check whether it has been relocated. */ #define Normal_BH(In_GC, then_what) \ -if (OBJECT_TYPE(*Old) == TC_BROKEN_HEART) \ { \ - *Scan = Make_New_Pointer(OBJECT_TYPE(Temp), *Old); \ - then_what; \ + if (OBJECT_TYPE(*Old) == TC_BROKEN_HEART) \ + { \ + *Scan = Make_New_Pointer(OBJECT_TYPE(Temp), *Old); \ + then_what; \ + } \ } -#define Setup_Internal(In_GC, Extra_Code, BH_Code) \ -if And2(In_GC, Consistency_Check) \ +#define Setup_Internal(In_GC, Transport_Code, Already_Relocated_Code) \ { \ - if ((Old >= Highest_Allocated_Address) || (Old < Heap)) \ + GC_Consistency_Check(In_GC); \ + if (Old >= Low_Constant) \ { \ - sprintf(gc_death_message_buffer, \ - "setup_internal: out of range pointer (0x%lx)", \ - Temp); \ - gc_death(TERM_EXIT, gc_death_message_buffer, Scan, To); \ - /*NOTREACHED*/ \ + continue; \ } \ -} \ -if (Old >= Low_Constant) \ + Already_Relocated_Code; \ + New_Address = (Make_Broken_Heart(C_To_Scheme(To))); \ + Transport_Code; \ +} + +#define Setup_Pointer(In_GC, Transport_Code) \ { \ - continue; \ -} \ -BH_Code; \ -New_Address = (Make_Broken_Heart(C_To_Scheme(To))); \ -Extra_Code; \ -continue - -#define Setup_Pointer(In_GC, Extra_Code) \ -Setup_Internal(In_GC, Extra_Code, Normal_BH(In_GC, continue)) - -#define Pointer_End() \ -*Get_Pointer(Temp) = New_Address; \ -*Scan = Make_New_Pointer(Type_Code(Temp), New_Address) + Setup_Internal(In_GC, Transport_Code, Normal_BH(In_GC, continue)); \ +} + +#define Pointer_End() \ +{ \ + *Get_Pointer(Temp) = New_Address; \ + *Scan = Make_New_Pointer(Type_Code(Temp), New_Address); \ +} /* GC Type handlers. These do the actual work. */ -#define Transport_Cell() \ -*To++ = *Old; \ -Pointer_End() - -#define Transport_Pair() \ -*To++ = *Old++; \ -*To++ = *Old; \ -Pointer_End() - -#define Transport_Triple() \ -*To++ = *Old++; \ -*To++ = *Old++; \ -*To++ = *Old; \ -Pointer_End() - -#define Transport_Quadruple() \ -*To++ = *Old++; \ -*To++ = *Old++; \ -*To++ = *Old++; \ -*To++ = *Old; \ -Pointer_End() +#define Transport_Cell() \ +{ \ + *To++ = *Old; \ + Pointer_End(); \ +} + +#define Transport_Pair() \ +{ \ + *To++ = *Old++; \ + *To++ = *Old; \ + Pointer_End(); \ +} + +#define Transport_Triple() \ +{ \ + *To++ = *Old++; \ + *To++ = *Old++; \ + *To++ = *Old; \ + Pointer_End(); \ +} + +#define Transport_Quadruple() \ +{ \ + *To++ = *Old++; \ + *To++ = *Old++; \ + *To++ = *Old++; \ + *To++ = *Old; \ + Pointer_End(); \ +} #ifndef In_Fasdump @@ -257,7 +273,7 @@ Pointer_End() Scan = Saved_Scan; \ } -#else In_Fasdump +#else /* In_Fasdump */ #define Real_Transport_Vector() \ { \ @@ -281,24 +297,38 @@ Pointer_End() #endif +#define Transport_Vector() \ +{ \ +Move_Vector: \ + Real_Transport_Vector(); \ + Pointer_End(); \ +} #ifdef FLOATING_ALIGNMENT -#define Transport_Flonum() \ - Align_Float(To); \ - New_Address = (Make_Broken_Heart(C_To_Scheme(To))); \ - Real_Transport_Vector(); \ - Pointer_End() -#endif -#define Transport_Vector() \ -Move_Vector: \ - Real_Transport_Vector(); \ - Pointer_End() +#define Transport_Flonum() \ +{ \ + Align_Float(To); \ + New_Address = (Make_Broken_Heart(C_To_Scheme(To))); \ + Real_Transport_Vector(); \ + Pointer_End(); \ +} + +#else + +#define Transport_Flonum() \ +{ \ + goto Move_Vector; \ +} + +#endif -#define Transport_Future() \ -if (!(Future_Spliceable(Temp))) \ - goto Move_Vector; \ -*Scan = Future_Value(Temp); \ -Scan -= 1 +#define Transport_Future() \ +{ \ + if (!(Future_Spliceable(Temp))) \ + goto Move_Vector; \ + *Scan = Future_Value(Temp); \ + Scan -= 1; \ +} /* Weak Pointer code. The idea here is to support a post-GC pass which removes any objects in the CAR of a WEAK_CONS cell which is no longer @@ -322,14 +352,17 @@ Scan -= 1 extern Pointer Weak_Chain; -#define Transport_Weak_Cons() \ -{ long Car_Type = Type_Code(*Old); \ - *To++ = Make_New_Pointer(TC_NULL, *Old); \ - Old += 1; \ - *To++ = *Old; \ - *Old = Make_New_Pointer(Car_Type, Weak_Chain); \ - Weak_Chain = Temp; \ - Pointer_End(); \ +#define Transport_Weak_Cons() \ +{ \ + long Car_Type; \ + \ + Car_Type = OBJECT_TYPE(*Old); \ + *To++ = Make_New_Pointer(TC_NULL, *Old); \ + Old += 1; \ + *To++ = *Old; \ + *Old = Make_New_Pointer(Car_Type, Weak_Chain); \ + Weak_Chain = Temp; \ + Pointer_End(); \ } /* Special versions of the above for DumpLoop in Fasdump. This code @@ -338,34 +371,39 @@ extern Pointer Weak_Chain; */ #define Fasdump_Setup_Pointer(Extra_Code, BH_Code) \ -BH_Code; \ +{ \ + BH_Code; \ \ -/* It must be transported to New Space */ \ + /* 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 + 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; \ +} /* Undefine Symbols */ -#define Fasdump_Symbol(global_value) \ -*To++ = *Old; \ -*To++ = global_value; \ -Pointer_End() +#define Fasdump_Symbol(global_value) \ +{ \ + *To++ = *Old; \ + *To++ = global_value; \ + Pointer_End(); \ +} -#define Fasdump_Variable() \ -*To++ = *Old; \ -*To++ = UNCOMPILED_VARIABLE; \ -*To++ = NIL; \ -Pointer_End() +#define Fasdump_Variable() \ +{ \ + *To++ = *Old; \ + *To++ = UNCOMPILED_VARIABLE; \ + *To++ = NIL; \ + Pointer_End(); \ +} /* Compiled Code Relocation Utilities */ @@ -378,22 +416,47 @@ Pointer_End() #endif #else -/* Is there anything else that can be done here? */ +typedef unsigned long machine_word; -#define Relocate_Compiled(object, new_block, old_block) \ - (gc_death(TERM_COMPILER_DEATH, \ - "relocate_compiled: No compiler support!", \ - Scan, To), \ - NIL) +/* Is there anything else that can be done here? */ -#define Compiled_BH(flag, then_what) \ -{ \ +#define GC_NO_COMPILER_STMT() \ gc_death(TERM_COMPILER_DEATH, \ "relocate_compiled: No compiler support!", \ - Scan, To); \ - /*NOTREACHED*/ \ -} + Scan, To) + +#define GC_NO_COMPILER_EXPR() \ + (GC_NO_COMPILER_STMT(), NIL) + +#define Relocate_Compiled(object, new_block, old_block) \ + GC_NO_COMPILER_EXPR() + +#define Transport_Compiled() GC_NO_COMPILER_STMT() + +#define Compiled_BH(flag, then_what) GC_NO_COMPILER_STMT() + +#define Get_Compiled_Block(var, address) GC_NO_COMPILER_STMT() + +#define READ_MANIFEST_CLOSURE_SIZE(scan) GC_NO_COMPILER_EXPR() + +#define FIRST_MANIFEST_CLOSURE_ENTRY(scan) GC_NO_COMPILER_EXPR() + +#define NEXT_MANIFEST_CLOSURE_ENTRY(word_ptr) GC_NO_COMPILER_EXPR() + +#define END_MANIFEST_CLOSURE_AREA(scan, count) GC_NO_COMPILER_EXPR() + +#define READ_LINKAGE_KIND(header) GC_NO_COMPILER_EXPR() + +#define READ_CACHE_LINKAGE_COUNT(header) GC_NO_COMPILER_EXPR() + +#define READ_OPERATOR_LINKAGE_COUNT(header) GC_NO_COMPILER_EXPR() + +#define END_OPERATOR_LINKAGE_AREA(scan, count) GC_NO_COMPILER_EXPR() + +#define FIRST_OPERATOR_LINKAGE_ENTRY(scan) GC_NO_COMPILER_EXPR() + +#define NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr) GC_NO_COMPILER_EXPR() -#define Transport_Compiled() +#define OPERATOR_LINKAGE_KIND 0 #endif diff --git a/v7/src/microcode/gcloop.c b/v7/src/microcode/gcloop.c index 41d0c1459..5e42a9227 100644 --- a/v7/src/microcode/gcloop.c +++ b/v7/src/microcode/gcloop.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/gcloop.c,v 9.26 1988/02/20 06:18:04 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gcloop.c,v 9.27 1988/03/12 16:06:06 jinx Exp $ * * This file contains the code for the most primitive part * of garbage collection. @@ -44,39 +44,57 @@ MIT in each case. */ extern Pointer *GCLoop(); -#define GC_Pointer(Code) \ -Old = Get_Pointer(Temp); \ -Code - -#define Setup_Pointer_for_GC(Extra_Code) \ -GC_Pointer(Setup_Pointer(true, Extra_Code)) +#define GC_Pointer(Code) \ +{ \ + Old = Get_Pointer(Temp); \ + Code; \ +} +#define Setup_Pointer_for_GC(Extra_Code) \ +{ \ + GC_Pointer(Setup_Pointer(true, Extra_Code)); \ +} + #ifdef ENABLE_DEBUGGING_TOOLS -static Pointer *gc_scan_trap = NULL; -static Pointer *gc_free_trap = NULL; -static Pointer gc_trap = Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_MAX_IMMEDIATE); + +Pointer + *gc_scan_trap = NULL, + *gc_free_trap = NULL, + gc_trap = Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_MAX_IMMEDIATE); + +#define HANDLE_GC_TRAP() \ +{ \ + if ((Temp == gc_trap) || \ + (Scan == gc_scan_trap) || \ + (To == gc_free_trap)) \ + { \ + fprintf(stderr, "\nGCLoop: trap.\n"); \ + } \ +} + +#else + +#define HANDLE_GC_TRAP() + #endif -Pointer -*GCLoop(Scan, To_Pointer) -fast Pointer *Scan; -Pointer **To_Pointer; -{ fast Pointer *To, *Old, Temp, *Low_Constant, New_Address; +Pointer * +GCLoop(Scan, To_Pointer) + fast Pointer *Scan; + Pointer **To_Pointer; +{ + fast Pointer *To, *Old, Temp, *Low_Constant, New_Address; To = *To_Pointer; Low_Constant = Constant_Space; for ( ; Scan != To; Scan++) - { Temp = *Scan; - -#ifdef ENABLE_DEBUGGING_TOOLS - if ((Temp == gc_trap) || (Scan == gc_scan_trap) || (To == gc_free_trap)) - { - fprintf(stderr, "\nGCLoop: trap.\n"); - } -#endif + { + Temp = *Scan; + HANDLE_GC_TRAP(); Switch_by_GC_Type(Temp) - { case TC_BROKEN_HEART: + { + case TC_BROKEN_HEART: if (Scan == (Get_Pointer(Temp))) { *To_Pointer = To; @@ -95,14 +113,86 @@ Pointer **To_Pointer; case_Non_Pointer: break; + + /* Compiled code relocation. */ + + case TC_LINKAGE_SECTION: + { + if (READ_LINKAGE_KIND(Temp) != OPERATOR_LINKAGE_KIND) + { + /* Assumes that all others are objects of type TC_QUAD without + their type codes. + */ + + fast long count; + + Scan++; + for (count = READ_CACHE_LINKAGE_COUNT(Temp); + --count >= 0; + Scan += 1) + { + Temp = *Scan; + Setup_Pointer_for_GC(Transport_Quadruple()); + } + Scan -= 1; + break; + } + else + { + fast long count; + fast machine_word *word_ptr; + Pointer *end_scan; + + count = READ_OPERATOR_LINKAGE_COUNT(Temp); + word_ptr = FIRST_OPERATOR_LINKAGE_ENTRY(Scan); + end_scan = END_OPERATOR_LINKAGE_AREA(Scan, count); + + while(--count >= 0) + { + Scan = ((Pointer *) word_ptr); + word_ptr = NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr); + Temp = *Scan; + GC_Pointer(Setup_Internal(true, + Transport_Compiled(), + Compiled_BH(true, continue))); + } + Scan = end_scan; + break; + } + } + + case TC_MANIFEST_CLOSURE: + { + machine_word *start_ptr; + fast machine_word *word_ptr; + Pointer *saved_scan; + + saved_scan = ++Scan; + word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(Scan); + start_ptr = word_ptr; + + while (VALID_MANIFEST_CLOSURE_ENTRY(word_ptr)) + { + Scan = MANIFEST_CLOSURE_ENTRY_ADDRESS(word_ptr); + word_ptr = NEXT_MANIFEST_CLOSURE_ENTRY(word_ptr); + Temp = *Scan; + GC_Pointer(Setup_Internal(true, + Transport_Compiled(), + Compiled_BH(true, continue))); + } + Scan = saved_scan + MANIFEST_CLOSURE_SIZE(word_ptr, start_ptr); + break; + } case_compiled_entry_point: GC_Pointer(Setup_Internal(true, Transport_Compiled(), Compiled_BH(true, continue))); - + break; + case_Cell: Setup_Pointer_for_GC(Transport_Cell()); + break; case TC_REFERENCE_TRAP: if (OBJECT_DATUM(Temp) <= TRAP_MAX_IMMEDIATE) @@ -110,36 +200,38 @@ Pointer **To_Pointer; /* It is a non pointer. */ break; } - /* It is a pair, fall through. */ + /* Fall Through. */ + case_Pair: Setup_Pointer_for_GC(Transport_Pair()); + break; case TC_VARIABLE: case_Triple: Setup_Pointer_for_GC(Transport_Triple()); - -/* GCLoop continues on the next page */ - -/* GCLoop, continued */ + break; case_Quadruple: Setup_Pointer_for_GC(Transport_Quadruple()); + break; -#ifdef FLOATING_ALIGNMENT - case TC_BIG_FLONUM: - Setup_Pointer_for_GC(Transport_Flonum()); -#else case TC_BIG_FLONUM: - /* Fall through */ -#endif + Setup_Pointer_for_GC({ + Transport_Flonum(); + break; + }); + case_Vector: Setup_Pointer_for_GC(Transport_Vector()); + break; case TC_FUTURE: Setup_Pointer_for_GC(Transport_Future()); + break; case TC_WEAK_CONS: Setup_Pointer_for_GC(Transport_Weak_Cons()); + break; default: sprintf(gc_death_message_buffer, @@ -150,6 +242,8 @@ Pointer **To_Pointer; /*NOTREACHED*/ } /* Switch_by_GC_Type */ } /* For loop */ + *To_Pointer = To; return (To); + } /* GCLoop */ diff --git a/v7/src/microcode/gctype.c b/v7/src/microcode/gctype.c index 2f0c594eb..8d95f3e14 100644 --- a/v7/src/microcode/gctype.c +++ b/v7/src/microcode/gctype.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/gctype.c,v 9.27 1988/02/12 16:51:15 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/gctype.c,v 9.28 1988/03/12 16:06:21 jinx Rel $ * * This file contains the table which maps between Types and * GC Types. @@ -55,7 +55,7 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = { GC_Vector, /* TC_VECTOR */ GC_Non_Pointer, /* TC_RETURN_CODE */ GC_Triple, /* TC_COMBINATION_2 */ - GC_Pair, /* TC_COMPILED_PROCEDURE */ + GC_Special, /* TC_MANIFEST_CLOSURE */ GC_Vector, /* TC_BIG_FIXNUM */ GC_Pair, /* TC_PROCEDURE */ GC_Pair, /* TC_ENTITY */ @@ -87,7 +87,7 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = { GC_Vector, /* TC_COMBINATION */ GC_Special, /* TC_MANIFEST_NM_VECTOR */ - GC_Compiled, /* TC_COMPILED_EXPRESSION */ + GC_Compiled, /* TC_COMPILED_ENTRY */ GC_Pair, /* TC_LEXPR */ GC_Vector, /* TC_PCOMB3 */ GC_Special, /* TC_MANIFEST_SPECIAL_NM_VECTOR */ @@ -104,7 +104,7 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = { GC_Cell, /* TC_CELL */ GC_Pair, /* TC_WEAK_CONS */ GC_Quadruple, /* TC_QUAD */ - GC_Compiled, /* TC_RETURN_ADDRESS */ + GC_Special, /* TC_LINKAGE_SECTION */ GC_Pair, /* TC_RATNUM */ GC_Non_Pointer, /* TC_STACK_ENVIRONMENT */ GC_Pair, /* TC_COMPLEX */ diff --git a/v7/src/microcode/interp.c b/v7/src/microcode/interp.c index ef2db9f6c..f4e4e7cef 100644 --- a/v7/src/microcode/interp.c +++ b/v7/src/microcode/interp.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/interp.c,v 9.39 1988/02/20 06:18:15 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.40 1988/03/12 16:06:40 jinx Exp $ * * This file contains the heart of the Scheme Scode * interpreter @@ -403,19 +403,25 @@ Repeat_Dispatch: { case PRIM_APPLY: LOG_FUTURES(); + case CODE_MAP(PRIM_APPLY): goto Internal_Apply; case PRIM_NO_TRAP_APPLY: LOG_FUTURES(); + case CODE_MAP(PRIM_NO_TRAP_APPLY): goto Apply_Non_Trapping; case PRIM_DO_EXPRESSION: + Val = Fetch_Expression(); LOG_FUTURES(); - Reduces_To(Fetch_Expression()); + case CODE_MAP(PRIM_DO_EXPRESSION): + Reduces_To(Val); case PRIM_NO_TRAP_EVAL: + Val = Fetch_Expression(); LOG_FUTURES(); - New_Reduction(Fetch_Expression(), Fetch_Env()); + case CODE_MAP(PRIM_NO_TRAP_EVAL): + New_Reduction(Val, Fetch_Env()); goto Eval_Non_Trapping; case 0: /* first time */ @@ -430,12 +436,20 @@ Repeat_Dispatch: case PRIM_POP_RETURN: LOG_FUTURES(); + case CODE_MAP(PRIM_POP_RETURN): goto Pop_Return; case PRIM_TOUCH: + { + Pointer temp; + + temp = Val; BACK_OUT_AFTER_PRIMITIVE(); + Val = temp; LOG_FUTURES(); /* fall through */ + } + case CODE_MAP(PRIM_TOUCH): TOUCH_SETUP(Val); goto Internal_Apply; @@ -549,7 +563,6 @@ Eval_Non_Trapping: case TC_CHARACTER_STRING: case TC_CHARACTER: case TC_COMPILED_CODE_BLOCK: - case TC_COMPILED_PROCEDURE: case TC_COMPLEX: case TC_CONTROL_POINT: case TC_DELAYED: @@ -635,7 +648,7 @@ Eval_Non_Trapping: Save_Env(); Do_Nth_Then(RC_CONDITIONAL_DECIDE, COND_PREDICATE, Pushed()); - case TC_COMPILED_EXPRESSION: + case TC_COMPILED_ENTRY: { Pointer compiled_expression; @@ -959,9 +972,6 @@ Pop_Return: define_compiler_restart (RC_COMP_INTERRUPT_RESTART, comp_interrupt_restart) - define_compiler_restart (RC_COMP_LEXPR_INTERRUPT_RESTART, - comp_lexpr_interrupt_restart) - define_compiler_restart (RC_COMP_LOOKUP_APPLY_RESTART, comp_lookup_apply_restart) @@ -986,32 +996,26 @@ Pop_Return: define_compiler_restart (RC_COMP_SAFE_REFERENCE_RESTART, comp_safe_reference_restart) - define_compiler_restart (RC_COMP_CACHE_LOOKUP_RESTART, - comp_cache_lookup_restart) - define_compiler_restart (RC_COMP_LOOKUP_TRAP_RESTART, comp_lookup_trap_restart) - define_compiler_restart (RC_COMP_CACHE_ASSIGN_RESTART, - comp_cache_assignment_restart) - define_compiler_restart (RC_COMP_ASSIGNMENT_TRAP_RESTART, comp_assignment_trap_restart) - define_compiler_restart (RC_COMP_CACHE_OPERATOR_RESTART, - comp_cache_operator_restart) - define_compiler_restart (RC_COMP_OP_REF_TRAP_RESTART, - comp_op_ref_trap_restart) + comp_op_lookup_trap_restart) define_compiler_restart (RC_COMP_CACHE_REF_APPLY_RESTART, - comp_cache_ref_apply_restart) + comp_cache_lookup_apply_restart) define_compiler_restart (RC_COMP_SAFE_REF_TRAP_RESTART, - comp_safe_ref_trap_restart) + comp_safe_lookup_trap_restart) define_compiler_restart (RC_COMP_UNASSIGNED_TRAP_RESTART, comp_unassigned_p_trap_restart) + + define_compiler_restart (RC_COMP_LINK_CACHES_RESTART, + comp_link_caches_restart) case RC_REENTER_COMPILED_CODE: compiled_code_restart(); @@ -1309,12 +1313,12 @@ external_assignment_return: Save_Cont(); \ } -#define Apply_Error(N) \ -{ \ - Store_Return(RC_INTERNAL_APPLY); \ - Store_Expression(NIL); \ - Val = NIL; \ - Pop_Return_Error(N); \ +#define Apply_Error(N) +{ + Store_Return(RC_INTERNAL_APPLY); + Store_Expression(NIL); + Val = NIL; + Pop_Return_Error(N); } /* Interpret() continues on the next page */ @@ -1599,7 +1603,7 @@ Perform_Application: /* Interpret(), continued */ - case TC_COMPILED_PROCEDURE: + case TC_COMPILED_ENTRY: { apply_compiled_setup(STACK_ENV_EXTRA_SLOTS + Get_Integer( Stack_Ref( STACK_ENV_HEADER))); @@ -1611,30 +1615,48 @@ return_from_compiled_code: switch (Which_Way) { case PRIM_DONE: - { compiled_code_done(); + { + compiled_code_done(); goto Pop_Return; } case PRIM_APPLY: - { compiler_apply_procedure(STACK_ENV_EXTRA_SLOTS + + { + compiler_apply_procedure(STACK_ENV_EXTRA_SLOTS + Get_Integer( Stack_Ref( STACK_ENV_HEADER))); goto Internal_Apply; } - case ERR_COMPILED_CODE_ERROR: - { /* The compiled code is signalling a microcode error. */ - compiled_error_backout(); - /* The Save_Cont is done by Pop_Return_Error. */ - Pop_Return_Error( compiled_code_error_code); - } - case PRIM_INTERRUPT: { compiled_error_backout(); Save_Cont(); Interrupt(PENDING_INTERRUPTS()); } + + + case PRIM_APPLY_INTERRUPT: + { + apply_compiled_backout(); + Prepare_Apply_Interrupt(); + Interrupt(PENDING_INTERRUPTS()); + } + + case ERR_COMPILED_CODE_ERROR: + { + /* The compiled code is signalling a microcode error. */ + compiled_error_backout(); + /* The Save_Cont is done by Pop_Return_Error. */ + Pop_Return_Error( compiled_code_error_code); + } + case ERR_INAPPLICABLE_OBJECT: + /* This error code means that apply_compiled_procedure + was called on an object which is not a compiled procedure. + + Fall through... + */ + case ERR_WRONG_NUMBER_OF_ARGUMENTS: { apply_compiled_backout(); @@ -1652,28 +1674,34 @@ return_from_compiled_code: } case ERR_EXECUTE_MANIFEST_VECTOR: - { /* This error code means that enter_compiled_expression + { + /* This error code means that enter_compiled_expression was called in a system without compiler support. */ + execute_compiled_backout(); - Val = Make_Non_Pointer( TC_COMPILED_EXPRESSION, + Val = Make_Non_Pointer( TC_COMPILED_ENTRY, Fetch_Expression()); Pop_Return_Error( Which_Way); } - case ERR_INAPPLICABLE_OBJECT: - { /* This error code means that apply_compiled_procedure + case ERR_BAD_COMBINATION: + { + /* This error code means that apply_compiled_procedure was called in a system without compiler support. */ + apply_compiled_backout(); Apply_Error( Which_Way); } case ERR_INAPPLICABLE_CONTINUATION: - { /* This error code means that return_to_compiled_code + { + /* This error code means that return_to_compiled_code or some other compiler continuation was called in a system without compiler support. */ + Store_Expression(NIL); Store_Return(RC_REENTER_COMPILED_CODE); Pop_Return_Error(Which_Way); diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c index 6720cee78..90c5c6f5a 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.31 1988/02/20 06:18:49 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.32 1988/03/12 16:07:11 jinx Exp $ * * This file contains the code that copies objects into pure * and constant space. @@ -47,26 +47,41 @@ MIT in each case. */ extern void GCFlip(), GC(); extern Pointer *GCLoop(); -/* This is a copy of GCLoop, with GC_Mode handling added, and +/* This is a copy of GCLoop, with mode handling added, and debugging printout removed. */ -#define Purify_Pointer(Code) \ -Old = Get_Pointer(Temp); \ -if ((GC_Mode == CONSTANT_COPY) && \ - (Old > Low_Constant)) \ - continue; \ -Code +/* Purify modes */ -#define Setup_Pointer_for_Purify(Extra_Code) \ -Purify_Pointer(Setup_Pointer(false, Extra_Code)) +#define NORMAL_GC 0 +#define PURE_COPY 1 +#define CONSTANT_COPY 2 -#define Indirect_BH(In_GC) \ -if (Type_Code(*Old) == TC_BROKEN_HEART) continue; +#define Purify_Pointer(Code) \ +{ \ + Old = Get_Pointer(Temp); \ + if ((GC_Mode == CONSTANT_COPY) && \ + (Old > Low_Constant)) \ + continue; \ + Code; \ +} + +#define Setup_Pointer_for_Purify(Extra_Code) \ +{ \ + Purify_Pointer(Setup_Pointer(false, Extra_Code)); \ +} -#define Transport_Vector_Indirect() \ -Real_Transport_Vector(); \ -*Get_Pointer(Temp) = New_Address +#define Indirect_BH(In_GC) \ +{ \ + if (OBJECT_TYPE(*Old) == TC_BROKEN_HEART) \ + continue; \ +} + +#define Transport_Vector_Indirect() \ +{ \ + Real_Transport_Vector(); \ + *Get_Pointer(Temp) = New_Address; \ +} Pointer * PurifyLoop(Scan, To_Pointer, GC_Mode) @@ -102,20 +117,104 @@ PurifyLoop(Scan, To_Pointer, GC_Mode) case_Non_Pointer: break; + + /* Compiled code relocation. */ - case_compiled_entry_point: + case TC_LINKAGE_SECTION: + { if (GC_Mode == PURE_COPY) + { + gc_death(TERM_COMPILER_DEATH, + "purifyloop: linkage section in pure area", + Scan, To); + /*NOTREACHED*/ + } + if (READ_LINKAGE_KIND(Temp) != OPERATOR_LINKAGE_KIND) + { + /* Assumes that all others are objects of type TC_QUAD without + their type codes. + */ + + fast long count; + + Scan++; + for (count = READ_CACHE_LINKAGE_COUNT(Temp); + --count >= 0; + Scan += 1) + { + Temp = *Scan; + Setup_Pointer_for_Purify(Transport_Quadruple()); + } + Scan -= 1; + break; + } + else + { + fast long count; + fast machine_word *word_ptr; + Pointer *end_scan; + + count = READ_OPERATOR_LINKAGE_COUNT(Temp); + word_ptr = FIRST_OPERATOR_LINKAGE_ENTRY(Scan); + end_scan = END_OPERATOR_LINKAGE_AREA(Scan, count); + + while(--count >= 0) + { + Scan = ((Pointer *) word_ptr); + word_ptr = NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr); + Temp = *Scan; + Purify_Pointer(Setup_Internal(false, + Transport_Compiled(), + Compiled_BH(false, continue))); + } + Scan = end_scan; break; - Purify_Pointer(Setup_Internal(false, - Transport_Compiled(), - Compiled_BH(false, continue))); + } + } + + case TC_MANIFEST_CLOSURE: + { + machine_word *start_ptr; + fast machine_word *word_ptr; + Pointer *saved_scan; - case_Cell: - Setup_Pointer_for_Purify(Transport_Cell()); + if (GC_Mode == PURE_COPY) + { + gc_death(TERM_COMPILER_DEATH, + "purifyloop: manifest closure in pure area", + Scan, To); + /*NOTREACHED*/ + } -/* PurifyLoop continues on the next page */ + saved_scan = ++Scan; + word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(Scan); + start_ptr = word_ptr; + + while (VALID_MANIFEST_CLOSURE_ENTRY(word_ptr)) + { + Scan = MANIFEST_CLOSURE_ENTRY_ADDRESS(word_ptr); + word_ptr = NEXT_MANIFEST_CLOSURE_ENTRY(word_ptr); + Temp = *Scan; + Purify_Pointer(Setup_Internal(false, + Transport_Compiled(), + Compiled_BH(false, continue))); + } + Scan = saved_scan + MANIFEST_CLOSURE_SIZE(word_ptr, start_ptr); + break; + } + + case_compiled_entry_point: + if (GC_Mode != PURE_COPY) + { + Purify_Pointer(Setup_Internal(false, + Transport_Compiled(), + Compiled_BH(false, continue))); + } + break; -/* PurifyLoop, continued */ + case_Cell: + Setup_Pointer_for_Purify(Transport_Cell()); + break; /* Symbols, variables, and reference traps cannot be put into @@ -124,7 +223,8 @@ PurifyLoop(Scan, To_Pointer, GC_Mode) */ case TC_REFERENCE_TRAP: - if ((Datum(Temp) <= TRAP_MAX_IMMEDIATE) || (GC_Mode == PURE_COPY)) + if ((OBJECT_DATUM(Temp) <= TRAP_MAX_IMMEDIATE) || + (GC_Mode == PURE_COPY)) { /* It is a non pointer. */ break; @@ -139,18 +239,24 @@ PurifyLoop(Scan, To_Pointer, GC_Mode) Purify_Pointer(Setup_Internal(false, Transport_Vector_Indirect(), Indirect_BH(false))); + break; } + /* Fall through */ + case_Fasdump_Pair: purify_pair: Setup_Pointer_for_Purify(Transport_Pair()); + break; case TC_WEAK_CONS: Setup_Pointer_for_Purify(Transport_Weak_Cons()); + break; case TC_VARIABLE: case_Triple: Setup_Pointer_for_Purify(Transport_Triple()); + break; /* PurifyLoop continues on the next page */ @@ -158,6 +264,7 @@ PurifyLoop(Scan, To_Pointer, GC_Mode) case_Quadruple: Setup_Pointer_for_Purify(Transport_Quadruple()); + break; /* No need to handle futures specially here, since PurifyLoop is always invoked after running GCLoop, which will have @@ -165,29 +272,28 @@ PurifyLoop(Scan, To_Pointer, GC_Mode) GC dameons spliced them, but this should not occur. */ - case TC_COMPILED_CODE_BLOCK: case TC_FUTURE: case TC_ENVIRONMENT: + case TC_COMPILED_CODE_BLOCK: if (GC_Mode == PURE_COPY) { - /* This should actually do an indirect pair transport of - the procedure, at least. + /* For environments, this should actually do an indirect pair + transport of the procedure, at least. */ break; } /* Fall through */ -#ifndef FLOATING_ALIGNMENT - case TC_BIG_FLONUM: - /* Fall through */ -#endif + case_Purify_Vector: purify_vector: Setup_Pointer_for_Purify(Transport_Vector()); + break; -#ifdef FLOATING_ALIGNMENT case TC_BIG_FLONUM: - Setup_Pointer_for_Purify(Transport_Flonum()); -#endif + Setup_Pointer_for_Purify({ + Transport_Flonum(); + break; + }); default: sprintf(gc_death_message_buffer, @@ -198,8 +304,10 @@ PurifyLoop(Scan, To_Pointer, GC_Mode) /*NOTREACHED*/ } /* Switch_by_GC_Type */ } /* For loop */ + *To_Pointer = To; return (To); + } /* PurifyLoop */ /* Description of the algorithm for PURIFY: @@ -316,7 +424,7 @@ Pointer Info; *Free_Constant++ = Relocated_Object; if (Purify_Object) { - Result = PurifyLoop(New_Object+1, &Free_Constant, PURE_COPY); + Result = PurifyLoop(New_Object + 1, &Free_Constant, PURE_COPY); if (Free_Constant != Result) { @@ -352,9 +460,9 @@ Pointer Info; Microcode_Termination(TERM_BROKEN_HEART); } } - Recomputed_Length = (Free_Constant-New_Object)-4; + Recomputed_Length = ((Free_Constant - New_Object) - 4); *Free_Constant++ = Make_Non_Pointer(TC_MANIFEST_SPECIAL_NM_VECTOR, 1); - *Free_Constant++ = Make_Non_Pointer(END_OF_BLOCK, Recomputed_Length+5); + *Free_Constant++ = Make_Non_Pointer(END_OF_BLOCK, (Recomputed_Length + 5)); if (Length > Recomputed_Length) { fprintf(stderr, "\nPurify phase error %x, %x\n", @@ -363,10 +471,10 @@ Pointer Info; } *New_Object++ = Make_Non_Pointer(TC_MANIFEST_SPECIAL_NM_VECTOR, Pure_Length); - *New_Object = Make_Non_Pointer(PURE_PART, Recomputed_Length+5); + *New_Object = Make_Non_Pointer(PURE_PART, (Recomputed_Length + 5)); GC(); Set_Pure_Top(); - return TRUTH; + return (TRUTH); } /* (PRIMITIVE-PURIFY OBJECT PURE?) diff --git a/v7/src/microcode/purutl.c b/v7/src/microcode/purutl.c index c0bdfe4e5..b87bf1bf0 100644 --- a/v7/src/microcode/purutl.c +++ b/v7/src/microcode/purutl.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/purutl.c,v 9.32 1987/11/17 08:15:51 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purutl.c,v 9.33 1988/03/12 16:07:29 jinx Rel $ */ /* Pure/Constant space utilities. */ @@ -43,13 +43,43 @@ void Update(From, To, Was, Will_Be) fast Pointer *From, *To, *Was, *Will_Be; { + fast long count; + for (; From < To; From++) { if (GC_Type_Special(*From)) { - if (OBJECT_TYPE(*From) == TC_MANIFEST_NM_VECTOR) - From += Get_Integer(*From); - continue; + switch(OBJECT_TYPE(*From)) + { + case TC_MANIFEST_NM_VECTOR: + From += OBJECT_DATUM(*From); + continue; + + /* The following two type codes assume that none of the protected + objects can be updated. + This may be seriously wrong! + */ + case TC_LINKAGE_SECTION: + if (READ_LINKAGE_KIND(*From) != OPERATOR_LINKAGE_KIND) + { + From += READ_CACHE_LINKAGE_COUNT(*From); + continue; + } + else + { + count = READ_OPERATOR_LINKAGE_COUNT(*From); + 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; + + default: + continue; + } } if (GC_Type_Non_Pointer(*From)) continue; @@ -79,7 +109,7 @@ Make_Impure(Object) case TC_MANIFEST_NM_VECTOR: case TC_MANIFEST_SPECIAL_NM_VECTOR: case_Non_Pointer: - fprintf(stderr, "\nImpurify Non-Pointer.\n"); + fprintf(stderr, "\nImpurify Non-Pointer (0x%lx)\n", Object); Microcode_Termination(TERM_NON_POINTER_RELOCATION); case TC_BIG_FLONUM: @@ -106,8 +136,11 @@ Make_Impure(Object) Length = 1; break; + case TC_LINKAGE_SECTION: + case TC_MANIFEST_CLOSURE: + case_compiled_entry_point: default: - fprintf(stderr, "\nImpurify: Bad type code = 0x%02x\n", + fprintf(stderr, "\nImpurify: Bad type code = 0x%02x.\n", OBJECT_TYPE(Object)); Invalid_Type_Code(); } diff --git a/v7/src/microcode/returns.h b/v7/src/microcode/returns.h index 89eaeab98..4bfb6e722 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.30 1988/02/06 20:41:26 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/returns.h,v 9.31 1988/03/12 16:07:42 jinx Rel $ * * Return codes. These are placed in Return when an * interpreter operation needs to operate in several @@ -112,21 +112,22 @@ MIT in each case. */ #define RC_COMP_UNASSIGNED_P_RESTART 0x4D #define RC_COMP_UNBOUND_P_RESTART 0x4E #define RC_COMP_DEFINITION_RESTART 0x4F -#define RC_COMP_LEXPR_INTERRUPT_RESTART 0x50 +/* formerly RC_COMP_LEXPR_INTERRUPT_RESTART 0x50 */ #define RC_COMP_SAFE_REFERENCE_RESTART 0x51 -#define RC_COMP_CACHE_LOOKUP_RESTART 0x52 +/* formerly RC_COMP_CACHE_LOOKUP_RESTART 0x52 */ #define RC_COMP_LOOKUP_TRAP_RESTART 0x53 #define RC_COMP_ASSIGNMENT_TRAP_RESTART 0x54 -#define RC_COMP_CACHE_OPERATOR_RESTART 0x55 +/* formerly RC_COMP_CACHE_OPERATOR_RESTART 0x55 */ #define RC_COMP_OP_REF_TRAP_RESTART 0x56 #define RC_COMP_CACHE_REF_APPLY_RESTART 0x57 #define RC_COMP_SAFE_REF_TRAP_RESTART 0x58 #define RC_COMP_UNASSIGNED_TRAP_RESTART 0x59 -#define RC_COMP_CACHE_ASSIGN_RESTART 0x5A +/* formerly RC_COMP_CACHE_ASSIGN_RESTART 0x5A */ +#define RC_COMP_LINK_CACHES_RESTART 0x5B /* When adding return codes, add them to the table below as well! */ -#define MAX_RETURN_CODE 0x5A +#define MAX_RETURN_CODE 0x5B #define RETURN_NAME_TABLE \ { \ @@ -211,15 +212,16 @@ MIT in each case. */ /* 0x4D */ "COMPILER_UNASSIGNED_P_RESTART", \ /* 0x4E */ "COMPILER_UNBOUND_P_RESTART", \ /* 0x4F */ "COMPILER_DEFINITION_RESTART", \ -/* 0x50 */ "COMPILER_LEXPR_GC_RESTART", \ +/* 0x50 */ "", \ /* 0x51 */ "COMPILER_SAFE_REFERENCE_RESTART", \ -/* 0x52 */ "COMPILER_CACHE_LOOKUP_RESTART", \ +/* 0x52 */ "", \ /* 0x53 */ "COMPILER_LOOKUP_TRAP_RESTART", \ /* 0x54 */ "COMPILER_ASSIGNMENT_TRAP_RESTART", \ -/* 0x55 */ "COMPILER_CACHE_OPERATOR_RESTART", \ +/* 0X55 */ "", \ /* 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" \ +/* 0x5A */ "", \ +/* 0x5A */ "COMPILER_LINK_CACHES_RESTART" \ } diff --git a/v7/src/microcode/types.h b/v7/src/microcode/types.h index d7af60610..49d1e612c 100644 --- a/v7/src/microcode/types.h +++ b/v7/src/microcode/types.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/types.h,v 9.27 1988/02/12 16:52:46 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/types.h,v 9.28 1988/03/12 16:07:56 jinx Rel $ * * Type code definitions, numerical order * @@ -51,7 +51,7 @@ MIT in each case. */ #define TC_VECTOR 0x0A #define TC_RETURN_CODE 0x0B #define TC_COMBINATION_2 0x0C -#define TC_COMPILED_PROCEDURE 0x0D +#define TC_MANIFEST_CLOSURE 0x0D #define TC_BIG_FIXNUM 0x0E #define TC_PROCEDURE 0x0F #define TC_ENTITY 0x10 /* PRIMITIVE_EXTERNAL */ @@ -79,7 +79,7 @@ MIT in each case. */ #define TC_IN_PACKAGE 0x25 #define TC_COMBINATION 0x26 #define TC_MANIFEST_NM_VECTOR 0x27 -#define TC_COMPILED_EXPRESSION 0x28 +#define TC_COMPILED_ENTRY 0x28 #define TC_LEXPR 0x29 #define TC_PCOMB3 0x2A #define TC_MANIFEST_SPECIAL_NM_VECTOR 0x2B @@ -96,7 +96,7 @@ MIT in each case. */ #define TC_CELL 0x36 #define TC_WEAK_CONS 0x37 #define TC_QUAD 0x38 /* TRAP */ -#define TC_RETURN_ADDRESS 0x39 +#define TC_LINKAGE_SECTION 0x39 #define TC_RATNUM 0x3A /* COMPILER_LINK */ #define TC_STACK_ENVIRONMENT 0x3B #define TC_COMPLEX 0x3C @@ -123,7 +123,7 @@ MIT in each case. */ /* 0x0A */ "VECTOR", \ /* 0x0B */ "RETURN-CODE", \ /* 0x0C */ "COMBINATION-2", \ - /* 0x0D */ "COMPILED-PROCEDURE", \ + /* 0x0D */ "MANIFEST-CLOSURE", \ /* 0x0E */ "BIG-FIXNUM", \ /* 0x0F */ "PROCEDURE", \ /* 0x10 */ "ENTITY", \ @@ -150,7 +150,7 @@ MIT in each case. */ /* 0x25 */ "IN-PACKAGE", \ /* 0x26 */ "COMBINATION", \ /* 0x27 */ "MANIFEST-NM-VECTOR", \ - /* 0x28 */ "COMPILED-EXPRESSION", \ + /* 0x28 */ "COMPILED-ENTRY", \ /* 0x29 */ "LEXPR", \ /* 0x2A */ "PCOMB3", \ /* 0x2B */ "MANIFEST-SPECIAL-NM-VECTOR", \ @@ -167,7 +167,7 @@ MIT in each case. */ /* 0x36 */ "CELL", \ /* 0x37 */ "WEAK-CONS", \ /* 0x38 */ "QUAD", \ - /* 0x39 */ "RETURN-ADDRESS", \ + /* 0x39 */ "LINKAGE-SECTION", \ /* 0x3A */ "RATNUM", \ /* 0x3B */ "STACK-ENVIRONMENT", \ /* 0x3C */ "COMPLEX", \ diff --git a/v7/src/microcode/utabmd.scm b/v7/src/microcode/utabmd.scm index a5101e9bf..66375b2ba 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.42 1988/02/12 16:53:42 jinx Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.43 1988/03/12 16:08:08 jinx Exp $ (declare (usual-integrations)) @@ -109,7 +109,7 @@ VECTOR ;0A (RETURN-CODE RETURN-ADDRESS) ;0B COMBINATION-2 ;0C - COMPILED-PROCEDURE ;0D + MANIFEST-CLOSURE ;0D (BIGNUM BIG-FIXNUM) ;0E PROCEDURE ;0F (ENTITY) ;10 @@ -136,7 +136,7 @@ IN-PACKAGE ;25 COMBINATION ;26 MANIFEST-NM-VECTOR ;27 - COMPILED-EXPRESSION ;28 + COMPILED-ENTRY ;28 LEXPR ;29 PRIMITIVE-COMBINATION-3 ;2A MANIFEST-SPECIAL-NM-VECTOR ;2B @@ -153,7 +153,7 @@ CELL ;36 WEAK-CONS ;37 QUAD ;38 - COMPILER-RETURN-ADDRESS ;39 + LINKAGE-SECTION ;39 RATNUM ;3A STACK-ENVIRONMENT ;3B (RECNUM COMPLEX) ;3C @@ -438,17 +438,18 @@ COMPILER-UNASSIGNED?-RESTART ;4D COMPILER-UNBOUND?-RESTART ;4E COMPILER-DEFINITION-RESTART ;4F - COMPILER-LEXPR-INTERRUPT-RESTART ;50 + #F ;50 COMPILER-SAFE-REFERENCE-RESTART ;51 - COMPILER-CACHE-VARIABLE-RESTART ;52 + #F ;52 COMPILER-REFERENCE-TRAP-RESTART ;53 COMPILER-ASSIGNMENT-TRAP-RESTART ;54 - COMPILER-UUO-LINK-RESTART ;55 - COMPILER-UUO-LINK-TRAP-RESTART ;56 - COMPILER-CACHE-REFERENCE-APPLY-RESTART ;57 + #F ;55 + COMPILER-OPERATOR-LOOKUP-TRAP-RESTART ;56 + COMPILER-LOOKUP-APPLY-TRAP-RESTART ;57 COMPILER-SAFE-REFERENCE-TRAP-RESTART ;58 COMPILER-UNASSIGNED?-TRAP-RESTART ;59 - COMPILER-CACHE-ASSIGNMENT-RESTART ;5A + #F ;5A + COMPILER-LINK-CACHES-RESTART ;5B )) ;;; [] Errors @@ -569,4 +570,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.42 1988/02/12 16:53:42 jinx Exp $" \ No newline at end of file +"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.43 1988/03/12 16:08:08 jinx Exp $" \ No newline at end of file diff --git a/v7/src/microcode/utils.c b/v7/src/microcode/utils.c index 254714fa7..bf8d7b895 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.36 1987/12/04 22:20:24 jinx Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.37 1988/03/12 16:08:24 jinx Rel $ */ /* This file contains utilities for interrupts, errors, etc. */ @@ -191,7 +191,7 @@ Back_Out_Of_Primitive () primitive = Fetch_Expression(); nargs = PRIMITIVE_N_ARGUMENTS(primitive); - if (OBJECT_TYPE(Stack_Ref(nargs)) == TC_RETURN_ADDRESS) + if (OBJECT_TYPE(Stack_Ref(nargs)) == TC_COMPILED_ENTRY) { compiler_apply_procedure(nargs); } @@ -225,7 +225,6 @@ void signal_error_from_primitive (error_code) long error_code; { - PRIMITIVE_ABORT(error_code); /*NOTREACHED*/ } diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index e9d4aedc5..61e0947e0 100644 --- a/v7/src/microcode/version.h +++ b/v7/src/microcode/version.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.27 1988/02/29 01:33:33 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.28 1988/03/12 16:08:44 jinx Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -46,7 +46,7 @@ MIT in each case. */ #define VERSION 10 #endif #ifndef SUBVERSION -#define SUBVERSION 27 +#define SUBVERSION 28 #endif #ifndef UCODE_TABLES_FILENAME diff --git a/v8/src/microcode/const.h b/v8/src/microcode/const.h index 6c51a4204..e72248c37 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.27 1988/02/06 20:39:40 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/const.h,v 9.28 1988/03/12 16:04:43 jinx Rel $ * * Named constants used throughout the interpreter * @@ -117,6 +117,7 @@ MIT in each case. */ #define PRIM_NO_TRAP_APPLY -6 #define PRIM_POP_RETURN -7 #define PRIM_TOUCH -8 +#define PRIM_APPLY_INTERRUPT -9 #define ABORT_NAME_TABLE \ { \ @@ -127,7 +128,8 @@ MIT in each case. */ /* -5 */ "NO-TRAP-EVAL", \ /* -6 */ "NO-TRAP_APPLY", \ /* -7 */ "POP-RETURN", \ - /* -8 */ "TOUCH" \ + /* -8 */ "TOUCH", \ + /* -9 */ "APPLY-INTERRUPT" \ } /* Some numbers of parameters which mean something special */ diff --git a/v8/src/microcode/gctype.c b/v8/src/microcode/gctype.c index 57f6c3c65..a6b877269 100644 --- a/v8/src/microcode/gctype.c +++ b/v8/src/microcode/gctype.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/gctype.c,v 9.27 1988/02/12 16:51:15 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/gctype.c,v 9.28 1988/03/12 16:06:21 jinx Rel $ * * This file contains the table which maps between Types and * GC Types. @@ -55,7 +55,7 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = { GC_Vector, /* TC_VECTOR */ GC_Non_Pointer, /* TC_RETURN_CODE */ GC_Triple, /* TC_COMBINATION_2 */ - GC_Pair, /* TC_COMPILED_PROCEDURE */ + GC_Special, /* TC_MANIFEST_CLOSURE */ GC_Vector, /* TC_BIG_FIXNUM */ GC_Pair, /* TC_PROCEDURE */ GC_Pair, /* TC_ENTITY */ @@ -87,7 +87,7 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = { GC_Vector, /* TC_COMBINATION */ GC_Special, /* TC_MANIFEST_NM_VECTOR */ - GC_Compiled, /* TC_COMPILED_EXPRESSION */ + GC_Compiled, /* TC_COMPILED_ENTRY */ GC_Pair, /* TC_LEXPR */ GC_Vector, /* TC_PCOMB3 */ GC_Special, /* TC_MANIFEST_SPECIAL_NM_VECTOR */ @@ -104,7 +104,7 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = { GC_Cell, /* TC_CELL */ GC_Pair, /* TC_WEAK_CONS */ GC_Quadruple, /* TC_QUAD */ - GC_Compiled, /* TC_RETURN_ADDRESS */ + GC_Special, /* TC_LINKAGE_SECTION */ GC_Pair, /* TC_RATNUM */ GC_Non_Pointer, /* TC_STACK_ENVIRONMENT */ GC_Pair, /* TC_COMPLEX */ diff --git a/v8/src/microcode/interp.c b/v8/src/microcode/interp.c index b6ccc6b7f..d08a6b626 100644 --- a/v8/src/microcode/interp.c +++ b/v8/src/microcode/interp.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/interp.c,v 9.39 1988/02/20 06:18:15 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.40 1988/03/12 16:06:40 jinx Exp $ * * This file contains the heart of the Scheme Scode * interpreter @@ -403,19 +403,25 @@ Repeat_Dispatch: { case PRIM_APPLY: LOG_FUTURES(); + case CODE_MAP(PRIM_APPLY): goto Internal_Apply; case PRIM_NO_TRAP_APPLY: LOG_FUTURES(); + case CODE_MAP(PRIM_NO_TRAP_APPLY): goto Apply_Non_Trapping; case PRIM_DO_EXPRESSION: + Val = Fetch_Expression(); LOG_FUTURES(); - Reduces_To(Fetch_Expression()); + case CODE_MAP(PRIM_DO_EXPRESSION): + Reduces_To(Val); case PRIM_NO_TRAP_EVAL: + Val = Fetch_Expression(); LOG_FUTURES(); - New_Reduction(Fetch_Expression(), Fetch_Env()); + case CODE_MAP(PRIM_NO_TRAP_EVAL): + New_Reduction(Val, Fetch_Env()); goto Eval_Non_Trapping; case 0: /* first time */ @@ -430,12 +436,20 @@ Repeat_Dispatch: case PRIM_POP_RETURN: LOG_FUTURES(); + case CODE_MAP(PRIM_POP_RETURN): goto Pop_Return; case PRIM_TOUCH: + { + Pointer temp; + + temp = Val; BACK_OUT_AFTER_PRIMITIVE(); + Val = temp; LOG_FUTURES(); /* fall through */ + } + case CODE_MAP(PRIM_TOUCH): TOUCH_SETUP(Val); goto Internal_Apply; @@ -549,7 +563,6 @@ Eval_Non_Trapping: case TC_CHARACTER_STRING: case TC_CHARACTER: case TC_COMPILED_CODE_BLOCK: - case TC_COMPILED_PROCEDURE: case TC_COMPLEX: case TC_CONTROL_POINT: case TC_DELAYED: @@ -635,7 +648,7 @@ Eval_Non_Trapping: Save_Env(); Do_Nth_Then(RC_CONDITIONAL_DECIDE, COND_PREDICATE, Pushed()); - case TC_COMPILED_EXPRESSION: + case TC_COMPILED_ENTRY: { Pointer compiled_expression; @@ -959,9 +972,6 @@ Pop_Return: define_compiler_restart (RC_COMP_INTERRUPT_RESTART, comp_interrupt_restart) - define_compiler_restart (RC_COMP_LEXPR_INTERRUPT_RESTART, - comp_lexpr_interrupt_restart) - define_compiler_restart (RC_COMP_LOOKUP_APPLY_RESTART, comp_lookup_apply_restart) @@ -986,32 +996,26 @@ Pop_Return: define_compiler_restart (RC_COMP_SAFE_REFERENCE_RESTART, comp_safe_reference_restart) - define_compiler_restart (RC_COMP_CACHE_LOOKUP_RESTART, - comp_cache_lookup_restart) - define_compiler_restart (RC_COMP_LOOKUP_TRAP_RESTART, comp_lookup_trap_restart) - define_compiler_restart (RC_COMP_CACHE_ASSIGN_RESTART, - comp_cache_assignment_restart) - define_compiler_restart (RC_COMP_ASSIGNMENT_TRAP_RESTART, comp_assignment_trap_restart) - define_compiler_restart (RC_COMP_CACHE_OPERATOR_RESTART, - comp_cache_operator_restart) - define_compiler_restart (RC_COMP_OP_REF_TRAP_RESTART, - comp_op_ref_trap_restart) + comp_op_lookup_trap_restart) define_compiler_restart (RC_COMP_CACHE_REF_APPLY_RESTART, - comp_cache_ref_apply_restart) + comp_cache_lookup_apply_restart) define_compiler_restart (RC_COMP_SAFE_REF_TRAP_RESTART, - comp_safe_ref_trap_restart) + comp_safe_lookup_trap_restart) define_compiler_restart (RC_COMP_UNASSIGNED_TRAP_RESTART, comp_unassigned_p_trap_restart) + + define_compiler_restart (RC_COMP_LINK_CACHES_RESTART, + comp_link_caches_restart) case RC_REENTER_COMPILED_CODE: compiled_code_restart(); @@ -1309,12 +1313,12 @@ external_assignment_return: Save_Cont(); \ } -#define Apply_Error(N) \ -{ \ - Store_Return(RC_INTERNAL_APPLY); \ - Store_Expression(NIL); \ - Val = NIL; \ - Pop_Return_Error(N); \ +#define Apply_Error(N) +{ + Store_Return(RC_INTERNAL_APPLY); + Store_Expression(NIL); + Val = NIL; + Pop_Return_Error(N); } /* Interpret() continues on the next page */ @@ -1599,7 +1603,7 @@ Perform_Application: /* Interpret(), continued */ - case TC_COMPILED_PROCEDURE: + case TC_COMPILED_ENTRY: { apply_compiled_setup(STACK_ENV_EXTRA_SLOTS + Get_Integer( Stack_Ref( STACK_ENV_HEADER))); @@ -1611,30 +1615,48 @@ return_from_compiled_code: switch (Which_Way) { case PRIM_DONE: - { compiled_code_done(); + { + compiled_code_done(); goto Pop_Return; } case PRIM_APPLY: - { compiler_apply_procedure(STACK_ENV_EXTRA_SLOTS + + { + compiler_apply_procedure(STACK_ENV_EXTRA_SLOTS + Get_Integer( Stack_Ref( STACK_ENV_HEADER))); goto Internal_Apply; } - case ERR_COMPILED_CODE_ERROR: - { /* The compiled code is signalling a microcode error. */ - compiled_error_backout(); - /* The Save_Cont is done by Pop_Return_Error. */ - Pop_Return_Error( compiled_code_error_code); - } - case PRIM_INTERRUPT: { compiled_error_backout(); Save_Cont(); Interrupt(PENDING_INTERRUPTS()); } + + + case PRIM_APPLY_INTERRUPT: + { + apply_compiled_backout(); + Prepare_Apply_Interrupt(); + Interrupt(PENDING_INTERRUPTS()); + } + + case ERR_COMPILED_CODE_ERROR: + { + /* The compiled code is signalling a microcode error. */ + compiled_error_backout(); + /* The Save_Cont is done by Pop_Return_Error. */ + Pop_Return_Error( compiled_code_error_code); + } + case ERR_INAPPLICABLE_OBJECT: + /* This error code means that apply_compiled_procedure + was called on an object which is not a compiled procedure. + + Fall through... + */ + case ERR_WRONG_NUMBER_OF_ARGUMENTS: { apply_compiled_backout(); @@ -1652,28 +1674,34 @@ return_from_compiled_code: } case ERR_EXECUTE_MANIFEST_VECTOR: - { /* This error code means that enter_compiled_expression + { + /* This error code means that enter_compiled_expression was called in a system without compiler support. */ + execute_compiled_backout(); - Val = Make_Non_Pointer( TC_COMPILED_EXPRESSION, + Val = Make_Non_Pointer( TC_COMPILED_ENTRY, Fetch_Expression()); Pop_Return_Error( Which_Way); } - case ERR_INAPPLICABLE_OBJECT: - { /* This error code means that apply_compiled_procedure + case ERR_BAD_COMBINATION: + { + /* This error code means that apply_compiled_procedure was called in a system without compiler support. */ + apply_compiled_backout(); Apply_Error( Which_Way); } case ERR_INAPPLICABLE_CONTINUATION: - { /* This error code means that return_to_compiled_code + { + /* This error code means that return_to_compiled_code or some other compiler continuation was called in a system without compiler support. */ + Store_Expression(NIL); Store_Return(RC_REENTER_COMPILED_CODE); Pop_Return_Error(Which_Way); diff --git a/v8/src/microcode/returns.h b/v8/src/microcode/returns.h index e86a086ff..339f898b1 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.30 1988/02/06 20:41:26 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/returns.h,v 9.31 1988/03/12 16:07:42 jinx Rel $ * * Return codes. These are placed in Return when an * interpreter operation needs to operate in several @@ -112,21 +112,22 @@ MIT in each case. */ #define RC_COMP_UNASSIGNED_P_RESTART 0x4D #define RC_COMP_UNBOUND_P_RESTART 0x4E #define RC_COMP_DEFINITION_RESTART 0x4F -#define RC_COMP_LEXPR_INTERRUPT_RESTART 0x50 +/* formerly RC_COMP_LEXPR_INTERRUPT_RESTART 0x50 */ #define RC_COMP_SAFE_REFERENCE_RESTART 0x51 -#define RC_COMP_CACHE_LOOKUP_RESTART 0x52 +/* formerly RC_COMP_CACHE_LOOKUP_RESTART 0x52 */ #define RC_COMP_LOOKUP_TRAP_RESTART 0x53 #define RC_COMP_ASSIGNMENT_TRAP_RESTART 0x54 -#define RC_COMP_CACHE_OPERATOR_RESTART 0x55 +/* formerly RC_COMP_CACHE_OPERATOR_RESTART 0x55 */ #define RC_COMP_OP_REF_TRAP_RESTART 0x56 #define RC_COMP_CACHE_REF_APPLY_RESTART 0x57 #define RC_COMP_SAFE_REF_TRAP_RESTART 0x58 #define RC_COMP_UNASSIGNED_TRAP_RESTART 0x59 -#define RC_COMP_CACHE_ASSIGN_RESTART 0x5A +/* formerly RC_COMP_CACHE_ASSIGN_RESTART 0x5A */ +#define RC_COMP_LINK_CACHES_RESTART 0x5B /* When adding return codes, add them to the table below as well! */ -#define MAX_RETURN_CODE 0x5A +#define MAX_RETURN_CODE 0x5B #define RETURN_NAME_TABLE \ { \ @@ -211,15 +212,16 @@ MIT in each case. */ /* 0x4D */ "COMPILER_UNASSIGNED_P_RESTART", \ /* 0x4E */ "COMPILER_UNBOUND_P_RESTART", \ /* 0x4F */ "COMPILER_DEFINITION_RESTART", \ -/* 0x50 */ "COMPILER_LEXPR_GC_RESTART", \ +/* 0x50 */ "", \ /* 0x51 */ "COMPILER_SAFE_REFERENCE_RESTART", \ -/* 0x52 */ "COMPILER_CACHE_LOOKUP_RESTART", \ +/* 0x52 */ "", \ /* 0x53 */ "COMPILER_LOOKUP_TRAP_RESTART", \ /* 0x54 */ "COMPILER_ASSIGNMENT_TRAP_RESTART", \ -/* 0x55 */ "COMPILER_CACHE_OPERATOR_RESTART", \ +/* 0X55 */ "", \ /* 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" \ +/* 0x5A */ "", \ +/* 0x5A */ "COMPILER_LINK_CACHES_RESTART" \ } diff --git a/v8/src/microcode/types.h b/v8/src/microcode/types.h index 680391c02..e8de8263d 100644 --- a/v8/src/microcode/types.h +++ b/v8/src/microcode/types.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/types.h,v 9.27 1988/02/12 16:52:46 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/types.h,v 9.28 1988/03/12 16:07:56 jinx Rel $ * * Type code definitions, numerical order * @@ -51,7 +51,7 @@ MIT in each case. */ #define TC_VECTOR 0x0A #define TC_RETURN_CODE 0x0B #define TC_COMBINATION_2 0x0C -#define TC_COMPILED_PROCEDURE 0x0D +#define TC_MANIFEST_CLOSURE 0x0D #define TC_BIG_FIXNUM 0x0E #define TC_PROCEDURE 0x0F #define TC_ENTITY 0x10 /* PRIMITIVE_EXTERNAL */ @@ -79,7 +79,7 @@ MIT in each case. */ #define TC_IN_PACKAGE 0x25 #define TC_COMBINATION 0x26 #define TC_MANIFEST_NM_VECTOR 0x27 -#define TC_COMPILED_EXPRESSION 0x28 +#define TC_COMPILED_ENTRY 0x28 #define TC_LEXPR 0x29 #define TC_PCOMB3 0x2A #define TC_MANIFEST_SPECIAL_NM_VECTOR 0x2B @@ -96,7 +96,7 @@ MIT in each case. */ #define TC_CELL 0x36 #define TC_WEAK_CONS 0x37 #define TC_QUAD 0x38 /* TRAP */ -#define TC_RETURN_ADDRESS 0x39 +#define TC_LINKAGE_SECTION 0x39 #define TC_RATNUM 0x3A /* COMPILER_LINK */ #define TC_STACK_ENVIRONMENT 0x3B #define TC_COMPLEX 0x3C @@ -123,7 +123,7 @@ MIT in each case. */ /* 0x0A */ "VECTOR", \ /* 0x0B */ "RETURN-CODE", \ /* 0x0C */ "COMBINATION-2", \ - /* 0x0D */ "COMPILED-PROCEDURE", \ + /* 0x0D */ "MANIFEST-CLOSURE", \ /* 0x0E */ "BIG-FIXNUM", \ /* 0x0F */ "PROCEDURE", \ /* 0x10 */ "ENTITY", \ @@ -150,7 +150,7 @@ MIT in each case. */ /* 0x25 */ "IN-PACKAGE", \ /* 0x26 */ "COMBINATION", \ /* 0x27 */ "MANIFEST-NM-VECTOR", \ - /* 0x28 */ "COMPILED-EXPRESSION", \ + /* 0x28 */ "COMPILED-ENTRY", \ /* 0x29 */ "LEXPR", \ /* 0x2A */ "PCOMB3", \ /* 0x2B */ "MANIFEST-SPECIAL-NM-VECTOR", \ @@ -167,7 +167,7 @@ MIT in each case. */ /* 0x36 */ "CELL", \ /* 0x37 */ "WEAK-CONS", \ /* 0x38 */ "QUAD", \ - /* 0x39 */ "RETURN-ADDRESS", \ + /* 0x39 */ "LINKAGE-SECTION", \ /* 0x3A */ "RATNUM", \ /* 0x3B */ "STACK-ENVIRONMENT", \ /* 0x3C */ "COMPLEX", \ diff --git a/v8/src/microcode/utabmd.scm b/v8/src/microcode/utabmd.scm index a5f9eb59a..52c85e9f4 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.42 1988/02/12 16:53:42 jinx Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.43 1988/03/12 16:08:08 jinx Exp $ (declare (usual-integrations)) @@ -109,7 +109,7 @@ VECTOR ;0A (RETURN-CODE RETURN-ADDRESS) ;0B COMBINATION-2 ;0C - COMPILED-PROCEDURE ;0D + MANIFEST-CLOSURE ;0D (BIGNUM BIG-FIXNUM) ;0E PROCEDURE ;0F (ENTITY) ;10 @@ -136,7 +136,7 @@ IN-PACKAGE ;25 COMBINATION ;26 MANIFEST-NM-VECTOR ;27 - COMPILED-EXPRESSION ;28 + COMPILED-ENTRY ;28 LEXPR ;29 PRIMITIVE-COMBINATION-3 ;2A MANIFEST-SPECIAL-NM-VECTOR ;2B @@ -153,7 +153,7 @@ CELL ;36 WEAK-CONS ;37 QUAD ;38 - COMPILER-RETURN-ADDRESS ;39 + LINKAGE-SECTION ;39 RATNUM ;3A STACK-ENVIRONMENT ;3B (RECNUM COMPLEX) ;3C @@ -438,17 +438,18 @@ COMPILER-UNASSIGNED?-RESTART ;4D COMPILER-UNBOUND?-RESTART ;4E COMPILER-DEFINITION-RESTART ;4F - COMPILER-LEXPR-INTERRUPT-RESTART ;50 + #F ;50 COMPILER-SAFE-REFERENCE-RESTART ;51 - COMPILER-CACHE-VARIABLE-RESTART ;52 + #F ;52 COMPILER-REFERENCE-TRAP-RESTART ;53 COMPILER-ASSIGNMENT-TRAP-RESTART ;54 - COMPILER-UUO-LINK-RESTART ;55 - COMPILER-UUO-LINK-TRAP-RESTART ;56 - COMPILER-CACHE-REFERENCE-APPLY-RESTART ;57 + #F ;55 + COMPILER-OPERATOR-LOOKUP-TRAP-RESTART ;56 + COMPILER-LOOKUP-APPLY-TRAP-RESTART ;57 COMPILER-SAFE-REFERENCE-TRAP-RESTART ;58 COMPILER-UNASSIGNED?-TRAP-RESTART ;59 - COMPILER-CACHE-ASSIGNMENT-RESTART ;5A + #F ;5A + COMPILER-LINK-CACHES-RESTART ;5B )) ;;; [] Errors @@ -569,4 +570,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.42 1988/02/12 16:53:42 jinx Exp $" \ No newline at end of file +"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.43 1988/03/12 16:08:08 jinx Exp $" \ No newline at end of file diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h index 3e7d44a1a..c285b3027 100644 --- a/v8/src/microcode/version.h +++ b/v8/src/microcode/version.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.27 1988/02/29 01:33:33 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.28 1988/03/12 16:08:44 jinx Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -46,7 +46,7 @@ MIT in each case. */ #define VERSION 10 #endif #ifndef SUBVERSION -#define SUBVERSION 27 +#define SUBVERSION 28 #endif #ifndef UCODE_TABLES_FILENAME -- 2.25.1