diff options
author | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2010-08-18 09:06:55 +0000 |
---|---|---|
committer | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2010-08-18 09:06:55 +0000 |
commit | a15858a0a8fcea82db02fe8c9bd2ed912210419f (patch) | |
tree | 5c0c19439f0d0f9e8873ce0dad2034cb9cafc4ba /cparser/StructByValue.ml | |
parent | adedca3a1ff17ff8ac66eb2bcd533a50df0927a0 (diff) | |
download | compcert-a15858a0a8fcea82db02fe8c9bd2ed912210419f.tar.gz compcert-a15858a0a8fcea82db02fe8c9bd2ed912210419f.zip |
Merge of branches/full-expr-4:
- Csyntax, Csem: source C language has side-effects within expressions,
performs implicit casts, and has nondeterministic reduction semantics
for expressions
- Cstrategy: deterministic red. sem. for the above
- Clight: the previous source C language, with pure expressions.
Added: temporary variables + implicit casts.
- New pass SimplExpr to pull side-effects out of expressions
(previously done in untrusted Caml code in cparser/)
- Csharpminor: added temporary variables to match Clight.
- Cminorgen: adapted, removed cast optimization (moved to back-end)
- CastOptim: RTL-level optimization of casts
- cparser: transformations Bitfields, StructByValue and StructAssign
now work on non-simplified expressions
- Added pretty-printers for several intermediate languages,
and matching -dxxx command-line flags.
git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1467 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
Diffstat (limited to 'cparser/StructByValue.ml')
-rw-r--r-- | cparser/StructByValue.ml | 187 |
1 files changed, 126 insertions, 61 deletions
diff --git a/cparser/StructByValue.ml b/cparser/StructByValue.ml index de797379..c66af32b 100644 --- a/cparser/StructByValue.ml +++ b/cparser/StructByValue.ml @@ -16,7 +16,7 @@ (* Eliminate by-value passing of structs and unions. *) (* Assumes: nothing. - Preserves: simplified code, unblocked code *) + Preserves: unblocked code *) open C open Cutil @@ -55,30 +55,126 @@ and transf_funarg env (id, t) = then (id, TPtr(add_attributes_type [AConst] t, [])) else (id, t) -(* Simple exprs: no change in structure, since calls cannot occur within, - but need to rewrite the types. *) - -let rec transf_expr env e = - { etyp = transf_type env e.etyp; - edesc = match e.edesc with - | EConst c -> EConst c - | ESizeof ty -> ESizeof (transf_type env ty) - | EVar x -> EVar x - | EUnop(op, e1) -> EUnop(op, transf_expr env e1) - | EBinop(op, e1, e2, ty) -> - EBinop(op, transf_expr env e1, transf_expr env e2, transf_type env ty) - | EConditional(e1, e2, e3) -> - assert (not (is_composite_type env e.etyp)); - EConditional(transf_expr env e1, transf_expr env e2, transf_expr env e3) - | ECast(ty, e1) -> ECast(transf_type env ty, transf_expr env e1) - | ECall(e1, el) -> assert false - } +(* Expressions: transform calls + rewrite the types *) + +type context = Val | Effects + +let rec transf_expr env ctx e = + let newty = transf_type env e.etyp in + match e.edesc with + | EConst c -> + {edesc = EConst c; etyp = newty} + | ESizeof ty -> + {edesc = ESizeof (transf_type env ty); etyp = newty} + | EVar x -> + {edesc = EVar x; etyp = newty} + | EUnop(op, e1) -> + {edesc = EUnop(op, transf_expr env Val e1); etyp = newty} + | EBinop(Oassign, lhs, {edesc = ECall(fn, args)}, ty) + when is_composite_type env ty -> + transf_composite_call env ctx (Some lhs) fn args ty + | EBinop(Ocomma, e1, e2, ty) -> + {edesc = EBinop(Ocomma, transf_expr env Effects e1, + transf_expr env ctx e2, + transf_type env ty); + etyp = newty} + | EBinop(op, e1, e2, ty) -> + {edesc = EBinop(op, transf_expr env Val e1, + transf_expr env Val e2, + transf_type env ty); + etyp = newty} + | EConditional(e1, e2, e3) -> + {edesc = EConditional(transf_expr env Val e1, + transf_expr env ctx e2, + transf_expr env ctx e3); + etyp = newty} + | ECast(ty, e1) -> + {edesc = ECast(transf_type env ty, transf_expr env Val e1); etyp = newty} + | ECall(fn, args) -> + if is_composite_type env e.etyp then + transf_composite_call env ctx None fn args e.etyp + else + {edesc = ECall(transf_expr env Val fn, List.map (transf_arg env) args); + etyp = newty} + +(* Function arguments: pass by reference those having composite type *) + +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' + +(* Function calls returning a composite: add first argument. + ctx = Effects: lv = f(...) -> f(&lv, ...) + f(...) -> f(&newtemp, ...) + ctx = Val: lv = f(...) -> f(&newtemp, ...), lv = newtemp, newtemp + f(...) -> f(&newtemp, ...), newtemp +*) + +and transf_composite_call env ctx opt_lhs fn args ty = + let ty = transf_type env ty in + let fn = transf_expr env Val fn in + let args = List.map (transf_arg env) args in + match ctx, opt_lhs with + | Effects, None -> + let tmp = new_temp ~name:"_res" ty in + {edesc = ECall(fn, eaddrof tmp :: args); etyp = TVoid []} + | Effects, Some lhs -> + let lhs = transf_expr env Val lhs in + {edesc = ECall(fn, eaddrof lhs :: args); etyp = TVoid []} + | Val, None -> + let tmp = new_temp ~name:"_res" ty in + ecomma {edesc = ECall(fn, eaddrof 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 []} + (eassign lhs tmp)) + tmp + +(* The transformation above can create ill-formed lhs containing ",", as in + f().x = y ---> (f(&tmp), tmp).x = y + f(g(x)); ---> f(&(g(&tmp),tmp)) + We fix this by floating the "," above the lhs, up to the nearest enclosing + rhs: + f().x = y ---> (f(&tmp), tmp).x = y --> f(&tmp), tmp.x = y + f(g(x)); ---> f(&(g(&tmp),tmp)) --> f((g(&tmp), &tmp)) +*) + +let rec float_comma e = + match e.edesc with + | EConst c -> e + | ESizeof ty -> e + | EVar x -> e + (* lvalue-consuming unops *) + | EUnop((Oaddrof|Opreincr|Opredecr|Opostincr|Opostdecr|Odot _) as op, + {edesc = EBinop(Ocomma, e1, e2, _)}) -> + ecomma (float_comma e1) + (float_comma {edesc = EUnop(op, e2); etyp = e.etyp}) + (* lvalue-consuming binops *) + | EBinop((Oassign|Oadd_assign|Osub_assign|Omul_assign|Odiv_assign + |Omod_assign|Oand_assign|Oor_assign|Oxor_assign + |Oshl_assign|Oshr_assign) as op, + {edesc = EBinop(Ocomma, e1, e2, _)}, e3, tyres) -> + ecomma (float_comma e1) + (float_comma {edesc = EBinop(op, e2, e3, tyres); etyp = e.etyp}) + (* other expressions *) + | EUnop(op, e1) -> + {edesc = EUnop(op, float_comma e1); etyp = e.etyp} + | EBinop(op, e1, e2, tyres) -> + {edesc = EBinop(op, float_comma e1, float_comma e2, tyres); etyp = e.etyp} + | EConditional(e1, e2, e3) -> + {edesc = EConditional(float_comma e1, float_comma e2, float_comma e3); + etyp = e.etyp} + | ECast(ty, e1) -> + {edesc = ECast(ty, float_comma e1); etyp = e.etyp} + | ECall(e1, el) -> + {edesc = ECall(float_comma e1, List.map float_comma el); etyp = e.etyp} (* Initializers *) let rec transf_init env = function | Init_single e -> - Init_single (transf_expr env e) + Init_single (float_comma(transf_expr env Val e)) | Init_array il -> Init_array (List.map (transf_init env) il) | Init_struct(id, fil) -> @@ -96,70 +192,39 @@ let transf_decl env (sto, id, ty, init) = let transf_funbody env body optres = -let transf_type t = transf_type env t -and transf_expr e = transf_expr env e in - -(* Function arguments: pass by reference those having struct/union type *) - -let transf_arg e = - let e' = transf_expr e in - if is_composite_type env e'.etyp - then {edesc = EUnop(Oaddrof, e'); etyp = TPtr(e'.etyp, [])} - else e' -in +let transf_expr ctx e = float_comma(transf_expr env ctx e) in -(* Function calls: if return type is struct or union, - lv = f(...) -> f(&lv, ...) - f(...) -> f(&newtemp, ...) - Returns: if return type is struct or union, +(* Function returns: if return type is struct or union, return x -> _res = x; return *) let rec transf_stmt s = match s.sdesc with | Sskip -> s - | Sdo {edesc = ECall(fn, args); etyp = ty} -> - let fn = transf_expr fn in - let args = List.map transf_arg args in - if is_composite_type env ty then begin - let tmp = new_temp ~name:"_res" ty in - let arg0 = {edesc = EUnop(Oaddrof, tmp); etyp = TPtr(ty, [])} in - {s with sdesc = Sdo {edesc = ECall(fn, arg0 :: args); etyp = TVoid []}} - end else - {s with sdesc = Sdo {edesc = ECall(fn, args); etyp = ty}} - | Sdo {edesc = EBinop(Oassign, dst, {edesc = ECall(fn, args); etyp = ty}, _)} -> - let dst = transf_expr dst in - let fn = transf_expr fn in - let args = List.map transf_arg args in - let ty = transf_type ty in - if is_composite_type env ty then begin - let arg0 = {edesc = EUnop(Oaddrof, dst); etyp = TPtr(dst.etyp, [])} in - {s with sdesc = Sdo {edesc = ECall(fn, arg0 :: args); etyp = TVoid []}} - end else - sassign s.sloc dst {edesc = ECall(fn, args); etyp = ty} | Sdo e -> - {s with sdesc = Sdo(transf_expr e)} + {s with sdesc = Sdo(transf_expr Effects e)} | Sseq(s1, s2) -> {s with sdesc = Sseq(transf_stmt s1, transf_stmt s2)} | Sif(e, s1, s2) -> - {s with sdesc = Sif(transf_expr e, transf_stmt s1, transf_stmt s2)} + {s with sdesc = Sif(transf_expr Val e, + transf_stmt s1, transf_stmt s2)} | Swhile(e, s1) -> - {s with sdesc = Swhile(transf_expr e, transf_stmt s1)} + {s with sdesc = Swhile(transf_expr Val e, transf_stmt s1)} | Sdowhile(s1, e) -> - {s with sdesc = Sdowhile(transf_stmt s1, transf_expr e)} + {s with sdesc = Sdowhile(transf_stmt s1, transf_expr Val e)} | Sfor(s1, e, s2, s3) -> - {s with sdesc = Sfor(transf_stmt s1, transf_expr e, + {s with sdesc = Sfor(transf_stmt s1, transf_expr Val e, transf_stmt s2, transf_stmt s3)} | Sbreak -> s | Scontinue -> s | Sswitch(e, s1) -> - {s with sdesc = Sswitch(transf_expr e, transf_stmt s1)} + {s with sdesc = Sswitch(transf_expr Val e, transf_stmt s1)} | Slabeled(lbl, s1) -> {s with sdesc = Slabeled(lbl, transf_stmt s1)} | Sgoto lbl -> s | Sreturn None -> s | Sreturn(Some e) -> - let e = transf_expr e in + let e = transf_expr Val e in begin match optres with | None -> {s with sdesc = Sreturn(Some e)} |