From cd875f8c1fb306067521330fbf84411713b7c20d Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 1 Mar 2004 23:22:25 +0000 Subject: [PATCH] 0.8.8.10: MORE MICRO-OPTIMIZATION ... renumber all widetags. (LESS BINARY-COMPATIBILITY) ... implement some smarter type tag checking on the x86. The smarter type checking comes in several flavours. * If we have two adjacent lowtags, in three cases out of four we can do "and, cmp, branch", rather than "cmp, branch, cmp, branch"; * If we have two lowtags that are unadjacent but differ by just one bit, we can likewise do "and, cmp, branch" rather than "cmp, branch, cmp, branch"; * If we have a contiguous range of lowtags that includes the most positive lowtag, we do not need to test the upper bound; * If we have four lowtags with only two bits different, we can do "and, cmp, branch" rather than *four* "cmp, branch" pairs. This change will conflict with ongoing 64-bit ports. The conflict is resolvable (there are enough widetags in the "array" range (which in practice is 130 - 254; currently there are five in this range unused (or three with long-float arrays) --- src/code/early-fasl.lisp | 5 +- src/compiler/generic/early-objdef.lisp | 97 +++++++++++++++++++++++++--------- src/compiler/x86/type-vops.lisp | 76 +++++++++++++++++++------- version.lisp-expr | 2 +- 4 files changed, 135 insertions(+), 45 deletions(-) diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp index 7b565eb18..22cc82f73 100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@ -76,7 +76,7 @@ ;;; versions which break binary compatibility. But it certainly should ;;; be incremented for release versions which break binary ;;; compatibility. -(def!constant +fasl-file-version+ 47) +(def!constant +fasl-file-version+ 48) ;;; (record of versions before 2003 deleted in 2003-04-26/0.pre8.107 or so) ;;; 38: (2003-01-05) changed names of internal SORT machinery ;;; 39: (2003-02-20) in 0.7.12.1 a slot was added to @@ -103,6 +103,9 @@ ;;; 46: (2003-11-11) Tim Daly, Jr. (and Christophe Rhodes) reported ;;; .fasl incompatibility on sbcl-devel 2003-11-09. ;;; 47: (2003-11-30) Static variables were rearranged in 0.8.6.11. +;;; 48: (2004-03-01) Renumbered all the widetags to allow for more +;;; microefficiency in sbcl-0.8.8.10 + ;;; the conventional file extension for our fasl files (declaim (type simple-string *fasl-file-type*)) diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp index f639f6cf7..ef6563c42 100644 --- a/src/compiler/generic/early-objdef.lisp +++ b/src/compiler/generic/early-objdef.lisp @@ -58,6 +58,41 @@ ;;; the heap types, stored in 8 bits of the header of an object on the ;;; heap, to identify the type of the heap object (which'll be at ;;; least two machine words, often more) +;;; +;;; Note: the order specified here is not critical for correctness, +;;; but (FIXME) with %TEST-HEADERS as currently defined, BIGNUM must +;;; be first, and COMPLEX-ARRAY must be last. +;;; +;;; However, for efficiency, we prefer contiguous sets of widetags for +;;; "similar" objects, so that type checking can be done with a range +;;; check, rather than several individual checks. +;;; +;;; * BIGNUM + RATIO (+ FIXNUM) = RATIONAL +;;; +;;; * SINGLE-FLOAT + DOUBLE-FLOAT + LONG-FLOAT = FLOAT +;;; +;;; * RATIONAL + FLOAT = REAL +;;; +;;; * (FIXME: COMPLEX example, which needs fixing anyway -- see +;;; UPGRADED-COMPLEX-PART-TYPE) +;;; +;;; * SIMPLE-ARRAY-* = (SIMPLE-ARRAY * (*)) +;;; +;;; * SIMPLE-ARRAY-NIL + SIMPLE-BASE-STRING = SIMPLE-STRING +;;; +;;; * SIMPLE-ARRAY + COMPLEX-ARRAYOID = (SATISFIES ARRAY-HEADER-P) +;;; +;;; In addition, with +;;; sufficient care we can cause extra combinations to appear with +;;; differences in only one bit, permitting a more efficient type +;;; test. As an example, if SIMPLE-BASE-STRING = 0xA6 and +;;; COMPLEX-BASE-STRING = 0xE6, then the type test for BASE-STRING is +;;; +;;; AND tag, ~0x40, tag +;;; ANDcc tag, 0xA6, tag +;;; JNE tag, label +;;; +;;; rather than two separate tests and jumps (defenum (:suffix -widetag :start (+ (ash 1 n-lowtag-bits) other-immediate-0-lowtag) :step (ash 1 (1- n-lowtag-bits))) @@ -71,17 +106,47 @@ complex-double-float #!+long-float complex-long-float - simple-array - simple-array-nil - simple-base-string - simple-bit-vector - simple-vector + code-header + simple-fun-header + closure-header + funcallable-instance-header + + return-pc-header + value-cell-header + symbol-header + base-char + sap + unbound-marker + weak-pointer + instance-header + fdefn + + unused00 + unused01 + unused02 + unused03 + unused04 + unused05 + unused06 + unused07 + #!-long-float unused08 + #!-long-float unused09 + + #!+long-float simple-array-long-float + #!+long-float simple-array-complex-long-float + #!-long-float unused10 + #!-long-float unused11 + simple-array-unsigned-byte-2 simple-array-unsigned-byte-4 simple-array-unsigned-byte-7 simple-array-unsigned-byte-8 simple-array-unsigned-byte-15 simple-array-unsigned-byte-16 + simple-array-nil + simple-base-string + simple-bit-vector + simple-vector simple-array-unsigned-byte-29 simple-array-unsigned-byte-31 simple-array-unsigned-byte-32 @@ -91,31 +156,15 @@ simple-array-signed-byte-32 simple-array-single-float simple-array-double-float - #!+long-float simple-array-long-float simple-array-complex-single-float simple-array-complex-double-float - #!+long-float simple-array-complex-long-float - complex-base-string + simple-array complex-vector-nil + complex-base-string complex-bit-vector complex-vector complex-array - - code-header - simple-fun-header - closure-header - funcallable-instance-header - nil ; this was closure-fun-header; remove when +FASL-FILE-VERSION+ will increase - - return-pc-header - value-cell-header - symbol-header - base-char - sap - unbound-marker - weak-pointer - instance-header - fdefn) +) ;;; the different vector subtypes (defenum (:prefix vector- :suffix -subtype) diff --git a/src/compiler/x86/type-vops.lisp b/src/compiler/x86/type-vops.lisp index 062c47f15..7335973ff 100644 --- a/src/compiler/x86/type-vops.lisp +++ b/src/compiler/x86/type-vops.lisp @@ -64,17 +64,18 @@ (inst and al-tn lowtag-mask)) (inst cmp al-tn lowtag) (inst jmp (if not-p :ne :e) target)) - + (defun %test-headers (value target not-p function-p headers &optional (drop-through (gen-label)) al-loaded) (let ((lowtag (if function-p fun-pointer-lowtag other-pointer-lowtag))) - (multiple-value-bind (equal less-or-equal when-true when-false) - ;; EQUAL and LESS-OR-EQUAL are the conditions for branching to TARGET. - ;; WHEN-TRUE and WHEN-FALSE are the labels to branch to when we know - ;; it's true and when we know it's false respectively. + (multiple-value-bind (equal less-or-equal greater-or-equal when-true when-false) + ;; EQUAL, LESS-OR-EQUAL and GREATER-OR-EQUAL are the conditions for + ;; branching to TARGET. WHEN-TRUE and WHEN-FALSE are the + ;; labels to branch to when we know it's true and when we know + ;; it's false respectively. (if not-p - (values :ne :a drop-through target) - (values :e :na target drop-through)) + (values :ne :a :b drop-through target) + (values :e :na :nb target drop-through)) (%test-lowtag value when-false t lowtag al-loaded) (inst mov al-tn (make-ea :byte :base value :disp (- lowtag))) (do ((remaining headers (cdr remaining))) @@ -83,22 +84,59 @@ (last (null (cdr remaining)))) (cond ((atom header) - (inst cmp al-tn header) - (if last - (inst jmp equal target) - (inst jmp :e when-true))) + (cond + ((and (not last) (null (cddr remaining)) + (atom (cadr remaining)) + (= (logcount (logxor header (cadr remaining))) 1)) + ;; BASE-STRING, (VECTOR NIL), BIT-VECTOR, (VECTOR T) + (inst and al-tn (ldb (byte 8 0) (logeqv header (cadr remaining)))) + (inst cmp al-tn (ldb (byte 8 0) (logand header (cadr remaining)))) + (inst jmp equal target) + (return)) + (t + (inst cmp al-tn header) + (if last + (inst jmp equal target) + (inst jmp :e when-true))))) (t (let ((start (car header)) (end (cdr header))) - (unless (= start bignum-widetag) - (inst cmp al-tn start) - (inst jmp :b when-false)) ; was :l - (inst cmp al-tn end) - (if last - (inst jmp less-or-equal target) - (inst jmp :be when-true))))))) ; was :le + (cond + ;; LAST = don't need al-tn later + ((and last (not (= start bignum-widetag)) + (= (+ start 4) end) (= (logcount (logxor start end)) 1)) + ;; SIMPLE-STRING + (inst and al-tn (ldb (byte 8 0) (logeqv start end))) + (inst cmp al-tn (ldb (byte 8 0) (logand start end))) + (inst jmp equal target)) + ((and (not last) (null (cddr remaining)) + (= (+ start 4) end) (= (logcount (logxor start end)) 1) + (listp (cadr remaining)) + (= (+ (caadr remaining) 4) (cdadr remaining)) + (= (logcount (logxor (caadr remaining) (cdadr remaining))) 1) + (= (logcount (logxor (caadr remaining) start)) 1)) + ;; STRING + (inst and al-tn (ldb (byte 8 0) (logeqv start (cdadr remaining)))) + (inst cmp al-tn (ldb (byte 8 0) (logand start (cdadr remaining)))) + (inst jmp equal target) + ;; we've shortcircuited the DO, so we must return. + ;; It's OK to do so, because (NULL (CDDR REMAINING)) + ;; was true. + (return)) + (t + (unless (= start bignum-widetag) + (inst cmp al-tn start) + (if (= end complex-array-widetag) + (progn + (aver last) + (inst jmp greater-or-equal target)) + (inst jmp :b when-false))) ; was :l + (unless (= end complex-array-widetag) + (inst cmp al-tn end) + (if last + (inst jmp less-or-equal target) + (inst jmp :be when-true)))))))))) ; was :le (emit-label drop-through)))) - ;;;; type checking and testing diff --git a/version.lisp-expr b/version.lisp-expr index 646566bae..b993143a5 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".) -"0.8.8.9" +"0.8.8.10" -- 2.11.4.GIT