0.9.10.8:
[sbcl.git] / src / runtime / gc-common.c
index a526ded..37555f9 100644 (file)
@@ -127,8 +127,8 @@ scavenge(lispobj *start, long n_words)
     lispobj *end = start + n_words;
     lispobj *object_ptr;
     long n_words_scavenged;
-    for (object_ptr = start;
 
+    for (object_ptr = start;
          object_ptr < end;
          object_ptr += n_words_scavenged) {
 
@@ -156,25 +156,28 @@ scavenge(lispobj *start, long n_words)
                 n_words_scavenged = 1;
             }
         }
-#ifndef LISP_FEATURE_GENCGC
-        /* this workaround is probably not necessary for gencgc; at least, the
-         * behaviour it describes has never been reported */
-        else if (n_words==1) {
-            /* there are some situations where an
-               other-immediate may end up in a descriptor
-               register.  I'm not sure whether this is
-               supposed to happen, but if it does then we
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+       /* This workaround is probably not needed for those ports
+          which don't have a partitioned register set (and therefore
+          scan the stack conservatively for roots). */
+        else if (n_words == 1) {
+            /* there are some situations where an other-immediate may
+               end up in a descriptor register.  I'm not sure whether
+               this is supposed to happen, but if it does then we
                don't want to (a) barf or (b) scavenge over the
-               data-block, because there isn't one.  So, if
-               we're checking a single word and it's anything
-               other than a pointer, just hush it up */
-            int type=widetag_of(object);
-            n_words_scavenged=1;
-
-            if ((scavtab[type]==scav_lose) ||
-                (((scavtab[type])(start,object))>1)) {
-                fprintf(stderr,"warning: attempted to scavenge non-descriptor value %x at %p.  If you can\nreproduce this warning, send a bug report (see manual page for details)\n",
-                        object,start);
+               data-block, because there isn't one.  So, if we're
+               checking a single word and it's anything other than a
+               pointer, just hush it up */
+            int widetag = widetag_of(object);
+            n_words_scavenged = 1;
+
+            if ((scavtab[widetag] == scav_lose) ||
+                (((sizetab[widetag])(object_ptr)) > 1)) {
+                fprintf(stderr,"warning: \
+attempted to scavenge non-descriptor value %x at %p.\n\n\
+If you can reproduce this warning, please send a bug report\n\
+(see manual page for details).\n",
+                        object, object_ptr);
             }
         }
 #endif
@@ -187,7 +190,8 @@ scavenge(lispobj *start, long n_words)
                 (scavtab[widetag_of(object)])(object_ptr, object);
         }
     }
-    gc_assert(object_ptr == end);
+    gc_assert_verbose(object_ptr == end, "Final object pointer %p, start %p, end %p\n",
+                      object_ptr, start, end);
 }
 
 static lispobj trans_fun_header(lispobj object); /* forward decls */
@@ -313,11 +317,18 @@ trans_code(struct code *code)
         fheaderl = fheaderp->next;
         prev_pointer = &nfheaderp->next;
     }
+#ifdef LISP_FEATURE_GENCGC
+    /* Cheneygc doesn't need this os_flush_icache, it flushes the whole
+       spaces once when all copying is done. */
     os_flush_icache((os_vm_address_t) (((long *)new_code) + nheader_words),
                     ncode_words * sizeof(long));
-#ifdef LISP_FEATURE_GENCGC
+
+#endif
+
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
     gencgc_apply_code_fixups(code, new_code);
 #endif
+
     return new_code;
 }
 
@@ -344,7 +355,8 @@ scav_code_header(lispobj *where, lispobj object)
          entry_point != NIL;
          entry_point = function_ptr->next) {
 
-        gc_assert(is_lisp_pointer(entry_point));
+        gc_assert_verbose(is_lisp_pointer(entry_point), "Entry point %lx\n",
+                          (long)entry_point);
 
         function_ptr = (struct simple_fun *) native_pointer(entry_point);
         gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
@@ -387,7 +399,7 @@ size_code_header(lispobj *where)
 static long
 scav_return_pc_header(lispobj *where, lispobj object)
 {
-    lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x",
+    lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x\n",
          (unsigned long) where,
          (unsigned long) object);
     return 0; /* bogus return value to satisfy static type checking */
@@ -442,7 +454,7 @@ scav_closure_header(lispobj *where, lispobj object)
 static long
 scav_fun_header(lispobj *where, lispobj object)
 {
-    lose("attempted to scavenge a function header where=0x%08x object=0x%08x",
+    lose("attempted to scavenge a function header where=0x%08x object=0x%08x\n",
          (unsigned long) where,
          (unsigned long) object);
     return 0; /* bogus return value to satisfy static type checking */
@@ -627,7 +639,7 @@ scav_immediate(lispobj *where, lispobj object)
 static lispobj
 trans_immediate(lispobj object)
 {
-    lose("trying to transport an immediate");
+    lose("trying to transport an immediate\n");
     return NIL; /* bogus return value to satisfy static type checking */
 }
 
@@ -649,7 +661,7 @@ scav_instance(lispobj *where, lispobj object)
 {
     lispobj nuntagged;
     long ntotal = HeaderValue(object);
-    lispobj layout = ((struct instance *)native_pointer(where))->slots[0];
+    lispobj layout = ((struct instance *)where)->slots[0];
 
     if (!layout)
         return 1;
@@ -693,7 +705,7 @@ size_boxed(lispobj *where)
 
 /* Note: on the sparc we don't have to do anything special for fdefns, */
 /* 'cause the raw-addr has a function lowtag. */
-#ifndef LISP_FEATURE_SPARC
+#if !defined(LISP_FEATURE_SPARC)
 static long
 scav_fdefn(lispobj *where, lispobj object)
 {
@@ -1491,7 +1503,7 @@ trans_weak_pointer(lispobj object)
 
     gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
     /* Push the weak pointer onto the list of weak pointers. */
-    wp->next = LOW_WORD(weak_pointers);
+    wp->next = (struct weak_pointer *)LOW_WORD(weak_pointers);
     weak_pointers = wp;
 #endif
     return copy;
@@ -1507,8 +1519,7 @@ size_weak_pointer(lispobj *where)
 void scan_weak_pointers(void)
 {
     struct weak_pointer *wp;
-    for (wp = weak_pointers; wp != NULL;
-         wp=(struct weak_pointer *)native_pointer(wp->next)) {
+    for (wp = weak_pointers; wp != NULL; wp=wp->next) {
         lispobj value = wp->value;
         lispobj *first_pointer;
         gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
@@ -1542,7 +1553,7 @@ void scan_weak_pointers(void)
 static long
 scav_lose(lispobj *where, lispobj object)
 {
-    lose("no scavenge function for object 0x%08x (widetag 0x%x)",
+    lose("no scavenge function for object 0x%08x (widetag 0x%x)\n",
          (unsigned long)object,
          widetag_of(*(lispobj*)native_pointer(object)));
 
@@ -1552,7 +1563,7 @@ scav_lose(lispobj *where, lispobj object)
 static lispobj
 trans_lose(lispobj object)
 {
-    lose("no transport function for object 0x%08x (widetag 0x%x)",
+    lose("no transport function for object 0x%08x (widetag 0x%x)\n",
          (unsigned long)object,
          widetag_of(*(lispobj*)native_pointer(object)));
     return NIL; /* bogus return value to satisfy static type checking */
@@ -1561,7 +1572,7 @@ trans_lose(lispobj object)
 static long
 size_lose(lispobj *where)
 {
-    lose("no size function for object at 0x%08x (widetag 0x%x)",
+    lose("no size function for object at 0x%08x (widetag 0x%x)\n",
          (unsigned long)where,
          widetag_of(LOW_WORD(where)));
     return 1; /* bogus return value to satisfy static type checking */
@@ -1711,7 +1722,7 @@ gc_init_tables(void)
     scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
     scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
     scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
-#ifndef LISP_FEATURE_GENCGC     /* FIXME ..._X86 ? */
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
     scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
     scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
 #endif
@@ -1727,8 +1738,9 @@ gc_init_tables(void)
     scavtab[CHARACTER_WIDETAG] = scav_immediate;
     scavtab[SAP_WIDETAG] = scav_unboxed;
     scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
+    scavtab[NO_TLS_VALUE_MARKER_WIDETAG] = scav_immediate;
     scavtab[INSTANCE_HEADER_WIDETAG] = scav_instance;
-#ifdef LISP_FEATURE_SPARC
+#if defined(LISP_FEATURE_SPARC)
     scavtab[FDEFN_WIDETAG] = scav_boxed;
 #else
     scavtab[FDEFN_WIDETAG] = scav_fdefn;
@@ -1861,6 +1873,7 @@ gc_init_tables(void)
     transother[CHARACTER_WIDETAG] = trans_immediate;
     transother[SAP_WIDETAG] = trans_unboxed;
     transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
+    transother[NO_TLS_VALUE_MARKER_WIDETAG] = trans_immediate;
     transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
     transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
     transother[FDEFN_WIDETAG] = trans_boxed;
@@ -2000,6 +2013,7 @@ gc_init_tables(void)
     sizetab[CHARACTER_WIDETAG] = size_immediate;
     sizetab[SAP_WIDETAG] = size_unboxed;
     sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
+    sizetab[NO_TLS_VALUE_MARKER_WIDETAG] = size_immediate;
     sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
     sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
     sizetab[FDEFN_WIDETAG] = size_boxed;