Change most uses of is_cons_half() to the opposite: is_header()

is_header() is a table lookup with no conditional branching
and works in all situations except conservative stack scan.

src/cold/warm.lisp

@@ -33,8 +33,10 @@
   ;; whatever it is that show would have shown. Comment this out if you need.
     (when s (set s nil))))
 
-(assert (zerop (deref (extern-alien "lowtag_for_widetag" (array char 64))
-                      (ash sb-vm:character-widetag -2))))
+(let ((byte (deref (extern-alien "widetag_lowtag" (array char 256))
+                   sb-vm:character-widetag)))
+  (assert (not (logbitp 7 byte))) ; not a headered object
+  (assert (= (logand byte sb-vm:lowtag-mask) sb-vm:list-pointer-lowtag)))
 (gc :full t)
 
 ;;; Verify that all defstructs except for one were compiled in a null lexical

src/compiler/generic/genesis.lisp

@@ -2968,17 +2968,6 @@ Legal values for OFFSET are -4, -8, -12, ..."
     (let ((c 'sb-impl::+magic-hash-vector-value+))
       (push (list (c-symbol-name c) 9 (symbol-value c) +c-literal-64bit+ nil)
             constants))
-    ;; And still one more
-    #+64-bit
-    (let ((c 'sb-vm::immediate-widetags-mask))
-      (push (list (c-symbol-name c)
-                  1
-                  (logior (ash 1 (ash sb-vm:character-widetag -2))
-                          (ash 1 (ash sb-vm:single-float-widetag -2))
-                          (ash 1 (ash sb-vm:unbound-marker-widetag -2)))
-                  "LU"
-                  nil)
-            constants))
     (setf constants
           (sort constants
                 (lambda (const1 const2)

src/compiler/generic/late-objdef.lisp

@@ -149,31 +149,43 @@
                       (ldb (byte 32 0) bits) (ldb (byte 32 32) bits))
     (format stream "~%}~%"))
 
-  (format stream "extern unsigned char lowtag_for_widetag[64];
+  (format stream "extern unsigned char widetag_lowtag[256];
 static inline lispobj compute_lispobj(lispobj* base_addr) {
-  lispobj header = *base_addr;
-  return make_lispobj(base_addr,
-                      is_cons_half(header) ? LIST_POINTER_LOWTAG :
-                        lowtag_for_widetag[header_widetag(header)>>2]);~%}~%")
+  return make_lispobj(base_addr, LOWTAG_FOR_WIDETAG(*base_addr & WIDETAG_MASK));~%}~%")
 
   (format stream "~%#ifdef WANT_SCAV_TRANS_SIZE_TABLES~%")
-  (let ((a (make-array 64 :initial-element 0)))
+  (let ((lowtag-tbl (make-array 256 :initial-element 0)))
+    ;; Build a table translating from the from low byte of first word of any
+    ;; heap object to that object's lowtag when pointed to by a tagged pointer.
+    ;; If the first word is {immediate | pointer} then the object is a cons,
+    ;; otherwise the object is a headered object.
+    (dotimes (byte 256)
+      (when (or (eql 0 (logand byte fixnum-tag-mask))
+                (member (logand byte lowtag-mask)
+                        `(,instance-pointer-lowtag
+                          ,list-pointer-lowtag
+                          ,fun-pointer-lowtag
+                          ,other-pointer-lowtag))
+                (member byte `(#+64-bit ,single-float-widetag
+                               ,character-widetag
+                               ,unbound-marker-widetag)))
+        ;; gotta be a CONS
+        (setf (svref lowtag-tbl byte) list-pointer-lowtag)))
     (dolist (entry *scav/trans/size*)
       (destructuring-bind (widetag scav &rest ignore) entry
         (declare (ignore ignore))
         (unless (string= scav "immediate")
-          (setf (aref a (ash widetag -2))
-                (case widetag
-                  (#.instance-widetag instance-pointer-lowtag)
-                  (#.+function-widetags+ fun-pointer-lowtag)
-                  (t other-pointer-lowtag))))))
-    (let ((contents (format nil "~{0x~x,~} " (coerce a 'list))))
-      (format stream
-              "unsigned char lowtag_for_widetag[64] = {~{~%  ~A~}~%};~%"
-              ;; write 4 characters per widetag ("0xN,"), 16 per line
-              (loop for i from 0 by 64 repeat 4
-                    ;; trailing comma on the last item is OK in C
-                    collect (subseq contents i (+ i 64))))))
+          (setf (svref lowtag-tbl widetag)
+                (+ #x80 (case widetag
+                          (#.instance-widetag instance-pointer-lowtag)
+                          (#.+function-widetags+ fun-pointer-lowtag)
+                          (t other-pointer-lowtag)))))))
+    (format stream "unsigned char widetag_lowtag[256] = {")
+    (dotimes (line 16)
+      (format stream "~%~:{ ~:[0x~2,'0x~;~4d~],~}"
+              (mapcar (lambda (x) (list (member x `(0 ,sb-vm:list-pointer-lowtag)) x))
+                      (coerce (subseq lowtag-tbl (* line 16) (* (1+ line) 16)) 'list))))
+    (format stream "~%};~%"))
   (let ((scavtab  (make-array 256 :initial-element nil))
         (ptrtab   (make-list #+ppc64 16 #-ppc64 4))
         (transtab (make-array 64  :initial-element nil))

src/runtime/coalesce.c

@@ -157,13 +157,9 @@ static uword_t coalesce_range(lispobj* where, lispobj* limit, uword_t arg)
     sword_t nwords, i;
 
     for ( ; where < limit ; where = next ) {
-        lispobj header = *where;
-        if (is_cons_half(header)) {
-            coalesce_obj(where+0, ht);
-            coalesce_obj(where+1, ht);
-            next = where + 2;
-        } else {
-            int widetag = header_widetag(header);
+        lispobj word = *where;
+        if (is_header(word)) {
+            int widetag = header_widetag(word);
             nwords = sizetab[widetag](where);
             next = where + nwords;
             switch (widetag) {
@@ -186,6 +182,10 @@ static uword_t coalesce_range(lispobj* where, lispobj* limit, uword_t arg)
             }
             for(i=1; i<nwords; ++i)
                 coalesce_obj(where+i, ht);
+        } else {
+            coalesce_obj(where+0, ht);
+            coalesce_obj(where+1, ht);
+            next = where + 2;
         }
     }
     return 0;

src/runtime/coreparse.c

@@ -393,7 +393,6 @@ static inline void fix_fun_header_layout(lispobj __attribute__((unused)) *fun,
 static void relocate_space(uword_t start, lispobj* end, struct heap_adjust* adj)
 {
     lispobj *where = (lispobj*)start;
-    lispobj header_word;
     int widetag;
     long nwords;
     lispobj layout, adjusted_layout, bitmap;
@@ -402,13 +401,13 @@ static void relocate_space(uword_t start, lispobj* end, struct heap_adjust* adj)
 
     adj->n_relocs_abs = adj->n_relocs_rel = 0;
     for ( ; where < end ; where += nwords ) {
-        header_word = *where;
-        if (is_cons_half(header_word)) {
+        lispobj word = *where;
+        if (!is_header(word)) {
             adjust_pointers(where, 2, adj);
             nwords = 2;
             continue;
         }
-        widetag = header_widetag(header_word);
+        widetag = header_widetag(word);
         nwords = sizetab[widetag](where);
         switch (widetag) {
         case FUNCALLABLE_INSTANCE_WIDETAG:
@@ -575,7 +574,7 @@ static void relocate_space(uword_t start, lispobj* end, struct heap_adjust* adj)
               && specialized_vector_widetag_p(widetag))
               continue;
           else
-              lose("Unrecognized heap object: @%p: %"OBJ_FMTX, where, header_word);
+              lose("Unrecognized heap object: @%p: %"OBJ_FMTX, where, *where);
         }
         adjust_pointers(where+1, nwords-1, adj);
     }

src/runtime/fullcgc.c

@@ -509,27 +509,16 @@ static uword_t sweep(lispobj* where, lispobj* end, uword_t arg)
 
     // TODO: consecutive dead objects on same page should be merged.
     for ( ; where < end ; where += nwords ) {
-        lispobj header = *where;
-        if (is_cons_half(header)) {
-            nwords = 2;
-            if (!cons_markedp((lispobj)where)) {
-                if (where[0] | where[1]) {
-               cons:
-                    gc_dcheck(!immobile_space_p((lispobj)where));
-                    NOTE_GARBAGE(page_table[find_page_index(where)].gen,
-                                 where, 2, zeroed,
-                                 where[0] = where[1] = 0);
-                }
-            }
-        } else {
-            nwords = sizetab[header_widetag(header)](where);
+        lispobj word = *where;
+        if (is_header(word)) {
+            nwords = sizetab[header_widetag(word)](where);
             lispobj markbit = MARK_BIT;
-            switch (header_widetag(header)) {
+            switch (header_widetag(word)) {
             case BIGNUM_WIDETAG: markbit = BIGNUM_MARK_BIT; break;
             case FDEFN_WIDETAG : markbit = FDEFN_MARK_BIT; break;
             }
-            if (header & markbit)
-                *where = header ^ markbit;
+            if (word & markbit)
+                *where = word ^ markbit;
             else {
                 // Turn the object into either a (0 . 0) cons
                 // or an unboxed filler depending on size.
@@ -549,6 +538,17 @@ static uword_t sweep(lispobj* where, lispobj* end, uword_t arg)
                     })
                 }
             }
+        } else {
+            nwords = 2;
+            if (!cons_markedp((lispobj)where)) {
+                if (where[0] | where[1]) {
+               cons:
+                    gc_dcheck(!immobile_space_p((lispobj)where));
+                    NOTE_GARBAGE(page_table[find_page_index(where)].gen,
+                                 where, 2, zeroed,
+                                 where[0] = where[1] = 0);
+                }
+            }
         }
     }
     return 0;

src/runtime/gc-common.c

@@ -1706,18 +1706,16 @@ properly_tagged_p_internal(lispobj pointer, lispobj *start_addr)
     // Given the precondition that the heap is in a valid state,
     // it may be assumed that one check of is_cons_half() suffices;
     // we don't need to check the other half.
-    lispobj header = *start_addr;
-    if (is_cons_half(header))
+    lispobj word = *start_addr;
+    if (!is_header(word))
         return make_lispobj(start_addr, LIST_POINTER_LOWTAG) == pointer;
 
     // Because this heap object was not deemed to be a cons,
     // it must be an object header. Don't need a check except when paranoid.
     gc_dcheck(other_immediate_lowtag_p(header));
 
-    // The space of potential widetags has 64 elements, not 256,
-    // because of the constant low 2 bits.
-    int widetag = header_widetag(header);
-    int lowtag = lowtag_for_widetag[widetag>>2];
+    int widetag = header_widetag(word);
+    int lowtag = LOWTAG_FOR_WIDETAG(widetag);
     if (lowtag && make_lispobj(start_addr, lowtag) == pointer)
         return 1; // instant win
 

src/runtime/gc-internal.h

@@ -99,7 +99,7 @@ extern struct weak_pointer *weak_pointer_chain; /* in gc-common.c */
 
 extern sword_t (*sizetab[256])(lispobj *where);
 #define OBJECT_SIZE(header,where) \
-  (is_cons_half(header)?2:sizetab[header_widetag(header)](where))
+  (is_header(header)?sizetab[header_widetag(header)](where):CONS_SIZE)
 
 lispobj *gc_search_space3(void *pointer, lispobj *start, void *limit);
 static inline lispobj *gc_search_space(lispobj *start, void *pointer) {

src/runtime/gencgc.c

@@ -1673,7 +1673,7 @@ static inline boolean plausible_tag_p(lispobj addr)
             && is_cons_half(CONS(addr)->cdr);
     unsigned char widetag = widetag_of(native_pointer(addr));
     return other_immediate_lowtag_p(widetag)
-        && lowtag_of(addr) == lowtag_for_widetag[widetag>>2];
+        && lowtag_of(addr) == LOWTAG_FOR_WIDETAG(widetag);
 }
 
 #if !GENCGC_IS_PRECISE
@@ -1824,13 +1824,16 @@ scavenge_pinned_ranges()
     int i;
     lispobj key;
     for_each_hopscotch_key(i, key, pinned_objects) {
-        lispobj* obj = native_pointer(key);
-        lispobj header = *obj;
-        // Never invoke scavenger on a simple-fun, just code components.
-        if (is_cons_half(header))
-            scavenge(obj, 2);
-        else if (header_widetag(header) != SIMPLE_FUN_WIDETAG)
-            scavtab[header_widetag(header)](obj, header);
+        gc_assert(is_lisp_pointer(key));
+        if (listp(key)) // don't need is_header() since we know the lowtag
+            scavenge((lispobj*)CONS(key), 2);
+        else {
+            lispobj* obj = native_pointer(key);
+            lispobj header = *obj;
+            int widetag = header_widetag(header);
+            // Never invoke scavenger on a simple-fun, just code components.
+            if (widetag != SIMPLE_FUN_WIDETAG) scavtab[widetag](obj, header);
+        }
     }
 }
 
@@ -1897,16 +1900,17 @@ void visit_freed_objects(char __attribute__((unused)) *start,
             where += OBJECT_SIZE(*fwd_where, fwd_where);
         } else { // dead object
             fprintf(stderr, "%p: %"OBJ_FMTX" %"OBJ_FMTX"\n", where, where[0], where[1]);
-            if (is_cons_half(word)) {
+            if (is_header(word)) {
+                // Do something interesting
+                where += sizetab[header_widetag(word)](where);
+            } else {
                 /* Can't do much useful with conses because often we can't distinguish
                  * filler from data. visit_freed_objects is called on ranges of pages
                  * without regard to whether each intervening page was completely full.
                  * (This is not usually the way, but freeing of pages is slightly
-                 * imprecise in that regard) */
+                 * imprecise in that regard).
+                 * And it's probably broken, since we leave detritus on code pages */
                 where += 2;
-            } else {
-                // Do something interesting
-                where += sizetab[header_widetag(word)](where);
             }
         }
     }
@@ -1961,11 +1965,11 @@ wipe_nonpinned_words()
       lispobj* obj = (lispobj*)pinned_objects.keys[i];
       lispobj word = *obj;
       int widetag = header_widetag(word);
-      if (is_cons_half(word))
-          fprintf(stderr, "%p: (cons)\n", obj);
-      else
+      if (is_header(word))
           fprintf(stderr, "%p: %d words (%s)\n", obj,
                   (int)sizetab[widetag](obj), widetag_names[widetag>>2]);
+      else
+          fprintf(stderr, "%p: (cons)\n", obj);
     }
 #endif
 
@@ -2836,8 +2840,7 @@ verify_range(lispobj *where, sword_t nwords, struct verify_state *state)
         if (!state->vaddr && where > state->object_end &&
             (state->flags & VERIFYING_HEAP_OBJECTS)) {
             state->object_start = where;
-            state->widetag =
-                is_cons_half(*where) ? LIST_POINTER_LOWTAG : widetag_of(where);
+            state->widetag = is_header(*where) ? widetag_of(where) : LIST_POINTER_LOWTAG;
             state->tagged_object_start = compute_lispobj(where);
             state->object_end = where + OBJECT_SIZE(*where, where) - 1;
             state->object_gen = gen_of((lispobj)where);
@@ -2936,8 +2939,7 @@ verify_range(lispobj *where, sword_t nwords, struct verify_state *state)
         int widetag = header_widetag(thing);
         if (is_lisp_immediate(thing) || widetag == NO_TLS_VALUE_MARKER_WIDETAG) {
             /* skip immediates */
-        } else if (!(other_immediate_lowtag_p(widetag)
-                     && lowtag_for_widetag[widetag>>2])) {
+        } else if (!(other_immediate_lowtag_p(widetag) && LOWTAG_FOR_WIDETAG(widetag))) {
             lose("Unhandled widetag %d at %p", widetag, where);
         } else if (leaf_obj_widetag_p(widetag)) {
             count = sizetab[widetag](where);

src/runtime/immobile-space.c

@@ -1621,7 +1621,6 @@ static void apply_absolute_fixups(lispobj, struct code*);
 static void fixup_space(lispobj* where, size_t n_words)
 {
     lispobj* end = where + n_words;
-    lispobj header_word;
     int widetag;
     long size;
     int __attribute__((unused)) static_space_p = ((lispobj)where == STATIC_SPACE_START);
@@ -1629,9 +1628,9 @@ static void fixup_space(lispobj* where, size_t n_words)
 
     while (where < end) {
         gc_assert(!forwarding_pointer_p(where));
-        header_word = *where;
-        if (is_cons_half(header_word)) {
-            adjust_words(where, 2, 0); // A cons.
+        lispobj header_word = *where;
+        if (!is_header(header_word)) {
+            adjust_words(where, 2, 0); // A cons. (It can only be filler?)
             where += 2;
             continue;
         }
@@ -1846,7 +1845,7 @@ static void place_fixedobj(lispobj* obj, int size_in_bytes,
 #endif
       gc_assert(!*tempspace_addr(new)); // better not clobber some other object
       memcpy(tempspace_addr(new), obj, size_in_bytes);
-      set_forwarding_pointer(obj, make_lispobj(new, lowtag_for_widetag[widetag>>2]));
+      set_forwarding_pointer(obj, make_lispobj(new, LOWTAG_FOR_WIDETAG(widetag)));
       if (widetag == FUNCALLABLE_INSTANCE_WIDETAG) // fix the self-pointer
           tempspace_addr(new)[1] = (lispobj)(new + 4*N_WORD_BYTES);
       *alloc_ptr = new + size_in_bytes;

src/runtime/monitor.c

@@ -199,8 +199,8 @@ dump_cmd(char **ptr)
                     && valid_widetag_p(header_widetag(word))) {
                     printf(" %s", widetag_names[header_widetag(word)>>2]);
                     next_object += sizetab[header_widetag(word)](next_object);
-                } else if (is_cons_half(word)) {
-                    next_object += 2;
+                } else if (!is_header(word)) {
+                    next_object += CONS_SIZE;
                 } else { // disable decoder if weirdness observed
                     decode = 0;
                 }

src/runtime/runtime.h

@@ -420,21 +420,32 @@ other_immediate_lowtag_p(lispobj header)
     return (lowtag_of(header) & 3) == OTHER_IMMEDIATE_0_LOWTAG;
 }
 
+// widetag_lowtag encodes in the sign bit whether the byte corresponds
+// to a headered object, and in the low bits the lowtag of a tagged pointer
+// pointing to this object, be it headered or a cons.
+extern unsigned char widetag_lowtag[256];
+#define LOWTAG_FOR_WIDETAG(x) (widetag_lowtag[x] & LOWTAG_MASK)
+
+// is_header() and is_cons_half() are logical complements when invoked
+// on the first word of any lisp object. However, given a word which is
+// only *potentially* the first word of a lisp object, they can both be false.
+// In ambiguous root detection, is_cons_half() is to be used, as it is the more
+// stringent check. The set of valid bit patterns in the low byte of the car
+// of a cons is smaller than the set of patterns accepted by !is_header().
+static inline int is_header(lispobj potential_header_word) {
+    return widetag_lowtag[potential_header_word & WIDETAG_MASK] & 0x80;
+}
+
 static inline int
 is_cons_half(lispobj obj)
 {
-    /* A word that satisfies other_immediate_lowtag_p is a headered object
-     * and can not be half of a cons, except that widetags which satisfy
-     * other_immediate and are Lisp immediates can be half of a cons */
-    return !other_immediate_lowtag_p(obj)
+    if (fixnump(obj) || is_lisp_pointer(obj)) return 1;
+    int widetag = header_widetag(obj);
+    return widetag == CHARACTER_WIDETAG ||
 #if N_WORD_BITS == 64
-        || ((uword_t)IMMEDIATE_WIDETAGS_MASK >> (header_widetag(obj) >> 2)) & 1;
-#else
-      /* The above bit-shifting approach is not applicable
-       * since we can't employ a 64-bit unsigned integer constant. */
-      || header_widetag(obj) == CHARACTER_WIDETAG
-      || header_widetag(obj) == UNBOUND_MARKER_WIDETAG;
+           widetag == SINGLE_FLOAT_WIDETAG ||
 #endif
+           widetag == UNBOUND_MARKER_WIDETAG;
 }
 
 /* KLUDGE: As far as I can tell there's no ANSI C way of saying

src/runtime/traceroot.c

@@ -151,9 +151,9 @@ static int find_ref(lispobj* source, lispobj target)
     lispobj layout, bitmap;
     int scan_limit, i;
 
-    lispobj header = *source;
-    if (is_cons_half(header)) {
-        check_ptr(0, header);
+    lispobj word = *source;
+    if (!is_header(word)) {
+        check_ptr(0, source[0]);
         check_ptr(1, source[1]);
         return -1;
     }
@@ -709,14 +709,14 @@ static uword_t build_refs(lispobj* where, lispobj* end,
     boolean count_only = !ss->record_ptrs;
     for ( ; where < end ; where += nwords ) {
         ++n_objects;
-        lispobj header = *where;
-        if (is_cons_half(header)) {
+        lispobj word = *where;
+        if (!is_header(word)) {
             nwords = 2;
-            check_ptr(header);
+            check_ptr(where[0]);
             check_ptr(where[1]);
             continue;
         }
-        int widetag = widetag_of(where);
+        int widetag = header_widetag(word);
         nwords = scan_limit = sizetab[widetag](where);
         switch (widetag) {
         case INSTANCE_WIDETAG:
@@ -776,7 +776,7 @@ static uword_t build_refs(lispobj* where, lispobj* end,
                 continue;
             break;
         default:
-            if (!(other_immediate_lowtag_p(widetag) && lowtag_for_widetag[widetag>>2]))
+            if (!(other_immediate_lowtag_p(widetag) && LOWTAG_FOR_WIDETAG(widetag)))
               lose("Unknown widetag %x", widetag);
             // Skip irrelevant objects.
             if (leaf_obj_widetag_p(widetag) ||