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, 174 insertions, 0 deletions

diff --git a/arm/Asmexpand.ml b/arm/Asmexpand.ml
index b65007df..dd960484 100644
--- a/arm/Asmexpand.ml
+++ b/arm/Asmexpand.ml
@@ -409,6 +409,161 @@ let expand_builtin_inline name args res =
   | _ ->
       raise (Error ("unrecognized builtin " ^ name))
 
+
+(* Handling of 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 dir f i1 i2 =
+    match dir with
+    | Incoming -> (* f <- (i1, i2)  *)
+      emit (Pfcpy_fii (f, i1, i2))
+    | Outgoing -> (* (i1, i2) <- f *)
+      emit (Pfcpy_iif (i1, i2, f))
+
+  let fixup_single dir f i =
+    match dir with
+    | Incoming -> (* f <- i *)
+      emit (Pfcpy_fi (f, i))
+    | Outgoing -> (* i <- f *)
+      emit (Pfcpy_if (i, f))
+
+  let fixup_conventions dir tyl =
+    let rec fixup i tyl =
+      if i < 4 then
+        match tyl with
+        | [] -> ()
+        | (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 begin
+            if Archi.big_endian
+            then fixup_double dir (freg_param i) (ireg_param (i+1)) (ireg_param i)
+            else fixup_double dir (freg_param i) (ireg_param i) (ireg_param (i+1));
+            fixup (i+2) tyl'
+          end
+        | Tsingle :: tyl' ->
+          fixup_single dir (freg_param i) (ireg_param i);
+          fixup (i+1) tyl'
+    in fixup 0 tyl
+
+  let fixup_arguments dir sg =
+    fixup_conventions dir sg.sig_args
+
+  let fixup_result dir sg =
+    fixup_conventions 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 freg_param = function
+    |  0 -> FR0  |  1 -> FR1  |  2 -> FR2  |  3 -> FR3
+    |  4 -> FR4  |  5 -> FR5  |  6 -> FR6  |  7 -> FR7
+    | _ -> assert false
+
+  let sreg_param = function
+    |  0 -> SR0  |  1 -> SR1  |  2 -> SR2  |  3 -> SR3
+    |  4 -> SR4  |  5 -> SR5  |  6 -> SR6  |  7 -> SR7
+    |  8 -> SR8  |  9 -> SR9  | 10 -> SR10 | 11 -> SR11
+    | 12 -> SR12 | 13 -> SR13 | 14 -> SR14 | 15 -> SR15
+    | _ -> assert false
+
+  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 = function
+    | [] -> ()
+    | (fr, Double, dr) :: act ->
+      if fr <> dr then begin
+        let fr = freg_param fr
+        and dr = freg_param dr in
+        emit (Pfcpyd (dr, fr))
+      end;
+      fixup_outgoing act
+    | (fr, Single, sr) :: act ->
+      let fr = freg_param fr
+      and sr = sreg_param sr in
+      emit (Pfcpy_sf (sr, fr));
+      fixup_outgoing act
+
+  let rec fixup_incoming = function
+    | [] -> ()
+    | (fr, Double, dr) :: act ->
+      fixup_incoming act;
+      if fr <> dr then begin
+        let fr = freg_param fr
+        and dr = freg_param dr in
+        emit (Pfcpyd (fr, dr))
+      end
+    | (fr, Single, sr) :: act ->
+      fixup_incoming act;
+      if (2 * fr) <> sr then begin
+        let fr = freg_param fr
+        and sr = sreg_param sr in
+        emit (Pfcpy_fs (fr, sr))
+      end
+
+  let fixup_arguments dir sg =
+    if sg.sig_cc.cc_vararg then
+      FixupEABI.fixup_arguments dir sg
+    else begin
+      let act = fixup_actions (Array.make 16 false) 0 sg.sig_args in
+      match dir with
+      | Outgoing -> fixup_outgoing act
+      | Incoming -> fixup_incoming act
+    end
+
+  let fixup_result dir sg =
+    if sg.sig_cc.cc_vararg then
+      FixupEABI.fixup_result dir sg
+end
+
+let (fixup_arguments, fixup_result) =
+  match Configuration.abi with
+  | "eabi"      -> (FixupEABI.fixup_arguments, FixupEABI.fixup_result)
+  | "hardfloat" -> (FixupHF.fixup_arguments, FixupHF.fixup_result)
+  | _ -> assert false
+
+
+(* Instruction expansion *)
+
 let expand_instruction instr =
   match instr with
   | Pallocframe (sz, ofs) ->
@@ -463,6 +618,24 @@ let expand_instruction instr =
 	   | _ ->
               assert false
      end
+  (* Fixup for calling conventions *)
+  | Pbsymb(id, sg) ->
+      fixup_arguments Outgoing sg;
+      emit instr
+  | Pbreg(r, sg) ->
+    if r = IR14 then
+      fixup_result Outgoing sg
+    else
+      fixup_arguments Outgoing sg;
+    emit instr
+  | Pblsymb(_, sg) ->
+      fixup_arguments Outgoing sg;
+      emit instr;
+      fixup_result Incoming sg
+  | Pblreg(_, sg) ->
+      fixup_arguments Outgoing sg;
+      emit instr;
+      fixup_result Incoming sg
   | _ ->
      emit instr
 
@@ -492,6 +665,7 @@ let preg_to_dwarf = function
 let expand_function id fn =
   try
     set_current_function fn;
+    fixup_arguments Incoming fn.fn_sig;
     if !Clflags.option_g then
       expand_debug id 13 preg_to_dwarf expand_instruction fn.fn_code
     else