\f
;;;; float move functions
-(define-move-function (load-fp-zero 1) (vop x y)
+(define-move-fun (load-fp-zero 1) (vop x y)
((fp-single-zero) (single-reg)
(fp-double-zero) (double-reg))
(inst fmove x y))
-(define-move-function (load-single 1) (vop x y)
+(define-move-fun (load-single 1) (vop x y)
((single-stack) (single-reg))
- (inst lds y (* (tn-offset x) word-bytes) (current-nfp-tn vop)))
+ (inst lds y (* (tn-offset x) n-word-bytes) (current-nfp-tn vop)))
-(define-move-function (store-single 1) (vop x y)
+(define-move-fun (store-single 1) (vop x y)
((single-reg) (single-stack))
- (inst sts x (* (tn-offset y) word-bytes) (current-nfp-tn vop)))
+ (inst sts x (* (tn-offset y) n-word-bytes) (current-nfp-tn vop)))
-
-(define-move-function (load-double 2) (vop x y)
+(define-move-fun (load-double 2) (vop x y)
((double-stack) (double-reg))
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset x) word-bytes)))
+ (offset (* (tn-offset x) n-word-bytes)))
(inst ldt y offset nfp)))
-(define-move-function (store-double 2) (vop x y)
+(define-move-fun (store-double 2) (vop x y)
((double-reg) (double-stack))
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset y) word-bytes)))
+ (offset (* (tn-offset y) n-word-bytes)))
(inst stt x offset nfp)))
\f
;;;; float move VOPs
(:generator 13
(with-fixed-allocation (y ndescr type size)
(if double-p
- (inst stt x (- (* data word-bytes) other-pointer-type) y)
- (inst sts x (- (* data word-bytes) other-pointer-type) y)))))
+ (inst stt x (- (* data n-word-bytes) other-pointer-lowtag) y)
+ (inst sts x (- (* data n-word-bytes) other-pointer-lowtag) y)))))
(macrolet ((frob (name sc &rest args)
`(progn
(:variant ,@args))
(define-move-vop ,name :move (,sc) (descriptor-reg)))))
(frob move-from-single single-reg
- nil single-float-size single-float-type single-float-value-slot)
+ nil single-float-size single-float-widetag single-float-value-slot)
(frob move-from-double double-reg
- t double-float-size double-float-type double-float-value-slot))
+ t double-float-size double-float-widetag double-float-value-slot))
(macrolet ((frob (name sc double-p value)
`(progn
(:note "pointer to float coercion")
(:generator 2
,@(if double-p
- `((inst ldt y (- (* ,value word-bytes)
- other-pointer-type)
+ `((inst ldt y (- (* ,value n-word-bytes)
+ other-pointer-lowtag)
x))
- `((inst lds y (- (* ,value word-bytes)
- other-pointer-type)
+ `((inst lds y (- (* ,value n-word-bytes)
+ other-pointer-lowtag)
x)))))
(define-move-vop ,name :move (descriptor-reg) (,sc)))))
(frob move-to-single single-reg nil single-float-value-slot)
(unless (location= x y)
(inst fmove x y)))
(,stack-sc
- (let ((offset (* (tn-offset y) word-bytes)))
+ (let ((offset (* (tn-offset y) n-word-bytes)))
,@(if double-p
'((inst stt x offset nfp))
'((inst sts x offset nfp))))))))
- (define-move-vop ,name :move-argument
+ (define-move-vop ,name :move-arg
(,sc descriptor-reg) (,sc)))))
- (frob move-single-float-argument single-reg single-stack nil)
- (frob move-double-float-argument double-reg double-stack t))
+ (frob move-single-float-arg single-reg single-stack nil)
+ (frob move-double-float-arg double-reg double-stack t))
\f
;;;; complex float move functions
:offset (1+ (tn-offset x))))
-(define-move-function (load-complex-single 2) (vop x y)
+(define-move-fun (load-complex-single 2) (vop x y)
((complex-single-stack) (complex-single-reg))
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset x) sb!vm:word-bytes)))
+ (offset (* (tn-offset x) n-word-bytes)))
(let ((real-tn (complex-single-reg-real-tn y)))
(inst lds real-tn offset nfp))
(let ((imag-tn (complex-single-reg-imag-tn y)))
- (inst lds imag-tn (+ offset sb!vm:word-bytes) nfp))))
+ (inst lds imag-tn (+ offset n-word-bytes) nfp))))
-(define-move-function (store-complex-single 2) (vop x y)
+(define-move-fun (store-complex-single 2) (vop x y)
((complex-single-reg) (complex-single-stack))
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset y) sb!vm:word-bytes)))
+ (offset (* (tn-offset y) n-word-bytes)))
(let ((real-tn (complex-single-reg-real-tn x)))
(inst sts real-tn offset nfp))
(let ((imag-tn (complex-single-reg-imag-tn x)))
- (inst sts imag-tn (+ offset sb!vm:word-bytes) nfp))))
+ (inst sts imag-tn (+ offset n-word-bytes) nfp))))
-(define-move-function (load-complex-double 4) (vop x y)
+(define-move-fun (load-complex-double 4) (vop x y)
((complex-double-stack) (complex-double-reg))
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset x) sb!vm:word-bytes)))
+ (offset (* (tn-offset x) n-word-bytes)))
(let ((real-tn (complex-double-reg-real-tn y)))
(inst ldt real-tn offset nfp))
(let ((imag-tn (complex-double-reg-imag-tn y)))
- (inst ldt imag-tn (+ offset (* 2 sb!vm:word-bytes)) nfp))))
+ (inst ldt imag-tn (+ offset (* 2 n-word-bytes)) nfp))))
-(define-move-function (store-complex-double 4) (vop x y)
+(define-move-fun (store-complex-double 4) (vop x y)
((complex-double-reg) (complex-double-stack))
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset y) sb!vm:word-bytes)))
+ (offset (* (tn-offset y) n-word-bytes)))
(let ((real-tn (complex-double-reg-real-tn x)))
(inst stt real-tn offset nfp))
(let ((imag-tn (complex-double-reg-imag-tn x)))
- (inst stt imag-tn (+ offset (* 2 sb!vm:word-bytes)) nfp))))
+ (inst stt imag-tn (+ offset (* 2 n-word-bytes)) nfp))))
;;;
;;; complex float register to register moves.
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:note "complex single float to pointer coercion")
(:generator 13
- (with-fixed-allocation (y ndescr sb!vm:complex-single-float-type
- sb!vm:complex-single-float-size)
+ (with-fixed-allocation (y ndescr complex-single-float-widetag
+ complex-single-float-size)
(let ((real-tn (complex-single-reg-real-tn x)))
- (inst sts real-tn (- (* sb!vm:complex-single-float-real-slot
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)
+ (inst sts real-tn (- (* complex-single-float-real-slot
+ n-word-bytes)
+ other-pointer-lowtag)
y))
(let ((imag-tn (complex-single-reg-imag-tn x)))
- (inst sts imag-tn (- (* sb!vm:complex-single-float-imag-slot
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)
+ (inst sts imag-tn (- (* complex-single-float-imag-slot
+ n-word-bytes)
+ other-pointer-lowtag)
y)))))
;;;
(define-move-vop move-from-complex-single :move
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:note "complex double float to pointer coercion")
(:generator 13
- (with-fixed-allocation (y ndescr sb!vm:complex-double-float-type
- sb!vm:complex-double-float-size)
+ (with-fixed-allocation (y ndescr complex-double-float-widetag
+ complex-double-float-size)
(let ((real-tn (complex-double-reg-real-tn x)))
- (inst stt real-tn (- (* sb!vm:complex-double-float-real-slot
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)
+ (inst stt real-tn (- (* complex-double-float-real-slot
+ n-word-bytes)
+ other-pointer-lowtag)
y))
(let ((imag-tn (complex-double-reg-imag-tn x)))
- (inst stt imag-tn (- (* sb!vm:complex-double-float-imag-slot
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)
+ (inst stt imag-tn (- (* complex-double-float-imag-slot
+ n-word-bytes)
+ other-pointer-lowtag)
y)))))
;;;
(define-move-vop move-from-complex-double :move
(:note "pointer to complex float coercion")
(:generator 2
(let ((real-tn (complex-single-reg-real-tn y)))
- (inst lds real-tn (- (* complex-single-float-real-slot sb!vm:word-bytes)
- sb!vm:other-pointer-type)
+ (inst lds real-tn (- (* complex-single-float-real-slot
+ n-word-bytes)
+ other-pointer-lowtag)
x))
(let ((imag-tn (complex-single-reg-imag-tn y)))
- (inst lds imag-tn (- (* complex-single-float-imag-slot sb!vm:word-bytes)
- sb!vm:other-pointer-type)
+ (inst lds imag-tn (- (* complex-single-float-imag-slot
+ n-word-bytes)
+ other-pointer-lowtag)
x))))
(define-move-vop move-to-complex-single :move
(descriptor-reg) (complex-single-reg))
(:note "pointer to complex float coercion")
(:generator 2
(let ((real-tn (complex-double-reg-real-tn y)))
- (inst ldt real-tn (- (* complex-double-float-real-slot sb!vm:word-bytes)
- sb!vm:other-pointer-type)
+ (inst ldt real-tn (- (* complex-double-float-real-slot
+ n-word-bytes)
+ other-pointer-lowtag)
x))
(let ((imag-tn (complex-double-reg-imag-tn y)))
- (inst ldt imag-tn (- (* complex-double-float-imag-slot sb!vm:word-bytes)
- sb!vm:other-pointer-type)
+ (inst ldt imag-tn (- (* complex-double-float-imag-slot
+ n-word-bytes)
+ other-pointer-lowtag)
x))))
(define-move-vop move-to-complex-double :move
(descriptor-reg) (complex-double-reg))
;;;
-;;; complex float move-argument vop
+;;; complex float MOVE-ARG VOP
;;;
-(define-vop (move-complex-single-float-argument)
+(define-vop (move-complex-single-float-arg)
(:args (x :scs (complex-single-reg) :target y)
(nfp :scs (any-reg) :load-if (not (sc-is y complex-single-reg))))
(:results (y))
(y-imag (complex-single-reg-imag-tn y)))
(inst fmove x-imag y-imag))))
(complex-single-stack
- (let ((offset (* (tn-offset y) sb!vm:word-bytes)))
+ (let ((offset (* (tn-offset y) n-word-bytes)))
(let ((real-tn (complex-single-reg-real-tn x)))
(inst sts real-tn offset nfp))
(let ((imag-tn (complex-single-reg-imag-tn x)))
- (inst sts imag-tn (+ offset word-bytes) nfp)))))))
-(define-move-vop move-complex-single-float-argument :move-argument
+ (inst sts imag-tn (+ offset n-word-bytes) nfp)))))))
+(define-move-vop move-complex-single-float-arg :move-arg
(complex-single-reg descriptor-reg) (complex-single-reg))
-(define-vop (move-complex-double-float-argument)
+(define-vop (move-complex-double-float-arg)
(:args (x :scs (complex-double-reg) :target y)
(nfp :scs (any-reg) :load-if (not (sc-is y complex-double-reg))))
(:results (y))
(y-imag (complex-double-reg-imag-tn y)))
(inst fmove x-imag y-imag))))
(complex-double-stack
- (let ((offset (* (tn-offset y) sb!vm:word-bytes)))
+ (let ((offset (* (tn-offset y) n-word-bytes)))
(let ((real-tn (complex-double-reg-real-tn x)))
(inst stt real-tn offset nfp))
(let ((imag-tn (complex-double-reg-imag-tn x)))
- (inst stt imag-tn (+ offset (* 2 word-bytes)) nfp)))))))
-(define-move-vop move-complex-double-float-argument :move-argument
+ (inst stt imag-tn (+ offset (* 2 n-word-bytes)) nfp)))))))
+(define-move-vop move-complex-double-float-arg :move-arg
(complex-double-reg descriptor-reg) (complex-double-reg))
-(define-move-vop move-argument :move-argument
+(define-move-vop move-arg :move-arg
(single-reg double-reg complex-single-reg complex-double-reg)
(descriptor-reg))
;;;; float conversion
(macrolet
- ((frob (name translate inst ld-inst to-sc to-type &optional single)
- (declare (ignorable single))
+ ((frob (name translate inst ld-inst to-sc to-type)
`(define-vop (,name)
(:args (x :scs (signed-reg) :target temp
:load-if (not (sc-is x signed-stack))))
- (:temporary (:scs (single-stack)) temp)
- (:results (y :scs (,to-sc)))
+ (:temporary (:scs (,to-sc)) freg1)
+ (:temporary (:scs (,to-sc)) freg2)
+ (:temporary (:scs (single-stack)) temp)
+
+ (:results (y :scs (,to-sc)))
(:arg-types signed-num)
(:result-types ,to-type)
(:policy :fast-safe)
(sc-case x
(signed-reg
(inst stl x
- (* (tn-offset temp) sb!vm:word-bytes)
+ (* (tn-offset temp)
+ n-word-bytes)
(current-nfp-tn vop))
temp)
(signed-stack
x))))
- (inst ,ld-inst y
- (* (tn-offset stack-tn) sb!vm:word-bytes)
+ (inst ,ld-inst freg1
+ (* (tn-offset stack-tn) n-word-bytes)
(current-nfp-tn vop))
(note-this-location vop :internal-error)
- ,@(when single
- `((inst cvtlq y y)))
- (inst ,inst y y))))))
- (frob %single-float/signed %single-float cvtqs lds single-reg single-float t)
- (frob %double-float/signed %double-float cvtqt lds double-reg double-float t))
-
+ (inst cvtlq freg1 freg2)
+ (inst ,inst freg2 y)
+ (inst excb)
+ )))))
+ (frob %single-float/signed %single-float cvtqs_sui lds single-reg single-float)
+ (frob %double-float/signed %double-float cvtqt_sui lds double-reg double-float))
+
+;;; see previous comment about software trap handlers: also applies here
(macrolet ((frob (name translate inst from-sc from-type to-sc to-type)
`(define-vop (,name)
- (:args (x :scs (,from-sc)))
- (:results (y :scs (,to-sc)))
- (:arg-types ,from-type)
- (:result-types ,to-type)
- (:policy :fast-safe)
- (:note "inline float coercion")
- (:translate ,translate)
- (:vop-var vop)
- (:save-p :compute-only)
- (:generator 2
- (note-this-location vop :internal-error)
- (inst ,inst x y)))))
- (frob %single-float/double-float %single-float cvtts
- double-reg double-float single-reg single-float)
+ (:args (x :scs (,from-sc)))
+ (:results (y :scs (,to-sc) :from :load))
+ (:arg-types ,from-type)
+ (:result-types ,to-type)
+ (:policy :fast-safe)
+ (:note "inline float coercion")
+ (:translate ,translate)
+ (:vop-var vop)
+ (:save-p :compute-only)
+ (:generator 2
+ (note-this-location vop :internal-error)
+ (inst ,inst x y)
+ (inst excb)
+ ))))
+ (frob %single-float/double-float %single-float cvtts_su
+ double-reg double-float single-reg single-float)
(frob %double-float/single-float %double-float fmove
- single-reg single-float double-reg double-float))
+ single-reg single-float double-reg double-float))
(macrolet
((frob (trans from-sc from-type inst &optional single)
- (declare (ignorable single))
- `(define-vop (,(symbolicate trans "/" from-type))
- (:args (x :scs (,from-sc) :target temp))
- (:temporary (:from (:argument 0) :sc single-reg) temp)
- (:temporary (:scs (signed-stack)) stack-temp)
- (:results (y :scs (signed-reg)
- :load-if (not (sc-is y signed-stack))))
- (:arg-types ,from-type)
- (:result-types signed-num)
- (:translate ,trans)
- (:policy :fast-safe)
- (:note "inline float truncate")
- (:vop-var vop)
- (:save-p :compute-only)
- (:generator 5
- (note-this-location vop :internal-error)
- (inst ,inst x temp)
- (sc-case y
- (signed-stack
- (inst stt temp
- (* (tn-offset y) sb!vm:word-bytes)
- (current-nfp-tn vop)))
- (signed-reg
- (inst stt temp
- (* (tn-offset stack-temp)
- sb!vm:word-bytes)
- (current-nfp-tn vop))
- (inst ldq y
- (* (tn-offset stack-temp) sb!vm:word-bytes)
- (current-nfp-tn vop))))))))
- (frob %unary-truncate single-reg single-float cvttq/c t)
- (frob %unary-truncate double-reg double-float cvttq/c)
- (frob %unary-round single-reg single-float cvttq t)
- (frob %unary-round double-reg double-float cvttq))
+ (declare (ignorable single))
+ `(define-vop (,(symbolicate trans "/" from-type))
+ (:args (x :scs (,from-sc) :target temp))
+ (:temporary (:from :load ;(:argument 0)
+ :sc single-reg) temp)
+ (:temporary (:scs (signed-stack)) stack-temp)
+ (:results (y :scs (signed-reg)
+ :load-if (not (sc-is y signed-stack))))
+ (:arg-types ,from-type)
+ (:result-types signed-num)
+ (:translate ,trans)
+ (:policy :fast-safe)
+ (:note "inline float truncate")
+ (:vop-var vop)
+ (:save-p :compute-only)
+ (:generator 5
+ (note-this-location vop :internal-error)
+ (inst ,inst x temp)
+ (sc-case y
+ (signed-stack
+ (inst stt temp
+ (* (tn-offset y) n-word-bytes)
+ (current-nfp-tn vop)))
+ (signed-reg
+ (inst stt temp
+ (* (tn-offset stack-temp)
+ n-word-bytes)
+ (current-nfp-tn vop))
+ (inst ldq y
+ (* (tn-offset stack-temp) n-word-bytes)
+ (current-nfp-tn vop))))
+ (inst excb)
+ ))))
+ (frob %unary-truncate single-reg single-float cvttq/c_sv t)
+ (frob %unary-truncate double-reg double-float cvttq/c_sv)
+ (frob %unary-round single-reg single-float cvttq_sv t)
+ (frob %unary-round double-reg double-float cvttq_sv))
(define-vop (make-single-float)
(:args (bits :scs (signed-reg) :target res
(sc-case res
(single-reg
(inst stl bits
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop))
(inst lds res
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop)))
(single-stack
(inst stl bits
- (* (tn-offset res) sb!vm:word-bytes)
+ (* (tn-offset res) n-word-bytes)
(current-nfp-tn vop)))))
(signed-stack
(sc-case res
(single-reg
(inst lds res
- (* (tn-offset bits) sb!vm:word-bytes)
+ (* (tn-offset bits) n-word-bytes)
(current-nfp-tn vop)))
(single-stack
(unless (location= bits res)
(inst ldl temp
- (* (tn-offset bits) sb!vm:word-bytes)
+ (* (tn-offset bits) n-word-bytes)
(current-nfp-tn vop))
(inst stl temp
- (* (tn-offset res) sb!vm:word-bytes)
+ (* (tn-offset res) n-word-bytes)
(current-nfp-tn vop)))))))))
(define-vop (make-double-float)
(double-stack res)
(double-reg temp))))
(inst stl hi-bits
- (* (1+ (tn-offset stack-tn)) sb!vm:word-bytes)
+ (* (1+ (tn-offset stack-tn)) n-word-bytes)
(current-nfp-tn vop))
(inst stl lo-bits
- (* (tn-offset stack-tn) sb!vm:word-bytes)
+ (* (tn-offset stack-tn) n-word-bytes)
(current-nfp-tn vop)))
(when (sc-is res double-reg)
(inst ldt res
- (* (tn-offset temp) sb!vm:word-bytes)
+ (* (tn-offset temp) n-word-bytes)
(current-nfp-tn vop)))))
(define-vop (single-float-bits)
(sc-case float
(single-reg
(inst sts float
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop))
(inst ldl bits
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop)))
(single-stack
(inst ldl bits
- (* (tn-offset float) sb!vm:word-bytes)
+ (* (tn-offset float) n-word-bytes)
(current-nfp-tn vop)))
(descriptor-reg
- (loadw bits float sb!vm:single-float-value-slot sb!vm:other-pointer-type))))
+ (loadw bits float single-float-value-slot
+ other-pointer-lowtag))))
(signed-stack
(sc-case float
(single-reg
(inst sts float
- (* (tn-offset bits) sb!vm:word-bytes)
+ (* (tn-offset bits) n-word-bytes)
(current-nfp-tn vop))))))))
(define-vop (double-float-high-bits)
(sc-case float
(double-reg
(inst stt float
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop))
(inst ldl hi-bits
- (* (1+ (tn-offset stack-temp)) sb!vm:word-bytes)
+ (* (1+ (tn-offset stack-temp)) n-word-bytes)
(current-nfp-tn vop)))
(double-stack
(inst ldl hi-bits
- (* (1+ (tn-offset float)) sb!vm:word-bytes)
+ (* (1+ (tn-offset float)) n-word-bytes)
(current-nfp-tn vop)))
(descriptor-reg
- (loadw hi-bits float (1+ sb!vm:double-float-value-slot)
- sb!vm:other-pointer-type)))))
+ (loadw hi-bits float (1+ double-float-value-slot)
+ other-pointer-lowtag)))))
(define-vop (double-float-low-bits)
(:args (float :scs (double-reg descriptor-reg)
(sc-case float
(double-reg
(inst stt float
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop))
(inst ldl lo-bits
- (* (tn-offset stack-temp) sb!vm:word-bytes)
+ (* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop)))
(double-stack
(inst ldl lo-bits
- (* (tn-offset float) sb!vm:word-bytes)
+ (* (tn-offset float) n-word-bytes)
(current-nfp-tn vop)))
(descriptor-reg
- (loadw lo-bits float sb!vm:double-float-value-slot
- sb!vm:other-pointer-type)))
+ (loadw lo-bits float double-float-value-slot
+ other-pointer-lowtag)))
(inst mskll lo-bits 4 lo-bits)))
\f
-;;;; float mode hackery
-
-(sb!xc:deftype float-modes () '(unsigned-byte 32)) ;actually 24 -dan
-(defknown floating-point-modes () float-modes (flushable))
-(defknown ((setf floating-point-modes)) (float-modes)
- float-modes)
-
-;;; Modes bits are (byte 12 52) of fpcr. Grab and return in low bits.
-(define-vop (floating-point-modes)
- (:results (res :scs (unsigned-reg)))
- (:result-types unsigned-num)
- (:translate floating-point-modes)
- (:policy :fast-safe)
- (:vop-var vop)
- (:temporary (:sc double-stack) temp)
- (:temporary (:sc double-reg) temp1)
- (:generator 5
- (let ((nfp (current-nfp-tn vop)))
- (inst excb)
- (inst mf_fpcr temp1 temp1 temp1)
- (inst excb)
- (inst stt temp1 (* word-bytes (tn-offset temp)) nfp)
- (inst ldl res (* (1+ (tn-offset temp)) sb!vm:word-bytes) nfp)
- (inst srl res 49 res))))
-
-(define-vop (set-floating-point-modes)
- (:args (new :scs (unsigned-reg) :target res))
- (:results (res :scs (unsigned-reg)))
- (:arg-types unsigned-num)
- (:result-types unsigned-num)
- (:translate (setf floating-point-modes))
- (:policy :fast-safe)
- (:temporary (:sc double-stack) temp)
- (:temporary (:sc double-reg) temp1)
- (:vop-var vop)
- (:generator 8
- (let ((nfp (current-nfp-tn vop)))
- (inst sll new 49 res)
- (inst stl zero-tn (* (tn-offset temp) sb!vm:word-bytes) nfp)
- (inst stl res (* (1+ (tn-offset temp)) sb!vm:word-bytes) nfp)
- (inst ldt temp1 (* (tn-offset temp) sb!vm:word-bytes) nfp)
- (inst excb)
- (inst mt_fpcr temp1 temp1 temp1)
- (inst excb)
- (move res new))))
+;;;; float mode hackery has moved to alpha-vm.lisp
\f
;;;; complex float VOPs
(inst fmove imag r-imag))))
(complex-single-stack
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset r) sb!vm:word-bytes)))
+ (offset (* (tn-offset r) n-word-bytes)))
(inst sts real offset nfp)
- (inst sts imag (+ offset sb!vm:word-bytes) nfp))))))
+ (inst sts imag (+ offset n-word-bytes) nfp))))))
(define-vop (make-complex-double-float)
(:translate complex)
(inst fmove imag r-imag))))
(complex-double-stack
(let ((nfp (current-nfp-tn vop))
- (offset (* (tn-offset r) sb!vm:word-bytes)))
+ (offset (* (tn-offset r) n-word-bytes)))
(inst stt real offset nfp)
- (inst stt imag (+ offset (* 2 sb!vm:word-bytes)) nfp))))))
+ (inst stt imag (+ offset (* 2 n-word-bytes)) nfp))))))
(define-vop (complex-single-float-value)
(:args (x :scs (complex-single-reg) :target r
(inst fmove value-tn r))))
(complex-single-stack
(inst lds r (* (+ (ecase slot (:real 0) (:imag 1)) (tn-offset x))
- sb!vm:word-bytes)
+ n-word-bytes)
(current-nfp-tn vop))))))
(define-vop (realpart/complex-single-float complex-single-float-value)
(inst fmove value-tn r))))
(complex-double-stack
(inst ldt r (* (+ (ecase slot (:real 0) (:imag 2)) (tn-offset x))
- sb!vm:word-bytes)
+ n-word-bytes)
(current-nfp-tn vop))))))
(define-vop (realpart/complex-double-float complex-double-float-value)
(:translate imagpart)
(:note "complex double float imagpart")
(:variant :imag))
+