Index: /branches/working-0711/ccl/lisp-kernel/gc-common.c
===================================================================
--- /branches/working-0711/ccl/lisp-kernel/gc-common.c	(revision 13293)
+++ /branches/working-0711/ccl/lisp-kernel/gc-common.c	(revision 13294)
@@ -216,10 +216,10 @@
     *hashp = (hash_table_vector_header *) ptr_from_lispobj(untag(hashv));
   natural
-    dnode,
+    dnode;
+  signed_natural
     npairs = (header_element_count(hashp->header) - 
               (hash_table_vector_header_count -1)) >> 1;
   LispObj *pairp = (LispObj*) (hashp+1), weakelement;
-  Boolean 
-    weak_on_value = ((hashp->flags & nhash_weak_value_mask) != 0);
+  int weak_index = (((hashp->flags & nhash_weak_value_mask) == 0) ? 0 : 1);
   Boolean
     keys_frozen = ((hashp->flags & nhash_keys_frozen_mask) != 0);
@@ -227,14 +227,38 @@
   int tag;
 
-  /* TODO: hashv might be in old space, in which case should use refbits
-     rather than touching all entries
-  */
-
-  while (npairs--) {
-    if (weak_on_value) {
-      weakelement = pairp[1];
-    } else {
-      weakelement = pairp[0];
-    }
+  natural *tenured_low = (LispObj *)tenured_area->low;
+  natural tenured_dnodes = area_dnode(GCarealow, tenured_low);
+  natural memo_dnode = area_dnode(ptr_to_lispobj(pairp+weak_index), tenured_low);
+  Boolean
+    hashv_tenured = (memo_dnode < tenured_dnodes);
+  natural bits, bitidx, *bitsp;
+
+  if (hashv_tenured) {
+    set_bitidx_vars(tenured_area->refbits, memo_dnode, bitsp, bits, bitidx);
+  }
+
+  while (true) {
+    if (hashv_tenured) {
+      while (bits == 0) {
+        int skip = nbits_in_word - bitidx;
+        npairs -= skip;
+        if (npairs <= 0) break;
+        pairp += (skip+skip);
+        bitidx = 0;
+        bits = *++bitsp;
+      }
+      if (bits != 0) {
+        int skip = (count_leading_zeros(bits) - bitidx);
+        if (skip != 0) {
+          npairs -= skip;
+          pairp += (skip+skip);
+          bitidx += skip;
+        }
+      }
+    }
+
+    if (npairs <= 0) break;
+
+    weakelement = pairp[weak_index];
     tag = fulltag_of(weakelement);
     if (is_node_fulltag(tag)) {
@@ -255,4 +279,5 @@
     }
     pairp += 2;
+    --npairs;
   }
   deref(hashv, 1) = lisp_global(WEAKVLL);
@@ -324,19 +349,30 @@
 mark_weak_hash_vector(hash_table_vector_header *hashp, natural elements)
 {
-  natural flags = hashp->flags, key_dnode, val_dnode;
+  natural flags = hashp->flags, weak_dnode, nonweak_dnode;
   Boolean 
     marked_new = false, 
-    key_marked,
-    val_marked,
-    weak_value = ((flags & nhash_weak_value_mask) != 0);
+    weak_marked;
+  int non_weak_index = (((flags & nhash_weak_value_mask) != 0) ? 0 : 1);
   int 
     skip = hash_table_vector_header_count-1,
-    key_tag,
-    val_tag,
+    weak_tag,
+    nonweak_tag,
     i;
+  signed_natural
+    npairs = (elements - skip) >> 1;
   LispObj 
     *pairp = (LispObj*) (hashp+1),
-    key,
-    val;
+    weak,
+    nonweak;
+
+  natural *tenured_low = (LispObj *)tenured_area->low;
+  natural tenured_dnodes = area_dnode(GCarealow, tenured_low);
+  natural memo_dnode = area_dnode(ptr_to_lispobj(pairp+non_weak_index), tenured_low);
+  Boolean hashv_tenured = (memo_dnode < tenured_dnodes);
+  natural bits, bitidx, *bitsp;
+
+  if (hashv_tenured) {
+    set_bitidx_vars(tenured_area->refbits, memo_dnode, bitsp, bits, bitidx);
+  }
 
   /* Mark everything in the header */
@@ -346,42 +382,51 @@
   }
 
-  elements -= skip;
-
-  /* TODO: the hash table might be in old space, in which case should use refbits
-     rather than touching all entries
-  */
-
-  for (i = 0; i<elements; i+=2, pairp+=2) {
-    key = pairp[0];
-    val = pairp[1];
-    key_marked = val_marked = true;
-    key_tag = fulltag_of(key);
-    val_tag = fulltag_of(val);
-    if (is_node_fulltag(key_tag)) {
-      key_dnode = gc_area_dnode(key);
-      if ((key_dnode < GCndnodes_in_area) &&
-          ! ref_bit(GCmarkbits,key_dnode)) {
-        key_marked = false;
-      }
-    }
-    if (is_node_fulltag(val_tag)) {
-      val_dnode = gc_area_dnode(val);
-      if ((val_dnode < GCndnodes_in_area) &&
-          ! ref_bit(GCmarkbits,val_dnode)) {
-        val_marked = false;
-      }
-    }
-
-    if (weak_value) {
-      if (val_marked & !key_marked) {
-        mark_root(key);
-        marked_new = true;
-      }
-    } else {
-      if (key_marked & !val_marked) {
-        mark_root(val);
-        marked_new = true;
-      }
-    }
+  while (true) {
+    if (hashv_tenured) {
+      while (bits == 0) {
+        int skip = nbits_in_word - bitidx;
+        npairs -= skip;
+        if (npairs <= 0) break;
+        pairp += (skip+skip);
+        bitidx = 0;
+        bits = *++bitsp;
+      }
+      if (bits != 0) {
+        int skip = count_leading_zeros(bits) - bitidx;
+        if (skip != 0) {
+          npairs -= skip;
+          pairp += (skip+skip);
+          bitidx += skip;
+        }
+      }
+    }
+    if (npairs <= 0) break;
+
+    nonweak = pairp[non_weak_index];
+    weak = pairp[1-non_weak_index];
+
+    nonweak_tag = fulltag_of(nonweak);
+    if (is_node_fulltag(nonweak_tag)) {
+      nonweak_dnode = gc_area_dnode(nonweak);
+      if ((nonweak_dnode < GCndnodes_in_area) &&
+          ! ref_bit(GCmarkbits,nonweak_dnode)) {
+        weak_marked = true;
+        weak_tag = fulltag_of(weak);
+        if (is_node_fulltag(weak_tag)) {
+          weak_dnode = gc_area_dnode(weak);
+          if ((weak_dnode < GCndnodes_in_area) &&
+              ! ref_bit(GCmarkbits, weak_dnode)) {
+            weak_marked = false;
+          }
+        }
+        if (weak_marked) {
+          mark_root(nonweak);
+          marked_new = true;
+        }
+      }
+    }
+
+    pairp+=2;
+    --npairs;
   }
   return marked_new;
@@ -862,5 +907,8 @@
 init_weakvll ()
 {
+  LispObj this = lisp_global(WEAKVLL); /* all weak vectors as of last gc */
+
   GCweakvll = (LispObj)NULL;
+  lisp_global(WEAKVLL) = (LispObj)NULL;
 
   if (GCn_ephemeral_dnodes) {
@@ -868,5 +916,5 @@
        GC area.  Weak vectors in the GC area will be added during marking.
     */
-    LispObj this = lisp_global(WEAKVLL); /* all weak vectors as of last gc */
+
     LispObj *tenured_low = (LispObj *)tenured_area->low;
     natural tenured_dnodes = area_dnode(GCarealow, tenured_low);
@@ -890,11 +938,31 @@
           if (header_subtag(base[0]) != subtag_hash_vector)
             Bug(NULL, "Unexpected entry " LISP " -> " LISP " on WEAKVLL", base, base[0]);
-          /* hash vectors are already singled out for special processing if they */
-          /* have any ephemeral keys, but not if they have ephemeral values. */
-          if (((hash_table_vector_header *)base)->flags & nhash_weak_value_mask) {
-            dnode = area_dnode(&base[0], tenured_low);
-            if (dnode < tenured_dnodes) {
-              set_bit(refbits, dnode); /* need to look at it anyway */
+          dnode = area_dnode(base, tenured_low);
+          if ((dnode < tenured_dnodes) && !ref_bit(refbits, dnode)) {
+            Boolean drop = true;
+            /* hash vectors get marked headers if they have any ephemeral keys */
+            /* but not if they have ephemeral values. */
+            if (((hash_table_vector_header *)base)->flags & nhash_weak_value_mask) {
+              signed_natural count = (header_element_count(base[0]) + 2) >> 1;
+              natural bits, bitidx, *bitsp;
+              set_bitidx_vars(refbits, dnode, bitsp, bits, bitidx);
+              while ((0 < count) && (bits == 0)) {
+                int skip = nbits_in_word - bitidx;
+                count -= skip;
+                bits = *++bitsp;
+                bitidx = 0;
+              }
+              count -=  (count_leading_zeros(bits) - bitidx);
+
+              if (0 < count) {
+                set_bit(refbits, dnode); /* has ephemeral values, mark header */
+                drop = false;
+              }
             }
+            if (drop) { /* if nothing ephemeral, drop it from GCweakvll. */
+              GCweakvll = base[1];
+              base[1] = lisp_global(WEAKVLL);
+              lisp_global(WEAKVLL) = ptr_to_lispobj(base);
+            }
           }
         }
@@ -903,5 +971,4 @@
     }
   }
-  lisp_global(WEAKVLL) = (LispObj)NULL;
 }