summaryrefslogtreecommitdiff
path: root/cparser/SimplVolatile.ml
diff options
context:
space:
mode:
Diffstat (limited to 'cparser/SimplVolatile.ml')
-rw-r--r--cparser/SimplVolatile.ml77
1 files changed, 7 insertions, 70 deletions
diff --git a/cparser/SimplVolatile.ml b/cparser/SimplVolatile.ml
index b155a3c..ef7a3a0 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}