(:temporary (:scs (non-descriptor-reg)) temp)
(:translate *)
(:generator 4
- (inst sra y 2 temp)
+ (inst sra y n-fixnum-tag-bits temp)
(inst mulq x temp r)))
(define-vop (fast-*/signed=>signed fast-signed-binop)
(:results (digit :scs (unsigned-reg)))
(:result-types unsigned-num)
(:generator 1
- (inst sra fixnum 2 digit)))
+ (inst sra fixnum n-fixnum-tag-bits digit)))
(define-vop (bignum-floor)
(:translate sb!bignum:%floor)
(inst addq rank (fixnumize (1- array-dimensions-offset)) header)
(inst sll header n-widetag-bits header)
(inst bis header type header)
- (inst srl header 2 header)
+ (inst srl header n-fixnum-tag-bits header)
(pseudo-atomic ()
(inst bis alloc-tn other-pointer-lowtag result)
(storew header result 0 other-pointer-lowtag)
(loadw temp x 0 other-pointer-lowtag)
(inst sra temp n-widetag-bits temp)
(inst subq temp (1- array-dimensions-offset) temp)
- (inst sll temp 2 res)))
+ (inst sll temp n-fixnum-tag-bits res)))
\f
;;;; bounds checking routine
temp result)
(:generator 20
(inst srl index ,bit-shift temp)
- (inst sll temp 2 temp)
+ (inst sll temp n-fixnum-tag-bits temp)
(inst addq object temp lip)
(inst ldl result
(- (* vector-data-offset n-word-bytes)
,(1- (integer-length bits)) temp)))
(inst srl result temp result)
(inst and result ,(1- (ash 1 bits)) result)
- (inst sll result 2 value)))
+ (inst sll result n-fixnum-tag-bits value)))
(define-vop (,(symbolicate 'data-vector-ref-c/ type))
(:translate data-vector-ref)
(:policy :fast-safe)
:from (:argument 1)) shift)
(:generator 25
(inst srl index ,bit-shift temp)
- (inst sll temp 2 temp)
+ (inst sll temp n-fixnum-tag-bits temp)
(inst addq object temp lip)
(inst ldl old
(- (* vector-data-offset n-word-bytes)
(:results (res :scs (any-reg)))
(:result-types positive-fixnum)
(:generator 1
- (inst sll ch 2 res)))
+ (inst sll ch n-fixnum-tag-bits res)))
(define-vop (code-char)
(:translate code-char)
(:results (res :scs (base-char-reg)))
(:result-types base-char)
(:generator 1
- (inst srl code 2 res)))
+ (inst srl code n-fixnum-tag-bits res)))
\f
;;;; comparison of BASE-CHARs
(:arg-types tagged-num)
(:note "fixnum untagging")
(:generator 1
- (inst sra x 2 y)))
+ (inst sra x n-fixnum-tag-bits y)))
;;;
(define-move-vop move-to-word/fixnum :move
(any-reg descriptor-reg) (signed-reg unsigned-reg))
(:temporary (:sc non-descriptor-reg) header)
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 3
- (inst and x 3 temp)
- (inst sra x 2 y)
+ (inst and x fixnum-tag-mask temp)
+ (inst sra x n-fixnum-tag-bits y)
(inst beq temp done)
(loadw header x 0 other-pointer-lowtag)
(:result-types tagged-num)
(:note "fixnum tagging")
(:generator 1
- (inst sll x 2 y)))
+ (inst sll x n-fixnum-tag-bits y)))
;;;
(define-move-vop move-from-word/fixnum :move
(signed-reg unsigned-reg) (any-reg descriptor-reg))
(:note "signed word to integer coercion")
(:generator 18
(move arg x)
- (inst sra x 29 temp)
- (inst sll x 2 y)
+ (inst sra x n-positive-fixnum-bits temp)
+ (inst sll x n-fixnum-tag-bits y)
(inst beq temp done)
(inst not temp temp)
(inst beq temp done)
(:note "unsigned word to integer coercion")
(:generator 20
(move arg x)
- (inst srl x 29 temp)
- (inst sll x 2 y)
+ (inst srl x n-positive-fixnum-bits temp)
+ (inst sll x n-fixnum-tag-bits y)
(inst beq temp done)
(inst li 3 temp)
(inst blbs object done)
;; Pick off fixnums.
- (inst and object 3 result)
+ (inst and object fixnum-tag-mask result)
(inst beq result done)
;; Must be an other immediate.
(inst sll val n-widetag-bits temp)
(inst bis temp (tn-value type) res))
(t
- (inst sra type 2 temp)
- (inst sll val (- n-widetag-bits 2) res)
+ (inst sra type n-fixnum-tag-bits temp)
+ (inst sll val (- n-widetag-bits n-fixnum-tag-bits) res)
(inst bis res temp res)))))
\f
\f
(defun %test-fixnum (value target not-p &key temp)
(assemble ()
- (inst and value 3 temp)
+ (inst and value fixnum-tag-mask temp)
(if not-p
(inst bne temp target)
(inst beq temp target))))
(defun %test-fixnum-and-headers (value target not-p headers &key temp)
(let ((drop-through (gen-label)))
(assemble ()
- (inst and value 3 temp)
+ (inst and value fixnum-tag-mask temp)
(inst beq temp (if not-p drop-through target)))
(%test-headers value target not-p nil headers
:drop-through drop-through :temp temp)))
(values not-target target)
(values target not-target))
(assemble ()
- (inst and value 3 temp)
+ (inst and value fixnum-tag-mask temp)
(inst beq temp yep)
(inst and value lowtag-mask temp)
(inst xor temp other-pointer-lowtag temp)
(values target not-target))
(assemble ()
;; Is it a fixnum?
- (inst and value 3 temp1)
+ (inst and value fixnum-tag-mask temp1)
(inst move value temp)
(inst beq temp1 fixnum)
;;; 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.13.19"
+"0.8.13.20"