complex-double-float))
(macrolet ((generate (opinst commutative constant-sc load-inst)
- `(flet ((get-constant (tn)
- (register-inline-constant
- ,@(and (eq constant-sc 'fp-single-immediate)
- '(:aligned))
- (tn-value tn))))
+ `(flet ((get-constant (tn &optional maybe-aligned)
+ (declare (ignorable maybe-aligned))
+ (let ((value (tn-value tn)))
+ ,(if (eq constant-sc 'fp-complex-single-immediate)
+ `(if maybe-aligned
+ (register-inline-constant
+ :aligned value)
+ (register-inline-constant value))
+ `(register-inline-constant value)))))
(declare (ignorable #'get-constant))
(cond
((location= x r)
(when (sc-is y ,constant-sc)
- (setf y (get-constant y)))
+ (setf y (get-constant y t)))
(inst ,opinst x y))
((and ,commutative (location= y r))
(when (sc-is x ,constant-sc)
- (setf x (get-constant x)))
+ (setf x (get-constant x t)))
(inst ,opinst y x))
((not (location= r y))
(if (sc-is x ,constant-sc)
(inst ,load-inst r (get-constant x))
(move r x))
(when (sc-is y ,constant-sc)
- (setf y (get-constant y)))
+ (setf y (get-constant y t)))
(inst ,opinst r y))
(t
(if (sc-is x ,constant-sc)
(:vop-var vop)
(:save-p :compute-only)
(:generator 1
- (note-this-location vop :internal-error)
- ;; we should be able to do this better. what we
- ;; really would like to do is use the target as the
- ;; temp whenever it's not also the source
- (move y x)
- ,@body))))
+ (note-this-location vop :internal-error)
+ (move y x)
+ ,@body))))
(frob (%negate/double-float %negate double-reg double-float)
(inst xorpd y (register-inline-constant :oword (ash 1 63))))
(frob (%negate/complex-double-float %negate complex-double-reg complex-double-float)
:load-if (not (sc-is y ,constant-sc))))
(:arg-types ,type ,type)
(:temporary (:sc ,sc :from :eval) mask)
- (:temporary (:sc any-reg) bits)
+ (:temporary (:sc dword-reg) bits)
(:conditional :e)
(:generator ,cost
(when (or (location= y mask)
(setf y (register-inline-constant :aligned (tn-value y))))
(inst pcmpeqd mask y)
(inst movmskps bits mask)
- (inst cmp bits #b1111)))))
+ (inst cmp (if (location= bits eax-tn) al-tn bits)
+ #b1111)))))
(define-float-eql eql/single-float 4
single-reg fp-single-immediate single-float)
(define-float-eql eql/double-float 4
:load-if (not (sc-is y ,complex-constant-sc))))
(:arg-types ,complex-type ,complex-type)
(:temporary (:sc ,complex-sc :from :eval) cmp)
- (:temporary (:sc unsigned-reg) bits)
+ (:temporary (:sc dword-reg) bits)
(:info)
(:conditional :e)
(:generator 3
(note-this-location vop :internal-error)
(inst ,cmp-inst :eq cmp y)
(inst ,mask-inst bits cmp)
- (inst cmp bits ,mask)))
+ (inst cmp (if (location= bits eax-tn) al-tn bits)
+ ,mask)))
(define-vop (,complex-real-name ,complex-complex-name)
(:args (x :scs (,complex-sc ,complex-constant-sc)
:target cmp
(signed-stack
(inst movd res bits)))))))
+(define-vop (make-single-float-c)
+ (:results (res :scs (single-reg single-stack descriptor-reg)))
+ (:arg-types (:constant (signed-byte 32)))
+ (:result-types single-float)
+ (:info bits)
+ (:translate make-single-float)
+ (:policy :fast-safe)
+ (:vop-var vop)
+ (:generator 1
+ (sc-case res
+ (single-stack
+ (inst mov res bits))
+ (single-reg
+ (inst movss res (register-inline-constant :dword bits)))
+ (descriptor-reg
+ (inst mov res (logior (ash bits 32)
+ single-float-widetag))))))
+
(define-vop (make-double-float)
(:args (hi-bits :scs (signed-reg))
(lo-bits :scs (unsigned-reg)))
(inst or temp lo-bits)
(inst movd res temp)))
+(define-vop (make-double-float-c)
+ (:results (res :scs (double-reg)))
+ (:arg-types (:constant (signed-byte 32)) (:constant (unsigned-byte 32)))
+ (:result-types double-float)
+ (:info hi lo)
+ (:translate make-double-float)
+ (:policy :fast-safe)
+ (:vop-var vop)
+ (:generator 1
+ (inst movsd res (register-inline-constant :qword (logior (ash hi 32) lo)))))
+
(define-vop (single-float-bits)
(:args (float :scs (single-reg descriptor-reg)
:load-if (not (sc-is float single-stack))))