From 1cf91f337b53c1a1e6e37be55de13e150a5396dd Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Wed, 22 Jul 1987 21:54:58 +0000 Subject: [PATCH] The microcode now understands 32 bit block offsets in compiled code. --- v7/src/microcode/bchmmg.c | 10 ++---- v7/src/microcode/comutl.c | 67 ++++++++++++++++++++++++++++---------- v7/src/microcode/gccode.h | 14 +------- v7/src/microcode/purutl.c | 5 +-- v7/src/microcode/version.h | 4 +-- v8/src/microcode/version.h | 4 +-- 6 files changed, 60 insertions(+), 44 deletions(-) diff --git a/v7/src/microcode/bchmmg.c b/v7/src/microcode/bchmmg.c index 3f724ef49..54ef6c030 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.32 1987/06/23 22:00:37 cph Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.33 1987/07/22 21:54:00 jinx Exp $ */ /* Memory management top level. Garbage collection to disk. @@ -529,13 +529,7 @@ Fix_Weak_Chain() *Scan = Temp; continue; } - /* Ditto */ - Old = Get_Compiled_Block(Old); - if (Type_Code(*Old) == TC_BROKEN_HEART) - { - *Scan = Relocate_Compiled(Temp, Get_Pointer(*Old), Old); - continue; - } + Compiled_BH(false, continue); *Scan = NIL; continue; diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c index 3081caf67..70a24d558 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.6 1987/07/15 22:09:17 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.7 1987/07/22 21:54:26 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -37,11 +37,55 @@ 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(); #define COMPILED_CODE_ADDRESS_P(object) \ (((OBJECT_TYPE (object)) == TC_COMPILED_EXPRESSION) || \ ((OBJECT_TYPE (object)) == TC_RETURN_ADDRESS)) +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; +{ +#ifdef Get_Compiled_Offset + + Pointer *address; + long offset; + + address = Get_Pointer(ce); + Get_Compiled_Offset(offset, address); + return offset; + +#else + + error_external_return(); + /*NOTREACHED*/ + +#endif +} + Built_In_Primitive (Prim_comp_code_address_block, 1, "COMPILED-CODE-ADDRESS->BLOCK", 0xB5) { @@ -49,28 +93,17 @@ Built_In_Primitive (Prim_comp_code_address_block, 1, Primitive_1_Arg (); CHECK_ARG (1, COMPILED_CODE_ADDRESS_P); - address = (Get_Pointer (Arg1)); - -#ifdef CMPGCFILE - return (Make_Pointer (TC_COMPILED_CODE_BLOCK, - (Get_Compiled_Block (address)))); -#else /* not CMPGCFILE */ - error_external_return (); -#endif /* CMPGCFILE */ + address = compiled_entry_to_block_address(Arg1); + return (Make_Pointer (TC_COMPILED_CODE_BLOCK, address)); } Built_In_Primitive (Prim_comp_code_address_offset, 1, "COMPILED-CODE-ADDRESS->OFFSET", 0xAC) { - Pointer *address; + long offset; Primitive_1_Arg (); CHECK_ARG (1, COMPILED_CODE_ADDRESS_P); - address = (Get_Pointer (Arg1)); - -#ifdef CMPGCFILE - return (Make_Signed_Fixnum (Get_Compiled_Offset (address))); -#else /* not CMPGCFILE */ - error_external_return (); -#endif /* CMPGCFILE */ + offset = compiled_entry_to_block_offset(Arg1); + return (Make_Signed_Fixnum (offset)); } diff --git a/v7/src/microcode/gccode.h b/v7/src/microcode/gccode.h index 3502434e7..2eac14d8d 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.25 1987/07/21 22:51:22 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.26 1987/07/22 21:54:35 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 @@ -344,18 +344,6 @@ Pointer_End() /* Is there anything else that can be done here? */ -#define Get_Compiled_Offset(address) \ - (fprintf(stderr, \ - "\nRelocating compiled code without compiler support!\n"), \ - Microcode_Termination(TERM_COMPILER_DEATH), \ - 0) - -#define Get_Compiled_Block(address) \ - (fprintf(stderr, \ - "\nRelocating compiled code without compiler support!\n"), \ - Microcode_Termination(TERM_COMPILER_DEATH), \ - ((Pointer *) NULL)) - #define Relocate_Compiled(object, new_block, old_block) \ (fprintf(stderr, \ "\nRelocating compiled code without compiler support!\n"), \ diff --git a/v7/src/microcode/purutl.c b/v7/src/microcode/purutl.c index b79a72bf4..d8abfa8ad 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.29 1987/06/05 17:29:30 cph Rel $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purutl.c,v 9.30 1987/07/22 21:54:46 jinx Exp $ */ /* Pure/Constant space utilities. */ @@ -221,11 +221,12 @@ Built_In_Primitive(Prim_Pure_P, 1, "PURE?", 0xBB) return TRUTH; Touch_In_Primitive(Arg1, Arg1); { + extern Pointer *compiled_entry_to_block_address(); Pointer *Obj_Address; Obj_Address = ((GC_Type_Compiled(Arg1)) - ? (Get_Compiled_Block(Get_Pointer(Arg1))) + ? (compiled_entry_to_block_address(Arg1)) : (Get_Pointer(Arg1))); if (Is_Pure(Obj_Address)) return TRUTH; diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index 22f20e07b..681b6d720 100644 --- a/v7/src/microcode/version.h +++ b/v7/src/microcode/version.h @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 9.84 1987/07/19 22:00:32 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 9.85 1987/07/22 21:54:58 jinx Exp $ This file contains version information for the microcode. */ @@ -46,7 +46,7 @@ This file contains version information for the microcode. */ #define VERSION 9 #endif #ifndef SUBVERSION -#define SUBVERSION 84 +#define SUBVERSION 85 #endif #ifndef UCODE_TABLES_FILENAME diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h index 9280c4315..0167174b6 100644 --- a/v8/src/microcode/version.h +++ b/v8/src/microcode/version.h @@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising, promotional, or sales literature without prior written consent from MIT in each case. */ -/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 9.84 1987/07/19 22:00:32 cph Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 9.85 1987/07/22 21:54:58 jinx Exp $ This file contains version information for the microcode. */ @@ -46,7 +46,7 @@ This file contains version information for the microcode. */ #define VERSION 9 #endif #ifndef SUBVERSION -#define SUBVERSION 84 +#define SUBVERSION 85 #endif #ifndef UCODE_TABLES_FILENAME -- 2.25.1