From: Nikodemus Siivola Date: Wed, 29 Jul 2009 15:15:31 +0000 (+0000) Subject: 1.0.30.11: autogenerate tagname information for LDB in genesis X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=09d3e0862347c08634268d49dc2f72c2375b9d8c;p=sbcl.git 1.0.30.11: autogenerate tagname information for LDB in genesis * Also remove some 32-bit assumption from LDB, and add missing array types there. Patch by Luis Oliveira. * Also fix the DESCRIBE buglet credit in NEWS. --- diff --git a/NEWS b/NEWS index 05c25d6..907941a 100644 --- a/NEWS +++ b/NEWS @@ -17,6 +17,8 @@ changes relative to sbcl-1.0.30: absence of an explicit DEFGENERIC. * improvement: DESCRIBE now reports on symbols naming undefined but assumed or declared function as well. + * bug fix: the low-level debugger had 32-bit assumptions and was missing + information about some array types. (thanks to Luis Oliveira) * bug fix: moderately complex combinations of inline expansions could be miscompiled if the result was declared to be dynamic extent. * bug fix: in some cases no compiler note about failure to stack allocate @@ -25,7 +27,7 @@ changes relative to sbcl-1.0.30: allocation could cause objects users might reasonably expect to be heap allocated to be stack allocated. * bug fix: DESCRIBE signalled an error for generic functions under - certain circumstances. (reported by Leslie Polzer) + certain circumstances. (thanks to Leslie Polzer) changes in sbcl-1.0.30 relative to sbcl-1.0.29: * minor incompatible change: SB-THREAD:JOIN-THREAD-ERROR-THREAD and diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 4978acc..db3ca48 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -2867,7 +2867,36 @@ core and return a descriptor to it." (c-symbol-name symbol) (sb!xc:mask-field (symbol-value symbol) -1)))) - +#!+sb-ldb +(defun write-tagnames-h (&optional (out *standard-output*)) + (labels + ((pretty-name (symbol strip) + (let ((name (string-downcase symbol))) + (substitute #\Space #\- + (subseq name 0 (- (length name) (length strip)))))) + (list-sorted-tags (tail) + (loop for symbol being the external-symbols of "SB!VM" + when (and (constantp symbol) + (tailwise-equal (string symbol) tail)) + collect symbol into tags + finally (return (sort tags #'< :key #'symbol-value)))) + (write-tags (kind limit ash-count) + (format out "~%static const char *~(~A~)_names[] = {~%" + (subseq kind 1)) + (let ((tags (list-sorted-tags kind))) + (dotimes (i limit) + (if (eql i (ash (or (symbol-value (first tags)) -1) ash-count)) + (format out " \"~A\"" (pretty-name (pop tags) kind)) + (format out " \"unknown [~D]\"" i)) + (unless (eql i (1- limit)) + (write-string "," out)) + (terpri out))) + (write-line "};" out))) + (write-tags "-LOWTAG" sb!vm:lowtag-limit 0) + ;; this -2 shift depends on every OTHER-IMMEDIATE-?-LOWTAG + ;; ending with the same 2 bits. (#b10) + (write-tags "-WIDETAG" (ash (1+ sb!vm:widetag-mask) -2) -2)) + (values)) (defun write-primitive-object (obj) ;; writing primitive object layouts @@ -3355,6 +3384,8 @@ initially undefined function references:~2%") (write-map))) (out-to "config" (write-config-h)) (out-to "constants" (write-constants-h)) + #!+sb-ldb + (out-to "tagnames" (write-tagnames-h)) (let ((structs (sort (copy-list sb!vm:*primitive-objects*) #'string< :key (lambda (obj) (symbol-name @@ -3387,5 +3418,3 @@ initially undefined function references:~2%") (when core-file-name (write-initial-core-file core-file-name)))))) - - diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c index 6920df4..5bc83c3 100644 --- a/src/runtime/monitor.c +++ b/src/runtime/monitor.c @@ -273,8 +273,7 @@ search_cmd(char **ptr) end += 2; if (widetag_of(obj) == SIMPLE_FUN_HEADER_WIDETAG) { print((long)addr | FUN_POINTER_LOWTAG); - } else if (lowtag_of(obj) == OTHER_IMMEDIATE_0_LOWTAG || - lowtag_of(obj) == OTHER_IMMEDIATE_1_LOWTAG) { + } else if (other_immediate_lowtag_p(obj)) { print((lispobj)addr | OTHER_POINTER_LOWTAG); } else { print((lispobj)addr); diff --git a/src/runtime/print.c b/src/runtime/print.c index 6f3b505..a7a578c 100644 --- a/src/runtime/print.c +++ b/src/runtime/print.c @@ -34,10 +34,8 @@ #include "gencgc-alloc-region.h" /* genesis/thread.h needs this */ #include "genesis/static-symbols.h" #include "genesis/primitive-objects.h" - #include "genesis/static-symbols.h" - - +#include "genesis/tagnames.h" static int max_lines = 20, cur_lines = 0; static int max_depth = 5, brief_depth = 2, cur_depth = 0; @@ -49,123 +47,6 @@ static void print_obj(char *prefix, lispobj obj); #define NEWLINE_OR_RETURN if (continue_p(1)) newline(NULL); else return; -/* FIXME: This should be auto-generated by whatever generates - constants.h so we don't have to maintain this twice! */ -#ifdef LISP_FEATURE_X86_64 -char *lowtag_Names[] = { - "even fixnum", - "instance pointer", - "other immediate [0]", - "unknown [3]", - "unknown [4]", - "unknown [5]", - "other immediate [1]", - "list pointer", - "odd fixnum", - "function pointer", - "other immediate [2]", - "unknown [11]", - "unknown [12]", - "unknown [13]", - "other immediate [3]", - "other pointer" -}; -#else -char *lowtag_Names[] = { - "even fixnum", - "instance pointer", - "other immediate [0]", - "list pointer", - "odd fixnum", - "function pointer", - "other immediate [1]", - "other pointer" -}; -#endif - -/* FIXME: Yikes! This table implicitly depends on the values in sbcl.h, - * but doesn't actually depend on them, so if they change, it gets - * all broken. We should either get rid of it or - * rewrite the code so that it's cleanly initialized by gc_init_tables[] - * in a way which varies correctly with the values in sbcl.h. */ -char *subtype_Names[] = { - "unused 0", - "unused 1", - "bignum", - "ratio", - "single float", - "double float", -#ifdef LONG_FLOAT_WIDETAG - "long float", -#endif - "complex", -#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG - "complex single float", -#endif -#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG - "complex double float", -#endif -#ifdef COMPLEX_LONG_FLOAT_WIDETAG - "complex long float", -#endif - "simple-array", - "simple-string", - "simple-bit-vector", - "simple-vector", - "(simple-array (unsigned-byte 2) (*))", - "(simple-array (unsigned-byte 4) (*))", - "(simple-array (unsigned-byte 8) (*))", - "(simple-array (unsigned-byte 16) (*))", - "(simple-array (unsigned-byte 32) (*))", -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG - "(simple-array (signed-byte 8) (*))", -#endif -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG - "(simple-array (signed-byte 16) (*))", -#endif -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG - "(simple-array fixnum (*))", -#endif -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG - "(simple-array (signed-byte 32) (*))", -#endif - "(simple-array single-float (*))", - "(simple-array double-float (*))", -#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG - "(simple-array long-float (*))", -#endif -#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG - "(simple-array (complex single-float) (*))", -#endif -#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG - "(simple-array (complex double-float) (*))", -#endif -#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG - "(simple-array (complex long-float) (*))", -#endif - "complex-string", - "complex-bit-vector", - "(array * (*))", - "array", - "code header", - "function header", - "closure header", - "funcallable-instance header", - "unused function header 1", - "unused function header 2", - "unused function header 3", - "closure function header", - "return PC header", - "value cell header", - "symbol header", - "character", - "SAP", - "unbound marker", - "weak pointer", - "instance header", - "fdefn" -}; - static void indent(int in) { static char *spaces = " "; @@ -241,7 +122,6 @@ static void print_fixnum(lispobj obj) static void brief_otherimm(lispobj obj) { int type, c; - unsigned int idx; char buffer[10]; type = widetag_of(obj); @@ -281,28 +161,14 @@ static void brief_otherimm(lispobj obj) break; default: - idx = type >> 2; - if (idx < (sizeof(lowtag_Names) / sizeof(char *))) - printf("%s", lowtag_Names[idx]); - else - printf("unknown type (0x%0x)", type); + printf("%s", widetag_names[type >> 2]); break; } } static void print_otherimm(lispobj obj) { - int type; - - unsigned int idx; - - type = widetag_of(obj); - idx = type >> 2; - - if (idx < (sizeof(lowtag_Names) / sizeof(char *))) - printf(", %s", lowtag_Names[idx]); - else - printf(", unknown type (0x%0x)", type); + printf(", %s", widetag_names[widetag_of(obj) >> 2]); switch (widetag_of(obj)) { case CHARACTER_WIDETAG: @@ -451,9 +317,9 @@ static void print_slots(char **slots, int count, lispobj *ptr) } } -/* FIXME: Yikes again! This, like subtype_Names[], needs to depend - * on the values in sbcl.h (or perhaps be generated automatically - * by GENESIS as part of sbcl.h). */ +/* FIXME: Yikes! This needs to depend on the values in sbcl.h (or + * perhaps be generated automatically by GENESIS as part of + * sbcl.h). */ static char *symbol_slots[] = {"value: ", "hash: ", "plist: ", "name: ", "package: ", #ifdef LISP_FEATURE_SB_THREAD @@ -495,13 +361,12 @@ static void print_otherptr(lispobj obj) } header = *ptr++; - length = (*ptr) >> 2; - count = header>>8; + length = fixnum_value(*ptr); + count = HeaderValue(header); type = widetag_of(header); print_obj("header: ", header); - if (lowtag_of(header) != OTHER_IMMEDIATE_0_LOWTAG && - lowtag_of(header) != OTHER_IMMEDIATE_1_LOWTAG) { + if (!other_immediate_lowtag_p(header)) { NEWLINE_OR_RETURN; printf("(invalid header object)"); return; @@ -618,9 +483,24 @@ static void print_otherptr(lispobj obj) case SIMPLE_BIT_VECTOR_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG: +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG + case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG: +#endif + case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG + case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG: +#endif +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG + case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG: +#endif +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG + case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG: +#endif #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG: #endif @@ -633,6 +513,12 @@ static void print_otherptr(lispobj obj) #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG: #endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG: +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG: +#endif case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG: case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG: #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG @@ -764,7 +650,7 @@ static void print_obj(char *prefix, lispobj obj) newline(NULL); printf("%s0x%08lx: ", prefix, (unsigned long) obj); if (cur_depth < brief_depth) { - fputs(lowtag_Names[type], stdout); + fputs(lowtag_names[type], stdout); (*verbose_fns[type])(obj); } else diff --git a/src/runtime/print.h b/src/runtime/print.h index 9bfe560..f5b2844 100644 --- a/src/runtime/print.h +++ b/src/runtime/print.h @@ -15,8 +15,6 @@ #include "sbcl.h" #include "runtime.h" -extern char *lowtag_Names[], *subtype_Names[]; - extern void print(lispobj obj); extern void brief_print(lispobj obj); extern void reset_printer(void); diff --git a/src/runtime/runtime.h b/src/runtime/runtime.h index 2d4eea7..8602432 100644 --- a/src/runtime/runtime.h +++ b/src/runtime/runtime.h @@ -229,6 +229,24 @@ fixnum_value(lispobj n) #endif typedef int boolean; +static inline boolean +other_immediate_lowtag_p(lispobj header) +{ + switch (lowtag_of(header)) { + case OTHER_IMMEDIATE_0_LOWTAG: + case OTHER_IMMEDIATE_1_LOWTAG: +#ifdef OTHER_IMMEDIATE_2_LOWTAG + case OTHER_IMMEDIATE_2_LOWTAG: +#endif +#ifdef OTHER_IMMEDIATE_3_LOWTAG + case OTHER_IMMEDIATE_3_LOWTAG: +#endif + return 1; + default: + return 0; + } +} + /* KLUDGE: As far as I can tell there's no ANSI C way of saying * "this function never returns". This is the way that you do it * in GCC later than version 2.5 or so. */ diff --git a/version.lisp-expr b/version.lisp-expr index c65456a..fcd4f02 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.30.10" +"1.0.30.11"