[Openmcl-cvs-notifications] r15340 - in /trunk/source/compiler/ARM: arm-arch.lisp arm-vinsns.lisp arm2.lisp
gb at clozure.com
gb at clozure.com
Sat Apr 21 06:15:09 CDT 2012
Author: gb
Date: Sat Apr 21 06:15:09 2012
New Revision: 15340
Log:
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.)
Modified:
trunk/source/compiler/ARM/arm-arch.lisp
trunk/source/compiler/ARM/arm-vinsns.lisp
trunk/source/compiler/ARM/arm2.lisp
Modified: trunk/source/compiler/ARM/arm-arch.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/ARM/arm-arch.lisp (original)
+++ trunk/source/compiler/ARM/arm-arch.lisp Sat Apr 21 06:15:09 2012
@@ -438,6 +438,7 @@
(defarmsubprim .SPeabi-ff-call)
(defarmsubprim .SPdebind)
(defarmsubprim .SPeabi-callback)
+ (defarmsubprim .SPeabi-ff-callhf)
)))))
=
=
Modified: trunk/source/compiler/ARM/arm-vinsns.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/ARM/arm-vinsns.lisp (original)
+++ trunk/source/compiler/ARM/arm-vinsns.lisp Sat Apr 21 06:15:09 2012
@@ -4048,6 +4048,8 @@
=
(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 (()
()
((preserve (:lisp #.arm::=
arg_z))
@@ -4131,7 +4133,14 @@
((temp :imm)))
(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.
#+maybe-never
Modified: trunk/source/compiler/ARM/arm2.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/ARM/arm2.lisp (original)
+++ trunk/source/compiler/ARM/arm2.lisp Sat Apr 21 06:15:09 2012
@@ -8799,6 +8799,110 @@
(arm2-one-targeted-reg-form seg arg target))
(^)))))
=
+;;; Address to call is on top of the vstack. Leave it there.
+(defun arm2-eabi-hard-float-ff-call (seg argspecs argvals soft-label cont=
inue-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 (<=3D 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 ((<=3D 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-no=
de-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 ar=
gvals resultspec &optional monitor)
(declare (ignore monitor))
(let* ((*arm2-vstack* *arm2-vstack*)
@@ -8808,8 +8912,19 @@
(natural-64-bit-alignment
(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 a=
rm::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 cont=
inue-label))
+ (@ soft-label)
(dolist (argspec argspecs)
(case argspec
((:double-float :unsigned-doubleword :signed-doubleword)
@@ -8819,11 +8934,9 @@
(t (incf next-arg-word))))
(! 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 a=
rm::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))
(vals argvals (cdr vals)))
@@ -8864,40 +8977,34 @@
(! set-eabi-c-arg ptr next-arg-word)
(incf next-arg-word)))
(t
- (with-imm-target () (valreg :natural)
- (let* ((reg (arm2-unboxed-integer-arg-to-reg seg valform v=
alreg 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) (=3D 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-no=
de-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-mod=
e-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-mod=
e-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)
(! makeu64)
More information about the Openmcl-cvs-notifications
mailing list