Changeset 15340

Timestamp:

Apr 21, 2012, 4:15:09 AM (13 years ago)

Author:

Gary Byers

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:

• arm-arch.lisp (modified) (1 diff)
• arm-vinsns.lisp (modified) (2 diffs)
• arm2.lisp (modified) (4 diffs)

trunk/source/compiler/ARM/arm-arch.lisp

@@ -439 +439 @@
              (defarmsubprim .SPdebind)
              (defarmsubprim .SPeabi-callback)
+             (defarmsubprim .SPeabi-ff-callhf)
              )))))
 

trunk/source/compiler/ARM/arm-vinsns.lisp

@@ -4049 +4049 @@
 (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 +4134 @@
   (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.

trunk/source/compiler/ARM/arm2.lisp

@@ -8800 +8800 @@
       (^)))))
 
+;;; 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 +8913 @@
           (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 +8935 @@
       (! 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 +8978 @@
                (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)