mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
Replace fixnum-mod-p with range<=.
It can do everything fixnum-mod-p does and then some. For arm64 so far.
This commit is contained in:
Stas Boukarev
parent
066f1cee3a
commit
5e292dd5fc
|
|
@ -2360,6 +2360,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries.")
|
|||
"TWO-ARG-STRING/=" "TWO-ARG-STRING-LESSP" "TWO-ARG-STRING-GREATERP"
|
||||
"TWO-ARG-STRING-NOT-LESSP" "TWO-ARG-STRING-NOT-GREATERP" "TWO-ARG-STRING-NOT-EQUAL"
|
||||
"RANGE<" "RANGE<=" "RANGE<<=" "RANGE<=<"
|
||||
"CHECK-RANGE<" "CHECK-RANGE<=" "CHECK-RANGE<<=" "CHECK-RANGE<=<"
|
||||
"TYPE-*-TO-T"
|
||||
"TYPE-DIFFERENCE" "TYPE-INTERSECTION"
|
||||
"TYPE-INTERSECTION2" "TYPE-APPROX-INTERSECTION2"
|
||||
|
|
|
|||
|
|
@ -2677,227 +2677,243 @@
|
|||
(inst mul temp dividend c) ; want only the low 64 bits
|
||||
(inst umulh remainder temp divisor))) ; want only the high 64 bits
|
||||
|
||||
(macrolet ((def (name excl-low excl-high)
|
||||
`(progn
|
||||
(define-vop (,(symbolicate name '/c))
|
||||
(:translate ,name)
|
||||
(:args (x :scs (any-reg signed-reg unsigned-reg)))
|
||||
(:arg-types (:constant t)
|
||||
(:or tagged-num signed-num unsigned-num)
|
||||
(:constant t))
|
||||
(:info lo hi)
|
||||
(:temporary (:sc signed-reg
|
||||
:unused-if
|
||||
(cond ((or (= lo ,(if excl-low
|
||||
-1
|
||||
0))
|
||||
(= hi
|
||||
,(if excl-high
|
||||
0
|
||||
-1))))))
|
||||
temp)
|
||||
(:conditional :ls)
|
||||
(:vop-var vop)
|
||||
(:policy :fast-safe)
|
||||
(:generator 2
|
||||
(aver (>= hi lo))
|
||||
(let ((lo (+ lo ,@(and excl-low
|
||||
'(1))))
|
||||
(hi (+ hi ,@(and excl-high
|
||||
'(-1)))))
|
||||
(multiple-value-bind (flo fhi one)
|
||||
(if (sc-is x any-reg)
|
||||
(values (fixnumize lo) (fixnumize hi) ,(fixnumize 1))
|
||||
(values lo hi 1))
|
||||
(cond
|
||||
((and (sc-is x unsigned-reg)
|
||||
(< fhi 0))
|
||||
(inst cmp null-tn 0))
|
||||
((or (= lo 0)
|
||||
(and (sc-is x unsigned-reg)
|
||||
(<= lo 0)))
|
||||
(when (add-sub-immediate-p (+ fhi one))
|
||||
(incf fhi one)
|
||||
(change-vop-flags vop '(:lo)))
|
||||
(inst cmp x (add-sub-immediate fhi)))
|
||||
((= hi -1)
|
||||
(setf flo (- flo))
|
||||
(cond ((add-sub-immediate-p (+ flo one))
|
||||
(incf flo one)
|
||||
(change-vop-flags vop '(:hi)))
|
||||
(t
|
||||
(change-vop-flags vop '(:hs))))
|
||||
(inst cmn x (add-sub-immediate flo)))
|
||||
(t
|
||||
(if (plusp flo)
|
||||
(inst sub temp x (add-sub-immediate flo))
|
||||
(inst add temp x (add-sub-immediate (abs flo))))
|
||||
(let ((cmp (- fhi flo)))
|
||||
(when (add-sub-immediate-p (+ cmp one))
|
||||
(incf cmp one)
|
||||
(change-vop-flags vop '(:lo)))
|
||||
(inst cmp temp (add-sub-immediate cmp)))))))))
|
||||
(macrolet ((def (name excl-low excl-high &optional check)
|
||||
`(progn
|
||||
,@(unless check
|
||||
`((define-vop (,(symbolicate name '/c))
|
||||
(:translate ,name)
|
||||
(:args (x :scs (any-reg signed-reg unsigned-reg)))
|
||||
(:arg-types (:constant t)
|
||||
(:or tagged-num signed-num unsigned-num)
|
||||
(:constant t))
|
||||
(:info lo hi)
|
||||
(:temporary (:sc signed-reg
|
||||
:unused-if
|
||||
(cond ((or (= lo ,(if excl-low
|
||||
-1
|
||||
0))
|
||||
(= hi
|
||||
,(if excl-high
|
||||
0
|
||||
-1))))))
|
||||
temp)
|
||||
(:conditional :ls)
|
||||
(:vop-var vop)
|
||||
(:policy :fast-safe)
|
||||
(:generator 2
|
||||
(aver (>= hi lo))
|
||||
(let ((lo (+ lo ,@(and excl-low
|
||||
'(1))))
|
||||
(hi (+ hi ,@(and excl-high
|
||||
'(-1)))))
|
||||
(multiple-value-bind (flo fhi one)
|
||||
(if (sc-is x any-reg)
|
||||
(values (fixnumize lo) (fixnumize hi) ,(fixnumize 1))
|
||||
(values lo hi 1))
|
||||
(cond
|
||||
((and (sc-is x unsigned-reg)
|
||||
(< fhi 0))
|
||||
(inst cmp null-tn 0))
|
||||
((or (= lo 0)
|
||||
(and (sc-is x unsigned-reg)
|
||||
(<= lo 0)))
|
||||
(when (add-sub-immediate-p (+ fhi one))
|
||||
(incf fhi one)
|
||||
(change-vop-flags vop '(:lo)))
|
||||
(inst cmp x (add-sub-immediate fhi)))
|
||||
((= hi -1)
|
||||
(setf flo (- flo))
|
||||
(cond ((add-sub-immediate-p (+ flo one))
|
||||
(incf flo one)
|
||||
(change-vop-flags vop '(:hi)))
|
||||
(t
|
||||
(change-vop-flags vop '(:hs))))
|
||||
(inst cmn x (add-sub-immediate flo)))
|
||||
(t
|
||||
(if (plusp flo)
|
||||
(inst sub temp x (add-sub-immediate flo))
|
||||
(inst add temp x (add-sub-immediate (abs flo))))
|
||||
(let ((cmp (- fhi flo)))
|
||||
(when (add-sub-immediate-p (+ cmp one))
|
||||
(incf cmp one)
|
||||
(change-vop-flags vop '(:lo)))
|
||||
(inst cmp temp (add-sub-immediate cmp)))))))))
|
||||
|
||||
(define-vop (,(symbolicate name '-integer/c))
|
||||
(:translate ,name)
|
||||
(:args (x :scs (descriptor-reg)))
|
||||
(:arg-types (:constant t) (:or integer bignum) (:constant t))
|
||||
(:info lo hi)
|
||||
(:temporary (:sc signed-reg
|
||||
:unused-if
|
||||
(cond ((or (= lo ,(if excl-low
|
||||
-1
|
||||
0))
|
||||
(= hi
|
||||
,(if excl-high
|
||||
0
|
||||
-1))))))
|
||||
temp)
|
||||
(:conditional :ls)
|
||||
(:vop-var vop)
|
||||
(:policy :fast-safe)
|
||||
(:generator 5
|
||||
(let ((lo (fixnumize (+ lo ,@(and excl-low
|
||||
`(1)))))
|
||||
(hi (fixnumize (+ hi ,@(and excl-high
|
||||
`(-1)))))
|
||||
(lowest-bignum-address #+darwin (expt 2 32)
|
||||
#-darwin +backend-page-bytes+))
|
||||
|
||||
(cond ((> lo hi)
|
||||
(inst cmp null-tn 0))
|
||||
((= lo 0)
|
||||
(cond ((and (/= hi 0)
|
||||
(power-of-two-p (+ hi (fixnumize 1))))
|
||||
(change-vop-flags vop '(:eq))
|
||||
(inst tst x (lognot hi)))
|
||||
((< hi lowest-bignum-address)
|
||||
(inst cmp x (add-sub-immediate hi)))
|
||||
(t
|
||||
(inst tst x fixnum-tag-mask)
|
||||
(inst ccmp x (ccmp-immediate hi) :eq #b10))))
|
||||
((= hi ,(fixnumize -1))
|
||||
(change-vop-flags vop '(:hs))
|
||||
(inst tst x fixnum-tag-mask)
|
||||
(inst ccmn x (ccmp-immediate (- lo)) :eq))
|
||||
((and (< -1 lo lowest-bignum-address)
|
||||
(< -1 hi lowest-bignum-address))
|
||||
(inst sub temp x (add-sub-immediate lo))
|
||||
(inst cmp temp (add-sub-immediate (- hi lo))))
|
||||
(t
|
||||
(if (plusp lo)
|
||||
(inst sub temp x (add-sub-immediate lo))
|
||||
(inst add temp x (add-sub-immediate (abs lo))))
|
||||
(inst tst x fixnum-tag-mask)
|
||||
(inst ccmp temp (ccmp-immediate (- hi lo)) :eq #b10))))))
|
||||
|
||||
(define-vop ()
|
||||
(:translate ,name)
|
||||
(:args (lo :scs (any-reg immediate))
|
||||
(x :scs (any-reg signed-reg unsigned-reg))
|
||||
(hi :scs (any-reg immediate)))
|
||||
(:arg-types tagged-num
|
||||
(:or tagged-num signed-num unsigned-num)
|
||||
tagged-num)
|
||||
(:arg-refs lo-ref nil hi-ref)
|
||||
(:conditional ,(if excl-high :lt :le))
|
||||
(:vop-var vop)
|
||||
(:policy :fast-safe)
|
||||
(:generator 4
|
||||
(flet ((imm (i &optional (ccmp t))
|
||||
(let ((i (if (and (tn-p i)
|
||||
(sc-is i immediate))
|
||||
(tn-value i)
|
||||
i)))
|
||||
(cond ((integerp i)
|
||||
(funcall (if ccmp
|
||||
'ccmp-immediate
|
||||
'add-sub-immediate)
|
||||
(if (sc-is x any-reg)
|
||||
(fixnumize i)
|
||||
(define-vop ()
|
||||
(:translate ,name)
|
||||
(:args (lo :scs (any-reg immediate))
|
||||
(x :scs (any-reg signed-reg unsigned-reg))
|
||||
(hi :scs (any-reg immediate)))
|
||||
(:arg-types tagged-num
|
||||
(:or tagged-num signed-num unsigned-num)
|
||||
tagged-num)
|
||||
(:arg-refs lo-ref nil hi-ref)
|
||||
(:conditional ,(if excl-high :lt :le))
|
||||
(:vop-var vop)
|
||||
(:policy :fast-safe)
|
||||
(:generator 4
|
||||
(flet ((imm (i &optional (ccmp t))
|
||||
(let ((i (if (and (tn-p i)
|
||||
(sc-is i immediate))
|
||||
(tn-value i)
|
||||
i)))
|
||||
((sc-is x any-reg)
|
||||
i)
|
||||
(ccmp
|
||||
(inst asr tmp-tn i n-fixnum-tag-bits)
|
||||
tmp-tn)
|
||||
(t
|
||||
(asr i n-fixnum-tag-bits))))))
|
||||
(cond
|
||||
((sc-is x unsigned-reg)
|
||||
(inst tst x (ash 1 (- n-word-bits 1)))
|
||||
(inst ccmp x (imm lo) :eq 1)
|
||||
(inst ccmp x (imm hi) ,(if excl-low
|
||||
:gt
|
||||
:ge)))
|
||||
((sc-is hi immediate)
|
||||
(let ((hi (tn-value hi)))
|
||||
(change-vop-flags vop '(,(if excl-low
|
||||
:gt
|
||||
:ge)))
|
||||
(if (typep hi `(integer (,most-negative-fixnum) -1))
|
||||
(inst cmn x (imm (- hi) nil))
|
||||
(inst cmp x (imm hi nil)))
|
||||
(inst ccmp x (imm lo) ,(if excl-high :lt :le) 1)))
|
||||
((sc-is lo immediate)
|
||||
(let ((lo (tn-value lo)))
|
||||
(cond
|
||||
((and (= lo ,(if excl-low
|
||||
(cond ((integerp i)
|
||||
(funcall (if ccmp
|
||||
'ccmp-immediate
|
||||
'add-sub-immediate)
|
||||
(if (sc-is x any-reg)
|
||||
(fixnumize i)
|
||||
i)))
|
||||
((sc-is x any-reg)
|
||||
i)
|
||||
(ccmp
|
||||
(inst asr tmp-tn i n-fixnum-tag-bits)
|
||||
tmp-tn)
|
||||
(t
|
||||
(asr i n-fixnum-tag-bits))))))
|
||||
(cond
|
||||
((sc-is x unsigned-reg)
|
||||
(inst tst x (ash 1 (- n-word-bits 1)))
|
||||
(inst ccmp x (imm lo) :eq 1)
|
||||
(inst ccmp x (imm hi) ,(if excl-low
|
||||
:gt
|
||||
:ge)))
|
||||
((sc-is hi immediate)
|
||||
(let ((hi (tn-value hi)))
|
||||
(change-vop-flags vop '(,(if excl-low
|
||||
:gt
|
||||
:ge)))
|
||||
(if (typep hi `(integer (,most-negative-fixnum) -1))
|
||||
(inst cmn x (imm (- hi) nil))
|
||||
(inst cmp x (imm hi nil)))
|
||||
(inst ccmp x (imm lo) ,(if excl-high :lt :le) 1)))
|
||||
((sc-is lo immediate)
|
||||
(let ((lo (tn-value lo)))
|
||||
(cond
|
||||
((and (= lo ,(if excl-low
|
||||
-1
|
||||
0))
|
||||
(csubtypep (tn-ref-type hi-ref)
|
||||
(specifier-type 'unsigned-byte)))
|
||||
(change-vop-flags vop '(,(if excl-high :lo :ls)))
|
||||
(inst cmp x (imm hi nil)))
|
||||
(t
|
||||
(if (typep lo `(integer (,most-negative-fixnum) -1))
|
||||
(inst cmn x (imm (- lo) nil))
|
||||
(inst cmp x (imm lo nil)))
|
||||
(inst ccmp x (imm hi) ,(if excl-low :gt :ge))))))
|
||||
(t
|
||||
(inst cmp x (imm lo nil))
|
||||
(inst ccmp x (imm hi) ,(if excl-low :gt :ge)))))))))
|
||||
|
||||
(define-vop (,(symbolicate name '-integer/c))
|
||||
(:translate ,name)
|
||||
(:args (x :scs (descriptor-reg)))
|
||||
(:arg-types (:constant t) ,(if check
|
||||
t
|
||||
`(:or integer bignum)) (:constant t))
|
||||
(:info lo hi)
|
||||
(:temporary (:sc signed-reg
|
||||
:unused-if
|
||||
(cond ((or (= lo ,(if excl-low
|
||||
-1
|
||||
0))
|
||||
(= hi
|
||||
,(if excl-high
|
||||
0
|
||||
-1))))))
|
||||
temp)
|
||||
(:conditional :ls)
|
||||
(:vop-var vop)
|
||||
(:policy :fast-safe)
|
||||
(:generator 5
|
||||
(let ((lo (fixnumize (+ lo ,@(and excl-low
|
||||
`(1)))))
|
||||
(hi (fixnumize (+ hi ,@(and excl-high
|
||||
`(-1)))))
|
||||
(lowest-bignum-address (cond
|
||||
,(if check
|
||||
`(t 0)
|
||||
`(t
|
||||
#+darwin (expt 2 32)
|
||||
#-darwin +backend-page-bytes+)))))
|
||||
|
||||
(cond ((> lo hi)
|
||||
(inst cmp null-tn 0))
|
||||
((= lo 0)
|
||||
(cond ((and (/= hi 0)
|
||||
(power-of-two-p (+ hi (fixnumize 1))))
|
||||
(change-vop-flags vop '(:eq))
|
||||
(inst tst x (lognot hi)))
|
||||
((< hi lowest-bignum-address)
|
||||
(inst cmp x (add-sub-immediate hi)))
|
||||
(t
|
||||
(inst tst x fixnum-tag-mask)
|
||||
(inst ccmp x (ccmp-immediate hi) :eq #b10))))
|
||||
((= hi ,(fixnumize -1))
|
||||
(change-vop-flags vop '(:hs))
|
||||
(inst tst x fixnum-tag-mask)
|
||||
(inst ccmn x (ccmp-immediate (- lo)) :eq))
|
||||
((and (< -1 lo lowest-bignum-address)
|
||||
(< -1 hi lowest-bignum-address))
|
||||
(inst sub temp x (add-sub-immediate lo))
|
||||
(inst cmp temp (add-sub-immediate (- hi lo))))
|
||||
(t
|
||||
(if (plusp lo)
|
||||
(inst sub temp x (add-sub-immediate lo))
|
||||
(inst add temp x (add-sub-immediate (abs lo))))
|
||||
(inst tst x fixnum-tag-mask)
|
||||
(inst ccmp temp (ccmp-immediate (- hi lo)) :eq #b10))))))
|
||||
|
||||
(define-vop (,(symbolicate name '-integer))
|
||||
(:translate ,name)
|
||||
(:args (lo :scs (any-reg immediate))
|
||||
(x :scs (descriptor-reg))
|
||||
(hi :scs (any-reg immediate)))
|
||||
(:arg-types tagged-num ,(if check
|
||||
t
|
||||
`(:or integer bignum)) tagged-num)
|
||||
(:arg-refs lo-ref nil hi-ref)
|
||||
(:conditional ,(if excl-high
|
||||
:lt
|
||||
:le))
|
||||
(:vop-var vop)
|
||||
(:policy :fast-safe)
|
||||
(:generator 6
|
||||
(labels ((imm (x)
|
||||
(if (sc-is x immediate)
|
||||
(fixnumize (tn-value x))
|
||||
x))
|
||||
(ccmp (c cond &optional (flags 0))
|
||||
(if (typep c `(integer (,most-negative-fixnum) -1))
|
||||
(inst ccmn x (ccmp-immediate (- c)) cond flags)
|
||||
(inst ccmp x (ccmp-immediate c) cond flags))))
|
||||
(inst tst x fixnum-tag-mask)
|
||||
(cond ((and (sc-is lo immediate)
|
||||
(csubtypep (tn-ref-type hi-ref)
|
||||
(specifier-type 'unsigned-byte))
|
||||
(eql (tn-value lo)
|
||||
,(if excl-low
|
||||
-1
|
||||
0))
|
||||
(csubtypep (tn-ref-type hi-ref)
|
||||
(specifier-type 'unsigned-byte)))
|
||||
(change-vop-flags vop '(,(if excl-high :lo :ls)))
|
||||
(inst cmp x (imm hi nil)))
|
||||
(t
|
||||
(if (typep lo `(integer (,most-negative-fixnum) -1))
|
||||
(inst cmn x (imm (- lo) nil))
|
||||
(inst cmp x (imm lo nil)))
|
||||
(inst ccmp x (imm hi) ,(if excl-low :gt :ge))))))
|
||||
(t
|
||||
(inst cmp x (imm lo nil))
|
||||
(inst ccmp x (imm hi) ,(if excl-low :gt :ge)))))))
|
||||
(define-vop (,(symbolicate name '-integer))
|
||||
(:translate ,name)
|
||||
(:args (lo :scs (any-reg immediate))
|
||||
(x :scs (descriptor-reg))
|
||||
(hi :scs (any-reg immediate)))
|
||||
(:arg-types tagged-num (:or integer bignum) tagged-num)
|
||||
(:arg-refs lo-ref nil hi-ref)
|
||||
(:conditional ,(if excl-high
|
||||
:lt
|
||||
:le))
|
||||
(:vop-var vop)
|
||||
(:policy :fast-safe)
|
||||
(:generator 6
|
||||
(labels ((imm (x)
|
||||
(if (sc-is x immediate)
|
||||
(fixnumize (tn-value x))
|
||||
x))
|
||||
(ccmp (c cond &optional (flags 0))
|
||||
(if (typep c `(integer (,most-negative-fixnum) -1))
|
||||
(inst ccmn x (ccmp-immediate (- c)) cond flags)
|
||||
(inst ccmp x (ccmp-immediate c) cond flags))))
|
||||
(inst tst x fixnum-tag-mask)
|
||||
(cond ((and (sc-is lo immediate)
|
||||
(csubtypep (tn-ref-type hi-ref)
|
||||
(specifier-type 'unsigned-byte))
|
||||
(eql (tn-value lo)
|
||||
,(if excl-low
|
||||
-1
|
||||
0)))
|
||||
(change-vop-flags vop '(,(if excl-high :lo :ls)))
|
||||
(ccmp (imm hi) :eq #b10))
|
||||
(t
|
||||
(ccmp (imm lo) :eq 1)
|
||||
(ccmp (imm hi) ,(if excl-low
|
||||
:gt
|
||||
:ge))))))))))
|
||||
0)))
|
||||
(change-vop-flags vop '(,(if excl-high :lo :ls)))
|
||||
(ccmp (imm hi) :eq #b10))
|
||||
(t
|
||||
(ccmp (imm lo) :eq 1)
|
||||
(ccmp (imm hi) ,(if excl-low
|
||||
:gt
|
||||
:ge))))))))))
|
||||
|
||||
(def range< t t)
|
||||
(def range<= nil nil)
|
||||
(def range<<= t nil)
|
||||
(def range<=< nil t))
|
||||
(def range<=< nil t)
|
||||
|
||||
(def check-range< t t t)
|
||||
(def check-range<= nil nil t)
|
||||
(def check-range<<= t nil t)
|
||||
(def check-range<=< nil t t))
|
||||
|
||||
|
||||
(define-vop (signed-multiply-low-high)
|
||||
(:policy :fast-safe)
|
||||
|
|
|
|||
|
|
@ -110,6 +110,10 @@
|
|||
(eq (sb-c::ref-leaf ref)
|
||||
(sb-c::ref-leaf ref2))))))))
|
||||
|
||||
(defun power-of-two-limit-p (x)
|
||||
(and (fixnump x)
|
||||
(= (logcount (1+ x)) 1)))
|
||||
|
||||
;;;; Bounds checking routine.
|
||||
(define-vop (check-bound)
|
||||
(:translate %check-bound)
|
||||
|
|
|
|||
|
|
@ -590,163 +590,6 @@
|
|||
(:translate)
|
||||
(:variant :le)))
|
||||
|
||||
|
||||
;;; MOD type checks
|
||||
(defun power-of-two-limit-p (x)
|
||||
(and (fixnump x)
|
||||
(= (logcount (1+ x)) 1)))
|
||||
|
||||
(define-vop (test-fixnum-mod-power-of-two)
|
||||
(:args (value :scs (any-reg descriptor-reg
|
||||
unsigned-reg signed-reg)))
|
||||
(:arg-types *
|
||||
(:constant (satisfies power-of-two-limit-p)))
|
||||
(:translate fixnum-mod-p)
|
||||
(:conditional :eq)
|
||||
(:info hi)
|
||||
(:policy :fast-safe)
|
||||
(:generator 2
|
||||
(let* ((fixnum-hi (if (sc-is value unsigned-reg signed-reg)
|
||||
hi
|
||||
(fixnumize hi))))
|
||||
(inst tst value (lognot fixnum-hi)))))
|
||||
|
||||
(defun add-sub-immediate-p+1 (x)
|
||||
(add-sub-immediate-p (1+ x)))
|
||||
|
||||
(defun fixnum-add-sub-immediate-p+1 (x)
|
||||
(fixnum-add-sub-immediate-p (1+ x)))
|
||||
|
||||
(defun fixnum-add-sub-immediate-p/+1 (x)
|
||||
(or (fixnum-add-sub-immediate-p x)
|
||||
(fixnum-add-sub-immediate-p (1+ x))))
|
||||
|
||||
(define-vop (test-fixnum-mod-signed-unsigned-imm)
|
||||
(:args (value :scs (unsigned-reg signed-reg)))
|
||||
(:arg-types (:or unsigned-num signed-num)
|
||||
(:constant (satisfies add-sub-immediate-p)))
|
||||
(:translate fixnum-mod-p)
|
||||
(:conditional :ls)
|
||||
(:info hi)
|
||||
(:policy :fast-safe)
|
||||
(:generator 3
|
||||
(inst cmp value hi)))
|
||||
|
||||
(define-vop (test-fixnum-mod-signed-unsigned-imm+1 test-fixnum-mod-signed-unsigned-imm)
|
||||
(:arg-types (:or unsigned-num signed-num)
|
||||
(:constant (satisfies add-sub-immediate-p+1)))
|
||||
(:conditional :lo)
|
||||
(:generator 3
|
||||
(inst cmp value (1+ hi))))
|
||||
|
||||
(define-vop (test-fixnum-mod-tagged-imm)
|
||||
(:args (value :scs (any-reg)))
|
||||
(:arg-types tagged-num
|
||||
(:constant (satisfies fixnum-add-sub-immediate-p)))
|
||||
(:translate fixnum-mod-p)
|
||||
(:conditional :ls)
|
||||
(:info hi)
|
||||
(:policy :fast-safe)
|
||||
(:generator 3
|
||||
(inst cmp value (fixnumize hi))))
|
||||
|
||||
(define-vop (test-fixnum-mod-tagged-imm+1 test-fixnum-mod-tagged-imm)
|
||||
(:arg-types tagged-num
|
||||
(:constant (satisfies fixnum-add-sub-immediate-p+1)))
|
||||
(:conditional :lo)
|
||||
(:generator 3
|
||||
(inst cmp value (fixnumize (1+ hi)))))
|
||||
|
||||
(define-vop (test-fixnum-mod-signed-unsigned-imm)
|
||||
(:args (value :scs (unsigned-reg signed-reg)))
|
||||
(:arg-types (:or unsigned-num signed-num)
|
||||
(:constant (satisfies add-sub-immediate-p)))
|
||||
(:translate fixnum-mod-p)
|
||||
(:conditional :ls)
|
||||
(:info hi)
|
||||
(:policy :fast-safe)
|
||||
(:generator 3
|
||||
(inst cmp value hi)))
|
||||
|
||||
(define-vop (test-fixnum-mod-signed-unsigned-imm+1 test-fixnum-mod-signed-unsigned-imm)
|
||||
(:arg-types (:or unsigned-num signed-num)
|
||||
(:constant (satisfies add-sub-immediate-p+1)))
|
||||
(:conditional :lo)
|
||||
(:generator 3
|
||||
(inst cmp value (1+ hi))))
|
||||
|
||||
(define-vop (test-fixnum-mod-tagged-imm)
|
||||
(:args (value :scs (any-reg)))
|
||||
(:arg-types tagged-num
|
||||
(:constant (satisfies fixnum-add-sub-immediate-p)))
|
||||
(:translate fixnum-mod-p)
|
||||
(:conditional :ls)
|
||||
(:info hi)
|
||||
(:policy :fast-safe)
|
||||
(:generator 3
|
||||
(inst cmp value (fixnumize hi))))
|
||||
|
||||
(define-vop (test-fixnum-mod-tagged-imm+1 test-fixnum-mod-tagged-imm)
|
||||
(:arg-types tagged-num
|
||||
(:constant (satisfies fixnum-add-sub-immediate-p+1)))
|
||||
(:conditional :lo)
|
||||
(:generator 3
|
||||
(inst cmp value (fixnumize (1+ hi)))))
|
||||
|
||||
(define-vop (test-fixnum-mod-tagged-unsigned)
|
||||
(:args (value :scs (any-reg unsigned-reg signed-reg)))
|
||||
(:arg-types (:or tagged-num unsigned-num signed-num)
|
||||
(:constant fixnum))
|
||||
(:temporary (:scs (non-descriptor-reg)) temp)
|
||||
(:translate fixnum-mod-p)
|
||||
(:conditional :ls)
|
||||
(:info hi)
|
||||
(:policy :fast-safe)
|
||||
(:generator 4
|
||||
(let ((fixnum-hi (if (sc-is value unsigned-reg signed-reg)
|
||||
hi
|
||||
(fixnumize hi))))
|
||||
(load-immediate-word temp fixnum-hi)
|
||||
(inst cmp value temp))))
|
||||
|
||||
(define-vop (test-fixnum-mod-*-imm)
|
||||
(:args (value :scs (any-reg descriptor-reg)))
|
||||
(:arg-types * (:constant (satisfies fixnum-add-sub-immediate-p/+1)))
|
||||
(:translate fixnum-mod-p)
|
||||
(:conditional)
|
||||
(:info target not-p hi)
|
||||
(:policy :fast-safe)
|
||||
(:generator 5
|
||||
(let* ((1+ (not (fixnum-add-sub-immediate-p hi)))
|
||||
(fixnum-hi (fixnumize (if 1+
|
||||
(1+ hi)
|
||||
hi))))
|
||||
#.(assert (= fixnum-tag-mask 1))
|
||||
(inst tbnz* value 0 (if not-p target skip))
|
||||
(inst cmp value fixnum-hi)
|
||||
(inst b (if not-p
|
||||
(if 1+ :hs :hi)
|
||||
(if 1+ :lo :ls))
|
||||
target))
|
||||
skip))
|
||||
|
||||
(define-vop (test-fixnum-mod-*)
|
||||
(:args (value :scs (any-reg descriptor-reg)))
|
||||
(:arg-types * (:constant fixnum))
|
||||
(:translate fixnum-mod-p)
|
||||
(:temporary (:scs (any-reg)) temp)
|
||||
(:conditional)
|
||||
(:info target not-p hi)
|
||||
(:policy :fast-safe)
|
||||
(:generator 6
|
||||
#.(assert (= fixnum-tag-mask 1))
|
||||
(inst tbnz* value 0 (if not-p target skip))
|
||||
(let ((condition (if not-p :hi :ls)))
|
||||
(load-immediate-word temp (fixnumize hi))
|
||||
(inst cmp value temp)
|
||||
(inst b condition target))
|
||||
SKIP))
|
||||
|
||||
;;;; List/symbol types:
|
||||
;;;
|
||||
;;; symbolp (or symbol (eq nil))
|
||||
|
|
|
|||
|
|
@ -283,6 +283,10 @@
|
|||
(fixnum real fixnum) boolean
|
||||
(foldable flushable movable no-verify-arg-count))
|
||||
|
||||
(defknown (check-range< check-range<= check-range<<= check-range<=<)
|
||||
(fixnum t fixnum) boolean
|
||||
(foldable flushable movable no-verify-arg-count))
|
||||
|
||||
(defknown (two-arg-gcd two-arg-lcm two-arg-and two-arg-ior two-arg-xor two-arg-eqv)
|
||||
(integer integer) integer
|
||||
(no-verify-arg-count))
|
||||
|
|
|
|||
|
|
@ -2961,6 +2961,13 @@ is :ANY, the function name is not checked."
|
|||
(pop vars) type))
|
||||
(setf vars (nthcdr length vars))))))))))
|
||||
|
||||
(defun if-type-check (if)
|
||||
(let ((test (lvar-uses (if-test if))))
|
||||
(when (combination-p test)
|
||||
(let ((name (combination-fun-source-name test nil)))
|
||||
(values (gethash name *backend-predicate-types*)
|
||||
(car (combination-args test)))))))
|
||||
|
||||
|
||||
(defun proper-or-circular-list-p (x)
|
||||
(if (consp x)
|
||||
|
|
|
|||
|
|
@ -6425,6 +6425,33 @@
|
|||
(t
|
||||
(give-up-ir1-transform)))))
|
||||
|
||||
(defun prev-node (node &key type (cast t))
|
||||
(let (ctran)
|
||||
(tagbody
|
||||
:next
|
||||
(setf ctran (node-prev node))
|
||||
(setf node (ctran-use ctran))
|
||||
:next-node
|
||||
(typecase node
|
||||
(ref
|
||||
(unless (eq type :non-ref)
|
||||
(return-from prev-node node)))
|
||||
(cast
|
||||
(unless cast
|
||||
(return-from prev-node node)))
|
||||
(enclose)
|
||||
(null
|
||||
(let ((pred (block-pred (ctran-block ctran))))
|
||||
(when (cdr pred)
|
||||
(return-from prev-node))
|
||||
(setf node (block-last (car pred)))
|
||||
(go :next-node)))
|
||||
(t
|
||||
(return-from prev-node
|
||||
(unless (eq type :ref)
|
||||
node))))
|
||||
(go :next))))
|
||||
|
||||
(defun next-node (node-or-block &key type (cast t) single-predecessor)
|
||||
(let ((node node-or-block)
|
||||
ctran)
|
||||
|
|
@ -6599,6 +6626,21 @@
|
|||
(>= '(and (<= l (truly-the fixnum x)) (< (truly-the fixnum x) h)))
|
||||
(> '(< l (truly-the fixnum x) h))))))))))
|
||||
(when form
|
||||
(when-vop-existsp (:translate check-range<)
|
||||
(let ((prev (prev-node node :type :non-ref)))
|
||||
(when (and (if-p prev)
|
||||
(eq (if-alternative prev) alternative))
|
||||
(multiple-value-bind (type lvar) (if-type-check prev)
|
||||
(when (and type
|
||||
(csubtypep type (specifier-type 'integer)))
|
||||
(setf a lvar)
|
||||
(kill-if-branch-1 prev (if-test prev)
|
||||
(node-block prev)
|
||||
alternative)
|
||||
(setf form (cons (package-symbolicate "SB-KERNEL" "CHECK-" (car form))
|
||||
(cdr form))))))))
|
||||
|
||||
|
||||
(kill-if-branch-1 if (if-test if)
|
||||
(node-block if)
|
||||
alternative)
|
||||
|
|
@ -6644,3 +6686,5 @@
|
|||
|
||||
(defoptimizer (<= optimizer) ((a b) node)
|
||||
(range-transform '<= a b node))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -403,8 +403,8 @@
|
|||
;; in %SOURCE-TRANSFORM-TYPEP, but even if it wasn't,
|
||||
;; the OR will drop out due to constraint propagation.
|
||||
`(or (eq ,object ,low) (eq ,object ,high)))
|
||||
#+(or x86 x86-64 arm arm64) ;; Not implemented elsewhere yet
|
||||
((and (eql (numeric-type-class type) 'integer)
|
||||
((and (vop-existsp :translate 'fixnum-mod-p)
|
||||
(eql (numeric-type-class type) 'integer)
|
||||
(or (eql low 0)
|
||||
(and (eql low 1)
|
||||
(not (eql high most-positive-fixnum))))
|
||||
|
|
|
|||
|
|
@ -1217,6 +1217,7 @@
|
|||
(< (#.(S #x-21800000) #.(D #x-100001 #xFFFFFFFF)) NIL)
|
||||
(< (#.(S #x-21800000) #.(D 0 0)) T)
|
||||
(< (#.(S #x-21600000) 0) T)
|
||||
(< (#.(S #x-21000000) #.(S 0)) T)
|
||||
(< (#.(S #x-21000000) #.(S #x4F800000)) T)
|
||||
(< (#.(S #x-20B6F025) 0) T)
|
||||
(< (#.(S #x-20B6F025) #.(S #x-20B6F025)) NIL)
|
||||
|
|
@ -1461,6 +1462,7 @@
|
|||
(< (#.(S #x42000000) #.(S #x42800000)) T)
|
||||
(< (#.(S #x42000000) #.(D #x40400000 0)) NIL)
|
||||
(< (#.(S #x42040000) #.(S #x42040000)) NIL)
|
||||
(< (#.(S #x42040000) #.(S #x42080000)) T)
|
||||
(< (#.(S #x42040000) #.(S #x43160000)) T)
|
||||
(< (#.(S #x42040000) #.(S #x43190000)) T)
|
||||
(< (#.(S #x42080000) #.(S #x42080000)) NIL)
|
||||
|
|
@ -2017,6 +2019,7 @@
|
|||
(< (#.(D #x-3C300000 0) #.(D #x43D00000 #x80000000)) T)
|
||||
(< (#.(D #x-3C300000 0) #.(D #x43D00004 0)) T)
|
||||
(< (#.(D #x-3C2C0000 0) 0) T)
|
||||
(< (#.(D #x-3C200000 0) #.(D 0 0)) T)
|
||||
(< (#.(D #x-3C200000 0) #.(D #x41F00000 0)) T)
|
||||
(< (#.(D #x-3C16DE05 #x54442D18) 0) T)
|
||||
(< (#.(D #x-3C16DE05 #x54442D18) #.(D #x-3C16DE05 #x54442D18)) NIL)
|
||||
|
|
@ -2330,6 +2333,8 @@
|
|||
(< (#.(D #x40400000 0) #.(D #x40500000 0)) T)
|
||||
(< (#.(D #x40408000 0) 33) NIL)
|
||||
(< (#.(D #x40408000 0) #.(S #x42040000)) NIL)
|
||||
(< (#.(D #x40408000 0) #.(D #x40408000 0)) NIL)
|
||||
(< (#.(D #x40408000 0) #.(D #x40410000 0)) T)
|
||||
(< (#.(D #x40408000 0) #.(D #x4062C000 0)) T)
|
||||
(< (#.(D #x40408000 0) #.(D #x40632000 0)) T)
|
||||
(< (#.(D #x40410000 0) 34) NIL)
|
||||
|
|
@ -2578,6 +2583,7 @@
|
|||
(< (#.(D #x42C00000 #x100) #.(D #x42BFFFFF #xFFFFFF00)) NIL)
|
||||
(< (#.(D #x42C0007F #xFFFFFF00) #.(D #x41FFFFFF #xFFE00000)) NIL)
|
||||
(< (#.(D #x42CFFFFF #xFFFFFF00) 0) NIL)
|
||||
(< (#.(D #x42CFFFFF #xFFFFFF00) #.(D #x40000000 0)) NIL)
|
||||
(< (#.(D #x4310624D #xD2F1A9F8) #.(D 0 0)) NIL)
|
||||
(< (#.(D #x4310624D #xD2F1A9F8) #.(D #x4310624D #xD2F1A9F8)) NIL)
|
||||
(< (#.(D #x433FFFFF #xFFFFFFFF) #.(D #x-40100000 0)) NIL)
|
||||
|
|
@ -5364,6 +5370,7 @@
|
|||
(<= (#.(S #x42040000) #.(S #x43160000)) T)
|
||||
(<= (#.(S #x42040000) #.(S #x43190000)) T)
|
||||
(<= (#.(S #x42040000) #.(S #x7F7FFFFF)) T)
|
||||
(<= (#.(S #x42080000) #.(S #x42040000)) NIL)
|
||||
(<= (#.(S #x42080000) #.(S #x43170000)) T)
|
||||
(<= (#.(S #x42080000) #.(S #x431A0000)) T)
|
||||
(<= (#.(S #x42080000) #.(S #x431B0000)) T)
|
||||
|
|
@ -5427,6 +5434,7 @@
|
|||
(<= (#.(S #x431A0000) #.(S #x42080000)) NIL)
|
||||
(<= (#.(S #x431A0000) #.(S #x431A0000)) T)
|
||||
(<= (#.(S #x431A0000) #.(S #x7F7FFFFF)) T)
|
||||
(<= (#.(S #x431B0000) #.(S #x42040000)) NIL)
|
||||
(<= (#.(S #x431B0000) #.(S #x42080000)) NIL)
|
||||
(<= (#.(S #x431B0000) #.(S #x7F7FFFFF)) T)
|
||||
(<= (#.(S #x431D0000) #.(S #x431D0000)) T)
|
||||
|
|
@ -7371,6 +7379,7 @@
|
|||
(<= (#.(D #x40000000 0) #.(D #x40420000 0)) T)
|
||||
(<= (#.(D #x40000000 0) #.(D #x424FFFFF #xFFFF8000)) T)
|
||||
(<= (#.(D #x40000000 0) #.(D #x42AFFFFF #xFFFFFE00)) T)
|
||||
(<= (#.(D #x40000000 0) #.(D #x42CFFFFF #xFFFFFF00)) T)
|
||||
(<= (#.(D #x40000000 0) #.(D #x43D00000 0)) T)
|
||||
(<= (#.(D #x4005BF0A #x8B145769) #.(D 0 0)) NIL)
|
||||
(<= (#.(D #x4005BF0A #x8B145769) #.(D #x7FEFFFFF #xFFFFFFFF)) T)
|
||||
|
|
@ -7540,6 +7549,7 @@
|
|||
(<= (#.(D #x40400000 0) #.(D #x40500000 0)) T)
|
||||
(<= (#.(D #x40400000 0) #.(D #x7FEFFFFF #xFFFFFFFF)) T)
|
||||
(<= (#.(D #x40408000 0) #.(D #x7FEFFFFF #xFFFFFFFF)) T)
|
||||
(<= (#.(D #x40410000 0) #.(D #x40408000 0)) NIL)
|
||||
(<= (#.(D #x40410000 0) #.(D #x40634000 0)) T)
|
||||
(<= (#.(D #x40410000 0) #.(D #x40636000 0)) T)
|
||||
(<= (#.(D #x40410000 0) #.(D #x7FEFFFFF #xFFFFFFFF)) T)
|
||||
|
|
@ -7610,6 +7620,7 @@
|
|||
(<= (#.(D #x40634000 0) #.(D #x40410000 0)) NIL)
|
||||
(<= (#.(D #x40634000 0) #.(D #x40634000 0)) T)
|
||||
(<= (#.(D #x40634000 0) #.(D #x7FEFFFFF #xFFFFFFFF)) T)
|
||||
(<= (#.(D #x40636000 0) #.(D #x40408000 0)) NIL)
|
||||
(<= (#.(D #x40636000 0) #.(D #x40410000 0)) NIL)
|
||||
(<= (#.(D #x40636000 0) #.(D #x7FEFFFFF #xFFFFFFFF)) T)
|
||||
(<= (#.(D #x4063A000 0) #.(D #x4063A000 0)) T)
|
||||
|
|
@ -12776,6 +12787,7 @@
|
|||
(> (#.(S #x42040000) #.(S #x43160000)) NIL)
|
||||
(> (#.(S #x42040000) #.(S #x43190000)) NIL)
|
||||
(> (#.(S #x42040000) #.(D #x40408000 0)) NIL)
|
||||
(> (#.(S #x42080000) #.(S #x42040000)) T)
|
||||
(> (#.(S #x42080000) #.(S #x42080000)) NIL)
|
||||
(> (#.(S #x42080000) #.(S #x43170000)) NIL)
|
||||
(> (#.(S #x42080000) #.(S #x431A0000)) NIL)
|
||||
|
|
@ -12824,6 +12836,7 @@
|
|||
(> (#.(S #x43060000) #.(S #x43060000)) NIL)
|
||||
(> (#.(S #x43100000) #.(S #x433F0000)) NIL)
|
||||
(> (#.(S #x431A0000) #.(S #x431A0000)) NIL)
|
||||
(> (#.(S #x431B0000) #.(S #x42040000)) T)
|
||||
(> (#.(S #x431B0000) #.(S #x431B0000)) NIL)
|
||||
(> (#.(S #x43200000) #.(S #x433F0000)) NIL)
|
||||
(> (#.(S #x433F0000) #.(S #x430F0000)) T)
|
||||
|
|
@ -13893,6 +13906,7 @@
|
|||
(> (#.(D #x40408000 0) #.(D #x40632000 0)) NIL)
|
||||
(> (#.(D #x40410000 0) 34) NIL)
|
||||
(> (#.(D #x40410000 0) #.(S #x42080000)) NIL)
|
||||
(> (#.(D #x40410000 0) #.(D #x40408000 0)) T)
|
||||
(> (#.(D #x40410000 0) #.(D #x40410000 0)) NIL)
|
||||
(> (#.(D #x40410000 0) #.(D #x4062E000 0)) NIL)
|
||||
(> (#.(D #x40410000 0) #.(D #x40634000 0)) NIL)
|
||||
|
|
@ -13953,6 +13967,7 @@
|
|||
(> (#.(D #x4060C000 0) #.(D #x4060C000 0)) NIL)
|
||||
(> (#.(D #x40620000 0) #.(D #x4067E000 0)) NIL)
|
||||
(> (#.(D #x40634000 0) #.(D #x40634000 0)) NIL)
|
||||
(> (#.(D #x40636000 0) #.(D #x40408000 0)) T)
|
||||
(> (#.(D #x40636000 0) #.(D #x40636000 0)) NIL)
|
||||
(> (#.(D #x40640000 0) #.(D #x4067E000 0)) NIL)
|
||||
(> (#.(D #x406633CE #x8FB9F87D) #.(D 0 0)) T)
|
||||
|
|
@ -14888,8 +14903,10 @@
|
|||
(>= (#.(S #x42000000) #.(S #x42000000)) T)
|
||||
(>= (#.(S #x42000000) #.(S #x42800000)) NIL)
|
||||
(>= (#.(S #x42040000) #.(S #x42040000)) T)
|
||||
(>= (#.(S #x42040000) #.(S #x42080000)) NIL)
|
||||
(>= (#.(S #x42040000) #.(S #x43160000)) NIL)
|
||||
(>= (#.(S #x42040000) #.(S #x43190000)) NIL)
|
||||
(>= (#.(S #x42040000) #.(S #x431B0000)) NIL)
|
||||
(>= (#.(S #x42080000) #.(S #x42080000)) T)
|
||||
(>= (#.(S #x42080000) #.(S #x43170000)) NIL)
|
||||
(>= (#.(S #x42080000) #.(S #x431A0000)) NIL)
|
||||
|
|
@ -15832,8 +15849,10 @@
|
|||
(>= (#.(D #x40408000 0) 150) NIL)
|
||||
(>= (#.(D #x40408000 0) 153) NIL)
|
||||
(>= (#.(D #x40408000 0) #.(D #x40408000 0)) T)
|
||||
(>= (#.(D #x40408000 0) #.(D #x40410000 0)) NIL)
|
||||
(>= (#.(D #x40408000 0) #.(D #x4062C000 0)) NIL)
|
||||
(>= (#.(D #x40408000 0) #.(D #x40632000 0)) NIL)
|
||||
(>= (#.(D #x40408000 0) #.(D #x40636000 0)) NIL)
|
||||
(>= (#.(D #x40410000 0) 151) NIL)
|
||||
(>= (#.(D #x40410000 0) #.(D #x40410000 0)) T)
|
||||
(>= (#.(D #x40410000 0) #.(D #x4062E000 0)) NIL)
|
||||
|
|
|
|||
Loading…
Reference in a new issue