From b283bdd732c27d6ef56a0a18d7a0ba686ad32360 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Mon, 21 Mar 1988 21:17:16 +0000 Subject: [PATCH] Fix bchscheme to handle new representation of compiled procedures. Add coerce-to-compiled-procedure primitive for inner loops. Clean up some gc macros. --- v7/src/microcode/comutl.c | 39 ++++++++++++++++++++++++++++++++++---- v7/src/microcode/fasdump.c | 9 ++++----- v7/src/microcode/fasload.c | 9 ++++----- v7/src/microcode/gccode.h | 27 +++++++++++++++++--------- v7/src/microcode/gcloop.c | 9 ++++----- v7/src/microcode/purify.c | 9 ++++----- v7/src/microcode/version.h | 4 ++-- v8/src/microcode/version.h | 4 ++-- 8 files changed, 73 insertions(+), 37 deletions(-) diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c index 6466a2416..89a0d4330 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.11 1988/03/12 16:04:26 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.12 1988/03/21 21:15:35 jinx Rel $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -37,9 +37,15 @@ MIT in each case. */ #include "scheme.h" #include "primitive.h" -extern Pointer *compiled_entry_to_block_address(); -extern long compiled_entry_to_block_offset(); -extern void compiled_entry_type(); +extern Pointer + *compiled_entry_to_block_address(); + +extern long + compiled_entry_to_block_offset(), + coerce_to_compiled(); + +extern void + compiled_entry_type(); #define COMPILED_CODE_ADDRESS_P(object) \ ((OBJECT_TYPE (object)) == TC_COMPILED_ENTRY) @@ -100,3 +106,28 @@ DEFINE_PRIMITIVE("COMPILED-ENTRY-KIND", Prim_Compiled_Entry_Type, 1) temp[2] = MAKE_SIGNED_FIXNUM(((long) temp[2])); PRIMITIVE_RETURN (Make_Pointer(TC_HUNK3, temp)); } + +DEFINE_PRIMITIVE("COERCE-TO-COMPILED-PROCEDURE", Prim_Coerce_To_Closure, 2) +{ + Pointer temp; + long value, result; + PRIMITIVE_HEADER(2); + + CHECK_ARG (2, FIXNUM_P); + + FIXNUM_VALUE(ARG_REF(2), value); + result = coerce_to_compiled(ARG_REF(1), value, &temp); + switch(result) + { + case PRIM_DONE: + PRIMITIVE_RETURN(temp); + + case PRIM_INTERRUPT: + Primitive_GC(10); + /*NOTREACHED*/ + + default: + Primitive_Error(ERR_ARG_2_BAD_RANGE); + /*NOTREACHED*/ + } +} diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c index aa4f58fd4..6d3e6b2fe 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.36 1988/03/12 16:05:10 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.37 1988/03/21 21:15:48 jinx Exp $ This file contains code for fasdump and dump-band. */ @@ -186,7 +186,7 @@ DumpLoop(Scan, Dump_Mode) while(--count >= 0) { - Scan = ((Pointer *) word_ptr); + Scan = OPERATOR_LINKAGE_ENTRY_ADDRESS(word_ptr); word_ptr = NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr); Temp = *Scan; Dump_Compiled_Entry(); @@ -200,9 +200,8 @@ DumpLoop(Scan, Dump_Mode) { machine_word *start_ptr; fast machine_word *word_ptr; - Pointer *saved_scan; - saved_scan = ++Scan; + Scan += 1; word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(Scan); start_ptr = word_ptr; @@ -213,7 +212,7 @@ DumpLoop(Scan, Dump_Mode) Temp = *Scan; Dump_Compiled_Entry(); } - Scan = saved_scan + MANIFEST_CLOSURE_SIZE(word_ptr, start_ptr); + Scan = MANIFEST_CLOSURE_END(word_ptr, start_ptr); break; } diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c index 541b733e6..474389a5b 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.35 1988/03/12 16:05:26 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.36 1988/03/21 21:16:04 jinx Rel $ The "fast loader" which reads in and relocates binary files and then interns symbols. It is called with one argument: the (character @@ -333,7 +333,7 @@ Relocate_Block(Scan, Stop_At) while(--count >= 0) { - Scan = ((Pointer *) word_ptr); + Scan = OPERATOR_LINKAGE_ENTRY_ADDRESS(word_ptr); word_ptr = NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr); address = ((long) *Scan); *Scan = ((Pointer) Relocate(address)); @@ -347,9 +347,8 @@ Relocate_Block(Scan, Stop_At) { machine_word *start_ptr; fast machine_word *word_ptr; - Pointer *saved_scan; - saved_scan = ++Scan; + Scan += 1; word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(Scan); start_ptr = word_ptr; @@ -360,7 +359,7 @@ Relocate_Block(Scan, Stop_At) address = ((long) *Scan); *Scan = ((Pointer) Relocate(address)); } - Scan = saved_scan + (1 + MANIFEST_CLOSURE_SIZE(word_ptr, start_ptr)); + Scan = &((MANIFEST_CLOSURE_END(word_ptr, start_ptr))[1]); break; } diff --git a/v7/src/microcode/gccode.h b/v7/src/microcode/gccode.h index 744c58ea6..6da351a09 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.35 1988/03/12 16:05:46 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.36 1988/03/21 21:16:23 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 @@ -425,11 +425,10 @@ typedef unsigned long machine_word; "relocate_compiled: No compiler support!", \ Scan, To) -#define GC_NO_COMPILER_EXPR() \ - (GC_NO_COMPILER_STMT(), NIL) +#define GC_NO_COMPILER_EXPR() (GC_NO_COMPILER_STMT(), NIL) -#define Relocate_Compiled(object, new_block, old_block) \ - GC_NO_COMPILER_EXPR() + +#define Relocate_Compiled(obj, nb, ob) GC_NO_COMPILER_EXPR() #define Transport_Compiled() GC_NO_COMPILER_STMT() @@ -437,26 +436,36 @@ typedef unsigned long machine_word; #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 VALID_MANIFEST_CLOSURE_ENTRY(word_ptr) 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 MANIFEST_CLOSURE_ENTRY_ADDRESS(ptr) GC_NO_COMPILER_EXPR() + +#define MANIFEST_CLOSURE_END(end, start) GC_NO_COMPILER_EXPR() + +#define MANIFEST_CLOSURE_VALID_FITS_P(end, st) GC_NO_COMPILER_EXPR() + #define READ_LINKAGE_KIND(header) GC_NO_COMPILER_EXPR() +#define OPERATOR_LINKAGE_KIND 0 + + #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 NEXT_LINKAGE_OPERATOR_ENTRY(ptr) GC_NO_COMPILER_EXPR() -#define OPERATOR_LINKAGE_KIND 0 +#define OPERATOR_LINKAGE_ENTRY_ADDRESS(ptr) GC_NO_COMPILER_EXPR() #endif diff --git a/v7/src/microcode/gcloop.c b/v7/src/microcode/gcloop.c index 5e42a9227..882b76a7e 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.27 1988/03/12 16:06:06 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gcloop.c,v 9.28 1988/03/21 21:16:41 jinx Rel $ * * This file contains the code for the most primitive part * of garbage collection. @@ -149,7 +149,7 @@ GCLoop(Scan, To_Pointer) while(--count >= 0) { - Scan = ((Pointer *) word_ptr); + Scan = OPERATOR_LINKAGE_ENTRY_ADDRESS(word_ptr); word_ptr = NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr); Temp = *Scan; GC_Pointer(Setup_Internal(true, @@ -165,9 +165,8 @@ GCLoop(Scan, To_Pointer) { machine_word *start_ptr; fast machine_word *word_ptr; - Pointer *saved_scan; - saved_scan = ++Scan; + Scan += 1; word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(Scan); start_ptr = word_ptr; @@ -180,7 +179,7 @@ GCLoop(Scan, To_Pointer) Transport_Compiled(), Compiled_BH(true, continue))); } - Scan = saved_scan + MANIFEST_CLOSURE_SIZE(word_ptr, start_ptr); + Scan = MANIFEST_CLOSURE_END(word_ptr, start_ptr); break; } diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c index 90c5c6f5a..af030b767 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.32 1988/03/12 16:07:11 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.33 1988/03/21 21:17:00 jinx Rel $ * * This file contains the code that copies objects into pure * and constant space. @@ -160,7 +160,7 @@ PurifyLoop(Scan, To_Pointer, GC_Mode) while(--count >= 0) { - Scan = ((Pointer *) word_ptr); + Scan = OPERATOR_LINKAGE_ENTRY_ADDRESS(word_ptr); word_ptr = NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr); Temp = *Scan; Purify_Pointer(Setup_Internal(false, @@ -176,7 +176,6 @@ PurifyLoop(Scan, To_Pointer, GC_Mode) { machine_word *start_ptr; fast machine_word *word_ptr; - Pointer *saved_scan; if (GC_Mode == PURE_COPY) { @@ -186,7 +185,7 @@ PurifyLoop(Scan, To_Pointer, GC_Mode) /*NOTREACHED*/ } - saved_scan = ++Scan; + Scan += 1; word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(Scan); start_ptr = word_ptr; @@ -199,7 +198,7 @@ PurifyLoop(Scan, To_Pointer, GC_Mode) Transport_Compiled(), Compiled_BH(false, continue))); } - Scan = saved_scan + MANIFEST_CLOSURE_SIZE(word_ptr, start_ptr); + Scan = MANIFEST_CLOSURE_END(word_ptr, start_ptr); break; } diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index 61e0947e0..07fcdc50c 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.28 1988/03/12 16:08:44 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.29 1988/03/21 21:17:16 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 28 +#define SUBVERSION 29 #endif #ifndef UCODE_TABLES_FILENAME diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h index c285b3027..bb3156cd4 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.28 1988/03/12 16:08:44 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.29 1988/03/21 21:17:16 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 28 +#define SUBVERSION 29 #endif #ifndef UCODE_TABLES_FILENAME -- 2.25.1