Menu
▾
▴
[Sbcl-commits] master: Autogenerate some bitmasks for testing sets of widetags.
|
From: Douglas K. <sn...@us...> - 2017-03-28 00:06:04
|
The branch "master" has been updated in SBCL:
via 12f875bff82d5a476e8d7e711c8301a202897a09 (commit)
from 3c1f8725a9df050cee07574e1999f1473a7c7141 (commit)
- Log -----------------------------------------------------------------
commit 12f875bff82d5a476e8d7e711c8301a202897a09
Author: Douglas Katzman <do...@go...>
Date: Mon Mar 27 19:57:07 2017 -0400
Autogenerate some bitmasks for testing sets of widetags.
Whether or not the compiler can generate jump tables for widetag-based
switch statements, we can improve the code flow both at the instruction
level as well as in readability of the source.
---
src/compiler/generic/late-objdef.lisp | 47 ++++++++++-
src/runtime/gc-common.c | 143 +++++++++-------------------------
src/runtime/gc-internal.h | 6 +-
src/runtime/gencgc.c | 15 ++--
src/runtime/marknsweepgc.c | 26 +------
5 files changed, 96 insertions(+), 141 deletions(-)
diff --git a/src/compiler/generic/late-objdef.lisp b/src/compiler/generic/late-objdef.lisp
index 7becc42..c525f82 100644
--- a/src/compiler/generic/late-objdef.lisp
+++ b/src/compiler/generic/late-objdef.lisp
@@ -109,6 +109,50 @@
#+sb-xc-host
(defun write-gc-tables (stream)
+ ;; Compute a bitmask of all specialized vector types,
+ ;; not including array headers, for maybe_adjust_large_object().
+ (let ((min #xff) (bits 0))
+ (dovector (saetp *specialized-array-element-type-properties*)
+ (unless (eq (saetp-primitive-type-name saetp) 'simple-vector)
+ (let ((widetag (saetp-typecode saetp)))
+ (setf min (min widetag min)
+ bits (logior bits (ash 1 (ash widetag -2)))))))
+ (format stream "static inline boolean specialized_vector_widetag_p(unsigned char widetag) {
+ return widetag>=0x~X && (0x~8,'0XU >> ((widetag-0x80)>>2)) & 1;~%}~%"
+ min (ldb (byte 32 32) bits))
+ ;; Union in the bits for other unboxed object types.
+ (dolist (entry *scav/trans/size*)
+ (when (string= (second entry) "unboxed")
+ (setf bits (logior bits (ash 1 (ash (car entry) -2))))))
+ (format stream "static inline boolean unboxed_obj_widetag_p(unsigned char widetag) {~%")
+ #!+64-bit (format stream " return (0x~XLU >> (widetag>>2)) & 1;" bits)
+ #!-64-bit (format stream " int bit = widetag>>2;
+ return (bit<32 ? 0x~XU >> bit : 0x~XU >> (bit-32)) & 1;"
+ (ldb (byte 32 0) bits) (ldb (byte 32 32) bits))
+ (format stream "~%}~%"))
+
+ (format stream "~%#ifdef WANT_SCAV_TRANS_SIZE_TABLES~%")
+ (let ((a (make-array 64 :initial-element 0)))
+ (dolist (entry *scav/trans/size*)
+ (destructuring-bind (widetag scav &rest ignore) entry
+ (declare (ignore ignore))
+ (unless (eq scav "immediate")
+ (setf (aref a (ash widetag -2))
+ (case widetag
+ (#.instance-header-widetag instance-pointer-lowtag)
+ ((#.funcallable-instance-header-widetag
+ #.closure-header-widetag
+ #.simple-fun-header-widetag)
+ 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))))))
(let ((scavtab (make-array 256 :initial-element nil))
(transtab (make-array 256 :initial-element nil))
(sizetab (make-array 256 :initial-element nil)))
@@ -147,4 +191,5 @@
(write-table "sword_t (*sizetab[256])(lispobj *where)"
"size_" sizetab)
(format stream "#undef size_pointer~%")
- (format stream "#undef size_unboxed~%"))))
+ (format stream "#undef size_unboxed~%")))
+ (format stream "#endif~%"))
diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c
index 6329a19..40ceee1 100644
--- a/src/runtime/gc-common.c
+++ b/src/runtime/gc-common.c
@@ -44,6 +44,7 @@
#include "genesis/static-symbols.h"
#include "genesis/layout.h"
#include "genesis/hash-table.h"
+#define WANT_SCAV_TRANS_SIZE_TABLES
#include "gc-internal.h"
#include "forwarding-ptr.h"
#include "var-io.h"
@@ -1362,54 +1363,45 @@ gc_search_space3(void *pointer, lispobj *start, void *limit)
*
* pointer is the pointer to check validity of,
* and start_addr is the address of the enclosing object.
+ *
+ * This is actually quite simple to check: because the heap state is assumed
+ * consistent, and 'start_addr' is known good, having come from
+ * gc_search_space(), only the 'pointer' argument is dubious.
+ * So make 'start_addr' into a tagged pointer and see if that matches 'pointer'.
+ * If it does, then 'pointer' is valid.
*/
int
-properly_tagged_descriptor_p(void *thing, lispobj *start_addr)
+properly_tagged_p_internal(lispobj pointer, lispobj *start_addr)
{
- lispobj pointer = (lispobj)thing;
- if (!is_lisp_pointer(pointer)) {
- return 0;
- }
+ // If a headerless object, confirm that 'pointer' is a list pointer.
+ // 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))
+ return make_lispobj(start_addr, LIST_POINTER_LOWTAG) == pointer;
- /* Check that the object pointed to is consistent with the pointer
- * low tag. */
- switch (lowtag_of(pointer)) {
- case FUN_POINTER_LOWTAG:
- /* Start_addr should be the enclosing code object, or a closure
- * header. */
- switch (widetag_of(*start_addr)) {
- case CODE_HEADER_WIDETAG:
- /* Make sure we actually point to a function in the code object,
- * as opposed to a random point there. */
- for_each_simple_fun(i, function, (struct code*)start_addr, 0, {
- if ((lispobj)function == pointer-FUN_POINTER_LOWTAG) return 1;
- })
- return 0;
- case CLOSURE_HEADER_WIDETAG:
- case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
- return make_lispobj(start_addr, FUN_POINTER_LOWTAG) == pointer;
- default:
- return 0;
- }
- break;
- case LIST_POINTER_LOWTAG:
- return make_lispobj(start_addr, LIST_POINTER_LOWTAG) == pointer
- && is_cons_half(start_addr[0]) // Is it plausible?
- && is_cons_half(start_addr[1]);
+ // 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));
- case INSTANCE_POINTER_LOWTAG:
- return make_lispobj(start_addr, INSTANCE_POINTER_LOWTAG) == pointer
- && widetag_of(*start_addr) == INSTANCE_HEADER_WIDETAG;
-
- case OTHER_POINTER_LOWTAG:
+ // The space of potential widetags has 64 elements, not 256,
+ // because of the constant low 2 bits.
+ int widetag = widetag_of(header);
+ int lowtag = lowtag_for_widetag[widetag>>2];
+ if (lowtag && make_lispobj(start_addr, lowtag) == pointer)
+ return 1; // instant win
+ if (widetag == CODE_HEADER_WIDETAG) {
+ // Check for RETURN_PC_HEADER first since it's quicker.
+ // Then consider the embedded simple-funs.
#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
/* The all-architecture test below is good as far as it goes,
* but an LRA object is similar to a FUN-POINTER: It is
* embedded within a CODE-OBJECT pointed to by start_addr, and
* cannot be found by simply walking the heap, therefore we
* need to check for it. -- AB, 2010-Jun-04 */
- if ((widetag_of(start_addr[0]) == CODE_HEADER_WIDETAG)) {
+ if (lowtag_of(pointer) == OTHER_POINTER_LOWTAG) {
lispobj *potential_lra = native_pointer(pointer);
if ((widetag_of(potential_lra[0]) == RETURN_PC_HEADER_WIDETAG) &&
((potential_lra - HeaderValue(potential_lra[0])) == start_addr)) {
@@ -1417,80 +1409,15 @@ properly_tagged_descriptor_p(void *thing, lispobj *start_addr)
}
}
#endif
-
- if (pointer != make_lispobj(start_addr, OTHER_POINTER_LOWTAG)
- || !other_immediate_lowtag_p(*start_addr))
- return 0;
-
- switch (widetag_of(start_addr[0])) {
- case UNBOUND_MARKER_WIDETAG:
- case NO_TLS_VALUE_MARKER_WIDETAG:
- case CHARACTER_WIDETAG:
-#if N_WORD_BITS == 64
- case SINGLE_FLOAT_WIDETAG:
-#endif
- return 0;
-
- /* only pointed to by function pointers? */
- case CLOSURE_HEADER_WIDETAG:
- case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
- return 0;
-
- case INSTANCE_HEADER_WIDETAG:
- return 0;
-
- /* the valid other immediate pointer objects */
- case SIMPLE_VECTOR_WIDETAG:
- case RATIO_WIDETAG:
- case COMPLEX_WIDETAG:
-#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
- case COMPLEX_SINGLE_FLOAT_WIDETAG:
-#endif
-#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
- case COMPLEX_DOUBLE_FLOAT_WIDETAG:
-#endif
-#ifdef COMPLEX_LONG_FLOAT_WIDETAG
- case COMPLEX_LONG_FLOAT_WIDETAG:
-#endif
-#ifdef SIMD_PACK_WIDETAG
- case SIMD_PACK_WIDETAG:
-#endif
- case SIMPLE_ARRAY_WIDETAG:
- case COMPLEX_BASE_STRING_WIDETAG:
-#ifdef COMPLEX_CHARACTER_STRING_WIDETAG
- case COMPLEX_CHARACTER_STRING_WIDETAG:
-#endif
- case COMPLEX_VECTOR_NIL_WIDETAG:
- case COMPLEX_BIT_VECTOR_WIDETAG:
- case COMPLEX_VECTOR_WIDETAG:
- case COMPLEX_ARRAY_WIDETAG:
- case VALUE_CELL_HEADER_WIDETAG:
- case SYMBOL_HEADER_WIDETAG:
- case FDEFN_WIDETAG:
- case CODE_HEADER_WIDETAG:
- case BIGNUM_WIDETAG:
-#if N_WORD_BITS != 64
- case SINGLE_FLOAT_WIDETAG:
-#endif
- case DOUBLE_FLOAT_WIDETAG:
-#ifdef LONG_FLOAT_WIDETAG
- case LONG_FLOAT_WIDETAG:
-#endif
-#include "genesis/specialized-vectors.inc"
- case SAP_WIDETAG:
- case WEAK_POINTER_WIDETAG:
- break;
-
- default:
- return 0;
+ if (lowtag_of(pointer) == FUN_POINTER_LOWTAG) {
+ struct simple_fun *pfun =
+ (struct simple_fun*)(pointer-FUN_POINTER_LOWTAG);
+ for_each_simple_fun(i, function, (struct code*)start_addr, 0, {
+ if (pfun == function) return 1;
+ })
}
- break;
- default:
- return 0;
}
-
- /* looks good */
- return 1;
+ return 0; // no good
}
/* META: Note the ambiguous word "validate" in the comment below.
diff --git a/src/runtime/gc-internal.h b/src/runtime/gc-internal.h
index 6785bda..791e5e0 100644
--- a/src/runtime/gc-internal.h
+++ b/src/runtime/gc-internal.h
@@ -221,7 +221,11 @@ static inline int instruction_ptr_p(void *pointer, lispobj *start_addr)
return widetag_of(*start_addr) == CODE_HEADER_WIDETAG &&
pointer >= (void*)(start_addr + code_header_words(*start_addr));
}
-extern int properly_tagged_descriptor_p(void *pointer, lispobj *start_addr);
+extern int properly_tagged_p_internal(lispobj pointer, lispobj *start_addr);
+static inline int properly_tagged_descriptor_p(void *pointer, lispobj *start_addr) {
+ return is_lisp_pointer((lispobj)pointer) &&
+ properly_tagged_p_internal((lispobj)pointer, start_addr);
+}
extern void scavenge_control_stack(struct thread *th);
extern void scrub_control_stack(void);
diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index f43c369..185fd42 100644
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -47,6 +47,7 @@
#include "thread.h"
#include "pseudo-atomic.h"
#include "alloc.h"
+#include "genesis/gc-tables.h"
#include "genesis/vector.h"
#include "genesis/weak-pointer.h"
#include "genesis/fdefn.h"
@@ -2066,20 +2067,16 @@ maybe_adjust_large_object(lispobj *where)
int boxed;
/* Check whether it's a vector or bignum object. */
- switch (widetag_of(where[0])) {
- case SIMPLE_VECTOR_WIDETAG:
+ lispobj widetag = widetag_of(where[0]);
+ if (widetag == SIMPLE_VECTOR_WIDETAG)
boxed = BOXED_PAGE_FLAG;
- break;
- case BIGNUM_WIDETAG:
-#include "genesis/specialized-vectors.inc"
+ else if (specialized_vector_widetag_p(widetag) || widetag == BIGNUM_WIDETAG)
boxed = UNBOXED_PAGE_FLAG;
- break;
- default:
+ else
return;
- }
/* Find its current size. */
- nwords = (sizetab[widetag_of(where[0])])(where);
+ nwords = sizetab[widetag](where);
first_page = find_page_index((void *)where);
gc_assert(first_page >= 0);
diff --git a/src/runtime/marknsweepgc.c b/src/runtime/marknsweepgc.c
index 445daee..7c586b6 100644
--- a/src/runtime/marknsweepgc.c
+++ b/src/runtime/marknsweepgc.c
@@ -47,6 +47,7 @@
#include "gc.h"
#include "gc-internal.h"
+#include "genesis/gc-tables.h"
#include "genesis/vector.h"
#include "forwarding-ptr.h"
#include "var-io.h"
@@ -398,21 +399,6 @@ void update_immobile_nursery_bits()
#endif
}
-#ifdef SIMPLE_CHARACTER_STRING_WIDETAG
-#define MAXIMUM_STRING_WIDETAG SIMPLE_CHARACTER_STRING_WIDETAG
-#else
-#define MAXIMUM_STRING_WIDETAG SIMPLE_BASE_STRING_WIDETAG
-#endif
-
-static inline boolean unboxed_array_p(int widetag)
-{
- // This is not an exhaustive test for unboxed objects,
- // but it's enough to avoid some unnecessary scavenging.
- return (widetag >= SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG
- && widetag <= MAXIMUM_STRING_WIDETAG
- && widetag != SIMPLE_VECTOR_WIDETAG);
-}
-
/* Turn a white object grey. Also enqueue the object for re-scan if required */
void
promote_immobile_obj(lispobj *ptr, int rescan) // a native pointer
@@ -420,7 +406,7 @@ promote_immobile_obj(lispobj *ptr, int rescan) // a native pointer
if (widetag_of(*ptr) == SIMPLE_FUN_HEADER_WIDETAG)
ptr = (lispobj*)code_obj_from_simple_fun((struct simple_fun*)ptr);
gc_assert(__immobile_obj_gen_bits(ptr) == from_space);
- int pointerish = !unboxed_array_p(widetag_of(*ptr));
+ int pointerish = !unboxed_obj_widetag_p(widetag_of(*ptr));
assign_generation(ptr, (pointerish ? 0 : IMMOBILE_OBJ_VISITED_FLAG) | new_space);
low_page_index_t page_index = find_immobile_page_index(ptr);
@@ -871,8 +857,7 @@ varyobj_points_to_younger_p(lispobj* obj, int gen, int keep_gen, int new_gen,
sword_t length = fixnum_value(((struct vector *)obj)->length);
begin = obj + 2; // skip the header and length
end = obj + CEILING(length + 2, 2);
- } else if (widetag >= SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG &&
- widetag <= MAXIMUM_STRING_WIDETAG) {
+ } else if (unboxed_obj_widetag_p(widetag)) {
return 0;
} else {
lose("Unexpected widetag @ %p", obj);
@@ -1715,10 +1700,7 @@ static void fixup_space(lispobj* where, size_t n_words)
size = sizetab[widetag](where);
switch (widetag) {
default:
- if (!(widetag <= COMPLEX_DOUBLE_FLOAT_WIDETAG
- || widetag == SAP_WIDETAG // Better not point to code!
- || widetag == SIMD_PACK_WIDETAG
- || unboxed_array_p(widetag)))
+ if (!unboxed_obj_widetag_p(widetag))
lose("Unhandled widetag in fixup_space: %p\n", (void*)header_word);
break;
#ifdef LISP_FEATURE_COMPACT_INSTANCE_HEADER
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|