From df2dbdfbc3d300e1c860e6b334e65c9551d19087 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 17 Apr 2007 07:54:14 +0000
Subject: [PATCH] avoid potential trouble when write-barrier signals are
 blocked when handling SIGCHLD (seems to happen in OS X)

svn: r5961
---
 src/mzscheme/gc2/compact.c | 35 ++++++++++++++++++++++++++---------
 src/mzscheme/gc2/gc2.h     |  6 ++++++
 src/mzscheme/gc2/newgc.c   | 15 +++++++++++----
 src/mzscheme/src/port.c    | 14 ++++++++++++--
 4 files changed, 55 insertions(+), 15 deletions(-)

diff --git a/src/mzscheme/gc2/compact.c b/src/mzscheme/gc2/compact.c
index 7914c98f44..ee9e8a38ab 100644
--- a/src/mzscheme/gc2/compact.c
+++ b/src/mzscheme/gc2/compact.c
@@ -2619,7 +2619,7 @@ void protect_old_mpages()
 
 #if GENERATIONS
 
-static int designate_modified(void *p)
+static int designate_modified_maybe(void *p, int no_barrier_ok)
 {
   unsigned long g = ((unsigned long)p >> MAPS_SHIFT);
   MPage *map;
@@ -2641,14 +2641,21 @@ static int designate_modified(void *p)
 	num_seg_faults++;
 	return 1;
       } else if (page->age) {
-	page->flags |= MFLAG_MODIFIED;
-	p = (void *)((long)p & MPAGE_START);
-	if (page->flags & MFLAG_BIGBLOCK)
-	  protect_pages(p, page->u.size, 1);
-	else
-	  protect_pages(p, MPAGE_SIZE, 1);
-	num_seg_faults++;
-	return 1;
+        if (page->flags & MFLAG_MODIFIED) {
+          if (no_barrier_ok)
+            return 0;
+        } else {
+          page->flags |= MFLAG_MODIFIED;
+          p = (void *)((long)p & MPAGE_START);
+          if (page->flags & MFLAG_BIGBLOCK)
+            protect_pages(p, page->u.size, 1);
+          else
+            protect_pages(p, MPAGE_SIZE, 1);
+          num_seg_faults++;
+          return 1;
+        }
+      } else if (no_barrier_ok) {
+        return 0;
       }
 
       GCPRINT(GCOUTF, "Seg fault (internal error) at %lx [%ld]\n", 
@@ -2667,6 +2674,16 @@ static int designate_modified(void *p)
   return 0;
 }
 
+static int designate_modified(void *p)
+{
+  designate_modified_maybe(p, 0);
+}
+
+void GC_write_barrier(void *p)
+{
+  designate_modified_maybe(p, 1);
+}
+
 /* The platform-specific signal handlers, and initialization function: */
 # include "sighand.c"
 
diff --git a/src/mzscheme/gc2/gc2.h b/src/mzscheme/gc2/gc2.h
index 80757ac154..0d0a4e9ec9 100644
--- a/src/mzscheme/gc2/gc2.h
+++ b/src/mzscheme/gc2/gc2.h
@@ -338,6 +338,12 @@ GC2_EXTERN void GC_fixup_variable_stack(void **var_stack,
    The `stack_mem' argument indicates the start of the allocated memory
    that contains `var_stack'. It is used for backtraces. */
 
+GC2_EXTERN void GC_write_barrier(void *p);
+/* 
+   Explicit write barrier to ensure that a write-barrier signal is not
+   triggered by a memory write.
+*/
+
 # ifdef __cplusplus
 };
 # endif
diff --git a/src/mzscheme/gc2/newgc.c b/src/mzscheme/gc2/newgc.c
index e1caf4fcc0..647d4dff16 100644
--- a/src/mzscheme/gc2/newgc.c
+++ b/src/mzscheme/gc2/newgc.c
@@ -1899,13 +1899,20 @@ int designate_modified(void *p)
   struct mpage *page = find_page(p);
 
   if(page) {
-    protect_pages(page, page->size, 1);
-    page->back_pointers = 1;
-    return 1;
+    if (!page->back_pointers) {
+      protect_pages(page, page->size, 1);
+      page->back_pointers = 1;
+      return 1;
+    }
   } else {
     GCPRINT(GCOUTF, "Seg fault (internal error) at %p\n", p);
-    return 0;
   }
+  return 0;
+}
+
+void GC_write_barrier(void *p) 
+{
+  (void)designate_modified(p);
 }
 
 #include "sighand.c"
diff --git a/src/mzscheme/src/port.c b/src/mzscheme/src/port.c
index 74e3fb2330..8af949cda6 100644
--- a/src/mzscheme/src/port.c
+++ b/src/mzscheme/src/port.c
@@ -6497,6 +6497,10 @@ static int MyPipe(int *ph, int near_index) {
 
 # define WAITANY(s) waitpid((pid_t)-1, s, WNOHANG)
 
+#ifndef MZ_PRECISE_GC
+# define GC_write_barrier(x) /* empty */
+#endif
+
 #ifdef MZ_XFORM
 START_XFORM_SKIP;
 #endif
@@ -6533,12 +6537,18 @@ static void child_done(int ingored)
       prev = NULL;
       for (sc = scheme_system_children; sc; prev = sc, sc = sc->next) {
 	if (sc->id == result) {
+          /* Explicit write barriers avoid triggering a write-barrier signal,
+             just in case we're in some context where the signal is disabled
+             (which seems to happen in some OS X contexts). */
+          GC_write_barrier(sc);
+
 	  sc->done = 1;
 	  sc->status = status;
 
-	  if (prev)
+	  if (prev) {
+            GC_write_barrier(prev);
 	    prev->next = sc->next;
-	  else
+	  } else
 	    scheme_system_children = sc->next;
 
 	  scheme_signal_received();