0.9.10.30:

[sbcl.git] / src / runtime / gc-common.c

diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c
index a8f6aaf..40d5547 100644 (file)
--- a/src/runtime/gc-common.c
+++ b/src/runtime/gc-common.c
@@ -127,8 +127,8 @@ scavenge(lispobj *start, long n_words)
     lispobj *end = start + n_words;
     lispobj *object_ptr;
     long n_words_scavenged;
     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) {
 
          object_ptr < end;
          object_ptr += n_words_scavenged) {
 

@@ -156,25 +156,28 @@ scavenge(lispobj *start, long n_words)
                 n_words_scavenged = 1;
             }
         }
                 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
                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
             }
         }
 #endif

@@ -187,7 +190,8 @@ scavenge(lispobj *start, long n_words)
                 (scavtab[widetag_of(object)])(object_ptr, object);
         }
     }
                 (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 */
 }
 
 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;
     }
         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));
     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
     gencgc_apply_code_fixups(code, new_code);
 #endif

+

     return new_code;
 }
 
     return new_code;
 }
 

@@ -344,7 +355,8 @@ scav_code_header(lispobj *where, lispobj object)
          entry_point != NIL;
          entry_point = function_ptr->next) {
 
          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);
 
         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)
 {
 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 */
          (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)
 {
 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 */
          (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)
 {
 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 */
 }
 
     return NIL; /* bogus return value to satisfy static type checking */
 }
 

@@ -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. */
 
 /* 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)
 {
 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. */
 
     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;
     weak_pointers = wp;
 #endif
     return copy;

@@ -1541,7 +1553,7 @@ void scan_weak_pointers(void)
 static long
 scav_lose(lispobj *where, lispobj object)
 {
 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)));
 
          (unsigned long)object,
          widetag_of(*(lispobj*)native_pointer(object)));
 

@@ -1551,7 +1563,7 @@ scav_lose(lispobj *where, lispobj object)
 static lispobj
 trans_lose(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 */
          (unsigned long)object,
          widetag_of(*(lispobj*)native_pointer(object)));
     return NIL; /* bogus return value to satisfy static type checking */

@@ -1560,7 +1572,7 @@ trans_lose(lispobj object)
 static long
 size_lose(lispobj *where)
 {
 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 */
          (unsigned long)where,
          widetag_of(LOW_WORD(where)));
     return 1; /* bogus return value to satisfy static type checking */

@@ -1710,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;
     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
     scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
     scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
 #endif

@@ -1728,7 +1740,7 @@ gc_init_tables(void)
     scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
     scavtab[NO_TLS_VALUE_MARKER_WIDETAG] = scav_immediate;
     scavtab[INSTANCE_HEADER_WIDETAG] = scav_instance;
     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;
     scavtab[FDEFN_WIDETAG] = scav_boxed;
 #else
     scavtab[FDEFN_WIDETAG] = scav_fdefn;