X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgencgc.c;fp=src%2Fruntime%2Fgencgc.c;h=c902d294b928c8fba82b4cf7c46805ebad68a282;hb=8c2a7241975ae5defff823601379c805acf262b6;hp=f755b8005127c54336503bd2e2349ed243a54250;hpb=379e3d3ee80c6b9dd9c59f8f76baa6d47c8c5b71;p=sbcl.git

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index f755b80..c902d29 100644
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -2312,14 +2312,6 @@ preserve_pointer(void *addr)
         /* Mark the page static. */
         page_table[i].dont_move = 1;
 
-        /* Move the page to the new_space. XX I'd rather not do this
-         * but the GC logic is not quite able to copy with the static
-         * pages remaining in the from space. This also requires the
-         * generation bytes_allocated counters be updated. */
-        page_table[i].gen = new_space;
-        generations[new_space].bytes_allocated += page_table[i].bytes_used;
-        generations[from_space].bytes_allocated -= page_table[i].bytes_used;
-
         /* It is essential that the pages are not write protected as
          * they may have pointers into the old-space which need
          * scavenging. They shouldn't be write protected at this
@@ -3362,6 +3354,28 @@ preserve_context_registers (os_context_t *c)
 }
 #endif
 
+static void
+move_pinned_pages_to_newspace()
+{
+    page_index_t i;
+
+    /* scavenge() will evacuate all oldspace pages, but no newspace
+     * pages.  Pinned pages are precisely those pages which must not
+     * be evacuated, so move them to newspace directly. */
+
+    for (i = 0; i < last_free_page; i++) {
+        if (page_table[i].dont_move &&
+            /* dont_move is cleared lazily, so validate the space as well. */
+            page_table[i].gen == from_space) {
+            page_table[i].gen = new_space;
+            /* And since we're moving the pages wholesale, also adjust
+             * the generation allocation counters. */
+            generations[new_space].bytes_allocated += page_table[i].bytes_used;
+            generations[from_space].bytes_allocated -= page_table[i].bytes_used;
+        }
+    }
+}
+
 /* Garbage collect a generation. If raise is 0 then the remains of the
  * generation are not raised to the next generation. */
 static void
@@ -3529,6 +3543,12 @@ garbage_collect_generation(generation_index_t generation, int raise)
     }
 #endif
 
+    /* Now that all of the pinned (dont_move) pages are known, and
+     * before we start to scavenge (and thus relocate) objects,
+     * relocate the pinned pages to newspace, so that the scavenger
+     * will not attempt to relocate their contents. */
+    move_pinned_pages_to_newspace();
+
     /* Scavenge all the rest of the roots. */
 
 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)