Improved treatment of structs/unions as r-values

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1701 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e

2 files changed, 47 insertions, 21 deletions

diff --git a/cparser/StructAssign.ml b/cparser/StructAssign.ml
index 6d38b55..a35dc5a 100644
--- a/cparser/StructAssign.ml
+++ b/cparser/StructAssign.ml
@@ -62,21 +62,19 @@ let find_memcpy env =
   with Env.Error _ ->
     (default_memcpy(), false)
 
-(* Smart constructor for "," expressions *)
-
-let comma e1 e2 =
-  match e1.edesc, e2.edesc with
-  | EConst _, _ -> e2
-  | _, EConst _ -> e1
-  | _, _ ->  ecomma e1 e2
-
-(* Smart constructor for "&" expressions *)
+(* Smart constructors that "bubble up" sequence expressions *)
 
 let rec addrof e =
   match e.edesc with
   | EBinop(Ocomma, e1, e2, _) -> ecomma e1 (addrof e2)
+  | EUnop(Oderef, e1) -> e1
   | _ -> eaddrof e
 
+let rec dot f e ty =
+  match e.edesc with
+  | EBinop(Ocomma, e1, e2, _) -> ecomma e1 (dot f e2 ty)
+  | _ -> { edesc = EUnop(Odot f, e); etyp = ty }
+
 (* Translate an assignment [lhs = rhs] between composite types.
    [lhs] and [rhs] must be l-values. *)
 
@@ -97,12 +95,9 @@ let transf_assign env lhs rhs =
 
 (* Detect invariant l-values *)
 
-let not_volatile env ty = not (List.mem AVolatile (attributes_of_type env ty))
-
 let rec invariant_lvalue env e =
   match e.edesc with
   | EVar _ -> true
-  | EUnop(Oderef, {edesc = EVar _; etyp = ty}) -> not_volatile env ty
   | EUnop(Odot _, e1) -> invariant_lvalue env e1
   | _ -> false
 
@@ -134,13 +129,36 @@ let rec transf_expr env ctx e =
       end
   | EConst c -> e
   | ESizeof ty -> e
-  | EVar x -> e
+  | EVar x ->
+      if ctx = Effects && is_composite_type env e.etyp
+      then nullconst
+      else e
+  | EUnop(Oaddrof, e1) ->
+      addrof (transf_expr env Val e1)
+  | EUnop(Oderef, e1) ->
+      let e1' = transf_expr env Val e1 in
+      if ctx = Effects && is_composite_type env e.etyp
+      then e1'
+      else {edesc = EUnop(Oderef, e1'); etyp = e.etyp}
+  | EUnop(Odot f, e1) ->
+      let e1' = transf_expr env Val e1 in
+      if ctx = Effects && is_composite_type env e.etyp
+      then e1'
+      else dot f e1' e.etyp
+  | EUnop(Oarrow f, e1) ->
+      let e1' = transf_expr env Val e1 in
+      if ctx = Effects && is_composite_type env e.etyp
+      then e1'
+      else {edesc = EUnop(Oarrow f, e1'); etyp = e.etyp}
   | EUnop(op, e1) ->
       {edesc = EUnop(op, transf_expr env Val e1); etyp = e.etyp}
+  | EBinop(Oindex, e1, e2, ty) ->
+      let e1' = transf_expr env Val e1 and e2' = transf_expr env Val e2 in
+      if ctx = Effects && is_composite_type env e.etyp
+      then ecomma e1' e2'
+      else {edesc = EBinop(Oindex, e1', e2', ty); etyp = e.etyp}
   | EBinop(Ocomma, e1, e2, ty) ->
-      {edesc = EBinop(Ocomma, transf_expr env Effects e1,
-                              transf_expr env ctx e2, ty);
-       etyp = e.etyp}
+      ecomma (transf_expr env Effects e1) (transf_expr env ctx e2)
   | EBinop(op, e1, e2, ty) ->
       {edesc = EBinop(op, transf_expr env Val e1,
                           transf_expr env Val e2, ty);
diff --git a/cparser/StructByValue.ml b/cparser/StructByValue.ml
index 60c1154..07a6acf 100644
--- a/cparser/StructByValue.ml
+++ b/cparser/StructByValue.ml
@@ -55,6 +55,14 @@ and transf_funarg env (id, t) =
   then (id, TPtr(add_attributes_type [AConst] t, []))
   else (id, t)
 
+(* Smart constructor that "bubble up" sequence expressions *)
+
+let rec addrof e =
+  match e.edesc with
+  | EBinop(Ocomma, e1, e2, _) -> ecomma e1 (addrof e2)
+  | EUnop(Oderef, e1) -> e1
+  | _ -> eaddrof e
+
 (* Expressions: transform calls + rewrite the types *)
 
 type context = Val | Effects
@@ -101,7 +109,7 @@ let rec transf_expr env ctx e =
 
 and transf_arg env e =
   let e' = transf_expr env Val e in
-  if is_composite_type env e'.etyp then eaddrof e' else e'
+  if is_composite_type env e'.etyp then addrof e' else e'
 
 (* Function calls returning a composite: add first argument.
     ctx = Effects:   lv = f(...)     -> f(&lv, ...)
@@ -117,17 +125,17 @@ and transf_composite_call env ctx opt_lhs fn args ty =
   match ctx, opt_lhs with
   | Effects, None ->
       let tmp = new_temp ~name:"_res" ty in
-      {edesc = ECall(fn, eaddrof tmp :: args); etyp = TVoid []}
+      {edesc = ECall(fn, addrof tmp :: args); etyp = TVoid []}
   | Effects, Some lhs ->
       let lhs = transf_expr env Val lhs in
-      {edesc = ECall(fn, eaddrof lhs :: args); etyp = TVoid []}
+      {edesc = ECall(fn, addrof lhs :: args); etyp = TVoid []}
   | Val, None ->
       let tmp = new_temp ~name:"_res" ty in
-      ecomma {edesc = ECall(fn, eaddrof tmp :: args); etyp = TVoid []} tmp
+      ecomma {edesc = ECall(fn, addrof tmp :: args); etyp = TVoid []} tmp
   | Val, Some lhs ->
       let lhs = transf_expr env Val lhs in
       let tmp = new_temp ~name:"_res" ty in
-      ecomma (ecomma {edesc = ECall(fn, eaddrof tmp :: args); etyp = TVoid []}
+      ecomma (ecomma {edesc = ECall(fn, addrof tmp :: args); etyp = TVoid []}
                      (eassign lhs tmp))
              tmp