Index: /trunk/source/compiler/ARM/arm-vinsns.lisp
===================================================================
--- /trunk/source/compiler/ARM/arm-vinsns.lisp	(revision 14158)
+++ /trunk/source/compiler/ARM/arm-vinsns.lisp	(revision 14159)
@@ -1975,5 +1975,5 @@
   (str prevsp (:@ sp (:$ 4))))
 
-(define-arm-vinsn (alloc-variable-c-frame :predicatable)
+(define-arm-vinsn (alloc-variable-eabi-c-frame :predicatable)
     (()
      ((n-c-args :lisp))
@@ -1981,5 +1981,5 @@
       (size :imm)
       (prevsp :imm)))
-  (add size n-c-args (:$ (ash (+ 4 1) arm::word-shift)))
+  (add size n-c-args (:$ (ash (+ 4 4 1) arm::word-shift)))
   (bic size size (:$ arm::fixnumone))
   (add size size (:$ arm::fixnumone))
Index: /trunk/source/compiler/ARM/arm2.lisp
===================================================================
--- /trunk/source/compiler/ARM/arm2.lisp	(revision 14158)
+++ /trunk/source/compiler/ARM/arm2.lisp	(revision 14159)
@@ -8470,6 +8470,5 @@
   (let* ((reg (arm2-one-untargeted-reg-form seg size arm::arg_z)))
     (ecase (backend-name *target-backend*)
-      (:linuxarm32 (! alloc-variable-eabi-c-frame reg))
-      ((:darwinarm32 :darwinarm64 :linuxarm64) (! alloc-variable-c-frame reg)))
+      (:linuxarm (! alloc-variable-eabi-c-frame reg)))
     (arm2-open-undo $undo-arm-c-frame)
     (arm2-undo-body seg vreg xfer body old-stack)))
Index: /trunk/source/level-0/ARM/arm-def.lisp
===================================================================
--- /trunk/source/level-0/ARM/arm-def.lisp	(revision 14158)
+++ /trunk/source/level-0/ARM/arm-def.lisp	(revision 14159)
@@ -294,718 +294,62 @@
   (return-lisp-frame))
 
-#+notyet
-(progn
-;;; FF-call, in LAP.
-#+eabi-target
-(progn
-  (defarmlapfunction %%ff-call ((fploads 8)
-                                (single-offset 4)
-                                (double-offset 0)
-                                (framesize arg_x) ;always even, negative, includes frame overhead
-                                (buf arg_y)
-                                (entry arg_z))
-    (check-nargs 6)
-    (la imm0 12 vsp)
-    (save-lisp-context imm0)
-    (stwux sp sp framesize)
-    (stw sp 4 sp)
-    (macptr-ptr imm2 buf)
-    (mov imm1 imm2)
-    (la imm3 ppc32::eabi-c-frame.param0 sp)
-    (li imm0 0)
-    (lwz temp1 single-offset vsp)
-    (lwz temp2 double-offset vsp)
-    @copy
-    (addi imm0 imm0 8)
-    (cmpw imm0 temp1)
-    (lfd fp0 0 imm2)
-    (la imm2 8 imm2)
-    (stfd fp0 0 imm3)
-    (la imm3 8 imm3)
-    (blt @copy)
-    ;; We've copied the gpr-save area and the "other" arg words.
-    ;; Sadly, we may still need to load up to 8 FPRs, and we have
-    ;; to use some pretty ugly code to do so.
-    (add temp1 temp1 imm1)
-    (add temp2 temp2 imm1)
-    (lwz temp0 fploads vsp)
-    @load-fp1
-    (lbz imm0 (+ ppc32::misc-data-offset 0) temp0)
-    (cmpwi imm0 1)
-    (blt @loaded)
-    (bne @load-fp1-double)
-    (lfs fp1 0 temp1)
-    (la temp1 4 temp1)
-    (b @load-fp2)
-    @load-fp1-double
-    (lfd fp1 0 temp2)
-    (la temp2 8 temp2)
-    @load-fp2
-    (lbz imm0 (+ ppc32::misc-data-offset 1) temp0)
-    (cmpwi imm0 1)
-    (blt @loaded)
-    (bne @load-fp2-double)
-    (lfs fp2 0 temp1)
-    (la temp1 4 temp1)
-    (b @load-fp3)
-    @load-fp2-double
-    (lfd fp2 0 temp2)
-    (la temp2 8 temp2)
-    @load-fp3
-    (lbz imm0 (+ ppc32::misc-data-offset 2) temp0)
-    (cmpwi imm0 1)
-    (blt @loaded)
-    (bne @load-fp3-double)
-    (lfs fp3 0 temp1)
-    (la temp1 4 temp1)
-    (b @load-fp4)
-    @load-fp3-double
-    (lfd fp3 0 temp2)
-    (la temp2 8 temp2)
-    @load-fp4
-    (lbz imm0 (+ ppc32::misc-data-offset 3) temp0)
-    (cmpwi imm0 1)
-    (blt @loaded)
-    (bne @load-fp4-double)
-    (lfs fp4 0 temp1)
-    (la temp1 4 temp1)
-    (b @load-fp5)
-    @load-fp4-double
-    (lfd fp4 0 temp2)
-    (la temp2 8 temp2)
-    @load-fp5
-    (lbz imm0 (+ ppc32::misc-data-offset 4) temp0)
-    (cmpwi imm0 1)
-    (blt @loaded)
-    (bne @load-fp5-double)
-    (lfs fp5 0 temp1)
-    (la temp1 4 temp1)
-    (b @load-fp6)
-    @load-fp5-double
-    (lfd fp5 0 temp2)
-    (la temp2 8 temp2)
-    @load-fp6
-    (lbz imm0 (+ ppc32::misc-data-offset 5) temp0)
-    (cmpwi imm0 1)
-    (blt @loaded)
-    (bne @load-fp6-double)
-    (lfs fp6 0 temp1)
-    (la temp1 4 temp1)
-    (b @load-fp7)
-    @load-fp6-double
-    (lfd fp6 0 temp2)
-    (la temp2 8 temp2)
-    @load-fp7
-    (lbz imm0 (+ ppc32::misc-data-offset 6) temp0)
-    (cmpwi imm0 1)
-    (blt @loaded)
-    (bne @load-fp7-double)
-    (lfs fp7 0 temp1)
-    (la temp1 4 temp1)
-    (b @load-fp8)
-    @load-fp7-double
-    (lfd fp7 0 temp2)
-    (la temp2 8 temp2)
-    @load-fp8
-    (lbz imm0 (+ ppc32::misc-data-offset 0) temp0)
-    (cmpwi imm0 1)
-    (blt @loaded)
-    (bne @load-fp8-double)
-    (lfs fp8 0 temp1)
-    (b @loaded)
-    @load-fp8-double
-    (lfd fp8 0 temp2)
-    @loaded
-    (vpush buf)
-    (bla .SPeabi-ff-call)
-    (vpop buf)
-    (macptr-ptr imm2 buf)
-    (stw imm0 0 imm2)
-    (stw imm1 4 imm2)
-    (stfs fp1 8 imm2)
-    (stfd fp1 16 imm2)
-    (restore-full-lisp-context)
-    (li arg_z (target-nil-value))
-    (bx lr))
+(defarmlapfunction %do-ff-call ((tag arg_x) (result arg_y) (entry arg_z))
+  (stmdb (:! vsp) (tag result))
+  (bla .SPeabi-ff-call)
+  (ldmia (:! vsp) (tag result))
+  (macptr-ptr imm2 result)
+  (str imm0 (:@ imm2 (:$ 0)))
+  (str imm1 (:@ imm2 (:$ 4)))
+  (vpush1 tag)
+  (mov arg_z 'nil)
+  (vpush1 arg_z)
+  (set-nargs 1)
+  (bla .SPthrow))
   
-  (defun %ff-call (entry &rest specs-and-vals)
-    "Call the foreign function at address entrypoint passing the values of
-each arg as a foreign argument of type indicated by the corresponding
-arg-type-keyword. Returns the foreign function result (coerced to a Lisp
-object of type indicated by result-type-keyword), or NIL if
-result-type-keyword is :VOID or NIL"
-    (declare (dynamic-extent specs-and-vals))
-    (let* ((len (length specs-and-vals))
-           (other-offset 8)
-           (single-float-offset 8)
-           (double-float-offset 0)
-           (nsingle-floats 0)
-           (ndouble-floats 0)
-           (nother-words 0)
-           (nfpr-args 0)
-           (ngpr-args 0))
-      (declare (fixnum len  other-offset single-float-offset double-float-offset
-                       nsingle-floats ndouble-floats nother-words nfpr-args ngpr-args))
-      (unless (oddp len)
-        (error "Length of ~s is even.  Missing result ?" specs-and-vals))
-
-      (let* ((result-spec (or (car (last specs-and-vals)) :void))
-             (nargs (ash (the fixnum (1- len)) -1))
-             (fpr-reloads (make-array 8 :element-type '(unsigned-byte 8))))
-        (declare (fixnum nargs) (dynamic-extent fpr-reloads))
-        (do* ((i 0 (1+ i))
-              (specs specs-and-vals (cddr specs))
-              (spec (car specs) (car specs)))
-             ((= i nargs))
-          (declare (fixnum i))
-          (ecase spec
-            (:double-float (incf nfpr-args)
-                           (if (<= nfpr-args 8)
-                             (incf ndouble-floats)
-                             (progn
-                               (if (oddp nother-words)
-                                 (incf nother-words))
-                               (incf nother-words 2))))
-            (:single-float (incf nfpr-args)
-                           (if (<= nfpr-args 8)
-                             (incf nsingle-floats)
-                             (incf nother-words)))
-	    ((:signed-doubleword :unsigned-doubleword)
-	     (if (oddp ngpr-args)
-	       (incf ngpr-args))
-	     (incf ngpr-args 2)
-	     (when (> ngpr-args 8)
-	       (if (oddp nother-words)
-		 (incf nother-words))
-	       (incf nother-words 2)))
-            ((:signed-byte :unsigned-byte :signed-halfword :unsigned-halfword
-                           :signed-fullword :unsigned-fullword :address)
-	     (incf ngpr-args)
-             (if (> ngpr-args 8)
-               (incf nother-words)))))
-        (let* ((single-words (+ 8 nother-words nsingle-floats))
-               (total-words (if (zerop ndouble-floats)
-                              single-words
-                              (+ (the fixnum (+ ndouble-floats ndouble-floats))
-                                 (the fixnum (logand (lognot 1)
-                                                     (the fixnum (1+ single-words))))))))
-          (declare (fixnum total-words single-words))
-          (%stack-block
-              ((buf (ash total-words 2)))
-            (setq single-float-offset (+ other-offset nother-words))
-            (setq double-float-offset
-                  (logand (lognot 1)
-                          (the fixnum (1+ (the fixnum (+ single-float-offset nsingle-floats))))))
-           ;;; Make another pass through the arg/value pairs, evaluating each arg into
-           ;;; the buffer.
-            (do* ((i 0 (1+ i))
-                  (specs specs-and-vals (cddr specs))
-                  (spec (car specs) (car specs))
-                  (val (cadr specs) (cadr specs))
-                  (ngpr 0)
-                  (nfpr 0)
-                  (gpr-byte-offset 0)
-                  (other-byte-offset (ash other-offset 2))
-                  (single-byte-offset (ash single-float-offset 2))
-                  (double-byte-offset (ash double-float-offset 2)))
-                 ((= i nargs))
-              (declare (fixnum i gpr-byte-offset single-byte-offset double-byte-offset
-                               ngpr nfpr))
-              (case spec
-                (:double-float
-                 (cond ((< nfpr 8)
-                        (setf (uvref fpr-reloads nfpr) 2
-                              (%get-double-float buf double-byte-offset) val
-                              double-byte-offset (+ double-byte-offset 8)))
-                       (t
-                        (setq other-byte-offset (logand (lognot 7)
-                                                        (the fixnum (+ other-byte-offset 4))))
-                        (setf (%get-double-float buf other-byte-offset) val)
-                        (setq other-byte-offset (+ other-byte-offset 8))))
-                 (incf nfpr))
-                (:single-float
-                 (cond ((< nfpr 8)
-                        (setf (uvref fpr-reloads nfpr) 1
-                              (%get-single-float buf single-byte-offset) val
-                              single-byte-offset (+ single-byte-offset 4)))
-                             
-                       (t
-                        (setf (%get-single-float buf other-byte-offset) val
-                              other-byte-offset (+ other-byte-offset 4))))
-                 (incf nfpr))
-                (:address
-                 (cond ((< ngpr 8)
-                        (setf (%get-ptr buf gpr-byte-offset) val
-                              gpr-byte-offset (+ gpr-byte-offset 4)))
-                       (t
-                        (setf (%get-ptr buf other-byte-offset) val
-                              other-byte-offset (+ other-byte-offset 4))))
-                 (incf ngpr))
-                ((:signed-doubleword :unsigned-doubleword)
-                 (when (oddp ngpr)
-                   (incf ngpr)
-                   (incf gpr-byte-offset 4))
-                 (cond ((< ngpr 8)
-                        (if (eq spec :signed-doubleword)
-                          (setf (%get-signed-long-long buf gpr-byte-offset) val)
-                          (setf (%get-unsigned-long-long buf gpr-byte-offset) val))
-                        (incf gpr-byte-offset 8))
-                       (t
-                        (when (logtest other-byte-offset 7)
-                          (incf other-byte-offset 4))
-                        (if (eq spec :signed-doubleword)
-                          (setf (%get-signed-long-long buf other-byte-offset) val)
-                          (setf (%get-unsigned-long-long buf other-byte-offset) val))
-                        (incf other-byte-offset 8)))
-                 (incf ngpr 2))
-		((:unsigned-byte :unsigned-halfword :unsigned-fullword)
-                 (cond ((< ngpr 8)
-                        (setf (%get-unsigned-long buf gpr-byte-offset) val
-                              gpr-byte-offset (+ gpr-byte-offset 4)))
-                       (t
-                        (setf (%get-unsigned-long buf other-byte-offset) val
-                              other-byte-offset (+ other-byte-offset 4))))
-		 (incf ngpr))
-                (t
-                 (cond ((< ngpr 8)
-                        (setf (%get-long buf gpr-byte-offset) val
-                              gpr-byte-offset (+ gpr-byte-offset 4)))
-                       (t
-                        (setf (%get-long buf other-byte-offset) val
-                              other-byte-offset (+ other-byte-offset 4))))
-                 (incf ngpr))))
-            (%%ff-call fpr-reloads
-                       single-float-offset
-                       double-float-offset
-                       (the fixnum (-
-                                    (ash (the fixnum
-                                           (+ 6
-                                              (the fixnum (logand
-                                                           (lognot 1)
-                                                           (the fixnum (1+ total-words))))))
-                                         2)))
-                       buf
-                       entry)
-            (ecase result-spec
-              (:void nil)
-              (:single-float (%get-single-float buf 8))
-              (:double-float (%get-double-float buf 16))
-              (:address (%get-ptr buf))
-              (:signed-doubleword (%get-signed-long-long buf 0))
-              (:unsigned-doubleword (%get-unsigned-long-long buf 0))
-              (:signed-fullword (%get-signed-long buf))
-              (:unsigned-fullword (%get-unsigned-long buf))
-              (:signed-halfword (%get-signed-word buf 2))
-              (:unsigned-halfword (%get-unsigned-word buf 2))
-              (:signed-byte (%get-signed-byte buf 3))
-              (:unsigned-byte (%get-unsigned-byte buf 3))))))))
-  )
-
-
-
-
-
-;;; In the PowerOpen ABI, all arguments are passed in a contiguous
-;;; block.  The first 13 (!) FP args are passed in FP regs; doubleword
-;;; arguments are aligned on word boundaries.
-#+poweropen-target
-(progn
-  #+ppc32-target
-  (progn
-    (defun %ff-call (entry &rest specs-and-vals)
-      (declare (dynamic-extent specs-and-vals))
-      (let* ((len (length specs-and-vals))
-             (total-words 0))
-        (declare (fixnum len total-words))
-        (unless (oddp len)
-          (error "Length of ~s is even.  Missing result ?" specs-and-vals))
-        (let* ((result-spec (or (car (last specs-and-vals)) :void))
-               (nargs (ash (the fixnum (1- len)) -1))
-               (fpr-reload-sizes (make-array 13 :element-type '(unsigned-byte 8)))
-               (fpr-reload-offsets (make-array 13 :element-type '(unsigned-byte 16))))
-          (declare (fixnum nargs) (dynamic-extent fpr-reload-sizes fpr-reload-offsets))
-          (do* ((i 0 (1+ i))
-                (specs specs-and-vals (cddr specs))
-                (spec (car specs) (car specs)))
-               ((= i nargs))
-            (declare (fixnum i))
-            (case spec
-              ((:double-float :signed-doubleword :unsigned-doubleword)
-               (incf total-words 2))
-              ((:single-float :signed-byte :unsigned-byte :signed-halfword
-                              :unsigned-halfword :signed-fullword
-                              :unsigned-fullword :address)
-               (incf total-words))
-              (t (if (typep spec 'unsigned-byte)
-                   (incf total-words spec)
-                   (error "Invalid argument spec ~s" spec)))))
-          (%stack-block ((buf (ash (logand (lognot 1) (1+ (max 6  total-words))) 2)))
-            (do* ((i 0 (1+ i))
-                  (fpr 0)
-                  (offset 0 (+ offset 4))
-                  (specs specs-and-vals (cddr specs))
-                  (spec (car specs) (car specs))
-                  (val (cadr specs) (cadr specs)))
-                 ((= i nargs))
-              (declare (fixnum i offset fpr))
-              (case spec
-                (:double-float
-                 (when (< fpr 13)
-                   (setf (uvref fpr-reload-sizes fpr) 2
-                         (uvref fpr-reload-offsets fpr) offset))
-                 (incf fpr)
-                 (setf (%get-double-float buf offset) val)
-                 (incf offset 4))
-                (:single-float
-                 (when (< fpr 13)
-                   (setf (uvref fpr-reload-sizes fpr) 1
-                         (uvref fpr-reload-offsets fpr) offset))
-                 (incf fpr)
-                 (setf (%get-single-float buf offset) val))
-                (:signed-doubleword
-                 (setf (%get-signed-long-long buf offset) val)
-                 (incf offset 4))
-                (:unsigned-doubleword
-                 (setf (%get-unsigned-long-long buf offset) val)
-                 (incf offset 4))
-                (:address
-                 (setf (%get-ptr buf offset) val))
-		((:unsigned-byte :unsigned-halfword :unsigned-fullword)
-		 (setf (%get-unsigned-long buf offset) val))
-                (t
-                 (if (typep spec 'unsigned-byte)
-                   (dotimes (i spec (decf offset 4))
-                     (setf (%get-ptr buf offset)
-                           (%get-ptr val (* i 4)))
-                     (incf offset 4))
-                   (setf (%get-long buf offset) val)))))
-            (let* ((frame-size (if (<= total-words 8)
-                                 (ash
-                                  (+ ppc32::c-frame.size ppc32::lisp-frame.size)
-                                  -2)
-                                 (+
-                                  (ash
-                                   (+ ppc32::c-frame.size ppc32::lisp-frame.size)
-                                   -2)
-                                  (logand (lognot 1)
-                                          (1+ (- total-words 8)))))))
-              
-              (%%ff-call
-               fpr-reload-sizes
-               fpr-reload-offsets
-               (- (logandc2 (+ frame-size 3) 3))
-               total-words
-               buf
-               entry))
-            (ecase result-spec
-              (:void nil)
-              (:single-float (%get-single-float buf 8))
-              (:double-float (%get-double-float buf 16))
-              (:address (%get-ptr buf))
-              (:signed-doubleword (%get-signed-long-long buf 0))
-              (:unsigned-doubleword (%get-unsigned-long-long buf 0))
-              (:signed-fullword (%get-signed-long buf))
-              (:unsigned-fullword (%get-unsigned-long buf))
-              (:signed-halfword (%get-signed-word buf 2))
-              (:unsigned-halfword (%get-unsigned-word buf 2))
-              (:signed-byte (%get-signed-byte buf 3))
-              (:unsigned-byte (%get-unsigned-byte buf 3)))))))
-
-
-    (defarmlapfunction %%ff-call ((reload-sizes 8)
-                                  (reload-offsets 4)
-                                  (frame-size 0)			     
-                                  (total-words arg_x)
-                                  (buf arg_y)
-                                  (entry arg_z))
-      (check-nargs 6)
-      (la imm0 12 vsp)
-      (save-lisp-context imm0)
-      (lwz imm0 frame-size vsp)
-      (stwux sp sp imm0)
-      (stw sp ppc32::c-frame.savelr sp)
-      (macptr-ptr imm2 buf)
-      (mov imm1 imm2)
-      (la imm3 ppc32::c-frame.param0 sp)
-      (li temp1 0)
-      @copy
-      (addi temp1 temp1 '1)
-      (cmpw temp1 total-words)
-      (lwz imm0 0 imm2)
-      (la imm2 4 imm2)
-      (stw imm0 0 imm3)
-      (la imm3 4 imm3)
-      (blt @copy)
-      (lwz temp0 reload-sizes vsp)
-      (lwz temp1 reload-offsets vsp)
-      @load-fp1
-      (lbz imm0 (+ ppc32::misc-data-offset 0) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 0) temp1)
-      (blt @loaded)
-      (bne @load-fp1-double)
-      (lfsx fp1 imm1 imm2)
-      (b @load-fp2)
-      @load-fp1-double
-      (lfdx fp1 imm1 imm2)
-
-      @load-fp2
-      (lbz imm0 (+ ppc32::misc-data-offset 1) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 2) temp1)
-      (blt @loaded)
-      (bne @load-fp2-double)
-      (lfsx fp2 imm1 imm2)
-      (b @load-fp3)
-      @load-fp2-double
-      (lfdx fp2 imm1 imm2)
-
-      @load-fp3
-      (lbz imm0 (+ ppc32::misc-data-offset 2) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 4) temp1)
-      (blt @loaded)
-      (bne @load-fp3-double)
-      (lfsx fp3 imm1 imm2)
-      (b @load-fp4)
-      @load-fp3-double
-      (lfdx fp3 imm1 imm2)
-
-      @load-fp4
-      (lbz imm0 (+ ppc32::misc-data-offset 3) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 6) temp1)
-      (blt @loaded)
-      (bne @load-fp4-double)
-      (lfsx fp4 imm1 imm2)
-      (b @load-fp5)
-      @load-fp4-double
-      (lfdx fp4 imm1 imm2)
-
-      @load-fp5
-      (lbz imm0 (+ ppc32::misc-data-offset 4) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 8) temp1)
-      (blt @loaded)
-      (bne @load-fp5-double)
-      (lfsx fp5 imm1 imm2)
-      (b @load-fp6)
-      @load-fp5-double
-      (lfdx fp5 imm1 imm2)
-
-      @load-fp6
-      (lbz imm0 (+ ppc32::misc-data-offset 5) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 10) temp1)
-      (blt @loaded)
-      (bne @load-fp1-double)
-      (lfsx fp6 imm1 imm2)
-      (b @load-fp7)
-      @load-fp6-double
-      (lfdx fp6 imm1 imm2)
-
-      @load-fp7
-      (lbz imm0 (+ ppc32::misc-data-offset 6) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 12) temp1)
-      (blt @loaded)
-      (bne @load-fp1-double)
-      (lfsx fp7 imm1 imm2)
-      (b @load-fp8)
-      @load-fp7-double
-      (lfdx fp7 imm1 imm2)
-
-      @load-fp8
-      (lbz imm0 (+ ppc32::misc-data-offset 7) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 14) temp1)
-      (blt @loaded)
-      (bne @load-fp8-double)
-      (lfsx fp8 imm1 imm2)
-      (b @load-fp9)
-      @load-fp8-double
-      (lfdx fp8 imm1 imm2)
-
-      @load-fp9
-      (lbz imm0 (+ ppc32::misc-data-offset 8) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 16) temp1)
-      (blt @loaded)
-      (bne @load-fp9-double)
-      (lfsx fp9 imm1 imm2)
-      (b @load-fp10)
-      @load-fp9-double
-      (lfdx fp9 imm1 imm2)
-
-      @load-fp10
-      (lbz imm0 (+ ppc32::misc-data-offset 9) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 18) temp1)
-      (blt @loaded)
-      (bne @load-fp10-double)
-      (lfsx fp10 imm1 imm2)
-      (b @load-fp11)
-      @load-fp10-double
-      (lfdx fp10 imm1 imm2)
-
-      @load-fp11
-      (lbz imm0 (+ ppc32::misc-data-offset 10) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 20) temp1)
-      (blt @loaded)
-      (bne @load-fp11-double)
-      (lfsx fp11 imm1 imm2)
-      (b @load-fp12)
-      @load-fp11-double
-      (lfdx fp11 imm1 imm2)
-
-      @load-fp12
-      (lbz imm0 (+ ppc32::misc-data-offset 11) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 22) temp1)
-      (blt @loaded)
-      (bne @load-fp12-double)
-      (lfsx fp12 imm1 imm2)
-      (b @load-fp13)
-      @load-fp12-double
-      (lfdx fp12 imm1 imm2)
-
-      @load-fp13
-      (lbz imm0 (+ ppc32::misc-data-offset 12) temp0)
-      (cmpwi imm0 1)
-      (lhz imm2 (+ ppc32::misc-data-offset 24) temp1)
-      (blt @loaded)
-      (bne @load-fp13-double)
-      (lfsx fp13 imm1 imm2)
-      (b @loaded)
-      @load-fp13-double
-      (lfdx fp13 imm1 imm2)
-      @loaded
-      (vpush buf)
-      (bla .SPpoweropen-ffcall)
-      @called
-      (vpop buf)
-      (macptr-ptr imm2 buf)
-      (stw imm0 0 imm2)
-      (stw imm1 4 imm2)
-      (stfs fp1 8 imm2)
-      (stfd fp1 16 imm2)
-      (restore-full-lisp-context)
-      (li arg_z (target-nil-value))
-      (bx lr))
-    )
-
-  #+ppc64-target
-  (progn
-  ;;; There are a few funky, non-obvious things going on here.
-  ;;; The main %FF-CALL function uses WITH-VARIABLE-C-FRAME;
-  ;;; the compiler will generate code to pop that frame off
-  ;;; of the C/control stack, but the subprim that implements
-  ;;; %ff-call has already popped it off.  To put things back
-  ;;; in balance, the LAP function %%FF-RESULT pushes an
-  ;;; extra frame on the cstack.
-  ;;; %FF-CALL calls %%FF-RESULT to box the result, which may
-  ;;; be in r3/imm0 or in fp1.  It's critical that the call
-  ;;; to %%FF-RESULT not be compiled as "multiple-value returning",
-  ;;; since the MV machinery may clobber IMM0.
-    (defarmlapfunction %%ff-result ((spec arg_z))
-      (stdu sp -160 sp)
-      (ld arg_y ':void nfn)
-      (cmpd cr0 spec arg_y)
-      (ld arg_x ':address nfn)
-      (cmpd cr1 spec arg_x)
-      (ld temp3 ':single-float nfn)
-      (cmpd cr2 spec temp3)
-      (ld arg_y ':double-float nfn)
-      (cmpd cr3 spec arg_y)
-      (ld arg_x ':unsigned-doubleword nfn)
-      (cmpd cr4 spec arg_x)
-      (ld temp3 ':signed-doubleword nfn)
-      (cmpd cr5 spec temp3)
-      (beq cr0 @void)
-      (beq cr1 @address)
-      (beq cr2 @single-float)
-      (beq cr3 @double-float)
-      (beq cr4 @unsigned-doubleword)
-      (beq cr5 @signed-doubleword)
-      (box-fixnum arg_z imm0)
-      (bx lr)
-      @void
-      (li arg_z nil)
-      (bx lr)
-      @address
-      (li imm1 ppc64::macptr-header)
-      (subi allocptr allocptr (- ppc64::macptr.size ppc64::fulltag-misc))
-      (tdlt allocptr allocbase)
-      (std imm1 ppc64::misc-header-offset allocptr)
-      (mov arg_z allocptr)
-      (clrrdi allocptr allocptr 4)
-      (std imm0 ppc64::macptr.address arg_z)
-      (bx lr)
-      @single-float
-      (put-single-float fp1 arg_z)
-      (bx lr)
-      @double-float
-      (li imm1 ppc64::double-float-header)
-      (subi allocptr allocptr (- ppc64::double-float.size ppc64::fulltag-misc))
-      (tdlt allocptr allocbase)
-      (std imm1 ppc64::misc-header-offset allocptr)
-      (mov arg_z allocptr)
-      (clrrdi allocptr allocptr 4)
-      (stfd fp1 ppc64::macptr.address arg_z)
-      (bx lr)
-      @unsigned-doubleword
-      (ba .SPmakeu64)
-      @signed-doubleword
-      (ba .SPmakes64))
-
-  ;;; This is just here so that we can jump to a subprim from lisp.
-    (defarmlapfunction %do-ff-call ((regbuf arg_y) (entry arg_z))
-      (cmpdi cr0 regbuf nil)
-      (bnea cr0 .SPpoweropen-ffcall-return-registers)
-      (ba .SPpoweropen-ffcall))
-  
-    (defun %ff-call (entry &rest specs-and-vals)
-      (declare (dynamic-extent specs-and-vals))
-      (let* ((len (length specs-and-vals))
-             (total-words 0)
-             (registers nil))
-        (declare (fixnum len total-words))
-        (let* ((result-spec (or (car (last specs-and-vals)) :void))
-               (nargs (ash (the fixnum (1- len)) -1)))
-          (declare (fixnum nargs))
-          (ecase result-spec
-            ((:address :unsigned-doubleword :signed-doubleword
-                       :single-float :double-float
-                       :signed-fullword :unsigned-fullword
-                       :signed-halfword :unsigned-halfword
-                       :signed-byte :unsigned-byte
-                       :void)
-             (do* ((i 0 (1+ i))
-                   (specs specs-and-vals (cddr specs))
-                   (spec (car specs) (car specs)))
-                  ((= i nargs))
-               (declare (fixnum i))
-               (case spec
-                 (:registers nil)
-                 ((:address :unsigned-doubleword :signed-doubleword
-                            :single-float :double-float
-                            :signed-fullword :unsigned-fullword
-                            :signed-halfword :unsigned-halfword
-                            :signed-byte :unsigned-byte
-                            :hybrid-int-float :hybrid-float-float
-                            :hybrid-float-int)
-                  (incf total-words))
-                 (t (if (typep spec 'unsigned-byte)
-                      (incf total-words spec)
-                      (error "unknown arg spec ~s" spec)))))
-             (%stack-block ((fp-args (* 13 8)))
-               (with-variable-c-frame
-                   total-words frame
-                   (with-macptrs ((argptr))
+(defun %ff-call (entry &rest specs-and-vals)
+  (declare (dynamic-extent specs-and-vals))
+  (let* ((len (length specs-and-vals))
+         (total-words 0))
+    (declare (fixnum len total-words))
+    (let* ((result-spec (or (car (last specs-and-vals)) :void))
+           (nargs (ash (the fixnum (1- len)) -1)))
+      (declare (fixnum nargs))
+      (ecase result-spec
+        ((:address :unsigned-doubleword :signed-doubleword
+                   :single-float :double-float
+                   :signed-fullword :unsigned-fullword
+                   :signed-halfword :unsigned-halfword
+                   :signed-byte :unsigned-byte
+                   :void)
+         (do* ((i 0 (1+ i))
+               (specs specs-and-vals (cddr specs))
+               (spec (car specs) (car specs)))
+              ((= i nargs))
+           (declare (fixnum i))
+           (case spec
+             ((:address :single-float
+                        :signed-fullword :unsigned-fullword
+                        :signed-halfword :unsigned-halfword
+                        :signed-byte :unsigned-byte)
+              (incf total-words))
+             ((:double-float :unsigned-doubleword :signed-doubleword)
+              (setq total-words (+ total-words (logand total-words 1)))
+              (incf total-words 2))
+
+             (t (if (typep spec 'unsigned-byte)
+                  (incf total-words spec)
+                  (error "unknown arg spec ~s" spec)))))
+         ;; It's necessary to ensure that the C frame is the youngest thing on
+         ;; the foreign stack here.
+         (let* ((tag (cons nil nil)))
+           (declare (dynamic-extent tag))
+           (%stack-block ((result 8))
+             (catch tag
+               (with-macptrs ((argptr))
+                 (with-variable-c-frame
+                     total-words frame
                      (%setf-macptr-to-object argptr frame)
-                     (let* ((offset ppc64::c-frame.param0)
-                            (n-fp-args 0))
-                       (declare (fixnum offset n-fp-args))
+                     (let* ((arg-offset 8))
+                       (declare (fixnum arg-offset))
                        (do* ((i 0 (1+ i))
                              (specs specs-and-vals (cddr specs))
@@ -1015,68 +359,52 @@
                          (declare (fixnum i))
                          (case spec
-                           (:registers (setq registers val))
-                           (:address (setf (%get-ptr argptr offset) val)
-                                     (incf offset 8))
-                           ((:signed-doubleword :signed-fullword :signed-halfword
-                                                :signed-byte)
-                          
-                            (setf (%%get-signed-longlong argptr offset) val)
-                            (incf offset 8))
-                           ((:unsigned-doubleword :unsigned-fullword :unsigned-halfword
-                                                  :unsigned-byte)
-                            (setf (%%get-unsigned-longlong argptr offset) val)
-                            (incf offset 8))
-                           (:hybrid-int-float
-                            (setf (%%get-unsigned-longlong argptr offset) val)
-                            (when (< n-fp-args 13)
-                              (setf (%get-double-float fp-args (* n-fp-args 8))
-                                    (%double-float (%get-single-float argptr (+ offset 4)))))
-                            (incf n-fp-args)
-                            (incf offset 8))
-                           (:hybrid-float-int
-                            (setf (%%get-unsigned-longlong argptr offset) val)
-                            (when (< n-fp-args 13)
-                              (setf (%get-double-float fp-args (* n-fp-args 8))
-                                    (%double-float (%get-single-float argptr offset))))
-                            (incf n-fp-args)
-                            (incf offset 8))
-                           (:hybrid-float-float
-                            (setf (%%get-unsigned-longlong argptr offset) val)
-                            (when (< n-fp-args 13)
-                              (setf (%get-double-float fp-args (* n-fp-args 8))
-                                    (%double-float (%get-single-float argptr offset))))
-                            (incf n-fp-args)
-                            (when (< n-fp-args 13)
-                              (setf (%get-double-float fp-args (* n-fp-args 8))
-                                    (%double-float (%get-single-float argptr (+ offset 4)))))
-                            (incf n-fp-args)
-                            (incf offset 8))
+                           (:address
+                            (setf (%get-ptr argptr arg-offset) val)
+                            (incf arg-offset 4))
+                           (:signed-doubleword
+                            (when (logtest 7 arg-offset)
+                              (incf arg-offset 4))
+                            (setf (%%get-signed-longlong argptr arg-offset) val)
+                            (incf arg-offset 8))
+                           ((:signed-fullword :signed-halfword :signed-byte)
+                            (setf (%get-signed-long argptr arg-offset) val)
+                            (incf arg-offset 4))
+                           (:unsigned-doubleword
+                             (when (logtest 7 arg-offset)
+                               (incf arg-offset 4))
+                             (setf (%%get-unsigned-longlong argptr arg-offset) val)
+                             (incf arg-offset 8))
+                           ((:unsigned-fullword :unsigned-halfword :unsigned-byte)
+                            (setf (%get-unsigned-long argptr arg-offset) val)
+                            (incf arg-offset 4))
                            (:double-float
-                            (setf (%get-double-float argptr offset) val)
-                            (when (< n-fp-args 13)
-                              (setf (%get-double-float fp-args (* n-fp-args 8)) val))
-                            (incf n-fp-args)
-                            (incf offset 8))
+                            (when (logtest 7 arg-offset)
+                              (incf arg-offset 4))
+                            (setf (%get-double-float argptr arg-offset) val)
+                            (incf arg-offset 8))
                            (:single-float
-                            (setf (%get-single-float argptr offset) val)
-                            (when (< n-fp-args 13)
-                              (setf (%get-double-float fp-args (* n-fp-args 8))
-                                    (%double-float val)))
-                            (incf n-fp-args)
-                            (incf offset 8))
+                            (setf (%get-single-float argptr arg-offset) val)
+                            (incf arg-offset 4))
                            (t
-                            (let* ((p 0))
-                              (declare (fixnum p))
-                              (dotimes (i (the fixnum spec))
-                                (setf (%get-ptr argptr offset) (%get-ptr val p))
-                                (incf p 8)
-                                (incf offset 8))))))
-                       (%load-fp-arg-regs n-fp-args fp-args)
-                       (%do-ff-call registers entry)
-                       (values (%%ff-result result-spec)))))))))))
-
-    )
-  )
-)
+                              (let* ((p 0))
+                                (declare (fixnum p))
+                                (dotimes (i (the fixnum spec))
+                                  (setf (%get-ptr argptr arg-offset) (%get-ptr val p))
+                                  (incf p 4)
+                                  (incf arg-offset 4)))))))
+                         (%do-ff-call tag result entry))))
+             (ecase result-spec
+               (:void nil)
+               (:address (%get-ptr result 0))
+               (:unsigned-byte (%get-unsigned-byte result 0))
+               (:signed-byte (%get-signed-byte result 0))
+               (:unsigned-halfword (%get-unsigned-word result 0))
+               (:signed-halfword (%get-signed-word result 0))
+               (:unsigned-fullword (%get-unsigned-long result 0))
+               (:signed-fullword (%get-signed-long result 0))
+               (:unsigned-doubleword (%get-natural result 0))
+               (:signed-doubleword (%get-signed-natural result 0))
+               (:single-float (%get-single-float result 0))
+               (:double-float (%get-double-float result 0))))))))))