From: Stas Boukarev Date: Wed, 5 Jun 2013 14:38:42 +0000 (+0400) Subject: Optimize (mod FIXNUM) type-checks on x86oids. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=cd5a858174d892f876699373dc3ea389cf2c4d40;p=sbcl.git Optimize (mod FIXNUM) type-checks on x86oids. Instead of two (and (>= x 0) (< x FIXNUM)) comparisons, do one unsigned. (mod power-of-two) is further optimized by doing one mask test determine the range and fixnumness in one go. --- diff --git a/NEWS b/NEWS index a46a208..ffeca18 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,8 @@ changes relative to sbcl-1.1.8: * optimization: when referencing internal functions as #'x, don't go through an indirect fdefn structure. * optimization: SLEEP doesn't cons on non-immediate floats and on ratios. + * optimization: (mod fixnum) type-checks are performed using one unsigned + comparison, instead of two. * bug fix: problems with NCONC type derivation (reported by Jerry James). * bug fix: EXPT type derivation no longer constructs bogus floating-point types. (reported by Vsevolod Dyomkin) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 4638b51..9dad11f 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -242,6 +242,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)" "CHECK-SYMBOL" ;; FIXME: 32/64-bit issues "CHECK-UNSIGNED-BYTE-32" "CHECK-UNSIGNED-BYTE-64" + "CHECK-MOD-FIXNUM" "CLOSURE-INIT" "CLOSURE-REF" "CLOSURE-INIT-FROM-FP" "CODE-CONSTANT-REF" "CODE-CONSTANT-SET" "*CODE-COVERAGE-INFO*" @@ -1650,7 +1651,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "OBJECT-NOT-DOUBLE-FLOAT-ERROR" "OBJECT-NOT-FIXNUM-ERROR" "OBJECT-NOT-FLOAT-ERROR" "OBJECT-NOT-FUN-ERROR" "OBJECT-NOT-INSTANCE-ERROR" "OBJECT-NOT-INTEGER-ERROR" - "OBJECT-NOT-LIST-ERROR" + "OBJECT-NOT-LIST-ERROR" "OBJECT-NOT-MOD-ERROR" #!+long-float "OBJECT-NOT-LONG-FLOAT-ERROR" "OBJECT-NOT-NUMBER-ERROR" "OBJECT-NOT-RATIO-ERROR" "OBJECT-NOT-RATIONAL-ERROR" "OBJECT-NOT-REAL-ERROR" diff --git a/src/code/interr.lisp b/src/code/interr.lisp index fb16a77..18c571e 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -106,6 +106,11 @@ :datum object :expected-type 'fixnum)) +(deferr object-not-mod-error (object limit) + (error 'type-error + :datum object + :expected-type `(mod ,(1+ limit)))) + (deferr object-not-vector-error (object) (error 'type-error :datum object diff --git a/src/compiler/generic/interr.lisp b/src/compiler/generic/interr.lisp index 9ff81d3..e1120b7 100644 --- a/src/compiler/generic/interr.lisp +++ b/src/compiler/generic/interr.lisp @@ -55,6 +55,8 @@ "Object is not of type SIMPLE-STRING.") (object-not-fixnum "Object is not of type FIXNUM.") + (object-not-mod + "Object is not of type (MOD X).") (object-not-vector "Object is not of type VECTOR.") (object-not-string diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp index ccacc48..f447b9c 100644 --- a/src/compiler/generic/vm-type.lisp +++ b/src/compiler/generic/vm-type.lisp @@ -182,6 +182,7 @@ ;;; If TYPE has a CHECK-xxx template, but doesn't have a corresponding ;;; PRIMITIVE-TYPE, then return the template's name. Otherwise, return NIL. +;;; The second value is T if the template needs TYPE to be passed. (defun hairy-type-check-template-name (type) (declare (type ctype type)) (typecase type @@ -208,6 +209,11 @@ #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) ((type= type (specifier-type '(unsigned-byte 64))) 'sb!c:check-unsigned-byte-64) + #!+(or x86 x86-64) ; Not implemented yet on other platforms + ((and (eql (numeric-type-class type) 'integer) + (eql (numeric-type-low type) 0) + (fixnump (numeric-type-high type))) + (values 'sb!c:check-mod-fixnum t)) (t nil))) (fun-type 'sb!c:check-fun) diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index f37fde5..e2b593e 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -31,14 +31,16 @@ ;;; If there is any CHECK-xxx template for TYPE, then return it, ;;; otherwise return NIL. +;;; The second value is T if the template needs TYPE to be passed (defun type-check-template (type) (declare (type ctype type)) (multiple-value-bind (check-ptype exact) (primitive-type type) (if exact (primitive-type-check check-ptype) - (let ((name (hairy-type-check-template-name type))) + (multiple-value-bind (name type-needed) + (hairy-type-check-template-name type) (if name - (template-or-lose name) + (values (template-or-lose name) type-needed) nil))))) ;;; Emit code in BLOCK to check that VALUE is of the specified TYPE, @@ -49,7 +51,10 @@ (defun emit-type-check (node block value result type) (declare (type tn value result) (type node node) (type ir2-block block) (type ctype type)) - (emit-move-template node block (type-check-template type) value result) + (multiple-value-bind (template type-needed) (type-check-template type) + (if type-needed + (emit-load-template node block template value result (list type)) + (emit-move-template node block template value result))) (values)) ;;; Allocate an indirect value cell. diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp index 04fa745..5c54135 100644 --- a/src/compiler/x86-64/type-vops.lisp +++ b/src/compiler/x86-64/type-vops.lisp @@ -384,6 +384,36 @@ (emit-label yep) (move result value)))) + +(define-vop (check-mod-fixnum check-type) + (:info type) + (:temporary (:sc any-reg) temp) + (:generator 30 + (let* ((low (numeric-type-low type)) + (hi (fixnumize (numeric-type-high type))) + (error (gen-label))) + ;; FIXME: abstract + (assemble (*elsewhere*) + (emit-label error) + (inst mov temp hi) + (emit-error-break vop error-trap + (error-number-or-lose 'object-not-mod-error) + (list value temp))) + (aver (zerop low)) + (cond + ;; Handle powers of two specially + ;; The higher bits and the fixnum tag can be tested in one go + ((= (logcount (1+ hi)) 1) + (inst test value + (constantize (lognot hi))) + (inst jmp :ne error)) + (t + (generate-fixnum-test value) + (inst jmp :ne error) + (inst cmp value (constantize hi)) + (inst jmp :a error))) + (move result value)))) + ;;;; list/symbol types ;;; @@ -429,7 +459,6 @@ (progn (!define-type-vops simd-pack-p nil nil nil (simd-pack-widetag)) - #!+x86-64 (define-vop (check-simd-pack check-type) (:args (value :target result :scs (any-reg descriptor-reg diff --git a/src/compiler/x86/type-vops.lisp b/src/compiler/x86/type-vops.lisp index 38d6adc..4ad6d5d 100644 --- a/src/compiler/x86/type-vops.lisp +++ b/src/compiler/x86/type-vops.lisp @@ -370,6 +370,35 @@ (emit-label yep) (move result value)))) + +(define-vop (check-mod-fixnum check-type) + (:info type) + (:temporary (:sc any-reg) temp) + (:generator 30 + (let* ((low (numeric-type-low type)) + (hi (fixnumize (numeric-type-high type))) + (error (gen-label))) + ;; FIXME: abstract + (assemble (*elsewhere*) + (emit-label error) + (inst mov temp hi) + (emit-error-break vop error-trap + (error-number-or-lose 'object-not-mod-error) + (list value temp))) + (aver (zerop low)) + (cond + ;; Handle powers of two specially + ;; The higher bits and the fixnum tag can be tested in one go + ((= (logcount (1+ hi)) 1) + (inst test value (lognot hi)) + (inst jmp :ne error)) + (t + (generate-fixnum-test value) + (inst jmp :ne error) + (inst cmp value hi) + (inst jmp :a error))) + (move result value)))) + ;;;; list/symbol types ;;;