(thanks to Christophe Rhodes's port of the CMUCL runtime)
* cleanups to the runtime on SPARC, both Linux and Solaris, and for
gcc>=3 (thanks to Nathan Froyd and Ingvar Mattsson)
+ * SPARC backend cleanups, allowing builds of cores optimized for V8
+ and V9 SPARCS, and also emission of code targeted to a particular
+ backend chosen at runtime (thanks to Christophe Rhodes and Raymond
+ Toy)
* ANSI's DEFINE-SYMBOL-MACRO is now supported. (thanks to Nathan
Froyd porting CMU CL code originally by Douglas Thomas Crosher)
* The fasl file format has changed again, to allow the compiler's
INFO database to support symbol macros.
* The user manual (in doc/) is formatted into HTML more nicely.
(thanks to coreythomas)
-
-changes in sbcl-0.7.3 relative to sbcl-0.7.2:
* The system is smarter about SUBTYPEP relationships, especially
those involving NOT types (including types such as ATOM which are
represented internally using NOT types). Thus SUBTYPEP is less
(inst b :vc done)
(inst nop)
- (inst sra temp x fixnum-tag-bits)
- (inst sra temp2 y fixnum-tag-bits)
+ (inst sra temp x n-fixnum-tag-bits)
+ (inst sra temp2 y n-fixnum-tag-bits)
(inst add temp2 temp)
(with-fixed-allocation (res temp bignum-widetag (1+ bignum-digits-offset))
(storew temp2 res bignum-digits-offset other-pointer-lowtag))
(inst b :vc done)
(inst nop)
- (inst sra temp x fixnum-tag-bits)
- (inst sra temp2 y fixnum-tag-bits)
+ (inst sra temp x n-fixnum-tag-bits)
+ (inst sra temp2 y n-fixnum-tag-bits)
(inst sub temp2 temp temp2)
(with-fixed-allocation (res temp bignum-widetag (1+ bignum-digits-offset))
(storew temp2 res bignum-digits-offset other-pointer-lowtag))
;; Remove the tag from one arg so that the result will have the correct
;; fixnum tag.
- (inst sra temp x fixnum-tag-bits)
+ (inst sra temp x n-fixnum-tag-bits)
;; Compute the produce temp * y and return the double-word product
;; in hi:lo.
- ;;
- ;; FIXME: Note that the below shebang read-time conditionals aren't
- ;; actually shebang. This is because the assembly files are also
- ;; built in warm-init, when #! is not a defined read-macro. This
- ;; problem will actually go away when we rewrite these low-level
- ;; bits and pieces to use the backend-subfeatures machinery, as we
- ;; will then conditionalize at code-emission time or assembly time
- ;; for the VOP and the assembly routine respectively. - CSR,
- ;; 2002-02-11
- #+:sparc-64
- ;; Sign extend y to a full 64-bits. temp was already
- ;; sign-extended by the sra instruction above.
- (progn
- (inst sra y 0)
- (inst mulx hi temp y)
- (inst move lo hi)
- (inst srax hi 32))
- #+(and (not :sparc-64) (or :sparc-v8 :sparc-v9))
- (progn
- (inst smul lo temp y)
- (inst rdy hi))
- #+(and (not :sparc-64) (not (or :sparc-v8 :sparc-v9)))
- (let ((MULTIPLIER-POSITIVE (gen-label)))
- (inst wry temp)
- (inst andcc hi zero-tn)
- (inst nop)
- (inst nop)
- (dotimes (i 32)
- (inst mulscc hi y))
- (inst mulscc hi zero-tn)
- (inst cmp x)
- (inst b :ge MULTIPLIER-POSITIVE)
- (inst nop)
- (inst sub hi y)
- (emit-label MULTIPLIER-POSITIVE)
- (inst rdy lo))
-
+ (cond
+ ((member :sparc-64 *backend-subfeatures*)
+ ;; Sign extend y to a full 64-bits. temp was already
+ ;; sign-extended by the sra instruction above.
+ (inst sra y 0)
+ (inst mulx hi temp y)
+ (inst move lo hi)
+ (inst srax hi 32))
+ ((or (member :sparc-v8 *backend-subfeatures*)
+ (member :sparc-v9 *backend-subfeatures*))
+ (inst smul lo temp y)
+ (inst rdy hi))
+ (t
+ (let ((MULTIPLIER-POSITIVE (gen-label)))
+ (inst wry temp)
+ (inst andcc hi zero-tn)
+ (inst nop)
+ (inst nop)
+ (dotimes (i 32)
+ (inst mulscc hi y))
+ (inst mulscc hi zero-tn)
+ (inst cmp x)
+ (inst b :ge MULTIPLIER-POSITIVE)
+ (inst nop)
+ (inst sub hi y)
+ (emit-label MULTIPLIER-POSITIVE)
+ (inst rdy lo))))
;; Check to see if the result will fit in a fixnum. (I.e. the high word
;; is just 32 copies of the sign bit of the low word).
(inst sra temp lo 31)
(inst b :eq LOW-FITS-IN-FIXNUM)
;; Shift the double word hi:lo down two bits to get rid of the fixnum tag.
(inst sll temp hi 30)
- (inst srl lo fixnum-tag-bits)
+ (inst srl lo n-fixnum-tag-bits)
(inst or lo temp)
- (inst sra hi fixnum-tag-bits)
+ (inst sra hi n-fixnum-tag-bits)
;; Allocate a BIGNUM for the result.
#+nil
(pseudo-atomic (:extra (pad-data-block (1+ bignum-digits-offset)))
- (let ((one-word (gen-label)))
- (inst or res alloc-tn other-pointer-lowtag)
- ;; We start out assuming that we need one word. Is that correct?
- (inst sra temp lo 31)
- (inst xorcc temp hi)
- (inst b :eq one-word)
- (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
- ;; Nope, we need two, so allocate the addition space.
- (inst add alloc-tn (- (pad-data-block (+ 2 bignum-digits-offset))
- (pad-data-block (1+ bignum-digits-offset))))
- (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
- (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
- (emit-label one-word)
- (storew temp res 0 other-pointer-lowtag)
- (storew lo res bignum-digits-offset other-pointer-lowtag)))
+ (let ((one-word (gen-label)))
+ (inst or res alloc-tn other-pointer-lowtag)
+ ;; We start out assuming that we need one word. Is that correct?
+ (inst sra temp lo 31)
+ (inst xorcc temp hi)
+ (inst b :eq one-word)
+ (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
+ ;; Nope, we need two, so allocate the addition space.
+ (inst add alloc-tn (- (pad-data-block (+ 2 bignum-digits-offset))
+ (pad-data-block (1+ bignum-digits-offset))))
+ (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
+ (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
+ (emit-label one-word)
+ (storew temp res 0 other-pointer-lowtag)
+ (storew lo res bignum-digits-offset other-pointer-lowtag)))
;; Always allocate 2 words for the bignum result, even if we only
;; need one. The copying GC will take care of the extra word if it
;; isn't needed.
(storew lo res bignum-digits-offset other-pointer-lowtag)))
;; Out of here
(lisp-return lra :offset 2)
-
+
DO-STATIC-FUN
(inst ld code-tn null-tn (static-fun-offset 'two-arg-*))
(inst li nargs (fixnumize 2))
(:temp temp ,sc nl2-offset))
,@(when (eq type 'tagged-num)
`((inst sra x 2)))
- #+:sparc-64
- ;; Sign extend, then multiply
- (progn
- (inst sra x 0)
- (inst sra y 0)
- (inst mulx res x y))
- #+(and (not :sparc-64) (or :sparc-v8 :sparc-v9))
- (inst smul res x y)
- #+(and (not :sparc-64) (not (or :sparc-v8 :sparc-v9)))
- (progn
- (inst wry x)
- (inst andcc temp zero-tn)
- (inst nop)
- (inst nop)
- (dotimes (i 32)
- (inst mulscc temp y))
- (inst mulscc temp zero-tn)
- (inst rdy res)))))
+ (cond
+ ((member :sparc-64 *backend-subfeatures*)
+ ;; Sign extend, then multiply
+ (inst sra x 0)
+ (inst sra y 0)
+ (inst mulx res x y))
+ ((or (member :sparc-v8 *backend-subfeatures*)
+ (member :sparc-v9 *backend-subfeatures*))
+ (inst smul res x y))
+ (t
+ (inst wry x)
+ (inst andcc temp zero-tn)
+ (inst nop)
+ (inst nop)
+ (dotimes (i 32)
+ (inst mulscc temp y))
+ (inst mulscc temp zero-tn)
+ (inst rdy res))))))
(frob unsigned-* "unsigned *" 40 unsigned-num unsigned-reg)
(frob signed-* "unsigned *" 41 signed-num signed-reg)
(frob fixnum-* "fixnum *" 30 tagged-num any-reg))
(:temporary (:scs (signed-reg)) y-int)
(:vop-var vop)
(:save-p :compute-only)
- (:guard #!+(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) t
- #!-(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) nil)
+ (:guard (or (member :sparc-v8 *backend-subfeatures*)
+ (and (member :sparc-v9 *backend-subfeatures*)
+ (not (member :sparc-64 *backend-subfeatures*)))))
(:generator 12
(let ((zero (generate-error-code vop division-by-zero-error x y)))
(inst cmp y zero-tn)
(inst sra r x 31)
(inst wry r)
;; Remove tag bits so Q and R will be tagged correctly.
- (inst sra y-int y fixnum-tag-bits)
+ (inst sra y-int y n-fixnum-tag-bits)
(inst nop)
(inst nop)
(:temporary (:scs (signed-reg)) r)
(:vop-var vop)
(:save-p :compute-only)
- (:guard #!+(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) t
- #!-(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) nil)
+ (:guard (or (member :sparc-v8 *backend-subfeatures*)
+ (and (member :sparc-v9 *backend-subfeatures*)
+ (not (member :sparc-64 *backend-subfeatures*)))))
(:generator 12
(let ((zero (generate-error-code vop division-by-zero-error x y)))
(inst cmp y zero-tn)
- (inst b :eq zero #!+:sparc-v9 :pn)
+ (if (member :sparc-v9 *backend-subfeatures*)
+ (inst b :eq zero :pn)
+ (inst b :eq zero))
;; Extend the sign of X into the Y register
- (inst sra r x 31)
+ (inst sra r x 31)
(inst wry r)
(inst nop)
(inst nop)
(:temporary (:scs (unsigned-reg)) r)
(:vop-var vop)
(:save-p :compute-only)
- (:guard #!+(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) t
- #!-(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) nil)
+ (:guard (or (member :sparc-v8 *backend-subfeatures*)
+ (and (member :sparc-v9 *backend-subfeatures*)
+ (not (member :sparc-64 *backend-subfeatures*)))))
(:generator 8
(let ((zero (generate-error-code vop division-by-zero-error x y)))
(inst cmp y zero-tn)
- (inst b :eq zero #!+:sparc-v9 :pn)
- (inst wry zero-tn) ; Clear out high part
+ (if (member :sparc-v9 *backend-subfeatures*)
+ (inst b :eq zero :pn)
+ (inst b :eq zero))
+ (inst wry zero-tn) ; Clear out high part
(inst nop)
(inst nop)
(inst nop)
(unless (location= quo q)
(inst move quo q)))))
-#!+:sparc-v9
(define-vop (fast-v9-truncate/signed=>signed fast-safe-arith-op)
(:translate truncate)
(:args (x :scs (signed-reg))
(:temporary (:scs (signed-reg)) r)
(:vop-var vop)
(:save-p :compute-only)
- (:guard #!+:sparc-64 t #!-:sparc-64 nil)
+ (:guard (member :sparc-64 *backend-subfeatures*))
(:generator 8
(let ((zero (generate-error-code vop division-by-zero-error x y)))
(inst cmp y zero-tn)
- (inst b :eq zero #!+:sparc-v9 :pn)
+ (inst b :eq zero :pn)
;; Sign extend the numbers, just in case.
- (inst sra x 0)
+ (inst sra x 0)
(inst sra y 0)
(inst sdivx q x y)
;; Compute remainder
(:temporary (:scs (unsigned-reg)) r)
(:vop-var vop)
(:save-p :compute-only)
- (:guard #!+:sparc-64 t #!-:sparc-64 nil)
+ (:guard (member :sparc-64 *backend-subfeatures*))
(:generator 8
(let ((zero (generate-error-code vop division-by-zero-error x y)))
(inst cmp y zero-tn)
- (inst b :eq zero #!+:sparc-v9 :pn)
+ (inst b :eq zero :pn)
;; Zap the higher 32 bits, just in case
- (inst srl x 0)
+ (inst srl x 0)
(inst srl y 0)
(inst udivx q x y)
;; Compute remainder
(:temporary (:sc non-descriptor-reg) ndesc)
(:generator 5
(sc-case amount
- #!+:sparc-v9
- (signed-reg
- (let ((done (gen-label))
- (positive (gen-label)))
- (inst cmp amount)
- (inst b :ge positive)
- (inst neg ndesc amount)
- ;; ndesc = max(-amount, 31)
- (inst cmp ndesc 31)
- (inst cmove :ge ndesc 31)
- (inst b done)
- (inst ,shift-right-inst result number ndesc)
- (emit-label positive)
- ;; The result-type assures us that this shift will not
- ;; overflow.
- (inst sll result number amount)
- ;; We want a right shift of the appropriate size.
- (emit-label done)))
- #!-:sparc-v9
(signed-reg
- (let ((positive (gen-label))
- (done (gen-label)))
- (inst cmp amount)
- (inst b :ge positive)
- (inst neg ndesc amount)
- (inst cmp ndesc 31)
- (inst b :le done)
- (inst ,shift-right-inst result number ndesc)
- (inst b done)
- (inst ,shift-right-inst result number 31)
-
- (emit-label positive)
- ;; The result-type assures us that this shift will not overflow.
- (inst sll result number amount)
-
- (emit-label done)))
+ (cond
+ ;; FIXME: These two don't look different enough.
+ ((member :sparc-v9 *backend-subfeatures*)
+ (let ((done (gen-label))
+ (positive (gen-label)))
+ (inst cmp amount)
+ (inst b :ge positive)
+ (inst neg ndesc amount)
+ ;; ndesc = max(-amount, 31)
+ (inst cmp ndesc 31)
+ (inst cmove :ge ndesc 31)
+ (inst b done)
+ (inst ,shift-right-inst result number ndesc)
+ (emit-label positive)
+ ;; The result-type assures us that this shift will
+ ;; not overflow.
+ (inst sll result number amount)
+ ;; We want a right shift of the appropriate size.
+ (emit-label done)))
+ (t
+ (let ((positive (gen-label))
+ (done (gen-label)))
+ (inst cmp amount)
+ (inst b :ge positive)
+ (inst neg ndesc amount)
+ (inst cmp ndesc 31)
+ (inst b :le done)
+ (inst ,shift-right-inst result number ndesc)
+ (inst b done)
+ (inst ,shift-right-inst result number 31)
+ (emit-label positive)
+ ;; The result-type assures us that this shift will
+ ;; not overflow.
+ (inst sll result number amount)
+ (emit-label done)))))
(immediate
(let ((amount (tn-value amount)))
(if (minusp amount)
(define-vop (fast-v8-*/fixnum=>fixnum fast-fixnum-binop)
(:temporary (:scs (non-descriptor-reg)) temp)
(:translate *)
- (:guard #!+(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) t
- #!-(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) nil)
+ (:guard (or (member :sparc-v8 *backend-subfeatures*)
+ (and (member :sparc-v9 *backend-subfeatures*)
+ (not (member :sparc-64 *backend-subfeatures*)))))
(:generator 2
;; The cost here should be less than the cost for
;; */signed=>signed. Why? A fixnum product using signed=>signed
;; has to convert both args to signed-nums. But using this, we
;; don't have to and that saves an instruction.
- (inst sra temp y fixnum-tag-bits)
+ (inst sra temp y n-fixnum-tag-bits)
(inst smul r x temp)))
(define-vop (fast-v8-*/signed=>signed fast-signed-binop)
(:translate *)
- (:guard #!+(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) t
- #!-(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) nil)
+ (:guard (or (member :sparc-v8 *backend-subfeatures*)
+ (and (member :sparc-v9 *backend-subfeatures*)
+ (not (member :sparc-64 *backend-subfeatures*)))))
(:generator 3
(inst smul r x y)))
(define-vop (fast-v8-*/unsigned=>unsigned fast-unsigned-binop)
(:translate *)
- (:guard #!+(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) t
- #!-(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) nil)
+ (:guard (or (member :sparc-v8 *backend-subfeatures*)
+ (and (member :sparc-v9 *backend-subfeatures*)
+ (not (member :sparc-64 *backend-subfeatures*)))))
(:generator 3
(inst umul r x y)))
(define-vop (fast-v9-*/fixnum=>fixnum fast-fixnum-binop)
(:temporary (:scs (non-descriptor-reg)) temp)
(:translate *)
- (:guard #!+:sparc-64 t #!-:sparc-64 nil)
+ (:guard (member :sparc-64 *backend-subfeatures*))
(:generator 4
- (inst sra temp y fixnum-tag-bits)
+ (inst sra temp y n-fixnum-tag-bits)
(inst mulx r x temp)))
(define-vop (fast-v9-*/signed=>signed fast-signed-binop)
(:translate *)
- (:guard #!+:sparc-64 t #!-:sparc-64 nil)
+ (:guard (member :sparc-64 *backend-subfeatures*))
(:generator 3
(inst mulx r x y)))
(define-vop (fast-v9-*/unsigned=>unsigned fast-unsigned-binop)
(:translate *)
- (:guard #!+:sparc-64 t #!-:sparc-64 nil)
+ (:guard (member :sparc-64 *backend-subfeatures*))
(:generator 3
(inst mulx r x y)))
(:args (digit :scs (unsigned-reg)))
(:arg-types unsigned-num)
(:results (result :scs (descriptor-reg)))
- (:guard #!-:sparc-v9 t #!+:sparc-v9 nil)
+ (:guard (not (member :sparc-v9 *backend-subfeatures*)))
(:generator 3
(let ((done (gen-label)))
(inst cmp digit)
(:args (digit :scs (unsigned-reg)))
(:arg-types unsigned-num)
(:results (result :scs (descriptor-reg)))
- (:guard #!+:sparc-v9 t #!-:sparc-v9 nil)
+ (:guard (member :sparc-v9 *backend-subfeatures*))
(:generator 3
(inst cmp digit)
(load-symbol result t)
(type (or tn (signed-byte 13)) multiplicand))
;; It seems that emit-multiply is only used to do an unsigned
;; multiply, so the code only does an unsigned multiply.
- #!+:sparc-64
- (progn
- ;; Take advantage of V9's 64-bit multiplier.
- ;;
- ;; Make sure the multiplier and multiplicand are really
- ;; unsigned 64-bit numbers.
- (inst srl multiplier 0)
- (inst srl multiplicand 0)
+ (cond
+ ((member :sparc-64 *backend-subfeatures*)
+ ;; Take advantage of V9's 64-bit multiplier.
+ ;;
+ ;; Make sure the multiplier and multiplicand are really
+ ;; unsigned 64-bit numbers.
+ (inst srl multiplier 0)
+ (inst srl multiplicand 0)
- ;; Multiply the two numbers and put the result in
- ;; result-high. Copy the low 32-bits to result-low. Then
- ;; shift result-high so the high 32-bits end up in the low
- ;; 32-bits.
- (inst mulx result-high multiplier multiplicand)
- (inst move result-low result-high)
- (inst srax result-high 32))
- #!+(and (not :sparc-64) (or :sparc-v8 :sparc-v9))
- (progn
- ;; V8 has a multiply instruction. This should also work for
- ;; the V9, but umul and the Y register is deprecated on the
- ;; V9.
- (inst umul result-low multiplier multiplicand)
- (inst rdy result-high))
- #!+(and (not :sparc-64) (not (or :sparc-v8 :sparc-v9)))
- (let ((label (gen-label)))
- (inst wry multiplier)
- (inst andcc result-high zero-tn)
- ;; Note: we can't use the Y register until three insts
- ;; after it's written.
- (inst nop)
- (inst nop)
- (dotimes (i 32)
- (inst mulscc result-high multiplicand))
- (inst mulscc result-high zero-tn)
- (inst cmp multiplicand)
- (inst b :ge label)
- (inst nop)
- (inst add result-high multiplier)
- (emit-label label)
- (inst rdy result-low)))
+ ;; Multiply the two numbers and put the result in
+ ;; result-high. Copy the low 32-bits to result-low. Then
+ ;; shift result-high so the high 32-bits end up in the low
+ ;; 32-bits.
+ (inst mulx result-high multiplier multiplicand)
+ (inst move result-low result-high)
+ (inst srax result-high 32))
+ ((or (member :sparc-v8 *backend-subfeatures*)
+ (member :sparc-v9 *backend-subfeatures*))
+ ;; V8 has a multiply instruction. This should also work for
+ ;; the V9, but umul and the Y register is deprecated on the
+ ;; V9.
+ (inst umul result-low multiplier multiplicand)
+ (inst rdy result-high))
+ (t
+ (let ((label (gen-label)))
+ (inst wry multiplier)
+ (inst andcc result-high zero-tn)
+ ;; Note: we can't use the Y register until three insts
+ ;; after it's written.
+ (inst nop)
+ (inst nop)
+ (dotimes (i 32)
+ (inst mulscc result-high multiplicand))
+ (inst mulscc result-high zero-tn)
+ (inst cmp multiplicand)
+ (inst b :ge label)
+ (inst nop)
+ (inst add result-high multiplier)
+ (emit-label label)
+ (inst rdy result-low)))))
(define-vop (bignum-mult-and-add-3-arg)
(:translate sb!bignum::%multiply-and-add)
(:results (digit :scs (unsigned-reg)))
(:result-types unsigned-num)
(:generator 1
- (inst sra digit fixnum fixnum-tag-bits)))
+ (inst sra digit fixnum n-fixnum-tag-bits)))
(define-vop (bignum-floor)
(:translate sb!bignum::%floor)
(:results (quo :scs (unsigned-reg) :from (:argument 1))
(rem :scs (unsigned-reg) :from (:argument 0)))
(:result-types unsigned-num unsigned-num)
- (:guard #!+(not (or :sparc-v8 :sparc-v9)) t
- #!-(not (or :sparc-v8 :sparc-v9)) nil)
(:generator 300
(move rem div-high)
(move quo div-low)
(:temporary (:scs (unsigned-reg) :target quo) q)
;; This vop is for a v8 or v9, provided we're also not using
;; sparc-64, for which there a special sparc-64 vop.
- (:guard #!+(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) t
- #!-(or :sparc-v8 (and :sparc-v9 (not :sparc-64))) nil)
+ (:guard (or (member :sparc-v8 *backend-subfeatures*)
+ (member :sparc-v9 *backend-subfeatures*)))
(:generator 15
(inst wry div-high)
(inst nop)
(:results (quo :scs (unsigned-reg))
(rem :scs (unsigned-reg)))
(:result-types unsigned-num unsigned-num)
- (:guard #!+:sparc-64 t #!-:sparc-64 nil)
+ (:guard (member :sparc-64 *backend-subfeatures*))
(:generator 5
;; Set dividend to be div-high and div-low
(inst sllx dividend div-high 32)
(:generator 1
(sc-case res
(any-reg
- (inst sll res digit fixnum-tag-bits))
+ (inst sll res digit n-fixnum-tag-bits))
(signed-reg
(move res digit)))))
(inst or ndescr ndescr type)
;; Remove the extraneous fixnum tag bits because TYPE and RANK
;; were fixnums
- (inst srl ndescr ndescr fixnum-tag-bits)
+ (inst srl ndescr ndescr n-fixnum-tag-bits)
(storew ndescr header 0 other-pointer-lowtag))
(move result header)))
(loadw temp x 0 other-pointer-lowtag)
(inst sra temp n-widetag-bits)
(inst sub temp (1- array-dimensions-offset))
- (inst sll res temp fixnum-tag-bits)))
+ (inst sll res temp n-fixnum-tag-bits)))
\f
(:temporary (:scs (non-descriptor-reg) :to (:result 0)) temp result)
(:generator 20
(inst srl temp index ,bit-shift)
- (inst sll temp fixnum-tag-bits)
+ (inst sll temp n-fixnum-tag-bits)
(inst add temp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag))
(inst ld result object temp)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) shift)
(:generator 25
(inst srl offset index ,bit-shift)
- (inst sll offset fixnum-tag-bits)
+ (inst sll offset n-fixnum-tag-bits)
(inst add offset (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag))
(inst ld old object offset)
(let ((err-lab
(generate-error-code vop invalid-arg-count-error nargs)))
(inst cmp nargs (fixnumize count))
- ;; Assume we don't take the branch
- (inst b :ne err-lab #!+sparc-v9 :pn)
+ (if (member :sparc-v9 *backend-subfeatures*)
+ ;; Assume we don't take the branch
+ (inst b :ne err-lab :pn)
+ (inst b :ne err-lab))
(inst nop))))
;;; Signal various errors.
(:results (res :scs (any-reg)))
(:result-types positive-fixnum)
(:generator 1
- (inst sll res ch fixnum-tag-bits)))
+ (inst sll res ch n-fixnum-tag-bits)))
(define-vop (code-char)
(:translate code-char)
(:results (res :scs (base-char-reg)))
(:result-types base-char)
(:generator 1
- (inst srl res code fixnum-tag-bits)))
+ (inst srl res code n-fixnum-tag-bits)))
\f
;;; Comparison of base-chars.
;;; The offset may be an integer or a TN in which case it will be
;;; temporarily modified but is restored if restore-offset is true.
(defun load-long-reg (reg base offset &optional (restore-offset t))
- #!+:sparc-v9
- (inst ldqf reg base offset)
- #!-:sparc-v9
- (let ((reg0 (make-random-tn :kind :normal
- :sc (sc-or-lose 'double-reg)
- :offset (tn-offset reg)))
- (reg2 (make-random-tn :kind :normal
- :sc (sc-or-lose 'double-reg)
- :offset (+ 2 (tn-offset reg)))))
- (cond ((integerp offset)
- (inst lddf reg0 base offset)
- (inst lddf reg2 base (+ offset (* 2 n-word-bytes))))
- (t
- (inst lddf reg0 base offset)
- (inst add offset (* 2 n-word-bytes))
- (inst lddf reg2 base offset)
- (when restore-offset
- (inst sub offset (* 2 n-word-bytes)))))))
+ (cond
+ ((member :sparc-v9 *backend-subfeatures*)
+ (inst ldqf reg base offset))
+ (t
+ (let ((reg0 (make-random-tn :kind :normal
+ :sc (sc-or-lose 'double-reg)
+ :offset (tn-offset reg)))
+ (reg2 (make-random-tn :kind :normal
+ :sc (sc-or-lose 'double-reg)
+ :offset (+ 2 (tn-offset reg)))))
+ (cond ((integerp offset)
+ (inst lddf reg0 base offset)
+ (inst lddf reg2 base (+ offset (* 2 n-word-bytes))))
+ (t
+ (inst lddf reg0 base offset)
+ (inst add offset (* 2 n-word-bytes))
+ (inst lddf reg2 base offset)
+ (when restore-offset
+ (inst sub offset (* 2 n-word-bytes)))))))))
#!+long-float
(define-move-fun (load-long 2) (vop x y)
;;; The offset may be an integer or a TN in which case it will be
;;; temporarily modified but is restored if restore-offset is true.
(defun store-long-reg (reg base offset &optional (restore-offset t))
- #!+:sparc-v9
- (inst stqf reg base offset)
- #!-:sparc-v9
- (let ((reg0 (make-random-tn :kind :normal
- :sc (sc-or-lose 'double-reg)
- :offset (tn-offset reg)))
- (reg2 (make-random-tn :kind :normal
- :sc (sc-or-lose 'double-reg)
- :offset (+ 2 (tn-offset reg)))))
- (cond ((integerp offset)
- (inst stdf reg0 base offset)
- (inst stdf reg2 base (+ offset (* 2 n-word-bytes))))
- (t
- (inst stdf reg0 base offset)
- (inst add offset (* 2 n-word-bytes))
- (inst stdf reg2 base offset)
- (when restore-offset
- (inst sub offset (* 2 n-word-bytes)))))))
+ (cond
+ ((member :sparc-v9 *backend-subfeatures*)
+ (inst stqf reg base offset))
+ (t
+ (let ((reg0 (make-random-tn :kind :normal
+ :sc (sc-or-lose 'double-reg)
+ :offset (tn-offset reg)))
+ (reg2 (make-random-tn :kind :normal
+ :sc (sc-or-lose 'double-reg)
+ :offset (+ 2 (tn-offset reg)))))
+ (cond ((integerp offset)
+ (inst stdf reg0 base offset)
+ (inst stdf reg2 base (+ offset (* 2 n-word-bytes))))
+ (t
+ (inst stdf reg0 base offset)
+ (inst add offset (* 2 n-word-bytes))
+ (inst stdf reg2 base offset)
+ (when restore-offset
+ (inst sub offset (* 2 n-word-bytes)))))))))
#!+long-float
(define-move-fun (store-long 2) (vop x y)
;;; Exploit the V9 double-float move instruction. This is conditional
;;; on the :sparc-v9 feature.
(defun move-double-reg (dst src)
- #!+:sparc-v9
- (inst fmovd dst src)
- #!-:sparc-v9
- (dotimes (i 2)
- (let ((dst (make-random-tn :kind :normal
- :sc (sc-or-lose 'single-reg)
- :offset (+ i (tn-offset dst))))
- (src (make-random-tn :kind :normal
- :sc (sc-or-lose 'single-reg)
- :offset (+ i (tn-offset src)))))
- (inst fmovs dst src))))
+ (cond
+ ((member :sparc-v9 *backend-subfeatures*)
+ (inst fmovd dst src))
+ (t
+ (dotimes (i 2)
+ (let ((dst (make-random-tn :kind :normal
+ :sc (sc-or-lose 'single-reg)
+ :offset (+ i (tn-offset dst))))
+ (src (make-random-tn :kind :normal
+ :sc (sc-or-lose 'single-reg)
+ :offset (+ i (tn-offset src)))))
+ (inst fmovs dst src))))))
;;; Exploit the V9 long-float move instruction. This is conditional
;;; on the :sparc-v9 feature.
(defun move-long-reg (dst src)
- #!+:sparc-v9
- (inst fmovq dst src)
- #!-:sparc-v9
- (dotimes (i 4)
- (let ((dst (make-random-tn :kind :normal
- :sc (sc-or-lose 'single-reg)
- :offset (+ i (tn-offset dst))))
- (src (make-random-tn :kind :normal
- :sc (sc-or-lose 'single-reg)
- :offset (+ i (tn-offset src)))))
- (inst fmovs dst src))))
+ (cond
+ ((member :sparc-v9 *backend-subfeatures*)
+ (inst fmovq dst src)
+ (t
+ (dotimes (i 4)
+ (let ((dst (make-random-tn :kind :normal
+ :sc (sc-or-lose 'single-reg)
+ :offset (+ i (tn-offset dst))))
+ (src (make-random-tn :kind :normal
+ :sc (sc-or-lose 'single-reg)
+ :offset (+ i (tn-offset src)))))
+ (inst fmovs dst src)))))))
(macrolet ((frob (vop sc format)
`(progn
(frob %negate/single-float fnegs %negate single-reg single-float))
(defun negate-double-reg (dst src)
- #!+:sparc-v9
- (inst fnegd dst src)
- #!-:sparc-v9
- ;; Negate the MS part of the numbers, then copy over the rest
- ;; of the bits.
- (inst fnegs dst src)
- (let ((dst-odd (make-random-tn :kind :normal
- :sc (sc-or-lose 'single-reg)
- :offset (+ 1 (tn-offset dst))))
- (src-odd (make-random-tn :kind :normal
- :sc (sc-or-lose 'single-reg)
- :offset (+ 1 (tn-offset src)))))
- (inst fmovs dst-odd src-odd)))
+ (cond
+ ((member :sparc-v9 *backend-subfeatures*)
+ (inst fnegd dst src))
+ (t
+ ;; Negate the MS part of the numbers, then copy over the rest
+ ;; of the bits.
+ (inst fnegs dst src)
+ (let ((dst-odd (make-random-tn :kind :normal
+ :sc (sc-or-lose 'single-reg)
+ :offset (+ 1 (tn-offset dst))))
+ (src-odd (make-random-tn :kind :normal
+ :sc (sc-or-lose 'single-reg)
+ :offset (+ 1 (tn-offset src)))))
+ (inst fmovs dst-odd src-odd)))))
(defun abs-double-reg (dst src)
- #!+:sparc-v9
- (inst fabsd dst src)
- #!-:sparc-v9
- ;; Abs the MS part of the numbers, then copy over the rest
- ;; of the bits.
- (inst fabss dst src)
- (let ((dst-2 (make-random-tn :kind :normal
- :sc (sc-or-lose 'single-reg)
- :offset (+ 1 (tn-offset dst))))
- (src-2 (make-random-tn :kind :normal
- :sc (sc-or-lose 'single-reg)
- :offset (+ 1 (tn-offset src)))))
- (inst fmovs dst-2 src-2)))
+ (cond
+ ((member :sparc-v9 *backend-subfeatures*)
+ (inst fabsd dst src))
+ (t
+ ;; Abs the MS part of the numbers, then copy over the rest
+ ;; of the bits.
+ (inst fabss dst src)
+ (let ((dst-2 (make-random-tn :kind :normal
+ :sc (sc-or-lose 'single-reg)
+ :offset (+ 1 (tn-offset dst))))
+ (src-2 (make-random-tn :kind :normal
+ :sc (sc-or-lose 'single-reg)
+ :offset (+ 1 (tn-offset src)))))
+ (inst fmovs dst-2 src-2)))))
(define-vop (abs/double-float)
(:args (x :scs (double-reg)))
(:save-p :compute-only)
(:generator 1
(note-this-location vop :internal-error)
- #!+:sparc-v9
- (inst fabsq y x)
- #!-:sparc-v9
- (inst fabss y x)
- (dotimes (i 3)
- (let ((y-odd (make-random-tn
- :kind :normal
- :sc (sc-or-lose 'single-reg)
- :offset (+ i 1 (tn-offset y))))
- (x-odd (make-random-tn
- :kind :normal
- :sc (sc-or-lose 'single-reg)
- :offset (+ i 1 (tn-offset x)))))
- (inst fmovs y-odd x-odd)))))
+ (cond
+ ((member :sparc-v9 *backend-subfeatures*)
+ (inst fabsq y x))
+ (t
+ (inst fabss y x)
+ (dotimes (i 3)
+ (let ((y-odd (make-random-tn
+ :kind :normal
+ :sc (sc-or-lose 'single-reg)
+ :offset (+ i 1 (tn-offset y))))
+ (x-odd (make-random-tn
+ :kind :normal
+ :sc (sc-or-lose 'single-reg)
+ :offset (+ i 1 (tn-offset x)))))
+ (inst fmovs y-odd x-odd)))))))
#!+long-float
(define-vop (%negate/long-float)
(:save-p :compute-only)
(:generator 1
(note-this-location vop :internal-error)
- #!+:sparc-v9
- (inst fnegq y x)
- #!-:sparc-v9
- (inst fnegs y x)
- (dotimes (i 3)
- (let ((y-odd (make-random-tn
- :kind :normal
- :sc (sc-or-lose 'single-reg)
- :offset (+ i 1 (tn-offset y))))
- (x-odd (make-random-tn
- :kind :normal
- :sc (sc-or-lose 'single-reg)
- :offset (+ i 1 (tn-offset x)))))
- (inst fmovs y-odd x-odd)))))
+ (cond
+ ((member :sparc-v9 *backend-subfeatures*)
+ (inst fnegq y x))
+ (t
+ (inst fnegs y x)
+ (dotimes (i 3)
+ (let ((y-odd (make-random-tn
+ :kind :normal
+ :sc (sc-or-lose 'single-reg)
+ :offset (+ i 1 (tn-offset y))))
+ (x-odd (make-random-tn
+ :kind :normal
+ :sc (sc-or-lose 'single-reg)
+ :offset (+ i 1 (tn-offset x)))))
+ (inst fmovs y-odd x-odd)))))))
\f
;;;; Comparison:
(:long (inst fcmpq x y)))
;; The SPARC V9 doesn't need an instruction between a
;; floating-point compare and a floating-point branch.
- #!-:sparc-v9 (inst nop)
+ (unless (member :sparc-v9 *backend-subfeatures*)
+ (inst nop))
(inst fb (if not-p nope yep) target)
(inst nop)))
(:results (y :scs (double-reg)))
(:translate %sqrt)
(:policy :fast-safe)
- (:guard #!+(or :sparc-v7 :sparc-v8 :sparc-v9) t
- #!-(or :sparc-v7 :sparc-v8 :sparc-v9) nil)
+ (:guard (or (member :sparc-v7 *backend-subfeatures*)
+ (member :sparc-v8 *backend-subfeatures*)
+ (member :sparc-v9 *backend-subfeatures*)))
(:arg-types double-float)
(:result-types double-float)
(:note "inline float arithmetic")
(,@fabs ratio yr)
(,@fabs den yi)
(inst ,fcmp ratio den)
- #!-:sparc-v9 (inst nop)
+ (unless (member :sparc-v9 *backend-subfeatures*)
+ (inst nop))
(inst fb :ge bigger)
(inst nop)
;; The case of |yi| <= |yr|
(,@fabs ratio yr)
(,@fabs den yi)
(inst ,fcmp ratio den)
- #!-:sparc-v9 (inst nop)
+ (unless (member :sparc-v9 *backend-subfeatures*)
+ (inst nop))
(inst fb :ge bigger)
(inst nop)
;; The case of |yi| <= |yr|
(,@fabs ratio yr)
(,@fabs den yi)
(inst ,fcmp ratio den)
- #!-:sparc-v9 (inst nop)
+ (unless (member :sparc-v9 *backend-subfeatures*)
+ (inst nop))
(inst fb :ge bigger)
(inst nop)
;; The case of |yi| <= |yr|
(:note "inline complex float comparison")
(:vop-var vop)
(:save-p :compute-only)
- (:guard #!-:sparc-v9 t #!+:sparc-v9 nil)
(:generator 6
(note-this-location vop :internal-error)
(let ((xr (,real-part x))
(:vop-var vop)
(:save-p :compute-only)
(:temporary (:sc descriptor-reg) true)
- (:guard #!+:sparc-v9 t #!-:sparc-v9 nil)
- (:generator 6
+ (:guard (member :sparc-v9 *backend-subfeatures*))
+ (:generator 5
(note-this-location vop :internal-error)
(let ((xr (,real-part x))
(xi (,imag-part x))
) ; end progn complex-fp-vops
-#!+sparc-v9
+
+;;; XXX FIXME:
+;;;
+;;; The stuff below looks good, but we already have transforms for max
+;;; and min. How should we arrange that?
+#+nil
(progn
;; Vops to take advantage of the conditional move instruction
single-float double-float)
(movable foldable flushable))
-;; We need these definitions for byte-compiled code
+;; We need these definitions for byte-compiled code
+;;
+;; Well, we (SBCL) probably don't, having deleted the byte
+;; compiler. Let's see what happens if we comment out these
+;; definitions:
+#+nil
(defun %%min (x y)
(declare (type (or (unsigned-byte 32) (signed-byte 32)
single-float double-float) x y))
(if (< x y)
x y))
+#+nil
(defun %%max (x y)
(declare (type (or (unsigned-byte 32) (signed-byte 32)
single-float double-float) x y))
(if (> x y)
x y))
-
+#+nil
(macrolet
((frob (name sc-type type compare cmov cost cc max min note)
(let ((vop-name (symbolicate name "-" type "=>" type))
(:policy :fast-safe)
(:note ,note)
(:translate ,trans-name)
- (:guard #!+:sparc-v9 t #!-:sparc-v9 nil)
+ (:guard (member :sparc-v9 *backend-subfeatures*))
(:generator ,cost
(inst ,compare x y)
(cond ((location= r x)
) ; PROGN
+#+nil
(in-package "SB!C")
;;; FIXME
-#| #!+sparc-v9 |#
#+nil
(progn
;;; The sparc-v9 architecture has conditional move instructions that
;;; can be used. This should be faster than using the obvious if
;;; expression since we don't have to do branches.
-(def-source-transform min (&rest args)
- (case (length args)
- ((0 2) (values nil t))
- (1 `(values ,(first args)))
- (t (sb!c::associate-arguments 'min (first args) (rest args)))))
-
-(def-source-transform max (&rest args)
- (case (length args)
- ((0 2) (values nil t))
- (1 `(values ,(first args)))
- (t (sb!c::associate-arguments 'max (first args) (rest args)))))
+(define-source-transform min (&rest args)
+ (if (member :sparc-v9 sb!vm:*backend-subfeatures*)
+ (case (length args)
+ ((0 2) (values nil t))
+ (1 `(values ,(first args)))
+ (t (sb!c::associate-arguments 'min (first args) (rest args))))
+ (values nil t)))
+
+(define-source-transform max (&rest args)
+ (if (member :sparc-v9 sb!vm:*backend-subfeatures*)
+ (case (length args)
+ ((0 2) (values nil t))
+ (1 `(values ,(first args)))
+ (t (sb!c::associate-arguments 'max (first args) (rest args))))
+ (values nil t)))
;; Derive the types of max and min
(defoptimizer (max derive-type) ((x y))
(error "~S isn't a floating-point register." tn))
(let ((offset (tn-offset tn)))
(cond ((> offset 31)
- ;; Use the sparc v9 double float register encoding.
- #!-:sparc-v9 (error ":sparc-v9 should be on the target features")
- ;; (assert (backend-featurep :sparc-v9))
+ (assert (member :sparc-v9 *backend-subfeatures*))
;; No single register encoding greater than reg 31.
(assert (zerop (mod offset 2)))
;; Upper bit of the register number is encoded in the low bit.
(sb!disassem:define-arg-type relative-label
:sign-extend t
:use-label (lambda (value dstate)
- (declare (type (signed-byte 13) value)
- (type sb!disassem:disassem-state dstate))
- (+ (ash value 2) (sb!disassem:dstate-cur-addr dstate))))
+ (declare (type (signed-byte 22) value)
+ (type sb!disassem:disassem-state dstate))
+ (+ (ash value 2) (sb!disassem:dstate-cur-addr dstate))))
(defconstant-eqx branch-conditions
'(:f :eq :le :lt :leu :ltu :n :vs :t :ne :gt :ge :gtu :geu :p :vc)
(error "Offset of BA must be positive"))
offset)))))
-#!+sparc-v9
(defun emit-relative-branch-integer (segment a op2 cond-or-target target &optional (cc :icc) (pred :pt))
(declare (type integer-condition-register cc))
+ (assert (member :sparc-v9 *backend-subfeatures*))
(emit-back-patch segment 4
(lambda (segment posn)
(unless target
(error "Offset of BA must be positive"))
offset)))))
-#!+sparc-v9
(defun emit-relative-branch-fp (segment a op2 cond-or-target target &optional (cc :fcc0) (pred :pt))
+ (assert (member :sparc-v9 *backend-subfeatures*))
(emit-back-patch segment 4
(lambda (segment posn)
(unless target
;; just get translated to the branch with prediction
;; instructions. However, the disassembler uses the correct V9
;; mnemonic.
-#!-sparc-v9
-(define-instruction b (segment cond-or-target &optional target)
- (:declare (type (or label branch-condition) cond-or-target)
- (type (or label null) target))
+(define-instruction b (segment cond-or-target &rest args)
+ (:declare (type (or label branch-condition) cond-or-target))
(:printer format-2-branch ((op #b00) (op2 #b010)))
(:attributes branch)
(:dependencies (reads :psr))
(:delay 1)
(:emitter
- (emit-relative-branch segment 0 #b010 cond-or-target target)))
-
-#!+sparc-v9
-(define-instruction b (segment cond-or-target &optional target pred cc)
+ (cond
+ ((member :sparc-v9 *backend-subfeatures*)
+ (destructuring-bind (&optional target pred cc) args
+ (declare (type (or label null) target))
+ (emit-relative-branch-integer segment 0 #b001 cond-or-target target (or cc :icc) (or pred :pt))))
+ (t
+ (destructuring-bind (&optional target) args
+ (declare (type (or label null) target))
+ (emit-relative-branch segment 0 #b010 cond-or-target target))))))
+
+(define-instruction bp (segment cond-or-target &optional target pred cc)
(:declare (type (or label branch-condition) cond-or-target)
(type (or label null) target))
(:printer format-2-branch-pred ((op #b00) (op2 #b001))
(:emitter
(emit-relative-branch-integer segment 0 #b001 cond-or-target target (or cc :icc) (or pred :pt))))
-#!-sparc-v9
-(define-instruction ba (segment cond-or-target &optional target)
- (:declare (type (or label branch-condition) cond-or-target)
- (type (or label null) target))
+(define-instruction ba (segment cond-or-target &rest args)
+ (:declare (type (or label branch-condition) cond-or-target))
(:printer format-2-branch ((op #b00) (op2 #b010) (a 1))
nil
:print-name 'b)
(:dependencies (reads :psr))
(:delay 0)
(:emitter
- (emit-relative-branch segment 1 #b010 cond-or-target target)))
-
-#!+sparc-v9
-(define-instruction ba (segment cond-or-target &optional target pred cc)
+ (cond
+ ((member :sparc-v9 *backend-subfeatures*)
+ (destructuring-bind (&optional target pred cc) args
+ (declare (type (or label null) target))
+ (emit-relative-branch-integer segment 1 #b001 cond-or-target target (or cc :icc) (or pred :pt))))
+ (t
+ (destructuring-bind (&optional target) args
+ (declare (type (or label null) target))
+ (emit-relative-branch segment 1 #b010 cond-or-target target))))))
+
+(define-instruction bpa (segment cond-or-target &optional target pred cc)
(:declare (type (or label branch-condition) cond-or-target)
(type (or label null) target))
(:printer format-2-branch ((op #b00) (op2 #b001) (a 1))
;; Definition 2.4.1 says only trap numbers 16-31 are allowed for user
;; code. All other trap numbers have other uses. The restriction on
;; target will prevent us from using bad trap numbers by mistake.
-#!-sparc-v9
-(define-instruction t (segment condition target)
+
+(define-instruction t (segment condition target &optional cc)
(:declare (type branch-condition condition)
- ;; KLUDGE
+ ;; KLUDGE: see comments in vm.lisp regarding
+ ;; pseudo-atomic-trap.
#!-linux
(type (integer 16 31) target))
(:printer format-3-immed ((op #b10)
(:attributes branch)
(:dependencies (reads :psr))
(:delay 0)
- (:emitter (emit-format-3-immed segment #b10 (branch-condition condition)
- #b111010 0 1 target)))
-
-#!+sparc-v9
-(define-instruction t (segment condition target &optional (cc #!-sparc-64 :icc #!+sparc-64 :xcc))
+ (:emitter
+ (cond
+ ((member :sparc-v9 *backend-subfeatures*)
+ (unless cc
+ (setf cc :icc))
+ (emit-format-4-trap segment
+ #b10
+ (branch-condition condition)
+ #b111010 0 1
+ (integer-condition cc)
+ target))
+ (t
+ (assert (null cc))
+ (emit-format-3-immed segment #b10 (branch-condition condition)
+ #b111010 0 1 target)))))
+
+;;; KLUDGE: we leave this commented out, as these two (T and TCC)
+;;; operations are actually indistinguishable from their bitfields,
+;;; breaking the disassembler if these are left in. The printer isn't
+;;; terribly smart, but the emitted code is right. - CSR, 2002-08-04
+#+nil
+(define-instruction tcc (segment condition target &optional (cc #!-sparc-64 :icc #!+sparc-64 :xcc))
(:declare (type branch-condition condition)
+ ;; KLUDGE: see above.
#!-linux
(type (integer 16 31) target)
(type integer-condition-register cc))
;; Same as for the branch instructions. On the Sparc V9, we will use
;; the FP branch with prediction instructions instead.
-#!-sparc-v9
-(define-instruction fb (segment condition target)
+
+(define-instruction fb (segment condition target &rest args)
(:declare (type fp-branch-condition condition) (type label target))
(:printer format-2-branch ((op #B00)
(cond nil :type 'branch-fp-condition)
(:dependencies (reads :fsr))
(:delay 1)
(:emitter
- (emit-relative-branch segment 0 #b110 condition target t)))
-
-#!+sparc-v9
-(define-instruction fb (segment condition target &optional fcc pred)
+ (cond
+ ((member :sparc-v9 *backend-subfeatures*)
+ (destructuring-bind (&optional fcc pred) args
+ (emit-relative-branch-fp segment 0 #b101 condition target (or fcc :fcc0) (or pred :pt))))
+ (t
+ (assert (null args))
+ (emit-relative-branch segment 0 #b110 condition target t)))))
+
+(define-instruction fbp (segment condition target &optional fcc pred)
(:declare (type fp-branch-condition condition) (type label target))
(:printer format-2-fp-branch-pred ((op #b00) (op2 #b101))
fp-branch-pred-printer
(reads src2)
(writes :fsr))
;; The Sparc V9 doesn't need a delay after a FP compare.
- (:delay #!-sparc-v9 1 #!+sparc-v9 0)
+ ;;
+ ;; KLUDGE FIXME YAARGH -- how to express that? I guess for now we
+ ;; do the worst case, and hope to fix it.
+ ;; (:delay #-sparc-v9 1 #+sparc-v9 0)
+ (:delay 1)
(:emitter
(emit-format-3-fpop2 segment #b10
(or (position fcc '(:fcc0 :fcc1 :fcc2 :fcc3))
(when fixnump
`((inst andcc zero-tn ,reg fixnum-tag-mask)
,(if (or lowtags hdrs)
- `(inst b :eq ,(if not-p not-target target)
- #!+sparc-v9 ,(if not-p :pn :pt))
- `(inst b ,(if not-p :ne :eq) ,target
- #!+sparc-v9 ,(if not-p :pn :pt)))))
+ `(if (member :sparc-v9 *backend-subfeatures*)
+ (inst b :eq ,(if not-p not-target target) ,(if not-p :pn :pt))
+ (inst b :eq ,(if not-p not-target target)))
+ `(if (member :sparc-v9 *backend-subfeatures*)
+ (inst b ,(if not-p :ne :eq) ,target ,(if not-p :pn :pt))
+ (inst b ,(if not-p :ne :eq) ,target)))))
(when (or lowtags hdrs)
`((inst and ,temp ,reg lowtag-mask)))
(when lowtags
(1- lowtag-limit) lowtags)))
(when hdrs
`((inst cmp ,temp ,lowtag)
- (inst b :ne ,(if not-p target not-target)
- #!+sparc-v9 ,(if not-p :pn :pt))
+ (if (member :sparc-v9 *backend-subfeatures*)
+ (inst b :ne ,(if not-p target not-target) ,(if not-p :pn :pt))
+ (inst b :ne ,(if not-p target not-target)))
(inst nop)
(load-type ,temp ,reg (- ,lowtag))
,@(gen-other-immediate-test temp target not-target not-p hdrs))))))
(:arg-types tagged-num)
(:note "fixnum untagging")
(:generator 1
- (inst sra y x fixnum-tag-bits)))
+ (inst sra y x n-fixnum-tag-bits)))
(define-move-vop move-to-word/fixnum :move
(any-reg descriptor-reg) (signed-reg unsigned-reg))
(let ((done (gen-label)))
(inst andcc temp x fixnum-tag-mask)
(inst b :eq done)
- (inst sra y x fixnum-tag-bits)
+ (inst sra y x n-fixnum-tag-bits)
(loadw y x bignum-digits-offset other-pointer-lowtag)
(:result-types tagged-num)
(:note "fixnum tagging")
(:generator 1
- (inst sll y x fixnum-tag-bits)))
+ (inst sll y x n-fixnum-tag-bits)))
(define-move-vop move-from-word/fixnum :move
(signed-reg unsigned-reg) (any-reg descriptor-reg))
(move x arg)
(let ((fixnum (gen-label))
(done (gen-label)))
- (inst sra temp x positive-fixnum-bits)
+ (inst sra temp x n-positive-fixnum-bits)
(inst cmp temp)
(inst b :eq fixnum)
(inst orncc temp zero-tn temp)
(inst b :eq done)
- (inst sll y x fixnum-tag-bits)
+ (inst sll y x n-fixnum-tag-bits)
(with-fixed-allocation
(y temp bignum-widetag (1+ bignum-digits-offset))
(inst nop)
(emit-label fixnum)
- (inst sll y x fixnum-tag-bits)
+ (inst sll y x n-fixnum-tag-bits)
(emit-label done))))
(define-move-vop move-from-signed :move
(let ((done (gen-label))
(one-word (gen-label))
(initial-alloc (pad-data-block (1+ bignum-digits-offset))))
- (inst sra temp x positive-fixnum-bits)
+ (inst sra temp x n-positive-fixnum-bits)
(inst cmp temp)
(inst b :eq done)
- (inst sll y x fixnum-tag-bits)
+ (inst sll y x n-fixnum-tag-bits)
;; We always allocate 2 words even if we don't need it. (The
;; copying GC will take care of freeing the unused extra word.)
#!+sb-doc
"Number of bytes in a word.")
-;;; FIXME: The following three should probably be rationalized or at
-;;; least prefixed with n- where applicable
-(defconstant fixnum-tag-bits (1- n-lowtag-bits)
+(defconstant n-fixnum-tag-bits (1- n-lowtag-bits)
#!+sb-doc
"Number of tag bits used for a fixnum")
-(defconstant fixnum-tag-mask (1- (ash 1 fixnum-tag-bits))
+(defconstant fixnum-tag-mask (1- (ash 1 n-fixnum-tag-bits))
#!+sb-doc
"Mask to get the fixnum tag")
-(defconstant positive-fixnum-bits (- n-word-bits fixnum-tag-bits 1)
+(defconstant n-positive-fixnum-bits (- n-word-bits n-fixnum-tag-bits 1)
#!+sb-doc
"Maximum number of bits in a positive fixnum")
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.2.7"
+"0.7.2.8"
projects / sbcl.git / commitdiff