From 8b6ccea76c9bfbfedb81d815f8e620667805e40f Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 11 Nov 2008 22:23:30 +0000
Subject: [PATCH] restore GC_malloc_pair to 3m

svn: r12390
---
 src/mzscheme/gc2/compact.c | 17 +++++++++++++++
 src/mzscheme/gc2/gc2.h     |  6 ++++++
 src/mzscheme/gc2/newgc.c   | 43 ++++++++++++++++++++++++++++++++++++++
 src/mzscheme/src/list.c    |  4 ++++
 4 files changed, 70 insertions(+)

diff --git a/src/mzscheme/gc2/compact.c b/src/mzscheme/gc2/compact.c
index cfdbde2fa0..3468ddb242 100644
--- a/src/mzscheme/gc2/compact.c
+++ b/src/mzscheme/gc2/compact.c
@@ -3859,6 +3859,23 @@ void *GC_malloc_one_small_dirty_tagged(size_t size_in_bytes)
   return GC_malloc_one_tagged(size_in_bytes);
 }
 
+void *GC_malloc_pair(void *a, void *b)
+{
+  void *p;
+
+  park[0] = a;
+  park[1] = b;
+  p = GC_malloc_one_tagged(3 << LOG_WORD_SIZE);
+  a = park[0];
+  b = park[1];
+
+  ((Type_Tag *)p)[0] = pair_tag;
+  ((void **)p)[1] = a;
+  ((void **)p)[2] = b;
+
+  return p;
+}
+
 #ifndef gcINLINE
 # define gcINLINE inline
 #endif
diff --git a/src/mzscheme/gc2/gc2.h b/src/mzscheme/gc2/gc2.h
index 00e40ed3de..807e869778 100644
--- a/src/mzscheme/gc2/gc2.h
+++ b/src/mzscheme/gc2/gc2.h
@@ -164,6 +164,12 @@ GC2_EXTERN void *GC_malloc_one_small_dirty_tagged(size_t);
    zeroed. The client must set all words in the allocated
    object before a GC can occur. */
 
+GC2_EXTERN void *GC_malloc_pair(void *car, void *cdr);
+/* 
+   Like GC_malloc_one_tagged, but even more streamlined.
+   The main potential advantage is that `car' and `cdr' don't
+   have to be retained by the callee in the case of a GC. */
+
 GC2_EXTERN void *GC_malloc_one_xtagged(size_t);
 /* 
    Alloc an item, initially zeroed. Rather than having a specific tag,
diff --git a/src/mzscheme/gc2/newgc.c b/src/mzscheme/gc2/newgc.c
index cd8e37baa3..3d26e0214c 100644
--- a/src/mzscheme/gc2/newgc.c
+++ b/src/mzscheme/gc2/newgc.c
@@ -617,6 +617,49 @@ inline static void *fast_malloc_one_small_tagged(size_t sizeb, int dirty)
   }
 }
 
+void *GC_malloc_pair(void *car, void *cdr)
+{
+  unsigned long ptr, newptr;
+  size_t sizeb;
+  void *retval;
+
+  sizeb = ALIGN_BYTES_SIZE(gcWORDS_TO_BYTES(gcBYTES_TO_WORDS(sizeof(Scheme_Simple_Object))) + WORD_SIZE);
+  ptr = GC_gen0_alloc_page_ptr;
+  newptr = GC_gen0_alloc_page_ptr + sizeb;
+
+  if(OVERFLOWS_GEN0(newptr)) {
+    NewGC *gc = GC_get_GC();
+    gc->park[0] = car;
+    gc->park[1] = cdr;
+    retval = GC_malloc_one_tagged(sizeb - WORD_SIZE);
+    car = gc->park[0];
+    cdr = gc->park[1];
+    gc->park[0] = NULL;
+    gc->park[1] = NULL;
+  } else {
+    struct objhead *info;
+
+    GC_gen0_alloc_page_ptr = newptr;
+
+    retval = PTR(ptr);
+    info = (struct objhead *)retval;
+
+    ((void **)retval)[0] = NULL; /* objhead */
+    ((void **)retval)[1] = 0;    /* tag word */
+
+    /* info->type = type; */ /* We know that the type field is already 0 */
+    info->size = (sizeb >> gcLOG_WORD_SIZE);
+
+    retval = PTR(NUM(retval) + WORD_SIZE);
+  }
+    
+  ((short *)retval)[0] = scheme_pair_type;
+  ((void **)retval)[1] = car;
+  ((void **)retval)[2] = cdr;
+  
+  return retval;
+}
+
 /* the allocation mechanism we present to the outside world */
 void *GC_malloc(size_t s)                         { return allocate(s, PAGE_ARRAY); }
 void *GC_malloc_one_tagged(size_t s)              { return allocate(s, PAGE_TAGGED); }
diff --git a/src/mzscheme/src/list.c b/src/mzscheme/src/list.c
index 219dde0923..df6225c720 100644
--- a/src/mzscheme/src/list.c
+++ b/src/mzscheme/src/list.c
@@ -669,12 +669,16 @@ scheme_init_list (Scheme_Env *env)
 
 Scheme_Object *scheme_make_pair(Scheme_Object *car, Scheme_Object *cdr)
 {
+#ifdef MZ_PRECISE_GC
+  return GC_malloc_pair(car, cdr);
+#else
   Scheme_Object *cons;
   cons = scheme_alloc_object();
   cons->type = scheme_pair_type;
   SCHEME_CAR(cons) = car;
   SCHEME_CDR(cons) = cdr;
   return cons;
+#endif
 }
 
 Scheme_Object *scheme_make_mutable_pair(Scheme_Object *car, Scheme_Object *cdr)