From d23186a7cbfa8cba706d9180cb2a53a995e1d2a9 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 5 May 1988 08:42:47 +0000 Subject: [PATCH] Change interface of `primitive-purify' to take an extra argument, `safety-margin' (which works like the argument to `garbage-collect'), and returns an extra value (which is like the value of `garbage-collect'). These changes will allow purify to be used instead of gc when desired. --- v7/src/microcode/interp.c | 39 +++++++++++++++++++++++--------------- v7/src/microcode/purify.c | 25 +++++++++++++++--------- v7/src/microcode/version.h | 4 ++-- v7/src/runtime/gc.scm | 19 ++++++++++--------- v8/src/microcode/interp.c | 39 +++++++++++++++++++++++--------------- v8/src/microcode/version.h | 4 ++-- 6 files changed, 78 insertions(+), 52 deletions(-) diff --git a/v7/src/microcode/interp.c b/v7/src/microcode/interp.c index 2c88b5463..7b23e743e 100644 --- a/v7/src/microcode/interp.c +++ b/v7/src/microcode/interp.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1988 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.43 1988/03/23 18:45:39 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.44 1988/05/05 08:42:47 cph Exp $ * * This file contains the heart of the Scheme Scode * interpreter @@ -113,6 +113,16 @@ if (GC_Check(Amount)) \ Prepare_Eval_Repeat(); \ Immediate_GC(Amount); \ } + +#define RESULT_OF_PURIFY(success) \ +{ \ + Pointer words_free; \ + \ + words_free = (Make_Unsigned_Fixnum (MemTop - Free)); \ + Val = (Make_Pointer (TC_LIST, Free)); \ + (*Free++) = (success); \ + (*Free++) = words_free; \ +} #define Prepare_Eval_Repeat() \ { \ @@ -1908,20 +1918,19 @@ Primitive_Internal_Apply: Result = Purify_Pass_2(Fetch_Expression()); Import_Registers(); if (Result == NIL) - { - /* The object does not fit in Constant space. - There is no need to run the daemons, and we should let the runtime - system know what happened. - */ - Val = NIL; - break; - } + { + /* The object does not fit in Constant space. + There is no need to run the daemons, and we should let + the runtime system know what happened. */ + RESULT_OF_PURIFY (NIL); + break; + } GC_Daemon_Proc = Get_Fixed_Obj_Slot(GC_Daemon); if (GC_Daemon_Proc == NIL) - { - Val = TRUTH; - break; - } + { + RESULT_OF_PURIFY (TRUTH); + break; + } Store_Expression(NIL); Store_Return(RC_PURIFY_GC_2); Save_Cont(); @@ -1933,7 +1942,7 @@ Primitive_Internal_Apply: } case RC_PURIFY_GC_2: - Val = TRUTH; + RESULT_OF_PURIFY (TRUTH); break; case RC_REPEAT_DISPATCH: diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c index af030b767..cb336b2a1 100644 --- a/v7/src/microcode/purify.c +++ b/v7/src/microcode/purify.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1988 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/purify.c,v 9.33 1988/03/21 21:17:00 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.34 1988/05/05 08:42:17 cph Exp $ * * This file contains the code that copies objects into pure * and constant space. @@ -387,7 +387,7 @@ Pointer Object, Purify_Object; *Free++ = Object; Result = GCLoop(Heap_Start, &Free); if (Free != Result) - { fprintf(stderr, "\Purify: Pure Scan ended too early.\n"); + { fprintf(stderr, "\nPurify: Pure Scan ended too early.\n"); Microcode_Termination(TERM_BROKEN_HEART); } Length = (Free-Heap_Start)-1; /* Length of object */ @@ -476,7 +476,7 @@ Pointer Info; return (TRUTH); } -/* (PRIMITIVE-PURIFY OBJECT PURE?) +/* (PRIMITIVE-PURIFY OBJECT PURE? SAFETY-MARGIN) Copy an object from the heap into constant space. This requires a spare heap, and is tricky to use -- it should only be used through the wrapper provided in the Scheme runtime system. @@ -496,28 +496,35 @@ Pointer Info; have changed. */ -Built_In_Primitive(Prim_Primitive_Purify, 2, "PRIMITIVE-PURIFY", 0xB4) -Define_Primitive(Prim_Primitive_Purify, 2, "PRIMITIVE-PURIFY") +DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_Primitive_Purify, 3) { long Saved_Zone; Pointer Object, Lost_Objects, Purify_Result, Daemon; - Primitive_2_Args(); + Primitive_3_Args(); Save_Time_Zone(Zone_Purify); if ((Arg2 != TRUTH) && (Arg2 != NIL)) Primitive_Error(ERR_ARG_2_WRONG_TYPE); + Arg_3_Type(TC_FIXNUM); /* Pass 1 (Purify, above) does a first copy. Then any GC daemons run, and then Purify_Pass_2 is called to copy back. */ Touch_In_Primitive(Arg1, Object); + GC_Reserve = (Get_Integer (Arg3)); Purify_Result = Purify(Object, Arg2); - Pop_Primitive_Frame(2); + Pop_Primitive_Frame(3); Daemon = Get_Fixed_Obj_Slot(GC_Daemon); if (Daemon == NIL) { - Val = Purify_Pass_2(Purify_Result); + Pointer words_free; + + Purify_Result = Purify_Pass_2(Purify_Result); + words_free = (Make_Unsigned_Fixnum (MemTop - Free)); + Val = (Make_Pointer (TC_LIST, Free)); + (*Free++) = Purify_Result; + (*Free++) = words_free; PRIMITIVE_ABORT(PRIM_POP_RETURN); /*NOTREACHED*/ } diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index 03109c115..627f30756 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.35 1988/05/04 19:22:12 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.36 1988/05/05 08:41:51 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -46,7 +46,7 @@ MIT in each case. */ #define VERSION 10 #endif #ifndef SUBVERSION -#define SUBVERSION 35 +#define SUBVERSION 36 #endif #ifndef UCODE_TABLES_FILENAME diff --git a/v7/src/runtime/gc.scm b/v7/src/runtime/gc.scm index 9af65598a..df02d51f2 100644 --- a/v7/src/runtime/gc.scm +++ b/v7/src/runtime/gc.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/gc.scm,v 13.43 1987/03/18 20:07:23 jinx Rel $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/gc.scm,v 13.44 1988/05/05 08:39:12 cph Exp $ ;;; -;;; Copyright (c) 1987 Massachusetts Institute of Technology +;;; Copyright (c) 1988 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -149,12 +149,13 @@ (set! purify (named-lambda (purify item #!optional really-pure?) - (if (primitive-purify item - (if (unassigned? really-pure?) - false - really-pure?)) - item - (error "Not enough room in constant space" purify item)))) + (if (not (car (primitive-purify item + (if (unassigned? really-pure?) + false + really-pure?) + default-safety-margin))) + (error "Not enough room in constant space" purify item)) + item)) (set! impurify (named-lambda (impurify object) @@ -201,4 +202,4 @@ ie))))) ;;; end GARBAGE-COLLECTOR-PACKAGE. -)) +)) \ No newline at end of file diff --git a/v8/src/microcode/interp.c b/v8/src/microcode/interp.c index 047d32f08..45fcc321e 100644 --- a/v8/src/microcode/interp.c +++ b/v8/src/microcode/interp.c @@ -1,6 +1,6 @@ /* -*-C-*- -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1988 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.43 1988/03/23 18:45:39 jinx Rel $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.44 1988/05/05 08:42:47 cph Exp $ * * This file contains the heart of the Scheme Scode * interpreter @@ -113,6 +113,16 @@ if (GC_Check(Amount)) \ Prepare_Eval_Repeat(); \ Immediate_GC(Amount); \ } + +#define RESULT_OF_PURIFY(success) \ +{ \ + Pointer words_free; \ + \ + words_free = (Make_Unsigned_Fixnum (MemTop - Free)); \ + Val = (Make_Pointer (TC_LIST, Free)); \ + (*Free++) = (success); \ + (*Free++) = words_free; \ +} #define Prepare_Eval_Repeat() \ { \ @@ -1908,20 +1918,19 @@ Primitive_Internal_Apply: Result = Purify_Pass_2(Fetch_Expression()); Import_Registers(); if (Result == NIL) - { - /* The object does not fit in Constant space. - There is no need to run the daemons, and we should let the runtime - system know what happened. - */ - Val = NIL; - break; - } + { + /* The object does not fit in Constant space. + There is no need to run the daemons, and we should let + the runtime system know what happened. */ + RESULT_OF_PURIFY (NIL); + break; + } GC_Daemon_Proc = Get_Fixed_Obj_Slot(GC_Daemon); if (GC_Daemon_Proc == NIL) - { - Val = TRUTH; - break; - } + { + RESULT_OF_PURIFY (TRUTH); + break; + } Store_Expression(NIL); Store_Return(RC_PURIFY_GC_2); Save_Cont(); @@ -1933,7 +1942,7 @@ Primitive_Internal_Apply: } case RC_PURIFY_GC_2: - Val = TRUTH; + RESULT_OF_PURIFY (TRUTH); break; case RC_REPEAT_DISPATCH: diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h index c72aa086d..0f83a29bf 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.35 1988/05/04 19:22:12 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.36 1988/05/05 08:41:51 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -46,7 +46,7 @@ MIT in each case. */ #define VERSION 10 #endif #ifndef SUBVERSION -#define SUBVERSION 35 +#define SUBVERSION 36 #endif #ifndef UCODE_TABLES_FILENAME -- 2.25.1