diff options
-rw-r--r-- | cfrontend/C2C.ml | 29 | ||||
-rw-r--r-- | cparser/StructReturn.ml | 4 | ||||
-rw-r--r-- | driver/Clflags.ml | 4 | ||||
-rw-r--r-- | driver/Driver.ml | 38 |
4 files changed, 29 insertions, 46 deletions
diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index 8c7ec6d8..e4001e6b 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -466,6 +466,21 @@ let convertFkind = function if not !Clflags.option_flongdouble then unsupported "'long double' type"; F64 +let checkFunctionType env tres targs = + if not !Clflags.option_fstruct_passing then begin + if Cutil.is_composite_type env tres then + unsupported "function returning a struct or union (consider adding option -fstruct-passing)"; + begin match targs with + | None -> () + | Some l -> + List.iter + (fun (id, ty) -> + if Cutil.is_composite_type env ty then + unsupported "function parameter of struct or union type (consider adding option -fstruct-passing)") + l + end + end + let rec convertTyp env t = match t with | C.TVoid a -> Tvoid @@ -487,8 +502,7 @@ let rec convertTyp env t = | C.TArray(ty, Some sz, a) -> Tarray(convertTyp env ty, convertInt sz, convertAttr a) | C.TFun(tres, targs, va, a) -> - if Cutil.is_composite_type env tres then - unsupported "return type is a struct or union (consider adding option -fstruct-return)"; + checkFunctionType env tres targs; Tfunction(begin match targs with | None -> Tnil | Some tl -> convertParams env tl @@ -549,11 +563,6 @@ let string_of_type ty = Format.pp_print_flush fb (); Buffer.contents b -let supported_return_type env ty = - match Cutil.unroll env ty with - | C.TStruct _ | C.TUnion _ -> false - | _ -> true - let is_longlong env ty = match Cutil.unroll env ty with | C.TInt((C.ILongLong|C.IULongLong), _) -> true @@ -826,12 +835,11 @@ let rec convertExpr env e = targs, convertExprList env args, tres) | C.ECall(fn, args) -> - if not (supported_return_type env e.etyp) then - unsupported ("function returning a result of type " ^ string_of_type e.etyp ^ " (consider adding option -fstruct-return)"); begin match projFunType env fn.etyp with | None -> error "wrong type for function part of a call" | Some(tres, targs, va) -> + checkFunctionType env tres targs; if targs = None && not !Clflags.option_funprototyped then unsupported "call to unprototyped function (consider adding option -funprototyped)"; if va && not !Clflags.option_fvararg_calls then @@ -1039,8 +1047,7 @@ and convertSwitch env is_64 = function (** Function definitions *) let convertFundef loc env fd = - if Cutil.is_composite_type env fd.fd_ret then - unsupported "function returning a struct or union (consider adding option -fstruct-return)"; + checkFunctionType env fd.fd_ret (Some fd.fd_params); if fd.fd_vararg && not !Clflags.option_fvararg_calls then unsupported "variable-argument function (consider adding option -fvararg-calls)"; let ret = diff --git a/cparser/StructReturn.ml b/cparser/StructReturn.ml index 82c0a04c..4e019380 100644 --- a/cparser/StructReturn.ml +++ b/cparser/StructReturn.ml @@ -582,11 +582,11 @@ let program p = struct_passing_style := if !Clflags.option_interp then SP_ref_callee - else !Clflags.option_fstruct_passing_style; + else Configuration.struct_passing_style; struct_return_style := if !Clflags.option_interp then SR_ref - else !Clflags.option_fstruct_return_style; + else Configuration.struct_return_style; Transform.program ~decl:transf_decl ~fundef:transf_fundef diff --git a/driver/Clflags.ml b/driver/Clflags.ml index 6c2cc661..b67fd638 100644 --- a/driver/Clflags.ml +++ b/driver/Clflags.ml @@ -16,9 +16,7 @@ let prepro_options = ref ([]: string list) let linker_options = ref ([]: string list) let assembler_options = ref ([]: string list) let option_flongdouble = ref false -let option_fstruct_return = ref false -let option_fstruct_return_style = ref Configuration.struct_return_style -let option_fstruct_passing_style = ref Configuration.struct_passing_style +let option_fstruct_passing = ref false let option_fbitfields = ref false let option_fvararg_calls = ref true let option_funprototyped = ref true diff --git a/driver/Driver.ml b/driver/Driver.ml index 8d144ad5..9b0e8f13 100644 --- a/driver/Driver.ml +++ b/driver/Driver.ml @@ -120,7 +120,7 @@ let parse_c_file sourcename ifile = (* Simplification options *) let simplifs = "b" (* blocks: mandatory *) - ^ (if !option_fstruct_return then "s" else "") + ^ (if !option_fstruct_passing then "s" else "") ^ (if !option_fbitfields then "f" else "") ^ (if !option_fpacked_structs then "p" else "") in @@ -425,11 +425,9 @@ Preprocessing options: Language support options (use -fno-<opt> to turn off -f<opt>) : -fbitfields Emulate bit fields in structs [off] -flongdouble Treat 'long double' as 'double' [off] - -fstruct-return Emulate returning structs and unions by value [off] - -fstruct-return=<convention> - Set the calling conventions used to return structs by value - -fstruct-passing=<convention> - Set the calling conventions used to pass structs by value + -fstruct-passing Support passing structs and unions by value as function + results or function arguments [off] + -fstruct-return Like -fstruct-passing (deprecated) -fvararg-calls Support calls to variable-argument functions [on] -funprototyped Support calls to old-style functions without prototypes [on] -fpacked-structs Emulate packed structs [off] @@ -502,7 +500,7 @@ let print_version_and_exit _ = let language_support_options = [ option_fbitfields; option_flongdouble; - option_fstruct_return; option_fvararg_calls; option_funprototyped; + option_fstruct_passing; option_fvararg_calls; option_funprototyped; option_fpacked_structs; option_finline_asm ] @@ -611,33 +609,13 @@ let cmdline_actions = Exact "-quiet", Self (fun _ -> Interp.trace := 0); Exact "-trace", Self (fun _ -> Interp.trace := 2); Exact "-random", Self (fun _ -> Interp.mode := Interp.Random); - Exact "-all", Self (fun _ -> Interp.mode := Interp.All); -(* Special -f options *) - Exact "-fstruct-passing=ref-callee", - Self (fun _ -> option_fstruct_passing_style := Configuration.SP_ref_callee); - Exact "-fstruct-passing=ref-caller", - Self (fun _ -> option_fstruct_return := true; - option_fstruct_passing_style := Configuration.SP_ref_caller); - Exact "-fstruct-passing=ints", - Self (fun _ -> option_fstruct_return := true; - option_fstruct_passing_style := Configuration.SP_split_args); - Exact "-fstruct-return=ref", - Self (fun _ -> option_fstruct_return := true; - option_fstruct_return_style := Configuration.SR_ref); - Exact "-fstruct-return=int1248", - Self (fun _ -> option_fstruct_return := true; - option_fstruct_return_style := Configuration.SR_int1248); - Exact "-fstruct-return=int1-4", - Self (fun _ -> option_fstruct_return := true; - option_fstruct_return_style := Configuration.SR_int1to4); - Exact "-fstruct-return=int1-8", - Self (fun _ -> option_fstruct_return := true; - option_fstruct_return_style := Configuration.SR_int1to8) + Exact "-all", Self (fun _ -> Interp.mode := Interp.All) ] (* -f options: come in -f and -fno- variants *) (* Language support options *) @ f_opt "longdouble" option_flongdouble - @ f_opt "struct-return" option_fstruct_return + @ f_opt "struct-return" option_fstruct_passing + @ f_opt "struct-passing" option_fstruct_passing @ f_opt "bitfields" option_fbitfields @ f_opt "vararg-calls" option_fvararg_calls @ f_opt "unprototyped" option_funprototyped |