From 63baf24ad5201e26775774be6b99fc22a8dfe8e1 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 4 Apr 2020 13:32:11 -0600
Subject: [PATCH] repairs for locking

Fix clearing of locked-object information and copying adjacent pairs.

original commit: 53d092c50c1c24017c52b6e002e6073b81747e09
---
 c/gc.c    | 8 ++++----
 s/mkgc.ss | 2 +-
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/c/gc.c b/c/gc.c
index e7ef0864ba..1e14812abe 100644
--- a/c/gc.c
+++ b/c/gc.c
@@ -492,7 +492,6 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) {
 
          ls = copy_list(si->locked_objects, tg);
          si->locked_objects = ls;
-         si->unlocked_objects = Snil;
          
          while (ls != Snil) {
            ptr p = Scar(ls);
@@ -505,7 +504,8 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) {
            ls = Scdr(ls);
          }
        }
-      }
+       si->unlocked_objects = Snil;
+     }
 
 #ifdef ENABLE_OBJECT_COUNTS
   /* sweep count_roots in order and accumulate counts */
@@ -939,7 +939,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) {
 #endif /* WIN32 */
 
    /* post-collection handling of locked objects.  This must come after
-      any use of relocate or any other use of sorted_locked_objects */
+      any use of relocate. */
     for (ls = younger_locked_objects; ls != Snil; ls = Scdr(ls)) {
         ptr x = Scar(ls);
         ptr a1, a2; uptr seg; uptr n;
@@ -962,9 +962,9 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) {
           if (!(si->space  & space_locked)) {
             si->generation = tg;
             si->space = (si->space & ~space_old) | space_locked;
-            si->locked_mask = NULL;
             sanitize_locked_segment(si);
           }
+          si->locked_mask = NULL; /* really only need to clear the first one */
         }
     }
 
diff --git a/s/mkgc.ss b/s/mkgc.ss
index 4ce374e770..de6065b8e3 100644
--- a/s/mkgc.ss
+++ b/s/mkgc.ss
@@ -536,7 +536,7 @@
                (&& (!= (set! qsi (MaybeSegInfo (ptr_get_segment cdr_p))) NULL)
                    (&& (== (-> qsi space) (-> si space))
                        (&& (!= (FWDMARKER cdr_p) forward_marker)
-                           (! (locked si cdr_p)))))))
+                           (! (locked qsi cdr_p)))))))
        (check_triggers qsi)
        (size size-pair 2)
        (define new_cdr_p : ptr (cast ptr (+ (cast uptr _copy_) size_pair)))