;;; 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
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:variant-vars format size type data)
(:generator 13
- (with-fixed-allocation (y ndescr type size))
- (ecase format
- (:single
- (inst stf x y (- (* data n-word-bytes) other-pointer-lowtag)))
- (:double
- (inst stdf x y (- (* data n-word-bytes) other-pointer-lowtag)))
- (:long
- (store-long-reg x y (- (* data n-word-bytes)
- other-pointer-lowtag))))))
+ (with-fixed-allocation (y ndescr type size)
+ (ecase format
+ (:single
+ (inst stf x y (- (* data n-word-bytes) other-pointer-lowtag)))
+ (:double
+ (inst stdf x y (- (* data n-word-bytes) other-pointer-lowtag)))
+ (:long
+ (store-long-reg x y (- (* data n-word-bytes)
+ other-pointer-lowtag)))))))
(macrolet ((frob (name sc &rest args)
`(progn
(:note "complex single float to pointer coercion")
(:generator 13
(with-fixed-allocation (y ndescr complex-single-float-widetag
- complex-single-float-size))
- (let ((real-tn (complex-single-reg-real-tn x)))
- (inst stf real-tn y (- (* complex-single-float-real-slot
- n-word-bytes)
- other-pointer-lowtag)))
- (let ((imag-tn (complex-single-reg-imag-tn x)))
- (inst stf imag-tn y (- (* complex-single-float-imag-slot
- n-word-bytes)
- other-pointer-lowtag)))))
+ complex-single-float-size)
+ (let ((real-tn (complex-single-reg-real-tn x)))
+ (inst stf real-tn y (- (* complex-single-float-real-slot
+ n-word-bytes)
+ other-pointer-lowtag)))
+ (let ((imag-tn (complex-single-reg-imag-tn x)))
+ (inst stf imag-tn y (- (* complex-single-float-imag-slot
+ n-word-bytes)
+ other-pointer-lowtag))))))
;;;
(define-move-vop move-from-complex-single :move
(complex-single-reg) (descriptor-reg))
(:note "complex double float to pointer coercion")
(:generator 13
(with-fixed-allocation (y ndescr complex-double-float-widetag
- complex-double-float-size))
- (let ((real-tn (complex-double-reg-real-tn x)))
- (inst stdf real-tn y (- (* complex-double-float-real-slot
- n-word-bytes)
- other-pointer-lowtag)))
- (let ((imag-tn (complex-double-reg-imag-tn x)))
- (inst stdf imag-tn y (- (* complex-double-float-imag-slot
- n-word-bytes)
- other-pointer-lowtag)))))
+ complex-double-float-size)
+ (let ((real-tn (complex-double-reg-real-tn x)))
+ (inst stdf real-tn y (- (* complex-double-float-real-slot
+ n-word-bytes)
+ other-pointer-lowtag)))
+ (let ((imag-tn (complex-double-reg-imag-tn x)))
+ (inst stdf imag-tn y (- (* complex-double-float-imag-slot
+ n-word-bytes)
+ other-pointer-lowtag))))))
;;;
(define-move-vop move-from-complex-double :move
(complex-double-reg) (descriptor-reg))
(:note "complex long float to pointer coercion")
(:generator 13
(with-fixed-allocation (y ndescr complex-long-float-widetag
- complex-long-float-size))
- (let ((real-tn (complex-long-reg-real-tn x)))
- (store-long-reg real-tn y (- (* complex-long-float-real-slot
- n-word-bytes)
- other-pointer-lowtag)))
- (let ((imag-tn (complex-long-reg-imag-tn x)))
- (store-long-reg imag-tn y (- (* complex-long-float-imag-slot
- n-word-bytes)
- other-pointer-lowtag)))))
+ complex-long-float-size)
+ (let ((real-tn (complex-long-reg-real-tn x)))
+ (store-long-reg real-tn y (- (* complex-long-float-real-slot
+ n-word-bytes)
+ other-pointer-lowtag)))
+ (let ((imag-tn (complex-long-reg-imag-tn x)))
+ (store-long-reg imag-tn y (- (* complex-long-float-imag-slot
+ n-word-bytes)
+ other-pointer-lowtag))))))
;;;
#!+long-float
(define-move-vop move-from-complex-long :move
(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)))
;; The desired FP mode data is in the least significant 32
;; bits, which is stored at the next higher word in memory.
(loadw res nfp (+ offset 4))
- ;; Is this nop needed? (toy@rtp.ericsson.se)
+ ;; Is this nop needed? -- rtoy
(inst nop))))
(define-vop (set-floating-point-modes)
;; high 32 bits of the FSR, which contain the additional
;; %fcc's on the sparc V9. If not, we don't need this, but we
;; do need to make sure that the unused bits are written as
- ;; zeroes, according the the V9 architecture manual.
+ ;; zeroes, according the V9 architecture manual.
(inst sra new 0)
(inst srlx my-fsr 32)
(inst sllx my-fsr 32)
(: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)
+ (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)
+ (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 *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 *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))
(multiple-value-bind (definitely-< definitely->=)
(ir1-transform-<-helper x y)
(cond (definitely-<
- (continuation-type y))
+ (lvar-type y))
(definitely->=
- (continuation-type x))
+ (lvar-type x))
(t
- (make-canonical-union-type (list (continuation-type x)
- (continuation-type y)))))))
+ (make-canonical-union-type (list (lvar-type x)
+ (lvar-type y)))))))
(defoptimizer (min derive-type) ((x y))
- (multiple-value-bind (definitely-< definitely->=)
- (ir1-transform-<-helper x y)
- (cond (definitely-<
- (continuation-type x))
- (definitely->=
- (continuation-type y))
+ (multiple-value-bind (definitely-> definitely-<=)
+ (ir1-transform-<-helper y x)
+ (cond (definitely-<=
+ (lvar-type x))
+ (definitely->
+ (lvar-type y))
(t
- (make-canonical-union-type (list (continuation-type x)
- (continuation-type y)))))))
-
-(deftransform max ((x y) (number number) * :when :both)
- (let ((x-type (continuation-type x))
- (y-type (continuation-type y))
- (signed (specifier-type '(signed-byte #.sb!vm:n-word-bits)))
- (unsigned (specifier-type '(unsigned-byte #.sb!vm:n-word-bits)))
+ (make-canonical-union-type (list (lvar-type x)
+ (lvar-type y)))))))
+
+(deftransform max ((x y) (number number) *)
+ (let ((x-type (lvar-type x))
+ (y-type (lvar-type y))
+ (signed (specifier-type '(signed-byte #.n-word-bits)))
+ (unsigned (specifier-type '(unsigned-byte #.n-word-bits)))
(d-float (specifier-type 'double-float))
(s-float (specifier-type 'single-float)))
;; Use %%max if both args are good types of the same type. As a
(arg2 (gensym)))
`(let ((,arg1 x)
(,arg2 y))
- (if (> ,arg1 ,arg2)
+ (if (>= ,arg1 ,arg2)
,arg1 ,arg2)))))))
-(deftransform min ((x y) (real real) * :when :both)
- (let ((x-type (continuation-type x))
- (y-type (continuation-type y))
- (signed (specifier-type '(signed-byte #.sb!vm:n-word-bits)))
- (unsigned (specifier-type '(unsigned-byte #.sb!vm:n-word-bits)))
+(deftransform min ((x y) (real real) *)
+ (let ((x-type (lvar-type x))
+ (y-type (lvar-type y))
+ (signed (specifier-type '(signed-byte #.n-word-bits)))
+ (unsigned (specifier-type '(unsigned-byte #.n-word-bits)))
(d-float (specifier-type 'double-float))
(s-float (specifier-type 'single-float)))
(cond ((and (csubtypep x-type signed)
(arg2 (gensym)))
`(let ((,arg1 x)
(,arg2 y))
- (if (< ,arg1 ,arg2)
+ (if (<= ,arg1 ,arg2)
,arg1 ,arg2)))))))
) ; PROGN
projects / sbcl.git / blobdiff