Merge pull request #78 from AbsInt/struct-passing-2

Revise and simplify the -fstruct-return and -fstruct-passing options.

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