From 60b6624ae2b28ebe9fb30c2aa6115e4d5c1ab436 Mon Sep 17 00:00:00 2001
From: xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>
Date: Sat, 26 Nov 2011 15:40:57 +0000
Subject: cparser/*: refactoring of the expansion of read-modify-write
 operators cparser/PackedStructs: treat r-m-w operations over byte-swapped
 fields cparser/PackedStructs: allow static initialization of packed structs
 test/regression: more packedstruct tests

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1738 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
---
 cparser/SimplVolatile.ml | 77 +++++-------------------------------------------
 1 file changed, 7 insertions(+), 70 deletions(-)

(limited to 'cparser/SimplVolatile.ml')

diff --git a/cparser/SimplVolatile.ml b/cparser/SimplVolatile.ml
index b155a3c4..ef7a3a06 100644
--- a/cparser/SimplVolatile.ml
+++ b/cparser/SimplVolatile.ml
@@ -21,69 +21,6 @@ open C
 open Cutil
 open Transform
 
-(* Expansion of read-write-modify constructs. *)
-
-(* Temporaries must not be [const] because we assign into them,
-   and should not be [volatile] because they are private. *)
-
-let mk_temp env ty =
-  new_temp (erase_attributes_type env ty)
-
-(** [l = r]. *)
-
-let mk_assign env ctx l r =
-  match ctx with
-  | Effects ->
-      eassign l r
-  | Val ->
-      let tmp = mk_temp env l.etyp in
-      ecomma (eassign tmp r) (ecomma (eassign l tmp) tmp)
-
-(** [l op= r].  Warning: [l] is evaluated twice. *)
-
-let mk_assignop env ctx op l r ty =
-  let op' =
-    match op with
-    | Oadd_assign -> Oadd | Osub_assign -> Osub
-    | Omul_assign -> Omul | Odiv_assign -> Odiv | Omod_assign -> Omod
-    | Oand_assign -> Oand | Oor_assign -> Oor   | Oxor_assign -> Oxor
-    | Oshl_assign -> Oshl | Oshr_assign -> Oshr
-    | _ -> assert false in
-  let res = {edesc = EBinop(op', l, r, ty); etyp = ty} in
-  match ctx with
-  | Effects ->
-      eassign l res
-  | Val ->
-      let tmp = mk_temp env l.etyp in
-      ecomma (eassign tmp res) (ecomma (eassign l tmp) tmp)
-
-(** [++l] or [--l].  Warning: [l] is evaluated twice. *)
-
-let mk_preincrdecr env ctx op l ty =
-  let op' =
-    match op with
-    | Opreincr -> Oadd_assign
-    | Opredecr -> Osub_assign
-    | _ -> assert false in  
-  mk_assignop env ctx op' l (intconst 1L IInt) ty
-
-(** [l++] or [l--].  Warning: [l] is evaluated twice. *)
-
-let mk_postincrdecr env ctx op l ty =
-  let op' =
-    match op with
-    | Opostincr -> Oadd
-    | Opostdecr -> Osub
-    | _ -> assert false in  
-  match ctx with
-  | Effects ->
-      let newval = {edesc = EBinop(op', l, intconst 1L IInt, ty); etyp = ty} in
-      eassign l newval
-  | Val ->
-      let tmp = mk_temp env l.etyp in
-      let newval = {edesc = EBinop(op', tmp, intconst 1L IInt, ty); etyp = ty} in
-      ecomma (eassign tmp l) (ecomma (eassign l newval) tmp)
-
 (* Rewriting of expressions *)
 
 let transf_expr loc env ctx e =
@@ -97,22 +34,22 @@ let transf_expr loc env ctx e =
     | ESizeof _ -> e
     | EVar _ -> e
     | EUnop((Opreincr|Opredecr as op), e1) when is_volatile e1.etyp ->
-        bind_lvalue env (texp Val e1)
-          (fun l -> mk_preincrdecr env ctx op l (unary_conversion env l.etyp))
+        expand_preincrdecr ~read:(fun e -> e) ~write:eassign
+                           env ctx op (texp Val e1)
     | EUnop((Opostincr|Opostdecr as op), e1) when is_volatile e1.etyp ->
-        bind_lvalue env (texp Val e1)
-          (fun l -> mk_postincrdecr env ctx op l (unary_conversion env l.etyp))
+        expand_postincrdecr ~read:(fun e -> e) ~write:eassign
+                            env ctx op (texp Val e1)
     | EUnop(op, e1) ->
         {edesc = EUnop(op, texp Val e1); etyp = e.etyp}
     | EBinop(Oassign, e1, e2, ty) when is_volatile e1.etyp ->
-        mk_assign env ctx (texp Val e1) (texp Val e2)
+        expand_assign ~write:eassign env ctx (texp Val e1) (texp Val e2)
     | EBinop((Oadd_assign | Osub_assign | Omul_assign
               | Odiv_assign | Omod_assign
               | Oand_assign | Oor_assign | Oxor_assign
               | Oshl_assign | Oshr_assign) as op, e1, e2, ty)
       when is_volatile e1.etyp ->
-        bind_lvalue env (texp Val e1)
-          (fun l -> mk_assignop env ctx op l (texp Val e2) ty)
+        expand_assignop ~read:(fun e -> e) ~write:eassign
+                        env ctx op (texp Val e1) (texp Val e2) ty
     | EBinop(Ocomma, e1, e2, ty) ->
         {edesc = EBinop(Ocomma, texp Effects e1, texp ctx e2, ty);
          etyp = e.etyp}
-- 
cgit