Improvements in the StructReturn transformation (ABI conformance for passing composites).

- Implement the "1/2/4/8" composite return policy, used by IA32/MacOS X and IA32/BSD.
- Move the default passing conventions from Machine.ml to compcert.ini, making it easier to test the various conventions.
- More comprehensive interoperability test in regression/interop1.c.

3 files changed, 45 insertions, 66 deletions

diff --git a/cparser/Machine.ml b/cparser/Machine.ml
index e1f9998f..bd6489fd 100644
--- a/cparser/Machine.ml
+++ b/cparser/Machine.ml
@@ -44,16 +44,9 @@ type t = {
   alignof_fun: int option;
   bigendian: bool;
   bitfields_msb_first: bool;
-  supports_unaligned_accesses: bool;
-  struct_return_as_int: int;
-  struct_passing_style: struct_passing_style
+  supports_unaligned_accesses: bool
 }
 
-and struct_passing_style =
-  | SP_ref_callee
-  | SP_ref_caller
-  | SP_split_args
-
 let ilp32ll64 = {
   name = "ilp32ll64";
   char_signed = false;
@@ -83,9 +76,7 @@ let ilp32ll64 = {
   alignof_fun = None;
   bigendian = false;
   bitfields_msb_first = false;
-  supports_unaligned_accesses = false;
-  struct_return_as_int = 0;
-  struct_passing_style = SP_ref_callee
+  supports_unaligned_accesses = false
 }
 
 let i32lpll64 = {
@@ -117,9 +108,7 @@ let i32lpll64 = {
   alignof_fun = None;
   bigendian = false;
   bitfields_msb_first = false;
-  supports_unaligned_accesses = false;
-  struct_return_as_int = 0;
-  struct_passing_style = SP_ref_callee
+  supports_unaligned_accesses = false
 }
 
 let il32pll64 = {
@@ -151,9 +140,7 @@ let il32pll64 = {
   alignof_fun = None;
   bigendian = false;
   bitfields_msb_first = false;
-  supports_unaligned_accesses = false;
-  struct_return_as_int = 0;
-  struct_passing_style = SP_ref_callee
+  supports_unaligned_accesses = false
 }
 
 (* Canned configurations for some ABIs *)
@@ -163,12 +150,10 @@ let x86_32 =
                    char_signed = true;
                    alignof_longlong = 4; alignof_double = 4;
                    sizeof_longdouble = 12; alignof_longdouble = 4;
-                   supports_unaligned_accesses = true;
-                   struct_passing_style = SP_split_args }
+                   supports_unaligned_accesses = true }
 
 let x86_32_macosx =
-  { x86_32 with sizeof_longdouble = 16; alignof_longdouble = 16;
-                struct_return_as_int = 8 }
+  { x86_32 with sizeof_longdouble = 16; alignof_longdouble = 16 }
 
 let x86_64 =
   { i32lpll64 with name = "x86_64"; char_signed = true }
@@ -183,17 +168,10 @@ let ppc_32_bigendian =
   { ilp32ll64 with name = "powerpc";
                    bigendian = true;
                    bitfields_msb_first = true;
-                   supports_unaligned_accesses = true;
-                   struct_return_as_int = 8;
-                   struct_passing_style = SP_ref_caller }
-
-let ppc_32_bigendian_linux =
-  { ppc_32_bigendian with struct_return_as_int = 0 }
+                   supports_unaligned_accesses = true }
 
 let arm_littleendian =
-  { ilp32ll64 with name = "arm";
-                   struct_return_as_int = 4;
-                   struct_passing_style = SP_split_args }
+  { ilp32ll64 with name = "arm" }
 
 (* Add GCC extensions re: sizeof and alignof *)
 
@@ -205,9 +183,7 @@ let gcc_extensions c =
 
 let compcert_interpreter c =
   { c with sizeof_longdouble = 8; alignof_longdouble = 8;
-           supports_unaligned_accesses = false;
-           struct_return_as_int = 0;
-           struct_passing_style = SP_ref_callee }
+           supports_unaligned_accesses = false }
 
 (* Undefined configuration *)
 
@@ -240,9 +216,7 @@ let undef = {
   alignof_fun = None;
   bigendian = false;
   bitfields_msb_first = false;
-  supports_unaligned_accesses = false;
-  struct_return_as_int = 0;
-  struct_passing_style = SP_ref_callee
+  supports_unaligned_accesses = false
 }
 
 (* The current configuration.  Must be initialized before use. *)
diff --git a/cparser/Machine.mli b/cparser/Machine.mli
index 76cea879..fb7321f9 100644
--- a/cparser/Machine.mli
+++ b/cparser/Machine.mli
@@ -44,16 +44,9 @@ type t = {
   alignof_fun: int option;
   bigendian: bool;
   bitfields_msb_first: bool;
-  supports_unaligned_accesses: bool;
-  struct_return_as_int: int;
-  struct_passing_style: struct_passing_style
+  supports_unaligned_accesses: bool
 }
 
-and struct_passing_style =
-  | SP_ref_callee                       (* by reference, callee takes copy *)
-  | SP_ref_caller                       (* by reference, caller takes copy *)
-  | SP_split_args                       (* by value, as a sequence of ints *)
-
 (* The current configuration *)
 
 val config : t ref
@@ -69,7 +62,6 @@ val x86_64 : t
 val win32 : t
 val win64 : t
 val ppc_32_bigendian : t
-val ppc_32_bigendian_linux : t
 val arm_littleendian : t
 
 val gcc_extensions : t -> t
diff --git a/cparser/StructReturn.ml b/cparser/StructReturn.ml
index 04182c4e..8bfc6954 100644
--- a/cparser/StructReturn.ml
+++ b/cparser/StructReturn.ml
@@ -18,11 +18,12 @@
    - passed by value as function parameters. *)
 
 open Machine
+open Configuration
 open C
 open Cutil
 open Transform
 
-let struct_return_style = ref 0
+let struct_return_style = ref SR_ref
 let struct_passing_style = ref SP_ref_callee
 
 (* Classification of function return types. *)
@@ -38,11 +39,18 @@ let classify_return env ty =
   if is_composite_type env ty then begin
     match sizeof env ty, alignof env ty with
     | Some sz, Some al ->
-        if !struct_return_style >= 4 && sz <= 4 then
-          Ret_value (TInt(IUInt, []), sz, al)
-        else if !struct_return_style >= 8 && sz <= 8 then
-          Ret_value (TInt(IULongLong, []), sz, al)
-        else Ret_ref
+        begin match !struct_return_style with
+        | SR_int1248 when sz = 1 || sz = 2 || sz = 4 ->
+            Ret_value (TInt(IUInt, []), sz, al)
+        | SR_int1248 when sz = 8 ->
+            Ret_value (TInt(IULongLong, []), sz, al)
+        | (SR_int1to4 | SR_int1to8) when sz <= 4 ->
+            Ret_value (TInt(IUInt, []), sz, al)
+        | SR_int1to8 when sz > 4 && sz <= 8 ->
+            Ret_value (TInt(IULongLong, []), sz, al)
+        | _ ->
+            Ret_ref
+        end
     | _, _ ->
         Ret_ref  (* should not happen *)
   end else
@@ -85,6 +93,7 @@ let ulonglong = TInt(IULongLong, [])
 let ucharptr = TPtr(uchar, [])
 let ushortptr = TPtr(ushort, [])
 let uintptr = TPtr(uint, [])
+let ulonglongptr = TPtr(ulonglong, [])
 
 let ty_buffer n =
   TArray(uint, Some (Int64.of_int n), [])
@@ -110,6 +119,7 @@ let lshift a nbytes =
       etyp = uint }
 
 let offsetptr base ofs =
+  if ofs = 0 then base else
   { edesc = EBinop(Oadd, base, intconst (Int64.of_int ofs) IInt, ucharptr);
     etyp = ucharptr }
 
@@ -127,6 +137,10 @@ let load4 base ofs =
   let a = ecast uintptr (offsetptr base ofs) in
   { edesc = EUnop(Oderef, a); etyp = uint }
 
+let load8 base ofs =
+  let a = ecast ulonglongptr (offsetptr base ofs) in
+  { edesc = EUnop(Oderef, a); etyp = ulonglong }
+
 let lshift_ll a nbytes =
   let a = ecast ulonglong a in
   if nbytes = 0 then a else
@@ -172,14 +186,16 @@ let rec load_words base ofs sz al =
   else load_word base ofs 4 al :: load_words base (ofs + 4) sz al
 
 let load_result base sz al =
+  assert (sz <= 8);
   if sz <= 4 then
     load_word base 0 sz al
-  else if sz <= 8 then begin
+  else if sz = 8 && (al >= 8 || (!config).supports_unaligned_accesses) then
+    load8 base 0
+  else begin
     let (shift1, shift2) = if (!config).bigendian then (4, 0) else (0, 4) in
     or2_ll (lshift_ll (load_word base 0 4 al) shift1)
            (lshift_ll (load_word base 4 (sz - 4) al) shift2)
-  end else
-    assert false
+  end
 
 (* Rewriting of function types.  For the return type:
       return kind scalar   -> no change
@@ -368,7 +384,8 @@ and transf_arguments env args =
           let ty' = transf_type env arg.etyp in
           if translates_to_extended_lvalue arg then begin
             let tmp = new_temp ~name:"_arg" ucharptr in
-            (eassign tmp (eaddrof (transf_expr env Val arg)) :: assignments,
+            (eassign tmp (ecast ucharptr (eaddrof (transf_expr env Val arg)))
+             :: assignments,
              load_words tmp 0 sz al @ args')
           end else begin
             let tmp = new_temp ~name:"_arg" (ty_buffer n) in
@@ -452,7 +469,7 @@ let rec transf_stmt s =
           if translates_to_extended_lvalue e then begin
             let tmp = new_temp ~name:"_res" ucharptr in
             sseq s.sloc
-              (sassign s.sloc tmp (eaddrof e'))
+              (sassign s.sloc tmp (ecast ucharptr (eaddrof e')))
               {sdesc = Sreturn (Some (load_result tmp sz al)); sloc = s.sloc}
           end else begin
             let dst = new_temp ~name:"_res" ty in
@@ -553,17 +570,13 @@ let transf_composite env su id attr fl =
 
 let program p =
   struct_passing_style :=
-    if !Clflags.option_interp then SP_ref_callee else
-    begin match !Clflags.option_fstruct_passing_style with
-    | Some st -> st
-    | None -> (!config).struct_passing_style
-    end;
+    if !Clflags.option_interp
+    then SP_ref_callee
+    else !Clflags.option_fstruct_passing_style;
   struct_return_style :=
-    if !Clflags.option_interp then 0 else
-    begin match !Clflags.option_fstruct_return_style with
-    | Some st -> st
-    | None -> (!config).struct_return_as_int
-    end;
+    if !Clflags.option_interp
+    then SR_ref
+    else !Clflags.option_fstruct_return_style;
   Transform.program
     ~decl:transf_decl
     ~fundef:transf_fundef