sap.lisp

开源跨平台Lisp编译器

        (with-empty-tn@fp-top(result)
          (inst fldd (make-ea :dword :base sap :index offset
                              :disp (* 4 disp))))))))

(define-vop (%set-sap-ref-double-with-offset)
  (:translate sb!c::%set-sap-ref-double-with-offset)
  (:policy :fast-safe)
  (:args (sap :scs (sap-reg) :to (:eval 0))
         (offset :scs (signed-reg) :to (:eval 0))
         (value :scs (double-reg)))
  (:info disp)
  (:arg-types system-area-pointer signed-num
              (:constant (constant-displacement 0 ; lowtag
                                                8 ; double-float size
                                                0))
              double-float)
  (: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
                               :disp (* 8 disp)))
           (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
                               :disp (* 8 disp)))
           (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)))))))

(define-vop (%set-sap-ref-double-with-offset-c)
  (:translate sb!c::%set-sap-ref-double-with-offset)
  (:policy :fast-safe)
  (:args (sap :scs (sap-reg) :to (:eval 0))
         (value :scs (double-reg)))
  (:arg-types system-area-pointer (:constant (signed-byte 32))
              (:constant (constant-displacement 0 ; lowtag
                                                8 ; double-float size
                                                0))
              double-float)
  (:info offset disp)
  (:results (result :scs (double-reg)))
  (:result-types double-float)
  (:generator 4
    (aver (zerop disp))
    (cond ((zerop (tn-offset value))
           ;; Value is in ST0.
           (inst fstd (make-ea :dword :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 :dword :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)))))))

;;;; SAP-REF-SINGLE

(define-vop (sap-ref-single-with-offset)
  (:translate sb!c::sap-ref-single-with-offset)
  (:policy :fast-safe)
  (:args (sap :scs (sap-reg))
         (offset :scs (signed-reg immediate)))
  (:info disp)
  (:arg-types system-area-pointer signed-num
              (:constant (constant-displacement 0 ; lowtag
                                                4 ; single-float size
                                                0)))
  (:results (result :scs (single-reg)))
  (:result-types single-float)
  (:generator 5
     (sc-case offset
       (immediate
        (aver (zerop disp))
        (with-empty-tn@fp-top(result)
          (inst fld (make-ea :dword :base sap :disp (tn-value offset)))))
       (t
        (with-empty-tn@fp-top(result)
          (inst fld (make-ea :dword :base sap :index offset
                             :disp (* 4 disp))))))))

(define-vop (%set-sap-ref-single-with-offset)
  (:translate sb!c::%set-sap-ref-single-with-offset)
  (:policy :fast-safe)
  (:args (sap :scs (sap-reg) :to (:eval 0))
         (offset :scs (signed-reg) :to (:eval 0))
         (value :scs (single-reg)))
  (:info disp)
  (:arg-types system-area-pointer signed-num
              (:constant (constant-displacement 0 ; lowtag
                                                4 ; single-float size
                                                0))
              single-float)
  (: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
                              :disp (* 4 disp)))
           (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
                              :disp (* 4 disp)))
           (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)))))))

(define-vop (%set-sap-ref-single-with-offset-c)
  (:translate sb!c::%set-sap-ref-single-with-offset)
  (:policy :fast-safe)
  (:args (sap :scs (sap-reg) :to (:eval 0))
         (value :scs (single-reg)))
  (:arg-types system-area-pointer (:constant (signed-byte 32))
              (:constant (constant-displacement 0 ; lowtag
                                                4 ; single-float size
                                                0))
              single-float)
  (:info offset disp)
  (:results (result :scs (single-reg)))
  (:result-types single-float)
  (:generator 4
    (aver (zerop disp))
    (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)))))))

;;;; SAP-REF-LONG

(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 :dword :base sap :index offset)))))

(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 32)))
  (: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 :dword :base sap :disp offset)))))

#!+long-float
(define-vop (%set-sap-ref-long)
  (:translate %set-sap-ref-long)
  (:policy :fast-safe)
  (:args (sap :scs (sap-reg) :to (:eval 0))
         (offset :scs (signed-reg) :to (:eval 0))
         (value :scs (long-reg)))
  (:arg-types system-area-pointer signed-num long-float)
  (:results (result :scs (long-reg)))
  (:result-types long-float)
  (:generator 5
    (cond ((zerop (tn-offset value))
           ;; Value is in ST0
           (store-long-float (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)
           (store-long-float (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)))))))

;;; noise to convert normal lisp data objects into SAPs

(define-vop (vector-sap)
  (:translate vector-sap)
  (:policy :fast-safe)
  (:args (vector :scs (descriptor-reg) :target sap))
  (:results (sap :scs (sap-reg)))
  (:result-types system-area-pointer)
  (:generator 2
    (move sap vector)
    (inst add
          sap
          (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))))

;;; Transforms for 64-bit SAP accessors.

(deftransform sap-ref-64 ((sap offset) (* *))
  '(logior (sap-ref-32 sap offset)
           (ash (sap-ref-32 sap (+ offset 4)) 32)))

(deftransform signed-sap-ref-64 ((sap offset) (* *))
  '(logior (sap-ref-32 sap offset)
           (ash (signed-sap-ref-32 sap (+ offset 4)) 32)))

(deftransform %set-sap-ref-64 ((sap offset value) (* * *))
  '(progn
     (%set-sap-ref-32 sap offset (logand value #xffffffff))
     (%set-sap-ref-32 sap (+ offset 4) (ash value -32))))

(deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *))
  '(progn
     (%set-sap-ref-32 sap offset (logand value #xffffffff))
     (%set-signed-sap-ref-32 sap (+ offset 4) (ash value -32))))