Ignore:
Timestamp:
Nov 28, 2011, 3:13:14 PM (9 years ago)
Author:
tranquil
Message:
  • corrected previous bug
  • finished propagating immediates
File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051/src/RTLabs/RTLabsUtilities.ml

    r1569 r1572  
    99  match stmt with
    1010  | St_return _
    11         | St_tailcall_id _
    12         | St_tailcall_ptr _ ->
    13           []
     11  | St_tailcall_id _
     12  | St_tailcall_ptr _ ->
     13    []
    1414  | St_skip l
    1515  | St_cost (_, l)
     
    3131  match stmt with
    3232  | St_return _
    33         | St_tailcall_id _
    34         | St_tailcall_ptr _ -> 0
     33  | St_tailcall_id _
     34  | St_tailcall_ptr _ -> 0
    3535  | St_skip _
    3636  | St_cost _
     
    8383let fill_labels stmt lbls = match stmt, lbls with
    8484  | St_return _, _
    85         | St_tailcall_id _, _
    86         | St_tailcall_ptr _, _ -> stmt
     85  | St_tailcall_id _, _
     86  | St_tailcall_ptr _, _ -> stmt
    8787  | St_skip _, lbl :: _ -> St_skip lbl
    8888  | St_cost (cost_lbl, _), lbl :: _ -> St_cost (cost_lbl, lbl)
     
    9595  | St_store (q, r, s, _), lbl :: _ -> St_store (q, r, s, lbl)
    9696  | St_call_ptr (r, args, ret, sg, _), lbl :: _ ->
    97                 St_call_ptr (r, args, ret, sg, lbl)
     97    St_call_ptr (r, args, ret, sg, lbl)
    9898  | St_call_id (i, args, ret, sg, _), lbl :: _ ->
    9999    St_call_id (i, args, ret, sg, lbl)
    100100  | St_cond (r, _, _), lbl1 :: lbl2 :: _ -> St_cond (r, lbl1, lbl2)
    101101  | St_jumptable (r, _), lbls -> St_jumptable (r, lbls)
    102         | _ -> invalid_arg "fill_labels: not enough successors to fill"
     102  | _ -> invalid_arg "fill_labels: not enough successors to fill"
    103103
    104104(** [insert_in_between u g src tgt s] inserts [s] between [src] and [tgt].
     
    109109let insert_in_between
    110110    (fresh : unit -> node)
    111                 (g : graph)
    112                 (src : node)
    113                 (tgt : node)
    114                 (s : statement)
    115                 : Label.t * graph =
    116                 let new_lbl = fresh () in
    117                 let src_stmt = Label.Map.find src g in
    118                 let succs = statement_successors src_stmt in
    119                 let repl lbl = if lbl = tgt then new_lbl else lbl in
    120                 let new_succs = List.map repl succs in
    121                 let new_src_stmt = fill_labels src_stmt new_succs in
    122                 (new_lbl, Label.Map.add new_lbl s (Label.Map.add src new_src_stmt g))
     111    (g : graph)
     112    (src : node)
     113    (tgt : node)
     114    (s : statement)
     115    : Label.t * graph =
     116  let new_lbl = fresh () in
     117  let src_stmt = Label.Map.find src g in
     118  let succs = statement_successors src_stmt in
     119  let repl lbl = if lbl = tgt then new_lbl else lbl in
     120  let new_succs = List.map repl succs in
     121  let new_src_stmt = fill_labels src_stmt new_succs in
     122  (new_lbl, Label.Map.add new_lbl s (Label.Map.add src new_src_stmt g))
    123123
    124124let dfs_fold
    125125    (f : node -> statement -> 'a -> 'a)
    126                 (g : graph)
    127                 (entry : node)
    128                 (init : 'a)
    129                 : 'a =
    130         assert (Label.Map.mem entry g);
    131         let rec process done_set = function
    132                 | [] -> init
    133                 | next :: worklist when Label.Set.mem next done_set ->
    134                         process done_set worklist
    135                 | next :: worklist ->
    136                         let stmt = Label.Map.find next g in
    137                         let succs = statement_successors stmt in
    138                         f next stmt (process (Label.Set.add next done_set) (succs @ worklist)) in
    139         process Label.Set.empty [entry]
    140        
     126    (g : graph)
     127    (entry : node)
     128    (init : 'a)
     129    : 'a =
     130  assert (Label.Map.mem entry g);
     131  let rec process done_set = function
     132    | [] -> init
     133    | next :: worklist when Label.Set.mem next done_set ->
     134      process done_set worklist
     135    | next :: worklist ->
     136      let stmt = Label.Map.find next g in
     137      let succs = statement_successors stmt in
     138      f next stmt (process (Label.Set.add next done_set) (succs @ worklist)) in
     139  process Label.Set.empty [entry]
     140   
    141141let dead_code_elim
    142142    (g     : graph)
    143143    (entry : node)
    144144    : graph =
    145                 let add lbl _ = Label.Set.add lbl in
    146                 let reachable = dfs_fold add g entry Label.Set.empty in
    147     let is_reachable x _ = Label.Set.mem x reachable in
    148     Label.Map.filter is_reachable g
     145  let add lbl _ = Label.Set.add lbl in
     146  let reachable = dfs_fold add g entry Label.Set.empty in
     147  let is_reachable x _ = Label.Set.mem x reachable in
     148  Label.Map.filter is_reachable g
    149149
    150150let dfs_iter
     
    153153    (entry : node)
    154154    : unit =
    155     assert (Label.Map.mem entry g);
    156     let rec process done_set = function
    157         | [] -> ();
    158         | next :: worklist when Label.Set.mem next done_set ->
    159             process done_set worklist
    160         | next :: worklist ->
    161             let stmt = Label.Map.find next g in
    162             let succs = statement_successors stmt in
    163             f next stmt;
    164                                                 process (Label.Set.add next done_set) (succs @ worklist) in
    165     process Label.Set.empty [entry]
    166    
     155  assert (Label.Map.mem entry g);
     156  let rec process done_set = function
     157    | [] -> ();
     158    | next :: worklist when Label.Set.mem next done_set ->
     159      process done_set worklist
     160    | next :: worklist ->
     161      let stmt = Label.Map.find next g in
     162      let succs = statement_successors stmt in
     163      f next stmt;
     164      process (Label.Set.add next done_set) (succs @ worklist) in
     165  process Label.Set.empty [entry]
     166
    167167let computes_type_map
    168168    (f_def : internal_function)
    169                 : AST.sig_type Register.Map.t =
    170         let types = Register.Map.empty in
    171         let add map (r, typ)  = Register.Map.add r typ map in
    172         let types = List.fold_left add types f_def.f_params in
    173         let types = List.fold_left add types f_def.f_locals in
    174         match f_def.f_result with
     169    : AST.sig_type Register.Map.t =
     170  let types = Register.Map.empty in
     171  let add map (r, typ)  = Register.Map.add r typ map in
     172  let types = List.fold_left add types f_def.f_params in
     173  let types = List.fold_left add types f_def.f_locals in
     174  match f_def.f_result with
    175175    | None -> types
    176176    | Some x -> add types x
     
    179179let modified_at_stmt stmt =
    180180  match stmt with
    181         | St_op1 (_, r, _, _)
    182         | St_op2 (_, r, _, _, _)
    183         | St_cst (r, _, _)
    184         | St_load (_, _, r, _)
    185         | St_call_id (_, _, Some r, _, _)
    186         | St_call_ptr (_, _, Some r, _, _) -> Some r
    187         | _ -> None
     181    | St_op1 (_, r, _, _)
     182    | St_op2 (_, r, _, _, _)
     183    | St_cst (r, _, _)
     184    | St_load (_, _, r, _)
     185    | St_call_id (_, _, Some r, _, _)
     186    | St_call_ptr (_, _, Some r, _, _) -> Some r
     187    | _ -> None
    188188
    189189let modified_at (g : graph) (n : Label.t) : Register.t option =
    190     modified_at_stmt (Label.Map.find n g)
     190  modified_at_stmt (Label.Map.find n g)
    191191
Note: See TracChangeset for help on using the changeset viewer.