Changeset 15340


Ignore:
Timestamp:
Apr 21, 2012, 11:15:09 AM (7 years ago)
Author:
gb
Message:

New subprim (for hard-float ff-calls.)
Compiler handles hard-float ABI: %FF-CALL where some arg or result
is :SINGLE-/:DOUBLE-FLOAT compiles as runtime test for hard-float ABI
and both hard- and soft-float versions.

Still need hard-float support for callbacks (and more testing, though
simple cases seem to work.)

Location:
trunk/source/compiler/ARM
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/ARM/arm-arch.lisp

    r15257 r15340  
    439439             (defarmsubprim .SPdebind)
    440440             (defarmsubprim .SPeabi-callback)
     441             (defarmsubprim .SPeabi-ff-callhf)
    441442             )))))
    442443
  • trunk/source/compiler/ARM/arm-vinsns.lisp

    r15158 r15340  
    40494049(define-arm-subprim-call-vinsn (eabi-ff-call) .SPeabi-ff-call)
    40504050
     4051(define-arm-subprim-call-vinsn (eabi-ff-callhf) .SPeabi-ff-callhf)
     4052
    40514053(define-arm-vinsn unbind-interrupt-level-inline (()
    40524054                                                 ()
     
    41324134  (add temp base (:lsl idx (:$ 1)))
    41334135  (fstd val (:@ temp (:$ 0))))
    4134                                              
     4136
     4137(define-arm-vinsn (branch-if-soft-float :branch) (()
     4138                                                  ((lab :label))
     4139                                                  ((temp :imm)))
     4140  (mov temp (:$ (- arm::nil-value arm::fulltag-nil)))
     4141  (ldr temp (:@ temp (:$ (arm::%kernel-global 'arm::float-abi))))
     4142  (tst temp temp)
     4143  (beq lab))
    41354144
    41364145;;; In case arm::*arm-opcodes* was changed since this file was compiled.
  • trunk/source/compiler/ARM/arm2.lisp

    r15150 r15340  
    88008800      (^)))))
    88018801
     8802;;; Address to call is on top of the vstack.  Leave it there.
     8803(defun arm2-eabi-hard-float-ff-call (seg  argspecs argvals soft-label continue-label)
     8804  (with-arm-local-vinsn-macros (seg)
     8805    (let* ((next-fp-arg-word 0)
     8806           (next-arg-word 0)
     8807           (*arm2-vstack* *arm2-vstack*)
     8808           (*arm2-top-vstack-lcell* *arm2-top-vstack-lcell*)
     8809           (*arm2-cstack* *arm2-cstack*))
     8810      (dolist (spec argspecs)
     8811        (case spec
     8812          ((:signed-doubleword :unsigned-doubleword)
     8813           (if (oddp next-arg-word)
     8814             (incf next-arg-word 3)
     8815             (incf next-arg-word 2)))
     8816          (:double-float
     8817           (if (<= next-fp-arg-word 14)
     8818             (if (oddp next-fp-arg-word)
     8819               (incf next-fp-arg-word 3)
     8820               (incf next-fp-arg-word 2))
     8821             (if (oddp next-arg-word)
     8822               (incf next-arg-word 3)
     8823               (incf next-arg-word 2))))
     8824          (:single-float
     8825           (if (< next-fp-arg-word 16)
     8826             (incf next-fp-arg-word)
     8827             (incf next-arg-word)))
     8828          (t
     8829           (if (typep spec 'fixnum)
     8830             (incf next-arg-word spec)
     8831             (incf next-arg-word)))))
     8832      (! branch-if-soft-float (aref *backend-labels* soft-label))
     8833      (! alloc-eabi-c-frame (+ next-arg-word 16))
     8834      (arm2-open-undo $undo-arm-c-frame)
     8835      (setq next-fp-arg-word 0
     8836            next-arg-word 16)
     8837      (do* ((specs argspecs (cdr specs))
     8838            (vals argvals (cdr vals)))
     8839           ((null specs))
     8840        (declare (list specs vals))
     8841        (let* ((valform (car vals))
     8842               (spec (car specs))
     8843               (absptr (acode-absolute-ptr-p valform)))
     8844          (case spec
     8845            (:double-float
     8846             (with-fp-target () (df :double-float)
     8847               (arm2-one-targeted-reg-form seg valform df)
     8848               (cond ((<= next-fp-arg-word 14)
     8849                      (when (oddp next-fp-arg-word)
     8850                        (incf next-fp-arg-word))
     8851                      (! set-double-eabi-c-arg df next-fp-arg-word)
     8852                      (incf next-fp-arg-word 2))
     8853                     (t
     8854                      (when (oddp next-arg-word)
     8855                        (incf next-arg-word))
     8856                      (! set-double-eabi-c-arg df next-arg-word)
     8857                      (incf next-arg-word 2)))))
     8858            (:single-float
     8859             (with-fp-target () (sf :single-float)
     8860               (arm2-one-targeted-reg-form seg valform sf)
     8861               (cond ((< next-fp-arg-word 16)
     8862                      (! set-single-eabi-c-arg sf next-fp-arg-word)
     8863                      (incf next-fp-arg-word))
     8864                     (t
     8865                      (! set-single-eabi-c-arg sf next-arg-word)
     8866                      (incf next-arg-word)))))
     8867            ((:signed-doubleword :unsigned-doubleword)
     8868             (arm2-one-targeted-reg-form seg valform ($ arm::arg_z))
     8869             (if (eq spec :signed-doubleword)
     8870               (! gets64)
     8871               (! getu64))
     8872             (when (oddp next-arg-word)
     8873               (incf next-arg-word))
     8874             (! set-eabi-c-arg ($ arm::imm0) next-arg-word)
     8875             (incf next-arg-word)
     8876             (! set-eabi-c-arg ($ arm::imm1) next-arg-word)
     8877             (incf next-arg-word))
     8878            (:address
     8879             (with-imm-target () (ptr :address)
     8880               (if absptr
     8881                 (arm2-lri seg ptr absptr)
     8882                 (arm2-form seg ptr nil valform))
     8883               (! set-eabi-c-arg ptr next-arg-word)
     8884               (incf next-arg-word)))
     8885            (t
     8886             (if (typep spec 'fixnum)
     8887               (with-imm-target () (addr :address)
     8888                 (arm2-form seg addr nil valform)
     8889                 (with-imm-target (addr) (valreg :natural)
     8890                   (dotimes (i spec)
     8891                     (! mem-ref-c-natural valreg addr (* i *arm2-target-node-size*))
     8892                     (! set-eabi-c-arg valreg next-arg-word)
     8893                     (incf next-arg-word))))
     8894               (with-imm-target () (valreg :natural)
     8895                 (let* ((reg (arm2-unboxed-integer-arg-to-reg seg valform valreg spec)))
     8896                   (! set-eabi-c-arg reg next-arg-word)
     8897                   (incf next-arg-word))))))))
     8898      (arm2-vpop-register seg ($ arm::arg_z))
     8899      (! eabi-ff-callhf)
     8900      (arm2-close-undo)
     8901      (-> continue-label))))
     8902     
     8903     
     8904         
     8905           
    88028906(defarm2 arm2-eabi-ff-call eabi-ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor)
    88038907  (declare (ignore monitor))
     
    88098913          (case (backend-target-os *target-backend*)
    88108914            (:darwinarm nil)
    8811             (t t))))
     8915            (t t)))
     8916         (soft-label (backend-get-next-label))
     8917         (continue-label (backend-get-next-label)))
    88128918      (declare (fixnum next-arg-word))
     8919      (arm2-vpush-register seg (arm2-one-untargeted-reg-form seg address arm::arg_z))
     8920      (when (or (eq resultspec :single-float)
     8921                (eq resultspec :double-float)
     8922                (dolist (spec argspecs)
     8923                  (when (or (eq spec :single-float)
     8924                            (eq spec :double-float))
     8925                    (return t))))
     8926        (arm2-eabi-hard-float-ff-call seg argspecs argvals soft-label continue-label))
     8927      (@ soft-label)
    88138928      (dolist (argspec argspecs)
    88148929        (case argspec
     
    88208935      (! alloc-eabi-c-frame next-arg-word)
    88218936      (arm2-open-undo $undo-arm-c-frame)
    8822       (arm2-vpush-register seg (arm2-one-untargeted-reg-form seg address arm::arg_z))
     8937
    88238938      ;; Evaluate each form into the C frame, according to the
    88248939      ;; matching argspec.
    8825       ;; Remember type and arg offset of any FP args, since FP regs
    8826       ;; will have to be loaded later.
    88278940      (setq next-arg-word 0)
    88288941      (do* ((specs argspecs (cdr specs))
     
    88658978               (incf next-arg-word)))
    88668979            (t
    8867              (with-imm-target () (valreg :natural)
    8868                 (let* ((reg (arm2-unboxed-integer-arg-to-reg seg valform valreg spec)))
    8869                   (! set-eabi-c-arg reg next-arg-word)
    8870                   (incf next-arg-word)))))))
    8871       #+hard-float
    8872       (do* ((fpreg arm::fp1 (1+ fpreg))
    8873             (reloads (nreverse fp-loads) (cdr reloads)))
    8874            ((or (null reloads) (= fpreg arm::fp14)))
    8875         (declare (list reloads) (fixnum fpreg))
    8876         (let* ((reload (car reloads))
    8877                (size (car reload))
    8878                (from (cdr reload)))
    8879           (if (eq size :double-float)
    8880             (! reload-double-eabi-c-arg ($ fpreg :class :fpr :mode :double-float) from)
    8881             (! reload-single-eabi-c-arg ($ fpreg :class :fpr :mode :single-float) from))))
     8980             (if (typep spec 'fixnum)
     8981               (with-imm-target () (addr :address)
     8982                 (arm2-form seg addr nil valform)
     8983                 (with-imm-target (addr) (valreg :natural)
     8984                   (dotimes (i spec)
     8985                     (! mem-ref-c-natural valreg addr (* i *arm2-target-node-size*))
     8986                     (! set-eabi-c-arg valreg next-arg-word)
     8987                     (incf next-arg-word))))
     8988               (with-imm-target () (valreg :natural)
     8989                 (let* ((reg (arm2-unboxed-integer-arg-to-reg seg valform valreg spec)))
     8990                   (! set-eabi-c-arg reg next-arg-word)
     8991                   (incf next-arg-word))))))))
    88828992      (arm2-vpop-register seg ($ arm::arg_z))
    88838993      (! eabi-ff-call)
    88848994      (arm2-close-undo)
     8995      (case resultspec
     8996        (:double-float
     8997         
     8998         (! gpr-pair-to-double-float ($ arm::d0 :class :fpr :mode :double-float)  arm::imm0 arm::imm1))
     8999        (:single-float
     9000         (! gpr-to-single-float ($ arm::s0 :class :fpr :mode :single-float)  arm::imm0)))
     9001      (@ continue-label)
    88859002      (when vreg
    88869003        (cond ((eq resultspec :void) (<- nil))
    88879004              ((eq resultspec :double-float)
    8888                (if (and (eq (hard-regspec-class vreg) hard-reg-class-fpr)
    8889                         (eq (get-regspec-mode vreg) hard-reg-class-fpr-mode-double))
    8890                  (! gpr-pair-to-double-float vreg  arm::imm0 arm::imm1)
    8891                  (progn
    8892                    (! gpr-pair-to-double-float arm::d0 arm::imm0 arm::imm1)
    8893                    (<- ($  arm::d0 :class :fpr :mode :double-float)))))
     9005               (<- ($  arm::d0 :class :fpr :mode :double-float)))
    88949006              ((eq resultspec :single-float)
    8895                (if (and (eq (hard-regspec-class vreg) hard-reg-class-fpr)
    8896                         (eq (get-regspec-mode vreg) hard-reg-class-fpr-mode-single))
    8897                  (! gpr-to-single-float vreg arm::imm0)
    8898                  (progn
    8899                    (! gpr-to-single-float arm::s0 arm::imm0)
    8900                    (<- ($ arm::s0 :class :fpr :mode :single-float)))))
     9007               (<- ($ arm::s0 :class :fpr :mode :single-float)))
    89019008              ((eq resultspec :unsigned-doubleword)
    89029009               (ensuring-node-target (target vreg)
Note: See TracChangeset for help on using the changeset viewer.