(: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
;; 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)
(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
;;; expression since we don't have to do branches.
(define-source-transform min (&rest args)
- (if (member :sparc-v9 sb!vm:*backend-subfeatures*)
+ (if (member :sparc-v9 *backend-subfeatures*)
(case (length args)
((0 2) (values nil t))
(1 `(values ,(first args)))
(values nil t)))
(define-source-transform max (&rest args)
- (if (member :sparc-v9 sb!vm:*backend-subfeatures*)
+ (if (member :sparc-v9 *backend-subfeatures*)
(case (length args)
((0 2) (values nil t))
(1 `(values ,(first args)))
(lvar-type y)))))))
(defoptimizer (min derive-type) ((x y))
- (multiple-value-bind (definitely-< definitely->=)
- (ir1-transform-<-helper x y)
- (cond (definitely-<
+ (multiple-value-bind (definitely-> definitely-<=)
+ (ir1-transform-<-helper y x)
+ (cond (definitely-<=
(lvar-type x))
- (definitely->=
+ (definitely->
(lvar-type y))
(t
(make-canonical-union-type (list (lvar-type x)
(deftransform max ((x y) (number number) *)
(let ((x-type (lvar-type x))
(y-type (lvar-type y))
- (signed (specifier-type '(signed-byte #.sb!vm:n-word-bits)))
- (unsigned (specifier-type '(unsigned-byte #.sb!vm:n-word-bits)))
+ (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) *)
(let ((x-type (lvar-type x))
(y-type (lvar-type y))
- (signed (specifier-type '(signed-byte #.sb!vm:n-word-bits)))
- (unsigned (specifier-type '(unsigned-byte #.sb!vm:n-word-bits)))
+ (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