Moved arm eabi fixup to Asmexpand.

Instead of expanding the fixup code for incoming and outgoing
registers in the TargetPrinter we expand them in Asmexpand. This
simplifies the estimate size function and is a prerequisite for
the json export.
Bug 22472

1 files changed, 30 insertions, 157 deletions

diff --git a/arm/TargetPrinter.ml b/arm/TargetPrinter.ml
index 0cd3c908..cb66a9a1 100644
--- a/arm/TargetPrinter.ml
+++ b/arm/TargetPrinter.ml
@@ -71,9 +71,20 @@ struct
     | FR8 -> "s16"  | FR9 -> "s18"  | FR10 -> "s20"  | FR11 -> "s22"
     | FR12 -> "s24"  | FR13 -> "s26"  | FR14 -> "s28"  | FR15 -> "s30"
 
+  let single_param_reg_name = function
+    | SR0 -> "s0" | SR1 -> "s1" | SR2 -> "s2" | SR3 -> "s3"
+    | SR4 -> "s4" | SR5 -> "s5" | SR6 -> "s6" | SR7 -> "s7"
+    | SR8 -> "s8" | SR9 -> "s9" | SR10 -> "s10" | SR11 -> "s11"
+    | SR12 -> "s12" | SR13 -> "s13" | SR14 -> "s14" | SR15 -> "s15"
+    | SR16 -> "s16" | SR17 -> "s1"  | SR18 -> "s18" | SR19 -> "s19"
+    | SR20 -> "s20" | SR21 -> "s21" | SR22 -> "s22" | SR23 -> "s23"
+    | SR24 -> "s24" | SR25 -> "s25" | SR26 -> "s26" | SR27 -> "s27"
+    | SR28 -> "s28" | SR29 -> "s29" | SR30 -> "s30" | SR31 -> "s31"
+
   let ireg oc r = output_string oc (int_reg_name r)
   let freg oc r = output_string oc (float_reg_name r)
   let freg_single oc r = output_string oc (single_float_reg_name r)
+  let freg_param_single oc r = output_string oc (single_param_reg_name r)
 
   let preg oc = function
     | IR r -> ireg oc r
@@ -278,141 +289,6 @@ struct
     print_file_line oc comment file line
 
 
-  (* Fixing up calling conventions *)
-
-  type direction = Incoming | Outgoing
-
-  module FixupEABI = struct
-
-    let ireg_param = function
-      | 0 -> IR0 | 1 -> IR1 | 2 -> IR2 | 3 -> IR3 | _ -> assert false
-
-    let freg_param = function
-      | 0 -> FR0 | 1 -> FR1 | 2 -> FR2 | 3 -> FR3 | _ -> assert false
-
-    let fixup_double oc dir f i1 i2 =
-      match dir with
-      | Incoming ->     (* f <- (i1, i2)  *)
-        fprintf oc "	vmov	%a, %a, %a\n" freg f ireg i1 ireg i2
-      | Outgoing ->     (* (i1, i2) <- f *)
-        fprintf oc "	vmov	%a, %a, %a\n" ireg i1 ireg i2 freg f
-
-    let fixup_single oc dir f i =
-      match dir with
-      | Incoming ->     (* f <- i *)
-        fprintf oc "	vmov	%a, %a\n" freg_single f ireg i
-      | Outgoing ->     (* i <- f *)
-        fprintf oc "	vmov	%a, %a\n" ireg i freg_single f
-
-    let fixup_conventions oc dir tyl =
-      let rec fixup i tyl =
-        if i >= 4 then 0 else
-          match tyl with
-          | [] -> 0
-          | (Tint | Tany32) :: tyl' ->
-            fixup (i+1) tyl'
-          | Tlong :: tyl' ->
-            fixup (((i + 1) land (-2)) + 2) tyl'
-          | (Tfloat | Tany64) :: tyl' ->
-            let i = (i + 1) land (-2) in
-            if i >= 4 then 0 else begin
-              if Archi.big_endian
-              then fixup_double oc dir (freg_param i) (ireg_param (i+1)) (ireg_param i)
-              else fixup_double oc dir (freg_param i) (ireg_param i) (ireg_param (i+1));
-              1 + fixup (i+2) tyl'
-            end
-          | Tsingle :: tyl' ->
-            fixup_single oc dir (freg_param i) (ireg_param i);
-            1 + fixup (i+1) tyl'
-      in fixup 0 tyl
-
-    let fixup_arguments oc dir sg =
-      fixup_conventions oc dir sg.sig_args
-
-    let fixup_result oc dir sg =
-      fixup_conventions oc dir (proj_sig_res sg :: [])
-
-  end
-
-  module FixupHF = struct
-
-    type fsize = Single | Double
-
-    let rec find_single used pos =
-      if pos >= Array.length used then pos
-      else if used.(pos) then find_single used (pos + 1)
-      else begin used.(pos) <- true; pos end
-
-    let rec find_double used pos =
-      if pos + 1 >= Array.length used then pos
-      else if used.(pos) || used.(pos + 1) then find_double used (pos + 2)
-      else begin used.(pos) <- true; used.(pos + 1) <- true; pos / 2 end
-
-    let rec fixup_actions used fr tyl =
-      match tyl with
-      | [] -> []
-      | (Tint | Tlong | Tany32) :: tyl' -> fixup_actions used fr tyl'
-      | (Tfloat | Tany64) :: tyl' ->
-        if fr >= 8 then [] else begin
-          let dr = find_double used 0 in
-          assert (dr < 8);
-          (fr, Double, dr) :: fixup_actions used (fr + 1) tyl'
-        end
-      | Tsingle :: tyl' ->
-        if fr >= 8 then [] else begin
-          let sr = find_single used 0 in
-          assert (sr < 16);
-          (fr, Single, sr) :: fixup_actions used (fr + 1) tyl'
-        end
-
-    let rec fixup_outgoing oc = function
-      | [] -> 0
-      | (fr, Double, dr) :: act ->
-        if fr = dr then fixup_outgoing oc act else begin
-          fprintf oc "	vmov.f64 d%d, d%d\n" dr fr;
-          1 + fixup_outgoing oc act
-        end
-      | (fr, Single, sr) :: act ->
-        fprintf oc "	vmov.f32 s%d, s%d\n" sr (2*fr);
-        1 + fixup_outgoing oc act
-
-    let rec fixup_incoming oc = function
-      | [] -> 0
-      | (fr, Double, dr) :: act ->
-        let n = fixup_incoming oc act in
-        if fr = dr then n else begin
-          fprintf oc "	vmov.f64 d%d, d%d\n" fr dr;
-          1 + n
-        end
-      | (fr, Single, sr) :: act ->
-        let n = fixup_incoming oc act in
-        if (2*fr) = sr then n else begin
-          fprintf oc "	vmov.f32 s%d, s%d\n" (2*fr) sr;
-          1 + n
-        end
-
-    let fixup_arguments oc dir sg =
-      if sg.sig_cc.cc_vararg then
-        FixupEABI.fixup_arguments oc dir sg
-      else begin
-        let act = fixup_actions (Array.make 16 false) 0 sg.sig_args in
-        match dir with
-        | Outgoing -> fixup_outgoing oc act
-        | Incoming -> fixup_incoming oc act
-      end
-
-    let fixup_result oc dir sg =
-      if sg.sig_cc.cc_vararg then
-        FixupEABI.fixup_result oc dir sg
-      else
-        0
-  end
-
-  let (fixup_arguments, fixup_result) =
-    match Opt.float_abi with
-    | Soft -> (FixupEABI.fixup_arguments, FixupEABI.fixup_result)
-    | Hard -> (FixupHF.fixup_arguments, FixupHF.fixup_result)
-
   (* Printing of instructions *)
 
   let shift_op oc = function
@@ -446,26 +322,13 @@ struct
     | Pbne lbl ->
       fprintf oc "	bne	%a\n" print_label lbl; 1
     | Pbsymb(id, sg) ->
-      let n = fixup_arguments oc Outgoing sg in
-      fprintf oc "	b	%a\n" symbol id;
-      n + 1
+      fprintf oc "	b	%a\n" symbol id; 1
     | Pbreg(r, sg) ->
-      let n =
-        if r = IR14
-        then fixup_result oc Outgoing sg
-        else fixup_arguments oc Outgoing sg in
-      fprintf oc "	bx	%a\n" ireg r;
-      n + 1
+      fprintf oc "	bx	%a\n" ireg r; 1
     | Pblsymb(id, sg) ->
-      let n1 = fixup_arguments oc Outgoing sg in
-      fprintf oc "	bl	%a\n" symbol id;
-      let n2 = fixup_result oc Incoming sg in
-      n1 + 1 + n2
+      fprintf oc "	bl	%a\n" symbol id; 1
     | Pblreg(r, sg) ->
-      let n1 = fixup_arguments oc Outgoing sg in
-      fprintf oc "	blx	%a\n" ireg r;
-      let n2 = fixup_result oc Incoming sg in
-      n1 + 1 + n2
+      fprintf oc "	blx	%a\n" ireg r; 1
     | Pbic(r1, r2, so) ->
       fprintf oc "	bic%t	%a, %a, %a\n"
         thumbS ireg r1 ireg r2 shift_op so; 1
@@ -747,6 +610,20 @@ struct
       end
     | Pcfi_adjust sz -> cfi_adjust oc (camlint_of_coqint sz); 0
     | Pcfi_rel_offset ofs -> cfi_rel_offset oc "lr" (camlint_of_coqint ofs); 0
+    (* Fixup instructions for calling conventions *)
+    | Pfcpy_fs(r1, r2) ->
+      fprintf oc "	vmov.f32	%a, %a\n" freg_single r1 freg_param_single r2; 1
+    | Pfcpy_sf(r1, r2) ->
+      fprintf oc "	vmov.f32	%a, %a\n" freg_param_single r1 freg_single r2; 1
+    | Pfcpy_fii (r1, r2, r3) ->
+      fprintf oc "	vmov	%a, %a, %a\n" freg r1 ireg r2 ireg r3; 1
+    | Pfcpy_fi (r1, r2) ->
+      fprintf oc "	vmov	%a, %a\n" freg_single r1 ireg r2; 1
+    | Pfcpy_iif (r1, r2, r3) ->
+      fprintf oc "	vmov	%a, %a, %a\n" ireg r1 ireg r2 freg r3; 1
+    |  Pfcpy_if (r1, r2) ->
+      fprintf oc "	vmov	%a, %a\n" ireg r1 freg_single r2; 1
+
 
   let no_fallthrough = function
     | Pb _ -> true
@@ -762,10 +639,7 @@ struct
       else
         2 in
       (len + add) * 4
-    | Pbuiltin (EF_inline_asm _,_,_) -> 1024 (* Better be safe than sorry  *)
-    | Pbreg _
-    | Pblsymb _
-    | Pblreg _ -> 72 (* 4 for branch, 4 for fixup result 4 * 16 for fixup args *)
+    | Pbuiltin (EF_inline_asm _,_,_) -> 1024 (* Better be safe than sorry *)
     | _ -> 12
 
 
@@ -824,7 +698,6 @@ struct
 
   let print_instructions oc fn =
     current_function_sig := fn.fn_sig;
-    ignore (fixup_arguments oc Incoming fn.fn_sig);
     print_instructions oc false fn.fn_code;
     if !literals_in_code then emit_constants oc