diff options
Diffstat (limited to 'arm/Asmexpand.ml')
-rw-r--r-- | arm/Asmexpand.ml | 174 |
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 |