Ignore:
Timestamp:
Oct 17, 2011, 2:08:27 PM (9 years ago)
Author:
tranquil
Message:

fiddling with Cminor: elimination of loops, blocks and exits

File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051-indexed-labels-branch/src/clight/clightToCminor.ml

    r1334 r1392  
    492492let ind_inc i stmt = match i with
    493493        | None -> stmt
    494         | Some x -> Cminor.St_ind_inc(stmt, x)
    495 
    496 let f_stmt fresh var_locs stmt sub_exprs_res sub_stmts_res =
    497   let (tmps, sub_stmts_res) = List.split sub_stmts_res in
    498   let tmps = List.flatten tmps in
    499 
    500   let (added_tmps, stmt) = match stmt, sub_exprs_res, sub_stmts_res with
    501 
    502     | Clight.Sskip, _, _ -> ([], Cminor.St_skip)
    503 
    504     | Clight.Sassign (e1, _), _ :: e2 :: _, _ ->
     494        | Some x -> Cminor.St_ind_inc(x, stmt)
     495
     496let trans_for =
     497        let f_expr e _ = e in
     498        let f_stmt stmt expr_res stmt_res = match expr_res, stmt_res, stmt with
     499                | e::_, s1::s2::s3::_, Clight.Sfor(i,_,_,_,_) ->
     500                        Clight.Ssequence(s1,Clight.Swhile(i,e,
     501                         Clight.Ssequence(s3, s2)))
     502                | exprs, sub_sts, stm -> ClightFold.statement_fill_subs stm exprs sub_sts in
     503        ClightFold.statement2 f_expr f_stmt
     504
     505let rec translate_stmt fresh var_locs cnt_lbl br_lbl = function
     506
     507    | Clight.Sskip -> ([], Cminor.St_skip)
     508
     509    | Clight.Sassign (e1, e2) ->
     510                        let e2 = translate_expr var_locs e2 in
    505511      ([], assign var_locs e1 e2)
    506512
    507     | Clight.Scall (None, _, _), f :: args, _ ->
     513    | Clight.Scall (None, f, args) ->
     514                        let f = translate_expr var_locs f in
     515                        let args = List.map (translate_expr var_locs) args in
    508516      ([], Cminor.St_call (None, f, args, call_sig AST.Type_void args))
    509517
    510     | Clight.Scall (Some e, _, _), _ :: f :: args, _ ->
     518    | Clight.Scall (Some e, f, args) ->
     519            let f = translate_expr var_locs f in
     520            let args = List.map (translate_expr var_locs) args in
    511521      let t = sig_type_of_ctype (clight_type_of e) in
    512522      let tmp = fresh () in
     
    517527      ([(tmp, t)], Cminor.St_seq (stmt_call, stmt_assign))
    518528
    519     | Clight.Swhile (i,_,_), e :: _, stmt :: _ ->
     529    | Clight.Swhile (i,e,stmt) ->
     530                        let loop_lbl = fresh () in
     531                        let llbl_opt = Some loop_lbl in
     532                        let exit_lbl = fresh () in
     533            let elbl_opt = Some exit_lbl in
     534            let (tmps, stmt) = translate_stmt fresh var_locs llbl_opt elbl_opt stmt in
     535                        let e = translate_expr var_locs e in
     536                        let jmp lbl = Cminor.St_goto lbl in
    520537      let econd =               
    521538        Cminor.Expr (Cminor.Op1 (AST.Op_notbool, e), cminor_type_of e) in
    522539      let scond =
    523         Cminor.St_ifthenelse (econd, Cminor.St_exit 0, Cminor.St_skip) in
    524             let loop_body = Cminor.St_seq (scond, ind_inc i (Cminor.St_block stmt)) in
    525                         let loop = ind_0 i (Cminor.St_loop loop_body) in
    526       ([], Cminor.St_block loop)
     540        Cminor.St_ifthenelse (econd, jmp exit_lbl, Cminor.St_skip) in
     541            let loop =
     542                                Cminor.St_seq(scond,Cminor.St_seq (stmt, ind_inc i (jmp loop_lbl))) in
     543                        let loop = ind_0 i (Cminor.St_label(loop_lbl,loop)) in
     544      (tmps, Cminor.St_seq (loop, Cminor.St_label(exit_lbl,Cminor.St_skip)))
    527545                       
    528     | Clight.Sdowhile (i,_,_), e :: _, stmt :: _ ->
    529       let econd =               
    530         Cminor.Expr (Cminor.Op1 (AST.Op_notbool, e), cminor_type_of e) in
     546    | Clight.Sdowhile (i,e,stmt) ->
     547            let loop_lbl = fresh () in
     548            let llbl_opt = Some loop_lbl in
     549            let exit_lbl = fresh () in
     550            let elbl_opt = Some exit_lbl in
     551      let (tmps, stmt) = translate_stmt fresh var_locs llbl_opt elbl_opt stmt in
     552      let e = translate_expr var_locs e in
     553      let jmp lbl = Cminor.St_goto lbl in
    531554      let scond =
    532               Cminor.St_ifthenelse (econd, Cminor.St_exit 0, Cminor.St_skip) in
    533                         let loop_body = ind_inc i (Cminor.St_seq (Cminor.St_block stmt, scond)) in
    534                         let loop = ind_0 i (Cminor.St_loop loop_body) in
    535       ([], Cminor.St_block loop)
    536 
    537     | Clight.Sfor (i,_,_,_,_), e :: _, stmt1 :: stmt2 :: stmt3 :: _ ->
    538       let econd =                               
    539         Cminor.Expr (Cminor.Op1 (AST.Op_notbool, e), cminor_type_of e) in
    540       let scond =
    541               Cminor.St_ifthenelse (econd, Cminor.St_exit 0, Cminor.St_skip) in
    542       let body = Cminor.St_seq (ind_inc i (Cminor.St_block stmt3), stmt2) in
    543                         let body = Cminor.St_seq (scond, body) in
    544                         let block = Cminor.St_block (ind_0 i (Cminor.St_loop body)) in 
    545       ([], Cminor.St_seq (stmt1, block))
    546 
    547     | Clight.Sifthenelse _, e :: _, stmt1 :: stmt2 :: _ ->
    548       ([], Cminor.St_ifthenelse (e, stmt1, stmt2))
    549 
    550     | Clight.Ssequence _, _, stmt1 :: stmt2 :: _ ->
    551       ([], Cminor.St_seq (stmt1, stmt2))
    552 
    553     | Clight.Sbreak, _, _ -> ([], Cminor.St_exit 1)
    554 
    555     | Clight.Scontinue, _, _ -> ([], Cminor.St_exit 0)
    556 
    557     | Clight.Sswitch _, _, _ ->
     555        Cminor.St_ifthenelse (e, ind_inc i (jmp loop_lbl), Cminor.St_skip) in
     556            let loop =
     557        Cminor.St_seq (stmt, scond) in
     558      let loop = ind_0 i (Cminor.St_label(loop_lbl,loop)) in
     559      (tmps, Cminor.St_seq (loop, Cminor.St_label(exit_lbl,Cminor.St_skip)))
     560                       
     561    | Clight.Sfor _ -> assert false (* transformed *)
     562
     563    | Clight.Sifthenelse (e, stmt1, stmt2) ->
     564      let (tmps1, stmt1) = translate_stmt fresh var_locs cnt_lbl br_lbl stmt1 in
     565      let (tmps2, stmt2) = translate_stmt fresh var_locs cnt_lbl br_lbl stmt2 in
     566      let e = translate_expr var_locs e in
     567      (tmps1 @ tmps2, Cminor.St_ifthenelse (e, stmt1, stmt2))
     568
     569    | Clight.Ssequence(stmt1,stmt2) ->
     570      let (tmps1, stmt1) = translate_stmt fresh var_locs cnt_lbl br_lbl stmt1 in
     571      let (tmps2, stmt2) = translate_stmt fresh var_locs cnt_lbl br_lbl stmt2 in
     572      (tmps1 @ tmps2, Cminor.St_seq (stmt1, stmt2))
     573
     574    | Clight.Sbreak ->
     575                        let br_lbl = match br_lbl with
     576                                | Some x -> x
     577                                | None -> invalid_arg("break without enclosing scope") in
     578                        ([], Cminor.St_goto br_lbl)
     579
     580    | Clight.Scontinue ->
     581            let cnt_lbl = match cnt_lbl with
     582                | Some x -> x
     583                | None -> invalid_arg("continue without enclosing scope") in
     584      ([], Cminor.St_goto cnt_lbl)
     585    | Clight.Sswitch _ ->
    558586      (* Should not appear because of switch transformation performed
    559587         beforehand. *)
    560588      assert false
    561589
    562     | Clight.Sreturn None, _, _ -> ([], Cminor.St_return None)
    563 
    564     | Clight.Sreturn (Some _), e :: _, _ -> ([], Cminor.St_return (Some e))
    565 
    566     | Clight.Slabel (lbl, _), _, stmt :: _ -> ([], Cminor.St_label (lbl, stmt))
    567 
    568     | Clight.Sgoto lbl, _, _ -> ([], Cminor.St_goto lbl)
    569 
    570     | Clight.Scost (lbl, _), _, stmt :: _ -> ([], Cminor.St_cost (lbl, stmt))
    571 
    572     | _ -> assert false (* type error *) in
    573 
    574   (tmps @ added_tmps, stmt)
    575 
    576 let translate_statement fresh var_locs =
    577   ClightFold.statement2 (f_expr var_locs) (f_stmt fresh var_locs)
     590    | Clight.Sreturn None -> ([], Cminor.St_return None)
     591
     592    | Clight.Sreturn (Some e) ->
     593                        let e = translate_expr var_locs e in
     594                        ([], Cminor.St_return (Some e))
     595
     596    | Clight.Slabel (lbl, stmt) ->
     597                        let (tmps, stmt) = translate_stmt fresh var_locs cnt_lbl br_lbl stmt in
     598                        (tmps, Cminor.St_label (lbl, stmt))
     599
     600    | Clight.Sgoto lbl -> ([], Cminor.St_goto lbl)
     601
     602    | Clight.Scost (lbl, stmt) ->
     603                        let (tmps, stmt) = translate_stmt fresh var_locs cnt_lbl br_lbl stmt in
     604                        (tmps, Cminor.St_cost (lbl, stmt))
     605
     606    | _ -> assert false (* type error *)
    578607
    579608
     
    596625  let params =
    597626    List.map (fun (x, t) -> (x, sig_type_of_ctype t)) cfun.Clight.fn_params in
    598   let (tmps, body) = translate_statement fresh var_locs cfun.Clight.fn_body in
     627        let body = cfun.Clight.fn_body in
     628  let (tmps, body) = translate_stmt fresh var_locs None None body in
    599629  let body = add_stack_parameters_initialization var_locs body in
    600630  { Cminor.f_return = type_return_of_ctype cfun.Clight.fn_return ;
Note: See TracChangeset for help on using the changeset viewer.