(:results (res :scs (sap-reg) :from (:argument 0)
:load-if (not (location= ptr res))))
(:result-types system-area-pointer)
+ (:temporary (:sc signed-reg) temp)
(:policy :fast-safe)
(:generator 1
(cond ((and (sc-is ptr sap-reg) (sc-is res sap-reg)
(signed-reg
(inst lea res (make-ea :qword :base ptr :index offset :scale 1)))
(immediate
- (inst lea res (make-ea :qword :base ptr
- :disp (tn-value offset))))))
+ (let ((value (tn-value offset)))
+ (cond ((typep value '(or (signed-byte 32) (unsigned-byte 31)))
+ (inst lea res (make-ea :qword :base ptr :disp value)))
+ (t
+ (inst mov temp value)
+ (inst lea res (make-ea :qword :base ptr
+ :index temp
+ :scale 1))))))))
(t
(move res ptr)
(sc-case offset
(signed-reg
(inst add res offset))
(immediate
- (inst add res (tn-value offset))))))))
+ (let ((value (tn-value offset)))
+ (cond ((typep value '(or (signed-byte 32) (unsigned-byte 31)))
+ (inst add res (tn-value offset)))
+ (t
+ (inst mov temp value)
+ (inst add res temp))))))))))
(define-vop (pointer-)
(:translate sap-)
(:results (result :scs (double-reg)))
(:result-types double-float)
(:generator 5
- (with-empty-tn@fp-top(result)
- (inst fldd (make-ea :dword :base sap :index offset)))))
+ (inst movsd result (make-ea :qword :base sap :index offset))))
(define-vop (sap-ref-double-c)
(:translate sap-ref-double)
(:results (result :scs (double-reg)))
(:result-types double-float)
(:generator 4
- (with-empty-tn@fp-top(result)
- (inst fldd (make-ea :dword :base sap :disp offset)))))
+ (inst movsd result (make-ea :qword :base sap :disp offset))))
(define-vop (%set-sap-ref-double)
(:translate %set-sap-ref-double)
(:results (result :scs (double-reg)))
(:result-types double-float)
(:generator 5
- (cond ((zerop (tn-offset value))
- ;; Value is in ST0.
- (inst fstd (make-ea :dword :base sap :index offset))
- (unless (zerop (tn-offset result))
- ;; Value is in ST0 but not result.
- (inst fstd result)))
- (t
- ;; Value is not in ST0.
- (inst fxch value)
- (inst fstd (make-ea :dword :base sap :index offset))
- (cond ((zerop (tn-offset result))
- ;; The result is in ST0.
- (inst fstd value))
- (t
- ;; Neither value or result are in ST0.
- (unless (location= value result)
- (inst fstd result))
- (inst fxch value)))))))
+ (inst movsd (make-ea :qword :base sap :index offset) value)
+ (move result value)))
(define-vop (%set-sap-ref-double-c)
(:translate %set-sap-ref-double)
(:results (result :scs (double-reg)))
(:result-types double-float)
(:generator 4
- (cond ((zerop (tn-offset value))
- ;; Value is in ST0.
- (inst fstd (make-ea :qword :base sap :disp offset))
- (unless (zerop (tn-offset result))
- ;; Value is in ST0 but not result.
- (inst fstd result)))
- (t
- ;; Value is not in ST0.
- (inst fxch value)
- (inst fstd (make-ea :qword :base sap :disp offset))
- (cond ((zerop (tn-offset result))
- ;; The result is in ST0.
- (inst fstd value))
- (t
- ;; Neither value or result are in ST0.
- (unless (location= value result)
- (inst fstd result))
- (inst fxch value)))))))
+ (inst movsd (make-ea :qword :base sap :disp offset) value)
+ (move result value)))
\f
;;;; SAP-REF-SINGLE
(:results (result :scs (single-reg)))
(:result-types single-float)
(:generator 5
- (with-empty-tn@fp-top(result)
- (inst fld (make-ea :dword :base sap :index offset)))))
+ (inst movss result (make-ea :dword :base sap :index offset))))
(define-vop (sap-ref-single-c)
(:translate sap-ref-single)
(:results (result :scs (single-reg)))
(:result-types single-float)
(:generator 4
- (with-empty-tn@fp-top(result)
- (inst fld (make-ea :dword :base sap :disp offset)))))
+ (inst movss result (make-ea :dword :base sap :disp offset))))
(define-vop (%set-sap-ref-single)
(:translate %set-sap-ref-single)
(:results (result :scs (single-reg)))
(:result-types single-float)
(:generator 5
- (cond ((zerop (tn-offset value))
- ;; Value is in ST0
- (inst fst (make-ea :dword :base sap :index offset))
- (unless (zerop (tn-offset result))
- ;; Value is in ST0 but not result.
- (inst fst result)))
- (t
- ;; Value is not in ST0.
- (inst fxch value)
- (inst fst (make-ea :dword :base sap :index offset))
- (cond ((zerop (tn-offset result))
- ;; The result is in ST0.
- (inst fst value))
- (t
- ;; Neither value or result are in ST0
- (unless (location= value result)
- (inst fst result))
- (inst fxch value)))))))
+ (inst movss (make-ea :dword :base sap :index offset) value)
+ (move result value)))
(define-vop (%set-sap-ref-single-c)
(:translate %set-sap-ref-single)
(:results (result :scs (single-reg)))
(:result-types single-float)
(:generator 4
- (cond ((zerop (tn-offset value))
- ;; Value is in ST0
- (inst fst (make-ea :dword :base sap :disp offset))
- (unless (zerop (tn-offset result))
- ;; Value is in ST0 but not result.
- (inst fst result)))
- (t
- ;; Value is not in ST0.
- (inst fxch value)
- (inst fst (make-ea :dword :base sap :disp offset))
- (cond ((zerop (tn-offset result))
- ;; The result is in ST0.
- (inst fst value))
- (t
- ;; Neither value or result are in ST0
- (unless (location= value result)
- (inst fst result))
- (inst fxch value)))))))
-\f
-;;;; SAP-REF-LONG
-#+nil
-(define-vop (sap-ref-long)
- (:translate sap-ref-long)
- (:policy :fast-safe)
- (:args (sap :scs (sap-reg))
- (offset :scs (signed-reg)))
- (:arg-types system-area-pointer signed-num)
- (:results (result :scs (#!+long-float long-reg #!-long-float double-reg)))
- (:result-types #!+long-float long-float #!-long-float double-float)
- (:generator 5
- (with-empty-tn@fp-top(result)
- (inst fldl (make-ea :qword :base sap :index offset)))))
-#+nil
-(define-vop (sap-ref-long-c)
- (:translate sap-ref-long)
- (:policy :fast-safe)
- (:args (sap :scs (sap-reg)))
- (:arg-types system-area-pointer (:constant (signed-byte 64)))
- (:info offset)
- (:results (result :scs (#!+long-float long-reg #!-long-float double-reg)))
- (:result-types #!+long-float long-float #!-long-float double-float)
- (:generator 4
- (with-empty-tn@fp-top(result)
- (inst fldl (make-ea :qword :base sap :disp offset)))))
+ (inst movss (make-ea :dword :base sap :disp offset) value)
+ (move result value)))
\f
;;; noise to convert normal lisp data objects into SAPs