[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Make backtrace in ldb work during GC
From:       Douglas Katzman via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2020-06-29 22:16:30
Message-ID: 1593468990.670877.28399 () sfp-scm-3 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  82648a2f7063589043b78b25b7e20bda89c43b1b (commit)
      from  3d70239b0382be45f8935d4ac1c6ac20eeb5c0e8 (commit)

- Log -----------------------------------------------------------------
commit 82648a2f7063589043b78b25b7e20bda89c43b1b
Author: Douglas Katzman <dougk@google.com>
Date:   Mon Jun 29 18:15:26 2020 -0400

    Make backtrace in ldb work during GC
---
 src/runtime/backtrace.c      | 30 +++++++++++++++++-------------
 src/runtime/forwarding-ptr.h | 13 +++++++++++++
 src/runtime/immobile-space.c |  7 -------
 src/runtime/print.c          |  5 +----
 4 files changed, 31 insertions(+), 24 deletions(-)

diff --git a/src/runtime/backtrace.c b/src/runtime/backtrace.c
index 9b37cb042..23cea40be 100644
--- a/src/runtime/backtrace.c
+++ b/src/runtime/backtrace.c
@@ -35,6 +35,7 @@
 #include "gc.h"
 #include "code.h"
 #include "var-io.h"
+#include "forwarding-ptr.h"
 
 #ifdef LISP_FEATURE_OS_PROVIDES_DLADDR
 # include <dlfcn.h>
@@ -145,6 +146,7 @@ static int string_equal (struct vector *vector, char *string)
 static void
 print_entry_name (lispobj name, FILE *f)
 {
+    name = follow_maybe_fp(name);
     if (listp(name)) {
         putc('(', f);
         while (name != NIL) {
@@ -154,19 +156,20 @@ print_entry_name (lispobj name, FILE *f)
                 return;
             }
             print_entry_name(CONS(name)->car, f);
-            name = CONS(name)->cdr;
+            name = follow_maybe_fp(CONS(name)->cdr);
             if (name != NIL)
                 putc(' ', f);
         }
         putc(')', f);
     } else if (lowtag_of(name) == OTHER_POINTER_LOWTAG) {
-        lispobj *object = native_pointer(name);
-        if (widetag_of(object) == SYMBOL_WIDETAG) {
-            struct symbol *symbol = (struct symbol *) object;
+        struct symbol *symbol = SYMBOL(name);
+        int widetag = header_widetag(symbol->header);
+        switch (widetag) {
+        case SYMBOL_WIDETAG:
             if (symbol->package != NIL) {
                 struct package *pkg
-                    = (struct package *) native_pointer(symbol->package);
-                struct vector *pkg_name = VECTOR(pkg->_name);
+                    = (struct package *) native_pointer(follow_maybe_fp(symbol->package));
+                struct vector *pkg_name = VECTOR(follow_maybe_fp(pkg->_name));
                 if (string_equal(pkg_name, "COMMON-LISP"))
                     ;
                 else if (string_equal(pkg_name, "COMMON-LISP-USER")) {
@@ -179,17 +182,18 @@ print_entry_name (lispobj name, FILE *f)
                     fputs("::", f);
                 }
             }
-            print_string(VECTOR(symbol->name), f);
-        } else if (widetag_of(object) == SIMPLE_BASE_STRING_WIDETAG
+            print_string(VECTOR(follow_maybe_fp(symbol->name)), f);
+            break;
+        case SIMPLE_BASE_STRING_WIDETAG:
 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
-                   || widetag_of(object) == SIMPLE_CHARACTER_STRING_WIDETAG
+        case SIMPLE_CHARACTER_STRING_WIDETAG:
 #endif
-            ) {
             putc('"', f);
-            print_string((struct vector*)object, f);
+            print_string((struct vector*)symbol, f);
             putc('"', f);
-        } else {
-            fprintf(f, "<??? type %d>", widetag_of(object));
+            break;
+        default:
+            fprintf(f, "<??? type %d>", widetag);
         }
     } else if (fixnump(name)) {
         fprintf(f, "%d", (int)fixnum_value(name));
diff --git a/src/runtime/forwarding-ptr.h b/src/runtime/forwarding-ptr.h
index 81dc54cb0..31b842d10 100644
--- a/src/runtime/forwarding-ptr.h
+++ b/src/runtime/forwarding-ptr.h
@@ -59,4 +59,17 @@ set_forwarding_pointer(lispobj *pointer, lispobj newspace_copy) {
     return newspace_copy;
 }
 
+/// Chase the pointer in 'word' if it points to a forwarded object.
+static inline lispobj follow_maybe_fp(lispobj word)
+{
+    return (is_lisp_pointer(word) && forwarding_pointer_p(native_pointer(word)))
+        ? forwarding_pointer_value(native_pointer(word)) : word;
+}
+/// As above, but 'ptr' MUST be a pointer.
+static inline lispobj follow_fp(lispobj ptr)
+{
+  return forwarding_pointer_p(native_pointer(ptr))
+      ? forwarding_pointer_value(native_pointer(ptr)) : ptr;
+}
+
 #endif
diff --git a/src/runtime/immobile-space.c b/src/runtime/immobile-space.c
index a9d16af1b..8325a3f13 100644
--- a/src/runtime/immobile-space.c
+++ b/src/runtime/immobile-space.c
@@ -1605,13 +1605,6 @@ static struct layout* fix_object_layout(lispobj* obj)
     return native_layout;
 }
 
-static lispobj follow_fp(lispobj ptr)
-{
-  if (forwarding_pointer_p(native_pointer(ptr)))
-      return forwarding_pointer_value(native_pointer(ptr));
-  else
-      return ptr;
-}
 static void apply_absolute_fixups(lispobj, struct code*);
 
 /// It's tricky to try to use the scavtab[] functions for fixing up moved
diff --git a/src/runtime/print.c b/src/runtime/print.c
index f8994be25..0b719284b 100644
--- a/src/runtime/print.c
+++ b/src/runtime/print.c
@@ -921,10 +921,7 @@ struct vector * symbol_name(lispobj * sym)
     sym = native_pointer(forwarding_pointer_value(sym));
   if (lowtag_of(((struct symbol*)sym)->name) != OTHER_POINTER_LOWTAG)
       return NULL;
-  lispobj * name = native_pointer(((struct symbol*)sym)->name);
-  if (forwarding_pointer_p(name))
-      name = native_pointer(forwarding_pointer_value(name));
-  return (struct vector*)name;
+  return VECTOR(follow_maybe_fp(((struct symbol*)sym)->name));
 }
 struct vector * classoid_name(lispobj * classoid)
 {

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL


_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]