X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgencgc.c;h=6902759133960cd42129cf6e3ba12082534b0c1b;hb=b9e94e326f79ab01e56cb437e424ce5ea489471f;hp=c8c6919f23178281dec432d4fd052e99d2f497c8;hpb=88cc2f72774202503588331fddd1592ae8546de1;p=sbcl.git

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index c8c6919..6902759 100644
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -1,5 +1,5 @@
 /*
- * GENerational Conservative Garbage Collector for SBCL x86
+ * GENerational Conservative Garbage Collector for SBCL
  */
 
 /*
@@ -168,12 +168,6 @@ struct page page_table[NUM_PAGES];
  * is needed. */
 static void *heap_base = NULL;
 
-#if N_WORD_BITS == 32
- #define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG
-#elif N_WORD_BITS == 64
- #define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
-#endif
-
 /* Calculate the start address for the given page number. */
 inline void *
 page_address(page_index_t page_num)
@@ -1858,237 +1852,6 @@ trans_unboxed_large(lispobj object)
 
 
 /*
- * vector-like objects
- */
-
-
-/* FIXME: What does this mean? */
-int gencgc_hash = 1;
-
-#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
-
-static long
-scav_vector(lispobj *where, lispobj object)
-{
-    unsigned long kv_length;
-    lispobj *kv_vector;
-    unsigned long length = 0; /* (0 = dummy to stop GCC warning) */
-    struct hash_table *hash_table;
-    lispobj empty_symbol;
-    unsigned long *index_vector = NULL; /* (NULL = dummy to stop GCC warning) */
-    unsigned long *next_vector = NULL; /* (NULL = dummy to stop GCC warning) */
-    unsigned long *hash_vector = NULL; /* (NULL = dummy to stop GCC warning) */
-    lispobj weak_p_obj;
-    unsigned long next_vector_length = 0;
-
-    /* FIXME: A comment explaining this would be nice. It looks as
-     * though SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based
-     * hash tables in the Lisp HASH-TABLE code, and nowhere else. */
-    if (HeaderValue(object) != subtype_VectorValidHashing)
-        return 1;
-
-    if (!gencgc_hash) {
-        /* This is set for backward compatibility. FIXME: Do we need
-         * this any more? */
-        *where =
-            (subtype_VectorMustRehash<<N_WIDETAG_BITS) | SIMPLE_VECTOR_WIDETAG;
-        return 1;
-    }
-
-    kv_length = fixnum_value(where[1]);
-    kv_vector = where + 2;  /* Skip the header and length. */
-    /*FSHOW((stderr,"/kv_length = %d\n", kv_length));*/
-
-    /* Scavenge element 0, which may be a hash-table structure. */
-    scavenge(where+2, 1);
-    if (!is_lisp_pointer(where[2])) {
-        lose("no pointer at %x in hash table\n", where[2]);
-    }
-    hash_table = (struct hash_table *)native_pointer(where[2]);
-    /*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/
-    if (widetag_of(hash_table->header) != INSTANCE_HEADER_WIDETAG) {
-        lose("hash table not instance (%x at %x)\n",
-             hash_table->header,
-             hash_table);
-    }
-
-    /* Scavenge element 1, which should be some internal symbol that
-     * the hash table code reserves for marking empty slots. */
-    scavenge(where+3, 1);
-    if (!is_lisp_pointer(where[3])) {
-        lose("not empty-hash-table-slot symbol pointer: %x\n", where[3]);
-    }
-    empty_symbol = where[3];
-    /* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/
-    if (widetag_of(*(lispobj *)native_pointer(empty_symbol)) !=
-        SYMBOL_HEADER_WIDETAG) {
-        lose("not a symbol where empty-hash-table-slot symbol expected: %x\n",
-             *(lispobj *)native_pointer(empty_symbol));
-    }
-
-    /* Scavenge hash table, which will fix the positions of the other
-     * needed objects. */
-    scavenge((lispobj *)hash_table,
-             sizeof(struct hash_table) / sizeof(lispobj));
-
-    /* Cross-check the kv_vector. */
-    if (where != (lispobj *)native_pointer(hash_table->table)) {
-        lose("hash_table table!=this table %x\n", hash_table->table);
-    }
-
-    /* WEAK-P */
-    weak_p_obj = hash_table->weak_p;
-
-    /* index vector */
-    {
-        lispobj index_vector_obj = hash_table->index_vector;
-
-        if (is_lisp_pointer(index_vector_obj) &&
-            (widetag_of(*(lispobj *)native_pointer(index_vector_obj)) ==
-                 SIMPLE_ARRAY_WORD_WIDETAG)) {
-            index_vector =
-                ((unsigned long *)native_pointer(index_vector_obj)) + 2;
-            /*FSHOW((stderr, "/index_vector = %x\n",index_vector));*/
-            length = fixnum_value(((lispobj *)native_pointer(index_vector_obj))[1]);
-            /*FSHOW((stderr, "/length = %d\n", length));*/
-        } else {
-            lose("invalid index_vector %x\n", index_vector_obj);
-        }
-    }
-
-    /* next vector */
-    {
-        lispobj next_vector_obj = hash_table->next_vector;
-
-        if (is_lisp_pointer(next_vector_obj) &&
-            (widetag_of(*(lispobj *)native_pointer(next_vector_obj)) ==
-             SIMPLE_ARRAY_WORD_WIDETAG)) {
-            next_vector = ((unsigned long *)native_pointer(next_vector_obj)) + 2;
-            /*FSHOW((stderr, "/next_vector = %x\n", next_vector));*/
-            next_vector_length = fixnum_value(((lispobj *)native_pointer(next_vector_obj))[1]);
-            /*FSHOW((stderr, "/next_vector_length = %d\n", next_vector_length));*/
-        } else {
-            lose("invalid next_vector %x\n", next_vector_obj);
-        }
-    }
-
-    /* maybe hash vector */
-    {
-        lispobj hash_vector_obj = hash_table->hash_vector;
-
-        if (is_lisp_pointer(hash_vector_obj) &&
-            (widetag_of(*(lispobj *)native_pointer(hash_vector_obj)) ==
-             SIMPLE_ARRAY_WORD_WIDETAG)){
-            hash_vector =
-                ((unsigned long *)native_pointer(hash_vector_obj)) + 2;
-            /*FSHOW((stderr, "/hash_vector = %x\n", hash_vector));*/
-            gc_assert(fixnum_value(((lispobj *)native_pointer(hash_vector_obj))[1])
-                      == next_vector_length);
-        } else {
-            hash_vector = NULL;
-            /*FSHOW((stderr, "/no hash_vector: %x\n", hash_vector_obj));*/
-        }
-    }
-
-    /* These lengths could be different as the index_vector can be a
-     * different length from the others, a larger index_vector could help
-     * reduce collisions. */
-    gc_assert(next_vector_length*2 == kv_length);
-
-    /* now all set up.. */
-
-    /* Work through the KV vector. */
-    {
-        long i;
-        for (i = 1; i < next_vector_length; i++) {
-            lispobj old_key = kv_vector[2*i];
-
-#if N_WORD_BITS == 32
-            unsigned long old_index = (old_key & 0x1fffffff)%length;
-#elif N_WORD_BITS == 64
-            unsigned long old_index = (old_key & 0x1fffffffffffffff)%length;
-#endif
-
-            /* Scavenge the key and value. */
-            scavenge(&kv_vector[2*i],2);
-
-            /* Check whether the key has moved and is EQ based. */
-            {
-                lispobj new_key = kv_vector[2*i];
-#if N_WORD_BITS == 32
-                unsigned long new_index = (new_key & 0x1fffffff)%length;
-#elif N_WORD_BITS == 64
-                unsigned long new_index = (new_key & 0x1fffffffffffffff)%length;
-#endif
-
-                if ((old_index != new_index) &&
-                    ((!hash_vector) ||
-                     (hash_vector[i] == MAGIC_HASH_VECTOR_VALUE)) &&
-                    ((new_key != empty_symbol) ||
-                     (kv_vector[2*i] != empty_symbol))) {
-
-                     /*FSHOW((stderr,
-                            "* EQ key %d moved from %x to %x; index %d to %d\n",
-                            i, old_key, new_key, old_index, new_index));*/
-
-                    if (index_vector[old_index] != 0) {
-                         /*FSHOW((stderr, "/P1 %d\n", index_vector[old_index]));*/
-
-                        /* Unlink the key from the old_index chain. */
-                        if (index_vector[old_index] == i) {
-                            /*FSHOW((stderr, "/P2a %d\n", next_vector[i]));*/
-                            index_vector[old_index] = next_vector[i];
-                            /* Link it into the needing rehash chain. */
-                            next_vector[i] = fixnum_value(hash_table->needing_rehash);
-                            hash_table->needing_rehash = make_fixnum(i);
-                            /*SHOW("P2");*/
-                        } else {
-                            unsigned long prior = index_vector[old_index];
-                            unsigned long next = next_vector[prior];
-
-                            /*FSHOW((stderr, "/P3a %d %d\n", prior, next));*/
-
-                            while (next != 0) {
-                                 /*FSHOW((stderr, "/P3b %d %d\n", prior, next));*/
-                                if (next == i) {
-                                    /* Unlink it. */
-                                    next_vector[prior] = next_vector[next];
-                                    /* Link it into the needing rehash
-                                     * chain. */
-                                    next_vector[next] =
-                                        fixnum_value(hash_table->needing_rehash);
-                                    hash_table->needing_rehash = make_fixnum(next);
-                                    /*SHOW("/P3");*/
-                                    break;
-                                }
-                                prior = next;
-                                next = next_vector[next];
-                            }
-                        }
-                    }
-                }
-            }
-        }
-    }
-    return (CEILING(kv_length + 2, 2));
-}
-
-#else
-
-static long
-scav_vector(lispobj *where, lispobj object)
-{
-    if (HeaderValue(object) == subtype_VectorValidHashing) {
-        *where =
-            (subtype_VectorMustRehash<<N_WIDETAG_BITS) | SIMPLE_VECTOR_WIDETAG;
-    }
-    return 1;
-}
-
-#endif
-
-
-/*
  * Lutexes. Using the normal finalization machinery for finalizing
  * lutexes is tricky, since the finalization depends on working lutexes.
  * So we track the lutexes in the GC and finalize them manually.
@@ -3243,6 +3006,13 @@ scavenge_newspace_generation(generation_index_t generation)
     /* Record all new areas now. */
     record_new_objects = 2;
 
+    /* Give a chance to weak hash tables to make other objects live.
+     * FIXME: The algorithm implemented here for weak hash table gcing
+     * is O(W^2+N) as Bruno Haible warns in
+     * http://www.haible.de/bruno/papers/cs/weak/WeakDatastructures-writeup.html
+     * see "Implementation 2". */
+    scav_weak_hash_tables();
+
     /* Flush the current regions updating the tables. */
     gc_alloc_update_all_page_tables();
 
@@ -3281,8 +3051,8 @@ scavenge_newspace_generation(generation_index_t generation)
             if (gencgc_verbose)
                 SHOW("new_areas overflow, doing full scavenge");
 
-            /* Don't need to record new areas that get scavenge anyway
-             * during scavenge_newspace_generation_one_scan. */
+            /* Don't need to record new areas that get scavenged
+             * anyway during scavenge_newspace_generation_one_scan. */
             record_new_objects = 1;
 
             scavenge_newspace_generation_one_scan(generation);
@@ -3290,6 +3060,8 @@ scavenge_newspace_generation(generation_index_t generation)
             /* Record all new areas now. */
             record_new_objects = 2;
 
+            scav_weak_hash_tables();
+
             /* Flush the current regions updating the tables. */
             gc_alloc_update_all_page_tables();
 
@@ -3304,6 +3076,8 @@ scavenge_newspace_generation(generation_index_t generation)
                 scavenge(page_address(page)+offset, size);
             }
 
+            scav_weak_hash_tables();
+
             /* Flush the current regions updating the tables. */
             gc_alloc_update_all_page_tables();
         }
@@ -3455,13 +3229,6 @@ print_ptr(lispobj *addr)
 }
 #endif
 
-#if defined(LISP_FEATURE_PPC)
-extern int closure_tramp;
-extern int undefined_tramp;
-#else
-extern int undefined_tramp;
-#endif
-
 static void
 verify_space(lispobj *start, size_t words)
 {
@@ -3516,14 +3283,7 @@ verify_space(lispobj *start, size_t words)
                 */
             } else {
                 /* Verify that it points to another valid space. */
-                if (!to_readonly_space && !to_static_space &&
-#if defined(LISP_FEATURE_PPC)
-                    !((thing == &closure_tramp) ||
-                      (thing == &undefined_tramp))
-#else
-                    thing != (unsigned long)&undefined_tramp
-#endif
-                    ) {
+                if (!to_readonly_space && !to_static_space) {
                     lose("Ptr %x @ %x sees junk.\n", thing, start);
                 }
             }
@@ -3891,6 +3651,8 @@ write_protect_generation_pages(generation_index_t generation)
     }
 }
 
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+
 static void
 scavenge_control_stack()
 {
@@ -3906,7 +3668,6 @@ scavenge_control_stack()
     scavenge(control_stack, control_stack_size);
 }
 
-#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
 /* Scavenging Interrupt Contexts */
 
 static int boxed_registers[] = BOXED_REGISTERS;
@@ -4043,6 +3804,7 @@ scavenge_interrupt_contexts(void)
 
 #endif
 
+#if defined(LISP_FEATURE_SB_THREAD)
 static void
 preserve_context_registers (os_context_t *c)
 {
@@ -4063,10 +3825,11 @@ preserve_context_registers (os_context_t *c)
     #error "preserve_context_registers needs to be tweaked for non-x86 Darwin"
 #endif
 #endif
-    for(ptr = (void **)(c+1); ptr>=(void **)c; ptr--) {
+    for(ptr = ((void **)(c+1))-1; ptr>=(void **)c; ptr--) {
         preserve_pointer(*ptr);
     }
 }
+#endif
 
 /* Garbage collect a generation. If raise is 0 then the remains of the
  * generation are not raised to the next generation. */
@@ -4082,6 +3845,9 @@ garbage_collect_generation(generation_index_t generation, int raise)
     /* The oldest generation can't be raised. */
     gc_assert((generation != HIGHEST_NORMAL_GENERATION) || (raise == 0));
 
+    /* Check if weak hash tables were processed in the previous GC. */
+    gc_assert(weak_hash_tables == NULL);
+
     /* Initialize the weak pointer list. */
     weak_pointers = NULL;
 
@@ -4168,7 +3934,7 @@ garbage_collect_generation(generation_index_t generation, int raise)
 #else
             esp = (void **)((void *)&raise);
 #endif
-            for (ptr = (void **)th->control_stack_end; ptr > esp;  ptr--) {
+            for (ptr = ((void **)th->control_stack_end)-1; ptr > esp;  ptr--) {
                 preserve_pointer(*ptr);
             }
         }
@@ -4289,6 +4055,7 @@ garbage_collect_generation(generation_index_t generation, int raise)
     }
 #endif
 
+    scan_weak_hash_tables();
     scan_weak_pointers();
 
     /* Flush the current regions, updating the tables. */
@@ -4637,7 +4404,6 @@ gc_init(void)
     page_index_t i;
 
     gc_init_tables();
-    scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector;
     scavtab[WEAK_POINTER_WIDETAG] = scav_weak_pointer;
     transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed_large;
 
@@ -4962,7 +4728,8 @@ gc_and_save(char *filename, int prepend_runtime)
     void *runtime_bytes = NULL;
     size_t runtime_size;
 
-    file = prepare_to_save(filename, prepend_runtime, &runtime_bytes, &runtime_size);
+    file = prepare_to_save(filename, prepend_runtime, &runtime_bytes,
+                           &runtime_size);
     if (file == NULL)
        return;