From a4cffc065c83d046fce193919bf6d4e53f181455 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Mon, 9 Jan 2006 22:46:14 +0000 Subject: [PATCH] 0.9.8.28: Oh, the embarrassment. x86-64 was using full calls to GENERIC-< and GENERIC-> for (UN)SIGNED-BYTE-64-P and CHECK-(UN)SIGNED-BYTE-64. Fix it. * Conditionalize type predicate, type predicate wrapper and typecheckfun creation on N-WORD-BITS. Add missing 64-bit cases. * Add missing SIGNED-BYTE-64 VOPs. * Nuke the now-unused 32-bit VOPs. --- NEWS | 1 + src/code/pred.lisp | 6 +++ src/code/typecheckfuns.lisp | 15 ++++++- src/compiler/generic/vm-type.lisp | 8 ++++ src/compiler/generic/vm-typetran.lisp | 6 +++ src/compiler/x86-64/type-vops.lisp | 79 +++++++++++++-------------------- version.lisp-expr | 2 +- 7 files changed, 65 insertions(+), 52 deletions(-) diff --git a/NEWS b/NEWS index 9b03a93..289d8c3 100644 --- a/NEWS +++ b/NEWS @@ -13,6 +13,7 @@ changes in sbcl-0.9.9 relative to sbcl-0.9.8: * optimization: faster implementation of EQUAL * optimization: emit more efficient opcodes for some common immediate->register MOV instructions on x86-64. (thanks to Lutz Euler) + * optimization: several other minor code-generation improvements on x86-64 * fixed segfaults on x86 FreeBSD 7-current. (thanks to NIIMI Satoshi) changes in sbcl-0.9.8 relative to sbcl-0.9.7: diff --git a/src/code/pred.lisp b/src/code/pred.lisp index f0bf985..93299dd 100644 --- a/src/code/pred.lisp +++ b/src/code/pred.lisp @@ -93,8 +93,14 @@ (def-type-predicate-wrapper system-area-pointer-p) (def-type-predicate-wrapper weak-pointer-p) (def-type-predicate-wrapper vectorp) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) (def-type-predicate-wrapper unsigned-byte-32-p) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) (def-type-predicate-wrapper signed-byte-32-p) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (def-type-predicate-wrapper unsigned-byte-64-p) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (def-type-predicate-wrapper signed-byte-64-p) (def-type-predicate-wrapper simple-array-nil-p) (def-type-predicate-wrapper simple-array-unsigned-byte-2-p) (def-type-predicate-wrapper simple-array-unsigned-byte-4-p) diff --git a/src/code/typecheckfuns.lisp b/src/code/typecheckfuns.lisp index b602f64..8fe8217 100644 --- a/src/code/typecheckfuns.lisp +++ b/src/code/typecheckfuns.lisp @@ -46,7 +46,15 @@ ;; lemme know. -- WHN 2001-10-15 #(t character - bit fixnum (unsigned-byte 32) (signed-byte 32) + bit fixnum + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) + (unsigned-byte 32) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (unsigned-byte 64) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) + (signed-byte 32) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (signed-byte 64) single-float double-float))) (coerce (remove-duplicates (mapcar (lambda (typespec) @@ -77,7 +85,10 @@ symbol unsigned-byte (unsigned-byte 8) - (unsigned-byte 32)) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) + (unsigned-byte 32) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (unsigned-byte 64)) ;; systematic names for array types (map 'list (lambda (element-type) diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp index f8494cf..c214fe8 100644 --- a/src/compiler/generic/vm-type.lisp +++ b/src/compiler/generic/vm-type.lisp @@ -191,10 +191,18 @@ (numeric-type (cond ((type= type (specifier-type 'fixnum)) 'sb!c:check-fixnum) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) ((type= type (specifier-type '(signed-byte 32))) 'sb!c:check-signed-byte-32) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) ((type= type (specifier-type '(unsigned-byte 32))) 'sb!c:check-unsigned-byte-32) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + ((type= type (specifier-type '(signed-byte 64))) + 'sb!c:check-signed-byte-64) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + ((type= type (specifier-type '(unsigned-byte 64))) + 'sb!c:check-unsigned-byte-64) (t nil))) (fun-type 'sb!c:check-fun) diff --git a/src/compiler/generic/vm-typetran.lisp b/src/compiler/generic/vm-typetran.lisp index 8446c0e..05a08eb 100644 --- a/src/compiler/generic/vm-typetran.lisp +++ b/src/compiler/generic/vm-typetran.lisp @@ -96,8 +96,14 @@ #!+sb-unicode (define-type-predicate simple-character-string-p (simple-array character (*))) (define-type-predicate system-area-pointer-p system-area-pointer) +#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) (define-type-predicate unsigned-byte-32-p (unsigned-byte 32)) +#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) (define-type-predicate signed-byte-32-p (signed-byte 32)) +#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) +(define-type-predicate unsigned-byte-64-p (unsigned-byte 64)) +#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) +(define-type-predicate signed-byte-64-p (signed-byte 64)) (define-type-predicate vector-t-p (vector t)) (define-type-predicate vector-nil-p (vector nil)) (define-type-predicate weak-pointer-p weak-pointer) diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp index 09efe21..f3b540f 100644 --- a/src/compiler/x86-64/type-vops.lisp +++ b/src/compiler/x86-64/type-vops.lisp @@ -193,62 +193,43 @@ (inst shr tmp 61) (inst jmp (if not-p :nz :z) target))) -(define-vop (signed-byte-32-p type-predicate) - (:translate signed-byte-32-p) - (:generator 7 - ;; (and (fixnum) (or (no bits set >31) (all bits set >31)) - (move rax-tn value) - (inst test rax-tn 7) - (inst jmp :ne (if not-p target NOT-TARGET)) - (inst sar rax-tn (+ 32 3 -1)) - (if not-p - (progn - (inst jmp :nz MAYBE) - (inst jmp NOT-TARGET)) - (inst jmp :z target)) - MAYBE - (inst cmp rax-tn -1) - (inst jmp (if not-p :ne :eq) target) - NOT-TARGET)) +;;; A (SIGNED-BYTE 64) can be represented with either fixnum or a bignum with +;;; exactly one digit. -(define-vop (check-signed-byte-32 check-type) - (:generator 8 - (let ((nope (generate-error-code vop - object-not-signed-byte-32-error - value)) - (ok (gen-label))) +(define-vop (signed-byte-64-p type-predicate) + (:translate signed-byte-64-p) + (:generator 45 + (multiple-value-bind (yep nope) + (if not-p + (values not-target target) + (values target not-target)) + (generate-fixnum-test value) + (inst jmp :e yep) (move rax-tn value) - (inst test rax-tn 7) + (inst and al-tn lowtag-mask) + (inst cmp al-tn other-pointer-lowtag) (inst jmp :ne nope) - (inst sar rax-tn (+ 32 3 -1)) - (inst jmp :z ok) - (inst cmp rax-tn -1) - (inst jmp :ne nope) - (emit-label ok) - (move result value)))) - - -(define-vop (unsigned-byte-32-p type-predicate) - (:translate unsigned-byte-32-p) - (:generator 7 - ;; (and (fixnum) (no bits set >31)) - (move rax-tn value) - (inst test rax-tn 7) - (inst jmp :ne (if not-p target NOT-TARGET)) - (inst shr rax-tn (+ 32 sb!vm::n-fixnum-tag-bits)) - (inst jmp (if not-p :nz :z) target) + (loadw rax-tn value 0 other-pointer-lowtag) + (inst cmp rax-tn (+ (ash 1 n-widetag-bits) bignum-widetag)) + (inst jmp (if not-p :ne :e) target)) NOT-TARGET)) -(define-vop (check-unsigned-byte-32 check-type) - (:generator 8 - (let ((nope - (generate-error-code vop object-not-unsigned-byte-32-error value))) +(define-vop (check-signed-byte-64 check-type) + (:generator 45 + (let ((nope (generate-error-code vop + object-not-signed-byte-64-error + value))) + (generate-fixnum-test value) + (inst jmp :e yep) (move rax-tn value) - (inst test rax-tn 7) + (inst and al-tn lowtag-mask) + (inst cmp al-tn other-pointer-lowtag) (inst jmp :ne nope) - (inst shr rax-tn (+ 32 sb!vm::n-fixnum-tag-bits)) - (inst jmp :nz nope) - (move result value)))) + (loadw rax-tn value 0 other-pointer-lowtag) + (inst cmp rax-tn (+ (ash 1 n-widetag-bits) bignum-widetag)) + (inst jmp :ne nope)) + YEP + (move result value))) ;;; An (unsigned-byte 64) can be represented with either a positive ;;; fixnum, a bignum with exactly one positive digit, or a bignum with diff --git a/version.lisp-expr b/version.lisp-expr index f860a66..1de21b7 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.9.8.27" +"0.9.8.28" -- 1.7.10.4