Define new type code for compiled code blocks to guarantee that they

are not put in pure space.

diff --git a/v7/src/microcode/bchpur.c b/v7/src/microcode/bchpur.c
index ab9eba90eaae14b59159344eeecdcf5d6ea022f4..a58e72d45ad160067ef0c41cae2a1d700a4f5242 100644 (file)
--- a/v7/src/microcode/bchpur.c
+++ b/v7/src/microcode/bchpur.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/bchpur.c,v 9.29 1987/06/02 08:43:02 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.30 1987/06/05 17:29:53 cph Exp $
  *
  * This file contains the code for primitives dealing with pure
  * and constant space.  Garbage collection to disk version.
@@ -130,6 +130,8 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode)
        break;
 
       case_compiled_entry_point:
+       if (GC_Mode == PURE_COPY)
+         break;
        Old = Get_Pointer(Temp);
        if (Old >= Low_Constant)
          continue;
@@ -178,6 +180,7 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode)
       case_Quadruple:
        relocate_normal_pointer(copy_quadruple(), 4);
 \f
+      case TC_COMPILED_CODE_BLOCK:
       case TC_ENVIRONMENT:
        if (purify_mode == PURE_COPY)
          break;

diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c
index 41a89c401fc70302286e62ce44826320656bf394..90caa65b965bf228197e08d3d03847ab90ab3494 100644 (file)
--- 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.27 1987/06/02 00:17:36 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.28 1987/06/05 17:29:07 cph Rel $
  *
  * This file contains the code that copies objects into pure
  * and constant space.
@@ -162,6 +162,7 @@ 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:
        if (GC_Mode == PURE_COPY)

diff --git a/v7/src/microcode/purutl.c b/v7/src/microcode/purutl.c
index 4f1910422b95952b969819ec71fed7a3b3f29c56..b79a72bf4ad5fdeaab6b993878f235a5b977ae7e 100644 (file)
--- 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.28 1987/04/16 02:28:06 jinx Exp $ */
+/* $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 $ */
 
 /* Pure/Constant space utilities. */
 
@@ -219,13 +219,14 @@ Built_In_Primitive(Prim_Pure_P, 1, "PURE?", 0xBB)
   if ((GC_Type_Non_Pointer(Arg1)) ||
       (GC_Type_Special(Arg1)))
     return TRUTH;
-  if (GC_Type_Compiled(Arg1))
-    return NIL;
   Touch_In_Primitive(Arg1, Arg1);
   {
     Pointer *Obj_Address;
 
-    Obj_Address = Get_Pointer(Arg1);
+    Obj_Address =
+      ((GC_Type_Compiled(Arg1))
+       ? (Get_Compiled_Block(Get_Pointer(Arg1)))
+       : (Get_Pointer(Arg1)));
     if (Is_Pure(Obj_Address))
       return TRUTH;
   }
@@ -243,8 +244,7 @@ Built_In_Primitive(Prim_Constant_P, 1, "CONSTANT?", 0xBA)
   Touch_In_Primitive(Arg1, Arg1);
   return ((GC_Type_Non_Pointer(Arg1)) ||
          (GC_Type_Special(Arg1)) ||
-          ((Get_Pointer(Arg1) >= Constant_Space) &&
-           (Get_Pointer(Arg1) < Free_Constant))) ?
+         (Is_Constant(Get_Pointer(Arg1)))) ?
          TRUTH : NIL;
 }
 

diff --git a/v7/src/microcode/utabmd.scm b/v7/src/microcode/utabmd.scm
index e65f3b07e91940436059abb3694e1a521f6960db..459d5c26f4681338ddf1eedada2c462ac86c673f 100644 (file)
--- 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.33 1987/06/05 16:25:42 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.34 1987/06/05 17:28:37 cph Exp $
 
 (declare (usual-integrations))
 
@@ -159,7 +159,7 @@
               COMPILER-LINK                            ;3A
               STACK-ENVIRONMENT                        ;3B
               COMPLEX                                  ;3C
-              #F                                       ;3D
+              COMPILED-CODE-BLOCK                      ;3D
               #F                                       ;3E
               #F                                       ;3F
               #F                                       ;40
@@ -863,4 +863,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.33 1987/06/05 16:25:42 cph Exp $"
+"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.34 1987/06/05 17:28:37 cph Exp $"

diff --git a/v8/src/microcode/utabmd.scm b/v8/src/microcode/utabmd.scm
index 313b780967862d73f06be070a00232d60f63c7e7..1a527fa1695d7924ef2bbaa284025c1bcb2b6020 100644 (file)
--- 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.33 1987/06/05 16:25:42 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.34 1987/06/05 17:28:37 cph Exp $
 
 (declare (usual-integrations))
 
@@ -159,7 +159,7 @@
               COMPILER-LINK                            ;3A
               STACK-ENVIRONMENT                        ;3B
               COMPLEX                                  ;3C
-              #F                                       ;3D
+              COMPILED-CODE-BLOCK                      ;3D
               #F                                       ;3E
               #F                                       ;3F
               #F                                       ;40
@@ -863,4 +863,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.33 1987/06/05 16:25:42 cph Exp $"
+"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.34 1987/06/05 17:28:37 cph Exp $"