From de552808de214c93a005855c23123c34c9700e8f Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 5 Dec 2005 21:42:38 +0000
Subject: [PATCH] make SGC work with ephemerons

svn: r1532
---
 src/mzscheme/sgc/sgc.c  |  3 +++
 src/mzscheme/src/list.c | 21 +++++++++++++++------
 2 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/src/mzscheme/sgc/sgc.c b/src/mzscheme/sgc/sgc.c
index c6c52d2bf4..7af12da37f 100644
--- a/src/mzscheme/sgc/sgc.c
+++ b/src/mzscheme/sgc/sgc.c
@@ -3528,6 +3528,7 @@ static void prepare_stack_collect()
 #endif
   e = collect_stack[--collect_stack_count];
   s = collect_stack[--collect_stack_count];
+  e += PTR_ALIGNMENT - 1;
 
   PUSH_COLLECT(s, e, source);
   semi_collect_stack(0);
@@ -4113,6 +4114,8 @@ static void do_disappear_and_finals()
     }
   }
 
+  if (GC_push_last_roots_again) { GC_push_last_roots_again(); collect(); }
+
   /* Deregister dangling disappearings: */
   trim_disappearing(&disappearing);
   trim_disappearing(&late_disappearing);
diff --git a/src/mzscheme/src/list.c b/src/mzscheme/src/list.c
index 14809d031e..85e0ad153e 100644
--- a/src/mzscheme/src/list.c
+++ b/src/mzscheme/src/list.c
@@ -1763,11 +1763,21 @@ Scheme_Object *scheme_make_ephemeron(Scheme_Object *key, Scheme_Object *val)
   return GC_malloc_ephemeron(key, val);
 #else
   Scheme_Ephemeron *e;
+  int can_gc = 1;
 
-  e = (Scheme_Ephemeron *)scheme_malloc_atomic(sizeof(Scheme_Ephemeron));
+  if (SCHEME_INTP(val) || !GC_base(val)) 
+    can_gc = 0;
+
+  if (can_gc) {
+    e = (Scheme_Ephemeron *)scheme_malloc_atomic(sizeof(Scheme_Ephemeron));
+  } else {
+    e = (Scheme_Ephemeron *)scheme_malloc(sizeof(Scheme_Ephemeron));
+  }
   e->so.type = scheme_ephemeron_type;
-  e->next = ephemerons;
-  ephemerons = e;
+  if (can_gc) {
+    e->next = ephemerons;
+    ephemerons = e;
+  }
   e->key = key;
   e->val = val;
 
@@ -1814,9 +1824,8 @@ static int mark_ephemerons()
     for (e = ephemerons; e; e = next) {
       next = e->next;
 
-      if (e->key) {
-	if (!GC_is_marked(e)
-	    || (!SCHEME_INTP(e->key) && !GC_is_marked(e->key))) {
+      if (e->key) {      
+	if (!GC_is_marked(e) || !GC_is_marked(e->key)) {
 	  /* No reason to mark, yet. Randomly put this one back
 	     into one of the keep lists: */
 	  if (mix & 0x1) {