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.

diff --git a/v7/src/microcode/interp.c b/v7/src/microcode/interp.c
index 2c88b54638d5ad2ecf83a3e6d7a3b04da29a52d1..7b23e743e50d14bcb1dc4b2fe386c4429d5711f7 100644 (file)
--- 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;                                              \
+}
 \f
 #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 af030b76708e3912a246b811e6abeca81bdfff8a..cb336b2a12936c3e32d769070f0b3b93cf4395d0 100644 (file)
--- 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);
 }
 \f
-/* (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 03109c115592813dced3ffca6bf8e4b636183d74..627f3075656635e76c70070c195aa92e96e99c95 100644 (file)
--- 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 9af65598a434910ea30f01d03d292e2551a40ff4..df02d51f20df807d644d87efe87b29f98472138f 100644 (file)
--- 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 047d32f08b7cf2765206219581ab29354d55849c..45fcc321e9dbf2601cfc92d24cea5d629c0952ca 100644 (file)
--- 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;                                              \
+}
 \f
 #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 c72aa086d301a45deb8d33e9a5a91a6b5dfb6ca9..0f83a29bf56968513d69cf5a2dff285d269e7dd5 100644 (file)
--- 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