diff options
author | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2011-08-18 09:24:23 +0000 |
---|---|---|
committer | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2011-08-18 09:24:23 +0000 |
commit | 62a07ee96d51c29bab9668d8c41bf5f8bdf9e23d (patch) | |
tree | a44ae71bef9021e42a91da1787e7e83e75d18cad /cparser/Bitfields.ml | |
parent | 84cb73abe0f777521ee67cec2405c9593420d3da (diff) |
SimplVolatile: new pass to eliminate read-modify-write ops over volatiles
Elsewhere: refactoring, moving common code into Cutil and Transform
(to be continued)
git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1716 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
Diffstat (limited to 'cparser/Bitfields.ml')
-rw-r--r-- | cparser/Bitfields.ml | 48 |
1 files changed, 6 insertions, 42 deletions
diff --git a/cparser/Bitfields.ml b/cparser/Bitfields.ml index ff4c0c6..d16f91f 100644 --- a/cparser/Bitfields.ml +++ b/cparser/Bitfields.ml @@ -251,8 +251,6 @@ let rec is_bitfield_access env e = (* Expressions *) -type context = Val | Effects - let transf_expr env ctx e = let rec texp ctx e = @@ -329,7 +327,7 @@ let transf_expr env ctx e = {edesc = EUnop(Odot bf.bf_carrier, texp Val e); etyp = bf.bf_carrier_typ} and transf_assign ctx e1 bf e2 = - bind_lvalue (texp Val e1) (fun base -> + bind_lvalue env (texp Val e1) (fun base -> let carrier = {edesc = EUnop(Odot bf.bf_carrier, base); etyp = bf.bf_carrier_typ} in let asg = @@ -337,7 +335,7 @@ let transf_expr env ctx e = if ctx = Val then ecomma asg (bitfield_extract bf carrier) else asg) and transf_assignop ctx op e1 bf e2 tyres = - bind_lvalue (texp Val e1) (fun base -> + bind_lvalue env (texp Val e1) (fun base -> let carrier = {edesc = EUnop(Odot bf.bf_carrier, base); etyp = bf.bf_carrier_typ} in let rhs = @@ -355,7 +353,7 @@ let transf_expr env ctx e = if ctx = Effects then transf_pre ctx op e1 bf tyfield else begin - bind_lvalue (texp Val e1) (fun base -> + bind_lvalue env (texp Val e1) (fun base -> let carrier = {edesc = EUnop(Odot bf.bf_carrier, base); etyp = bf.bf_carrier_typ} in let temp = new_temp tyfield in @@ -372,47 +370,13 @@ let transf_expr env ctx e = (* Statements *) -let rec transf_stmt env s = - match s.sdesc with - | Sskip -> s - | Sdo e -> - {sdesc = Sdo(transf_expr env Effects e); sloc = s.sloc} - | Sseq(s1, s2) -> - {sdesc = Sseq(transf_stmt env s1, transf_stmt env s2); sloc = s.sloc } - | Sif(e, s1, s2) -> - {sdesc = Sif(transf_expr env Val e, transf_stmt env s1, transf_stmt env s2); - sloc = s.sloc} - | Swhile(e, s1) -> - {sdesc = Swhile(transf_expr env Val e, transf_stmt env s1); - sloc = s.sloc} - | Sdowhile(s1, e) -> - {sdesc = Sdowhile(transf_stmt env s1, transf_expr env Val e); - sloc = s.sloc} - | Sfor(s1, e, s2, s3) -> - {sdesc = Sfor(transf_stmt env s1, transf_expr env Val e, - transf_stmt env s2, transf_stmt env s3); - sloc = s.sloc} - | Sbreak -> s - | Scontinue -> s - | Sswitch(e, s1) -> - {sdesc = Sswitch(transf_expr env Val e, transf_stmt env s1); - sloc = s.sloc} - | Slabeled(lbl, s) -> - {sdesc = Slabeled(lbl, transf_stmt env s); sloc = s.sloc} - | Sgoto lbl -> s - | Sreturn None -> s - | Sreturn (Some e) -> - {sdesc = Sreturn(Some(transf_expr env Val e)); sloc = s.sloc} - | Sblock _ | Sdecl _ -> - assert false (* should not occur in unblocked code *) +let transf_stmt env s = + Transform.stmt (fun loc env ctx e -> transf_expr env ctx e) env s (* Functions *) let transf_fundef env f = - reset_temps(); - let newbody = transf_stmt env f.fd_body in - let temps = get_temps() in - { f with fd_locals = f.fd_locals @ temps; fd_body = newbody } + Transform.fundef transf_stmt env f (* Initializers *) |