Fix weak pairs for bchscheme.

diff --git a/v7/src/microcode/bchmmg.c b/v7/src/microcode/bchmmg.c
index 54ef6c0303515983c24bf0e598e204435526c7e6..0ac2c6eca8fc889a5807914abadb7e24d0571415 100644 (file)
--- 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.33 1987/07/22 21:54:00 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.34 1987/08/06 06:05:47 cph Exp $ */
 
 /* Memory management top level.  Garbage collection to disk.
 
@@ -440,6 +440,9 @@ guarantee_in_memory(addr)
 {
   long position, offset;
 
+  if (addr >= Constant_Space)
+    return addr;
+
   position = (addr - Heap_Bottom);
   offset = (position % GC_DISK_BUFFER_SIZE);
   position = (position / GC_DISK_BUFFER_SIZE);
@@ -548,7 +551,8 @@ Fix_Weak_Chain()
 }
 \f
 void
-GC()
+GC(initial_weak_chain)
+     Pointer initial_weak_chain;
 {
   static Pointer *Root, *Result, *end_of_constant_area,
                 The_Precious_Objects, *Root2, *free_buffer;
@@ -556,7 +560,7 @@ GC()
   free_buffer = initialize_free_buffer();
   Free = Heap_Bottom;
   Set_Mem_Top(Heap_Top - GC_Reserve);
-  Weak_Chain = NIL;
+  Weak_Chain = initial_weak_chain;
 
   /* Save the microcode registers so that they can be relocated */
 
@@ -667,7 +671,7 @@ Built_In_Primitive(Prim_Garbage_Collect, 1, "GARBAGE-COLLECT", 0x3A)
     /*NOTREACHED*/
   }
   GC_Reserve = Get_Integer(Arg1);
-  GC();
+  GC(NIL);
   IntCode &= ~INT_GC;
   Pop_Primitive_Frame(1);
   GC_Daemon_Proc = Get_Fixed_Obj_Slot(GC_Daemon);

diff --git a/v7/src/microcode/bchpur.c b/v7/src/microcode/bchpur.c
index de7911e7993b6a24751070bd5fcb8e395ef0527b..f40b264b611c98eeeff53845f39d28e41601890e 100644 (file)
--- a/v7/src/microcode/bchpur.c
+++ b/v7/src/microcode/bchpur.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.33 1987/06/16 23:43:14 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.34 1987/08/06 06:06:22 cph Rel $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -125,10 +125,10 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode)
                   (overflow % GC_DISK_BUFFER_SIZE)) - 1);
          break;
        }
-\f
+
       case_Non_Pointer:
        break;
-
+\f
       case_compiled_entry_point:
        if (purify_mode == PURE_COPY)
          break;
@@ -151,10 +151,7 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode)
 
       case TC_REFERENCE_TRAP:
        if (Datum(Temp) <= TRAP_MAX_IMMEDIATE)
-       {
-         /* It is a non pointer. */
-         break;
-       }
+         break; /* It is a non pointer. */
        goto purify_pair;
 
       case TC_INTERNED_SYMBOL:
@@ -168,11 +165,16 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode)
        }
        /* Fall through. */
 
-      case TC_WEAK_CONS:
       case_Fasdump_Pair:
       purify_pair:
        relocate_normal_pointer(copy_pair(), 2);
 
+      case TC_WEAK_CONS:
+       if (purify_mode == PURE_COPY)
+         break;
+       else
+         relocate_normal_pointer(copy_weak_pair(), 2);
+       
       case TC_VARIABLE:
       case_Triple:
        relocate_normal_pointer(copy_triple(), 3);
@@ -228,6 +230,7 @@ purify(object, flag)
   long length, pure_length;
   Pointer value, *Result, *free_buffer, *block_start;
 
+  Weak_Chain = NIL;
   free_buffer = initialize_free_buffer();
   block_start = Free_Constant;
   Free_Constant += 2;
@@ -315,7 +318,7 @@ purify(object, flag)
   *block_start++ = Make_Non_Pointer(TC_MANIFEST_SPECIAL_NM_VECTOR,
                                    pure_length);
   *block_start = Make_Non_Pointer(PURE_PART, (length - 1));
-  GC();
+  GC(Weak_Chain);
   Set_Pure_Top();
   return TRUTH;
 }

diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index cdbd4b985c502e83136e262663f432872d7e0801..0380dcb81de685f7d50456f2933697d24953d42c 100644 (file)
--- 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.93 1987/08/06 05:04:11 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 9.94 1987/08/06 06:07:46 cph Exp $
 
 This file contains version information for the microcode. */
 \f
@@ -46,7 +46,7 @@ This file contains version information for the microcode. */
 #define VERSION                9
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     93
+#define SUBVERSION     94
 #endif
 
 #ifndef UCODE_TABLES_FILENAME

diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 8f715f692d9f24ed98e3824813e5608d51db7126..2f244191cbd1d7db0c589b911ff7361affc8ca4b 100644 (file)
--- 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.93 1987/08/06 05:04:11 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 9.94 1987/08/06 06:07:46 cph Exp $
 
 This file contains version information for the microcode. */
 \f
@@ -46,7 +46,7 @@ This file contains version information for the microcode. */
 #define VERSION                9
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     93
+#define SUBVERSION     94
 #endif
 
 #ifndef UCODE_TABLES_FILENAME