Index: /trunk/source/compiler/ARM/arm-arch.lisp =================================================================== --- /trunk/source/compiler/ARM/arm-arch.lisp (revision 15339) +++ /trunk/source/compiler/ARM/arm-arch.lisp (revision 15340) @@ -439,4 +439,5 @@ (defarmsubprim .SPdebind) (defarmsubprim .SPeabi-callback) + (defarmsubprim .SPeabi-ff-callhf) ))))) Index: /trunk/source/compiler/ARM/arm-vinsns.lisp =================================================================== --- /trunk/source/compiler/ARM/arm-vinsns.lisp (revision 15339) +++ /trunk/source/compiler/ARM/arm-vinsns.lisp (revision 15340) @@ -4049,4 +4049,6 @@ (define-arm-subprim-call-vinsn (eabi-ff-call) .SPeabi-ff-call) +(define-arm-subprim-call-vinsn (eabi-ff-callhf) .SPeabi-ff-callhf) + (define-arm-vinsn unbind-interrupt-level-inline (() () @@ -4132,5 +4134,12 @@ (add temp base (:lsl idx (:$ 1))) (fstd val (:@ temp (:$ 0)))) - + +(define-arm-vinsn (branch-if-soft-float :branch) (() + ((lab :label)) + ((temp :imm))) + (mov temp (:$ (- arm::nil-value arm::fulltag-nil))) + (ldr temp (:@ temp (:$ (arm::%kernel-global 'arm::float-abi)))) + (tst temp temp) + (beq lab)) ;;; In case arm::*arm-opcodes* was changed since this file was compiled. Index: /trunk/source/compiler/ARM/arm2.lisp =================================================================== --- /trunk/source/compiler/ARM/arm2.lisp (revision 15339) +++ /trunk/source/compiler/ARM/arm2.lisp (revision 15340) @@ -8800,4 +8800,108 @@ (^))))) +;;; Address to call is on top of the vstack. Leave it there. +(defun arm2-eabi-hard-float-ff-call (seg argspecs argvals soft-label continue-label) + (with-arm-local-vinsn-macros (seg) + (let* ((next-fp-arg-word 0) + (next-arg-word 0) + (*arm2-vstack* *arm2-vstack*) + (*arm2-top-vstack-lcell* *arm2-top-vstack-lcell*) + (*arm2-cstack* *arm2-cstack*)) + (dolist (spec argspecs) + (case spec + ((:signed-doubleword :unsigned-doubleword) + (if (oddp next-arg-word) + (incf next-arg-word 3) + (incf next-arg-word 2))) + (:double-float + (if (<= next-fp-arg-word 14) + (if (oddp next-fp-arg-word) + (incf next-fp-arg-word 3) + (incf next-fp-arg-word 2)) + (if (oddp next-arg-word) + (incf next-arg-word 3) + (incf next-arg-word 2)))) + (:single-float + (if (< next-fp-arg-word 16) + (incf next-fp-arg-word) + (incf next-arg-word))) + (t + (if (typep spec 'fixnum) + (incf next-arg-word spec) + (incf next-arg-word))))) + (! branch-if-soft-float (aref *backend-labels* soft-label)) + (! alloc-eabi-c-frame (+ next-arg-word 16)) + (arm2-open-undo $undo-arm-c-frame) + (setq next-fp-arg-word 0 + next-arg-word 16) + (do* ((specs argspecs (cdr specs)) + (vals argvals (cdr vals))) + ((null specs)) + (declare (list specs vals)) + (let* ((valform (car vals)) + (spec (car specs)) + (absptr (acode-absolute-ptr-p valform))) + (case spec + (:double-float + (with-fp-target () (df :double-float) + (arm2-one-targeted-reg-form seg valform df) + (cond ((<= next-fp-arg-word 14) + (when (oddp next-fp-arg-word) + (incf next-fp-arg-word)) + (! set-double-eabi-c-arg df next-fp-arg-word) + (incf next-fp-arg-word 2)) + (t + (when (oddp next-arg-word) + (incf next-arg-word)) + (! set-double-eabi-c-arg df next-arg-word) + (incf next-arg-word 2))))) + (:single-float + (with-fp-target () (sf :single-float) + (arm2-one-targeted-reg-form seg valform sf) + (cond ((< next-fp-arg-word 16) + (! set-single-eabi-c-arg sf next-fp-arg-word) + (incf next-fp-arg-word)) + (t + (! set-single-eabi-c-arg sf next-arg-word) + (incf next-arg-word))))) + ((:signed-doubleword :unsigned-doubleword) + (arm2-one-targeted-reg-form seg valform ($ arm::arg_z)) + (if (eq spec :signed-doubleword) + (! gets64) + (! getu64)) + (when (oddp next-arg-word) + (incf next-arg-word)) + (! set-eabi-c-arg ($ arm::imm0) next-arg-word) + (incf next-arg-word) + (! set-eabi-c-arg ($ arm::imm1) next-arg-word) + (incf next-arg-word)) + (:address + (with-imm-target () (ptr :address) + (if absptr + (arm2-lri seg ptr absptr) + (arm2-form seg ptr nil valform)) + (! set-eabi-c-arg ptr next-arg-word) + (incf next-arg-word))) + (t + (if (typep spec 'fixnum) + (with-imm-target () (addr :address) + (arm2-form seg addr nil valform) + (with-imm-target (addr) (valreg :natural) + (dotimes (i spec) + (! mem-ref-c-natural valreg addr (* i *arm2-target-node-size*)) + (! set-eabi-c-arg valreg next-arg-word) + (incf next-arg-word)))) + (with-imm-target () (valreg :natural) + (let* ((reg (arm2-unboxed-integer-arg-to-reg seg valform valreg spec))) + (! set-eabi-c-arg reg next-arg-word) + (incf next-arg-word)))))))) + (arm2-vpop-register seg ($ arm::arg_z)) + (! eabi-ff-callhf) + (arm2-close-undo) + (-> continue-label)))) + + + + (defarm2 arm2-eabi-ff-call eabi-ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor) (declare (ignore monitor)) @@ -8809,6 +8913,17 @@ (case (backend-target-os *target-backend*) (:darwinarm nil) - (t t)))) + (t t))) + (soft-label (backend-get-next-label)) + (continue-label (backend-get-next-label))) (declare (fixnum next-arg-word)) + (arm2-vpush-register seg (arm2-one-untargeted-reg-form seg address arm::arg_z)) + (when (or (eq resultspec :single-float) + (eq resultspec :double-float) + (dolist (spec argspecs) + (when (or (eq spec :single-float) + (eq spec :double-float)) + (return t)))) + (arm2-eabi-hard-float-ff-call seg argspecs argvals soft-label continue-label)) + (@ soft-label) (dolist (argspec argspecs) (case argspec @@ -8820,9 +8935,7 @@ (! alloc-eabi-c-frame next-arg-word) (arm2-open-undo $undo-arm-c-frame) - (arm2-vpush-register seg (arm2-one-untargeted-reg-form seg address arm::arg_z)) + ;; Evaluate each form into the C frame, according to the ;; matching argspec. - ;; Remember type and arg offset of any FP args, since FP regs - ;; will have to be loaded later. (setq next-arg-word 0) (do* ((specs argspecs (cdr specs)) @@ -8865,38 +8978,32 @@ (incf next-arg-word))) (t - (with-imm-target () (valreg :natural) - (let* ((reg (arm2-unboxed-integer-arg-to-reg seg valform valreg spec))) - (! set-eabi-c-arg reg next-arg-word) - (incf next-arg-word))))))) - #+hard-float - (do* ((fpreg arm::fp1 (1+ fpreg)) - (reloads (nreverse fp-loads) (cdr reloads))) - ((or (null reloads) (= fpreg arm::fp14))) - (declare (list reloads) (fixnum fpreg)) - (let* ((reload (car reloads)) - (size (car reload)) - (from (cdr reload))) - (if (eq size :double-float) - (! reload-double-eabi-c-arg ($ fpreg :class :fpr :mode :double-float) from) - (! reload-single-eabi-c-arg ($ fpreg :class :fpr :mode :single-float) from)))) + (if (typep spec 'fixnum) + (with-imm-target () (addr :address) + (arm2-form seg addr nil valform) + (with-imm-target (addr) (valreg :natural) + (dotimes (i spec) + (! mem-ref-c-natural valreg addr (* i *arm2-target-node-size*)) + (! set-eabi-c-arg valreg next-arg-word) + (incf next-arg-word)))) + (with-imm-target () (valreg :natural) + (let* ((reg (arm2-unboxed-integer-arg-to-reg seg valform valreg spec))) + (! set-eabi-c-arg reg next-arg-word) + (incf next-arg-word)))))))) (arm2-vpop-register seg ($ arm::arg_z)) (! eabi-ff-call) (arm2-close-undo) + (case resultspec + (:double-float + + (! gpr-pair-to-double-float ($ arm::d0 :class :fpr :mode :double-float) arm::imm0 arm::imm1)) + (:single-float + (! gpr-to-single-float ($ arm::s0 :class :fpr :mode :single-float) arm::imm0))) + (@ continue-label) (when vreg (cond ((eq resultspec :void) (<- nil)) ((eq resultspec :double-float) - (if (and (eq (hard-regspec-class vreg) hard-reg-class-fpr) - (eq (get-regspec-mode vreg) hard-reg-class-fpr-mode-double)) - (! gpr-pair-to-double-float vreg arm::imm0 arm::imm1) - (progn - (! gpr-pair-to-double-float arm::d0 arm::imm0 arm::imm1) - (<- ($ arm::d0 :class :fpr :mode :double-float))))) + (<- ($ arm::d0 :class :fpr :mode :double-float))) ((eq resultspec :single-float) - (if (and (eq (hard-regspec-class vreg) hard-reg-class-fpr) - (eq (get-regspec-mode vreg) hard-reg-class-fpr-mode-single)) - (! gpr-to-single-float vreg arm::imm0) - (progn - (! gpr-to-single-float arm::s0 arm::imm0) - (<- ($ arm::s0 :class :fpr :mode :single-float))))) + (<- ($ arm::s0 :class :fpr :mode :single-float))) ((eq resultspec :unsigned-doubleword) (ensuring-node-target (target vreg)