From 9ab3738ae87a554fb742420b8c81ced4cd3c66c7 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Tue, 8 Sep 2020 13:56:01 +0200 Subject: Changed cc_varargs to an option type Instead of being a simple boolean we now use an option type to record the number of fixed (non-vararg) arguments. Hence, `None` means not vararg, and `Some n` means `n` fixed arguments followed with varargs. --- riscV/Asmexpand.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'riscV/Asmexpand.ml') diff --git a/riscV/Asmexpand.ml b/riscV/Asmexpand.ml index 810514a3..80e33b2b 100644 --- a/riscV/Asmexpand.ml +++ b/riscV/Asmexpand.ml @@ -100,7 +100,7 @@ let rec fixup_variadic_call ri rf tyl = end let fixup_call sg = - if sg.sig_cc.cc_vararg then fixup_variadic_call 0 0 sg.sig_args + if (sg.sig_cc.cc_vararg <> None) then fixup_variadic_call 0 0 sg.sig_args (* Handling of annotations *) @@ -588,7 +588,7 @@ let expand_instruction instr = | Pallocframe (sz, ofs) -> let sg = get_current_function_sig() in emit (Pmv (X30, X2)); - if sg.sig_cc.cc_vararg then begin + if (sg.sig_cc.cc_vararg <> None) then begin let n = arguments_size sg in let extra_sz = if n >= 8 then 0 else align ((8 - n) * wordsize) 16 in let full_sz = Z.add sz (Z.of_uint extra_sz) in @@ -606,7 +606,7 @@ let expand_instruction instr = | Pfreeframe (sz, ofs) -> let sg = get_current_function_sig() in let extra_sz = - if sg.sig_cc.cc_vararg then begin + if (sg.sig_cc.cc_vararg <> None) then begin let n = arguments_size sg in if n >= 8 then 0 else align ((8 - n) * wordsize) 16 end else 0 in -- cgit From 2076a3bb31daf5bc3663fce25de6d837ace3f952 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 22 Dec 2020 15:06:19 +0100 Subject: RISC-V: revised calling conventions for variadic functions Fixed (non-variadic) arguments follow the standard calling conventions. It's only the variadic arguments that need special treatment. --- riscV/Asmexpand.ml | 96 ++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 64 insertions(+), 32 deletions(-) (limited to 'riscV/Asmexpand.ml') diff --git a/riscV/Asmexpand.ml b/riscV/Asmexpand.ml index 80e33b2b..f01ecb23 100644 --- a/riscV/Asmexpand.ml +++ b/riscV/Asmexpand.ml @@ -57,50 +57,59 @@ let expand_storeind_ptr src base ofs = registers. *) -(* Fix-up code around calls to variadic functions. Floating-point arguments - residing in FP registers need to be moved to integer registers. *) +(* Fix-up code around calls to variadic functions. + Floating-point variadic arguments residing in FP registers need to + be moved to integer registers. *) let int_param_regs = [| X10; X11; X12; X13; X14; X15; X16; X17 |] let float_param_regs = [| F10; F11; F12; F13; F14; F15; F16; F17 |] -let rec fixup_variadic_call ri rf tyl = +let rec fixup_variadic_call fixed ri rf tyl = if ri < 8 then match tyl with | [] -> () | (Tint | Tany32) :: tyl -> - fixup_variadic_call (ri + 1) rf tyl + fixup_variadic_call (fixed - 1) (ri + 1) rf tyl | Tsingle :: tyl -> - let rs = float_param_regs.(rf) - and rd = int_param_regs.(ri) in - emit (Pfmvxs(rd, rs)); - fixup_variadic_call (ri + 1) (rf + 1) tyl + if fixed <= 0 then begin + let rs = float_param_regs.(rf) + and rd = int_param_regs.(ri) in + emit (Pfmvxs(rd, rs)) + end; + fixup_variadic_call (fixed - 1) (ri + 1) (rf + 1) tyl | Tlong :: tyl -> let ri' = if Archi.ptr64 then ri + 1 else align ri 2 + 2 in - fixup_variadic_call ri' rf tyl + fixup_variadic_call (fixed - 1) ri' rf tyl | (Tfloat | Tany64) :: tyl -> if Archi.ptr64 then begin - let rs = float_param_regs.(rf) - and rd = int_param_regs.(ri) in - emit (Pfmvxd(rd, rs)); - fixup_variadic_call (ri + 1) (rf + 1) tyl + if fixed <= 0 then begin + let rs = float_param_regs.(rf) + and rd = int_param_regs.(ri) in + emit (Pfmvxd(rd, rs)) + end; + fixup_variadic_call (fixed - 1) (ri + 1) (rf + 1) tyl end else begin let ri = align ri 2 in if ri < 8 then begin - let rs = float_param_regs.(rf) - and rd1 = int_param_regs.(ri) - and rd2 = int_param_regs.(ri + 1) in - emit (Paddiw(X2, X X2, Integers.Int.neg _16)); - emit (Pfsd(rs, X2, Ofsimm _0)); - emit (Plw(rd1, X2, Ofsimm _0)); - emit (Plw(rd2, X2, Ofsimm _4)); - emit (Paddiw(X2, X X2, _16)); - fixup_variadic_call (ri + 2) (rf + 1) tyl + if fixed <= 0 then begin + let rs = float_param_regs.(rf) + and rd1 = int_param_regs.(ri) + and rd2 = int_param_regs.(ri + 1) in + emit (Paddiw(X2, X X2, Integers.Int.neg _16)); + emit (Pfsd(rs, X2, Ofsimm _0)); + emit (Plw(rd1, X2, Ofsimm _0)); + emit (Plw(rd2, X2, Ofsimm _4)); + emit (Paddiw(X2, X X2, _16)) + end; + fixup_variadic_call (fixed - 1) (ri + 2) (rf + 1) tyl end end let fixup_call sg = - if (sg.sig_cc.cc_vararg <> None) then fixup_variadic_call 0 0 sg.sig_args + match sg.sig_cc.cc_vararg with + | None -> () + | Some fixed -> fixup_variadic_call (Z.to_int fixed) 0 0 sg.sig_args (* Handling of annotations *) @@ -305,18 +314,41 @@ let expand_builtin_vstore chunk args = (* Handling of varargs *) -(* Size in words of the arguments to a function. This includes both - arguments passed in registers and arguments passed on stack. *) +(* Number of integer registers, FP registers, and stack words + used to pass the (fixed) arguments to a function. *) + +let rec args_size ri rf ofs = function + | [] -> (ri, rf, ofs) + | (Tint | Tany32) :: l -> + if ri < 8 + then args_size (ri + 1) rf ofs l + else args_size ri rf (ofs + 1) l + | Tsingle :: l -> + if rf < 8 + then args_size ri (rf + 1) ofs l + else args_size ri rf (ofs + 1) l + | Tlong :: l -> + if Archi.ptr64 then + if ri < 8 + then args_size (ri + 1) rf ofs l + else args_size ri rf (ofs + 1) l + else + if ri < 7 then args_size (ri + 2) rf ofs l + else if ri = 7 then args_size (ri + 1) rf (ofs + 1) l + else args_size ri rf (align ofs 2 + 2) l + | (Tfloat | Tany64) :: l -> + if rf < 8 + then args_size ri (rf + 1) ofs l + else let ofs' = if Archi.ptr64 then ofs + 1 else align ofs 2 + 2 in + args_size ri rf ofs' l -let rec args_size sz = function - | [] -> sz - | (Tint | Tsingle | Tany32) :: l -> - args_size (sz + 1) l - | (Tlong | Tfloat | Tany64) :: l -> - args_size (if Archi.ptr64 then sz + 1 else align sz 2 + 2) l +(* Size in words of the arguments to a function. This includes both + arguments passed in integer registers and arguments passed on stack, + but not arguments passed in FP registers. *) let arguments_size sg = - args_size 0 sg.sig_args + let (ri, _, ofs) = args_size 0 0 0 sg.sig_args in + ri + ofs let save_arguments first_reg base_ofs = for i = first_reg to 7 do -- cgit From e81d015e3cc2cb0c352792d0cac12f1594281bc2 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Sun, 10 Jan 2021 14:34:58 +0100 Subject: RISC-V: wrong fixup code generated for vararg calls with fixed FP args This is a follow-up to 2076a3bb3. Integer registers were wrongly reserved for fixed FP arguments, causing variadic FP arguments to end up in the wrong integer registers. Added regression test in test/regression/varargs2.c --- riscV/Asmexpand.ml | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) (limited to 'riscV/Asmexpand.ml') diff --git a/riscV/Asmexpand.ml b/riscV/Asmexpand.ml index f01ecb23..da97c4a8 100644 --- a/riscV/Asmexpand.ml +++ b/riscV/Asmexpand.ml @@ -72,27 +72,33 @@ let rec fixup_variadic_call fixed ri rf tyl = | (Tint | Tany32) :: tyl -> fixup_variadic_call (fixed - 1) (ri + 1) rf tyl | Tsingle :: tyl -> - if fixed <= 0 then begin + if fixed > 0 then + fixup_variadic_call (fixed - 1) ri (rf + 1) tyl + else begin let rs = float_param_regs.(rf) and rd = int_param_regs.(ri) in - emit (Pfmvxs(rd, rs)) - end; - fixup_variadic_call (fixed - 1) (ri + 1) (rf + 1) tyl + emit (Pfmvxs(rd, rs)); + fixup_variadic_call (fixed - 1) (ri + 1) (rf + 1) tyl + end | Tlong :: tyl -> let ri' = if Archi.ptr64 then ri + 1 else align ri 2 + 2 in fixup_variadic_call (fixed - 1) ri' rf tyl | (Tfloat | Tany64) :: tyl -> if Archi.ptr64 then begin - if fixed <= 0 then begin + if fixed > 0 then + fixup_variadic_call (fixed - 1) ri (rf + 1) tyl + else begin let rs = float_param_regs.(rf) and rd = int_param_regs.(ri) in - emit (Pfmvxd(rd, rs)) - end; - fixup_variadic_call (fixed - 1) (ri + 1) (rf + 1) tyl + emit (Pfmvxd(rd, rs)); + fixup_variadic_call (fixed - 1) (ri + 1) (rf + 1) tyl + end end else begin let ri = align ri 2 in if ri < 8 then begin - if fixed <= 0 then begin + if fixed > 0 then + fixup_variadic_call (fixed - 1) ri (rf + 1) tyl + else begin let rs = float_param_regs.(rf) and rd1 = int_param_regs.(ri) and rd2 = int_param_regs.(ri + 1) in @@ -100,9 +106,9 @@ let rec fixup_variadic_call fixed ri rf tyl = emit (Pfsd(rs, X2, Ofsimm _0)); emit (Plw(rd1, X2, Ofsimm _0)); emit (Plw(rd2, X2, Ofsimm _4)); - emit (Paddiw(X2, X X2, _16)) - end; - fixup_variadic_call (fixed - 1) (ri + 2) (rf + 1) tyl + emit (Paddiw(X2, X X2, _16)); + fixup_variadic_call (fixed - 1) (ri + 2) (rf + 1) tyl + end end end -- cgit From 88567ce6d247562a9fa9151eaa32f7ad63ea37c0 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 11 Jan 2021 18:04:25 +0100 Subject: RISC-V: fix FP calling conventions This is a follow-up to e81d015e3. In the RISC-V ABI, FP arguments to functions are passed in integer registers (or pairs of integer registers) in two cases: 1- the FP argument is a variadic argument 2- the FP argument is a fixed argument but all 8 FP registers reserved for parameter passing have been used already. The previous implementation handled only case 1, with some problems. This commit implements both 1 and 2. To this end, 8 extra FP caller-save registers are used to hold the values of the FP arguments that must be passed in integer registers. Fixup code moves these FP registers to integer registers / register pairs. Symmetrically, at function entry, the integer registers / register pairs are moved back to the FP registers. 8 extra FP registers is enough because there are only 8 integer registers used for parameter passing, so at most 8 FP arguments may need to be moved to integer registers. --- riscV/Asmexpand.ml | 194 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 114 insertions(+), 80 deletions(-) (limited to 'riscV/Asmexpand.ml') diff --git a/riscV/Asmexpand.ml b/riscV/Asmexpand.ml index da97c4a8..e8c142e9 100644 --- a/riscV/Asmexpand.ml +++ b/riscV/Asmexpand.ml @@ -24,6 +24,7 @@ open Asmexpandaux open AST open Camlcoq open! Integers +open Locations exception Error of string @@ -50,6 +51,86 @@ let expand_addptrofs dst src n = let expand_storeind_ptr src base ofs = List.iter emit (Asmgen.storeind_ptr src base ofs []) +(* Fix-up code around function calls and function entry. + Some floating-point arguments residing in FP registers need to be + moved to integer registers or register pairs. + Symmetrically, some floating-point parameter passed in integer + registers or register pairs need to be moved to FP registers. *) + +let int_param_regs = [| X10; X11; X12; X13; X14; X15; X16; X17 |] + +let move_single_arg fr i = + emit (Pfmvxs(int_param_regs.(i), fr)) + +let move_double_arg fr i = + if Archi.ptr64 then begin + emit (Pfmvxd(int_param_regs.(i), fr)) + end else begin + emit (Paddiw(X2, X X2, Integers.Int.neg _16)); + emit (Pfsd(fr, X2, Ofsimm _0)); + emit (Plw(int_param_regs.(i), X2, Ofsimm _0)); + if i < 7 then begin + emit (Plw(int_param_regs.(i + 1), X2, Ofsimm _4)) + end else begin + emit (Plw(X31, X2, Ofsimm _4)); + emit (Psw(X31, X2, Ofsimm _16)) + end; + emit (Paddiw(X2, X X2, _16)) + end + +let move_single_param fr i = + emit (Pfmvsx(fr, int_param_regs.(i))) + +let move_double_param fr i = + if Archi.ptr64 then begin + emit (Pfmvdx(fr, int_param_regs.(i))) + end else begin + emit (Paddiw(X2, X X2, Integers.Int.neg _16)); + emit (Psw(int_param_regs.(i), X2, Ofsimm _0)); + if i < 7 then begin + emit (Psw(int_param_regs.(i + 1), X2, Ofsimm _4)) + end else begin + emit (Plw(X31, X2, Ofsimm _16)); + emit (Psw(X31, X2, Ofsimm _4)) + end; + emit (Pfld(fr, X2, Ofsimm _0)); + emit (Paddiw(X2, X X2, _16)) + end + +let float_extra_index = function + | Machregs.F0 -> Some (F0, 0) + | Machregs.F1 -> Some (F1, 1) + | Machregs.F2 -> Some (F2, 2) + | Machregs.F3 -> Some (F3, 3) + | Machregs.F4 -> Some (F4, 4) + | Machregs.F5 -> Some (F5, 5) + | Machregs.F6 -> Some (F6, 6) + | Machregs.F7 -> Some (F7, 7) + | _ -> None + +let fixup_gen single double sg = + let fixup ty loc = + match ty, loc with + | Tsingle, One (R r) -> + begin match float_extra_index r with + | Some(r, i) -> single r i + | None -> () + end + | (Tfloat | Tany64), One (R r) -> + begin match float_extra_index r with + | Some(r, i) -> double r i + | None -> () + end + | _, _ -> () + in + List.iter2 fixup sg.sig_args (Conventions1.loc_arguments sg) + +let fixup_call sg = + fixup_gen move_single_arg move_double_arg sg + +let fixup_function_entry sg = + fixup_gen move_single_param move_double_param sg + (* Built-ins. They come in two flavors: - annotation statements: take their arguments in registers or stack locations; generate no code; @@ -57,66 +138,6 @@ let expand_storeind_ptr src base ofs = registers. *) -(* Fix-up code around calls to variadic functions. - Floating-point variadic arguments residing in FP registers need to - be moved to integer registers. *) - -let int_param_regs = [| X10; X11; X12; X13; X14; X15; X16; X17 |] -let float_param_regs = [| F10; F11; F12; F13; F14; F15; F16; F17 |] - -let rec fixup_variadic_call fixed ri rf tyl = - if ri < 8 then - match tyl with - | [] -> - () - | (Tint | Tany32) :: tyl -> - fixup_variadic_call (fixed - 1) (ri + 1) rf tyl - | Tsingle :: tyl -> - if fixed > 0 then - fixup_variadic_call (fixed - 1) ri (rf + 1) tyl - else begin - let rs = float_param_regs.(rf) - and rd = int_param_regs.(ri) in - emit (Pfmvxs(rd, rs)); - fixup_variadic_call (fixed - 1) (ri + 1) (rf + 1) tyl - end - | Tlong :: tyl -> - let ri' = if Archi.ptr64 then ri + 1 else align ri 2 + 2 in - fixup_variadic_call (fixed - 1) ri' rf tyl - | (Tfloat | Tany64) :: tyl -> - if Archi.ptr64 then begin - if fixed > 0 then - fixup_variadic_call (fixed - 1) ri (rf + 1) tyl - else begin - let rs = float_param_regs.(rf) - and rd = int_param_regs.(ri) in - emit (Pfmvxd(rd, rs)); - fixup_variadic_call (fixed - 1) (ri + 1) (rf + 1) tyl - end - end else begin - let ri = align ri 2 in - if ri < 8 then begin - if fixed > 0 then - fixup_variadic_call (fixed - 1) ri (rf + 1) tyl - else begin - let rs = float_param_regs.(rf) - and rd1 = int_param_regs.(ri) - and rd2 = int_param_regs.(ri + 1) in - emit (Paddiw(X2, X X2, Integers.Int.neg _16)); - emit (Pfsd(rs, X2, Ofsimm _0)); - emit (Plw(rd1, X2, Ofsimm _0)); - emit (Plw(rd2, X2, Ofsimm _4)); - emit (Paddiw(X2, X X2, _16)); - fixup_variadic_call (fixed - 1) (ri + 2) (rf + 1) tyl - end - end - end - -let fixup_call sg = - match sg.sig_cc.cc_vararg with - | None -> () - | Some fixed -> fixup_variadic_call (Z.to_int fixed) 0 0 sg.sig_args - (* Handling of annotations *) let expand_annot_val kind txt targ args res = @@ -323,37 +344,49 @@ let expand_builtin_vstore chunk args = (* Number of integer registers, FP registers, and stack words used to pass the (fixed) arguments to a function. *) -let rec args_size ri rf ofs = function +let arg_int_size ri rf ofs k = + if ri < 8 + then k (ri + 1) rf ofs + else k ri rf (ofs + 1) + +let arg_single_size ri rf ofs k = + if rf < 8 + then k ri (rf + 1) ofs + else arg_int_size ri rf ofs k + +let arg_long_size ri rf ofs k = + if Archi.ptr64 then + if ri < 8 + then k (ri + 1) rf ofs + else k ri rf (ofs + 1) + else + if ri < 7 then k (ri + 2) rf ofs + else if ri = 7 then k (ri + 1) rf (ofs + 1) + else k ri rf (align ofs 2 + 2) + +let arg_double_size ri rf ofs k = + if rf < 8 + then k ri (rf + 1) ofs + else arg_long_size ri rf ofs k + +let rec args_size l ri rf ofs = + match l with | [] -> (ri, rf, ofs) | (Tint | Tany32) :: l -> - if ri < 8 - then args_size (ri + 1) rf ofs l - else args_size ri rf (ofs + 1) l + arg_int_size ri rf ofs (args_size l) | Tsingle :: l -> - if rf < 8 - then args_size ri (rf + 1) ofs l - else args_size ri rf (ofs + 1) l + arg_single_size ri rf ofs (args_size l) | Tlong :: l -> - if Archi.ptr64 then - if ri < 8 - then args_size (ri + 1) rf ofs l - else args_size ri rf (ofs + 1) l - else - if ri < 7 then args_size (ri + 2) rf ofs l - else if ri = 7 then args_size (ri + 1) rf (ofs + 1) l - else args_size ri rf (align ofs 2 + 2) l + arg_long_size ri rf ofs (args_size l) | (Tfloat | Tany64) :: l -> - if rf < 8 - then args_size ri (rf + 1) ofs l - else let ofs' = if Archi.ptr64 then ofs + 1 else align ofs 2 + 2 in - args_size ri rf ofs' l + arg_double_size ri rf ofs (args_size l) (* Size in words of the arguments to a function. This includes both arguments passed in integer registers and arguments passed on stack, but not arguments passed in FP registers. *) let arguments_size sg = - let (ri, _, ofs) = args_size 0 0 0 sg.sig_args in + let (ri, _, ofs) = args_size sg.sig_args 0 0 0 in ri + ofs let save_arguments first_reg base_ofs = @@ -744,6 +777,7 @@ let preg_to_dwarf = function let expand_function id fn = try set_current_function fn; + fixup_function_entry fn.fn_sig; expand id (* sp= *) 2 preg_to_dwarf expand_instruction fn.fn_code; Errors.OK (get_current_function ()) with Error s -> -- cgit