summaryrefslogtreecommitdiff
path: root/cparser/StructByValue.ml
diff options
context:
space:
mode:
Diffstat (limited to 'cparser/StructByValue.ml')
-rw-r--r--cparser/StructByValue.ml187
1 files changed, 126 insertions, 61 deletions
diff --git a/cparser/StructByValue.ml b/cparser/StructByValue.ml
index de79737..c66af32 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)}
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-05 12:05:17 +0000