-;;;; the VM definition of arithmetic VOPs for the x86
+;;;; the VM definition of arithmetic VOPs for the x86-64
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
(define-vop (fast-lognot/fixnum fixnum-unop)
(:translate lognot)
- (:generator 2
+ (:generator 1
(move res x)
(inst xor res (fixnumize -1))))
(define-vop (fast-lognot/signed signed-unop)
(:translate lognot)
- (:generator 1
+ (:generator 2
(move res x)
(inst not res)))
\f
(:vop-var vop)
(:save-p :compute-only)
(:generator 31
- (let ((zero (generate-error-code vop division-by-zero-error x y)))
+ (let ((zero (generate-error-code vop 'division-by-zero-error x y)))
(if (sc-is y any-reg)
(inst test y y) ; smaller instruction
(inst cmp y 0))
(:vop-var vop)
(:save-p :compute-only)
(:generator 33
- (let ((zero (generate-error-code vop division-by-zero-error x y)))
+ (let ((zero (generate-error-code vop 'division-by-zero-error x y)))
(if (sc-is y unsigned-reg)
(inst test y y) ; smaller instruction
(inst cmp y 0))
(:vop-var vop)
(:save-p :compute-only)
(:generator 33
- (let ((zero (generate-error-code vop division-by-zero-error x y)))
+ (let ((zero (generate-error-code vop 'division-by-zero-error x y)))
(if (sc-is y signed-reg)
(inst test y y) ; smaller instruction
(inst cmp y 0))
(inst lea result (make-ea :qword :index number :scale 8)))
(t
(move result number)
- (cond ((plusp amount)
- ;; We don't have to worry about overflow because of the
- ;; result type restriction.
- (inst shl result amount))
- (t
- ;; Since the shift instructions take the shift amount
- ;; modulo 64 we must special case amounts of 64 and more.
- ;; Because fixnums have only 61 bits, the result is 0 or
- ;; -1 for all amounts of 60 or more, so use this as the
- ;; limit instead.
- (inst sar result (min (- n-word-bits n-fixnum-tag-bits 1)
- (- amount)))
- (inst and result (lognot fixnum-tag-mask))))))))
+ (cond ((< -64 amount 64)
+ ;; this code is used both in ASH and ASH-SMOD61, so
+ ;; be careful
+ (if (plusp amount)
+ (inst shl result amount)
+ (progn
+ (inst sar result (- amount))
+ (inst and result (lognot fixnum-tag-mask)))))
+ ((plusp amount)
+ (if (sc-is result any-reg)
+ (inst xor result result)
+ (inst mov result 0)))
+ (t (inst sar result 63)
+ (inst and result (lognot fixnum-tag-mask))))))))
(define-vop (fast-ash-left/fixnum=>fixnum)
(:translate ash)
(:result-types unsigned-num)
(:generator 28
(move res arg)
- (inst cmp res 0)
+ (if (sc-is res unsigned-reg)
+ (inst test res res)
+ (inst cmp res 0))
(inst jmp :ge POS)
(inst not res)
POS
(svop61f (intern (format nil "FAST-~S-SMOD61/FIXNUM=>FIXNUM" name)))
(svop61cf (intern (format nil "FAST-~S-SMOD61-C/FIXNUM=>FIXNUM" name))))
`(progn
- (define-modular-fun ,fun64 (x y) ,name :unsigned 64)
- (define-modular-fun ,sfun61 (x y) ,name :signed 61)
+ (define-modular-fun ,fun64 (x y) ,name :untagged nil 64)
+ (define-modular-fun ,sfun61 (x y) ,name :tagged t 61)
(define-mod-binop (,vop64u ,vopu) ,fun64)
(define-vop (,vop64f ,vopf) (:translate ,fun64))
(define-vop (,svop61f ,vopf) (:translate ,sfun61))
(signed-byte 61)
(foldable flushable movable))
-(define-modular-fun-optimizer %lea ((base index scale disp) :unsigned :width width)
+(define-modular-fun-optimizer %lea ((base index scale disp) :untagged nil :width width)
(when (and (<= width 64)
(constant-lvar-p scale)
(constant-lvar-p disp))
- (cut-to-width base :unsigned width)
- (cut-to-width index :unsigned width)
+ (cut-to-width base :untagged width nil)
+ (cut-to-width index :untagged width nil)
'sb!vm::%lea-mod64))
-(define-modular-fun-optimizer %lea ((base index scale disp) :signed :width width)
+(define-modular-fun-optimizer %lea ((base index scale disp) :tagged t :width width)
(when (and (<= width 61)
(constant-lvar-p scale)
(constant-lvar-p disp))
- (cut-to-width base :signed width)
- (cut-to-width index :signed width)
+ (cut-to-width base :tagged width t)
+ (cut-to-width index :tagged width t)
'sb!vm::%lea-smod61))
#+sb-xc-host
(:translate %lea-smod61))
;;; logical operations
-(define-modular-fun lognot-mod64 (x) lognot :unsigned 64)
+(define-modular-fun lognot-mod64 (x) lognot :untagged nil 64)
(define-vop (lognot-mod64/unsigned=>unsigned)
(:translate lognot-mod64)
(:args (x :scs (unsigned-reg unsigned-stack) :target r
(move r x)
(inst not r)))
-(define-modular-fun logxor-mod64 (x y) logxor :unsigned 64)
-(define-mod-binop (fast-logxor-mod64/word=>unsigned
- fast-logxor/unsigned=>unsigned)
- logxor-mod64)
-(define-mod-binop-c (fast-logxor-mod64-c/word=>unsigned
- fast-logxor-c/unsigned=>unsigned)
- logxor-mod64)
-(define-vop (fast-logxor-mod64/fixnum=>fixnum
- fast-logxor/fixnum=>fixnum)
- (:translate logxor-mod64))
-(define-vop (fast-logxor-mod64-c/fixnum=>fixnum
- fast-logxor-c/fixnum=>fixnum)
- (:translate logxor-mod64))
-
(define-source-transform logeqv (&rest args)
(if (oddp (length args))
`(logxor ,@args)
(define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag
(unsigned-reg) unsigned-num sb!bignum:%bignum-ref)
-
+(define-full-reffer+offset bignum--ref-with-offset * bignum-digits-offset
+ other-pointer-lowtag (unsigned-reg) unsigned-num
+ sb!bignum:%bignum-ref-with-offset)
(define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag
(unsigned-reg) unsigned-num sb!bignum:%bignum-set)
projects / sbcl.git / blobdiff