Ignore:
Timestamp:
Nov 1, 2011, 6:31:24 PM (9 years ago)
Author:
tranquil
Message:
  • corrected a bug
  • implemented copy propagation
  • enhanced constant propagation with some algebraic equalities
  • temporarily added immediates to RTLabs, to be seen if it is useful
File:
1 edited

Legend:

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

    r1473 r1477  
    22    common subexpression elimination and loop-invariant code motion.
    33    This is a reformulation of material found in Muchnick, Advanced compiler
    4     design and implementation. *)
     4    design and implementation.
     5                Along the way we also perform a first rough liveness analysis. *)
     6               
    57
    68open RTLabs
    79open AST
    810
    9 let error_prefix = "RTLabs to RTL"
    10 let error = Error.global_error error_prefix
    11 
    12 let error_int () = error "int16 and int32 not supported."
    13 let error_float () = error "float not supported."
    14 let error_shift () = error "Shift operations not supported."
     11(* Notes: To move loop-invariant computation, peeling is needed. It would *)
     12(* also profit from algebraic transformations that piece together *)
     13(* loop-constants: if x and y are loop-invariants, then x*y*i won't be *)
     14(* optimized unless it is transformed to (x*y)*i. Pretty important for *)
     15(* array addresses. *)
    1516
    1617(* ----- PHASE 0 : critical edge elimination ------ *)
     
    2021(* these must be avoided, inserting an empty node in-between. *)
    2122(* Note: maybe in our case we can avoid this, as branchings will have *)
    22 (* emit cost nodes afterwards. To be checked. *)
     23(* emit cost nodes afterwards. To be checked. Empirically I haven't found *)
     24(* an example where this transformation really applies. *)
    2325
    2426let count_predecessors
     
    8789(*      | Cst of cst (* do we need to consider constants? maybe only big ones? *)*)
    8890  | UnOp of op1 * Register.t
    89   | BinOp of op2 * Register.t * Register.t
     91  | BinOp of op2 * argument * argument
    9092
    9193let expr_of_stmt (s : statement) : expr option = match s with
    9294(*      | St_cst (_, c, _) -> Some (Cst c)*)
    93         | St_op1 (op, _, s, _) -> Some (UnOp (op, s))
     95        | St_op1 (op, _, s, _) when op <> Op_id -> Some (UnOp (op, s))
    9496        | St_op2 (op, _, s, t, _) -> Some (BinOp (op, s, t))
    9597        | _ -> None
     
    99101
    100102(* the register modified by a node *)
    101 let modified_at_stmt stmt =
    102   match stmt with
    103                 | St_op1 (_, r, _, _)
    104                 | St_op2 (_, r, _, _, _)
    105                 | St_cst (r, _, _)
    106                 | St_load (_, r, _, _)
    107                 | St_call_id (_, _, Some r, _, _)
    108                 | St_call_ptr (_, _, Some r, _, _) -> Some r
    109                 | _ -> None
    110 
    111 let modified_at (g : graph) (n : Label.t) : Register.t option =
    112         modified_at_stmt (Label.Map.find n g)
     103let modified_at_stmt = RTLabsUtilities.modified_at_stmt
     104
     105let modified_at = RTLabsUtilities.modified_at
     106
     107(* registers on which the value computed at the statement depends, which are*)
     108(* needed if the modified register is needed. Below used_at lists those*)
     109(* registers that may be needed regardless (i.e. in non-side-effect-free *)
     110(* statements).*)
     111let vars_of_stmt = function
     112  | St_op2 (_, _, Reg s, Reg t, _) ->
     113                Register.Set.add s (Register.Set.singleton t)
     114  | St_load (_, Reg s, _, _)
     115  | St_op1 (_, _, s, _)
     116        | St_op2 (_, _, Reg s, _, _)
     117        | St_op2 (_, _, _, Reg s, _) -> Register.Set.singleton s
     118        | _ -> Register.Set.empty
     119
     120let vars_of (g : graph) (n : Label.t) : Register.Set.t =
     121        vars_of_stmt (Label.Map.find n g)
     122       
     123(* used in possibly non side-effect-free statements *)
     124let used_at_stmt = function
     125        | St_call_id (_, rs, _, _, _)
     126        | St_call_ptr (_, rs, _, _, _)
     127        | St_tailcall_id (_, rs, _)
     128        | St_tailcall_ptr (_, rs, _) ->
     129            let f s r = Register.Set.add r s in
     130            List.fold_left f Register.Set.empty rs
     131  | St_store (_, Reg s, Reg t, _) ->
     132                Register.Set.add s (Register.Set.singleton t)
     133        | St_return (Some r)
     134        | St_cond (r, _, _)
     135        | St_store (_, Reg r, _, _)
     136        | St_store (_, _, Reg r, _)  -> Register.Set.singleton r
     137        | _ -> Register.Set.empty
     138
     139let used_at g n = used_at_stmt (Label.Map.find n g)
    113140
    114141module ExprOrdered = struct
     
    147174      List.fold_left inter (f l) ls
    148175
     176let big_union (f : Label.t -> Register.Set.t) (ls : Label.t list)
     177    : Register.Set.t =
     178    (* generalized union *)
     179  let union s l' = Register.Set.union s (f l') in
     180    List.fold_left union Register.Set.empty ls
     181
    149182let filter_unchanged (r : Register.t option) (s : expr_set) : expr_set =
    150183        match r with
     
    153186                        let filter = function
    154187                                | UnOp (_, s) when r = s -> false
    155                                 | BinOp (_, s, t) when r = s || r = t -> false
     188                                | BinOp (_, s, t) when s = Reg r || t = Reg r -> false
    156189                                | _ -> true in
    157190                        ExprSet.filter filter s
     
    184217end
    185218
     219module Lexprid = struct
     220   
     221  (* A property is a set of expressions and a set of registers. *)
     222  type property = expr_set * Register.Set.t
     223   
     224  let bottom = (ExprSet.empty, Register.Set.empty)
     225   
     226  let equal (a, b) (c, d) = ExprSet.equal a c && Register.Set.equal b d
     227
     228  let is_maximal _ = false
     229   
     230end
     231
    186232module Fpair = Fix.Make (Label.ImpMap) (Lpair)
    187233
    188234module Fsing = Fix.Make (Label.ImpMap) (Lsing)
    189235
     236module Fexprid = Fix.Make (Label.ImpMap) (Lexprid)
    190237(* printing tools to debug *)
    191238
     
    320367(* e is preceded by an optimal computation point for it. These are expressions*)
    321368(* which will not be touched *)
    322 let semantics_isolated
     369(* A variable is used at entry if every use of it later in the execution path *)
     370(* is to compute variables which are in turn used. *)
     371let semantics_isolated_used
    323372    (g : graph)
    324373                (late : Fsing.valuation)
    325374    (lbl : Label.t)
    326     (valu : Fsing.valuation)
    327                 : Fsing.property =
     375    (valu : Fexprid.valuation)
     376                : Fexprid.property =
    328377       
    329378        let stmt = Label.Map.find lbl g in
    330379        let succs = RTLabsUtilities.statement_successors stmt in
    331         let f l = late l ++ (valu l --* expr_of g l) in
    332         big_inter f succs
    333        
    334 let compute_isolated
     380        let f l = late l ++ (fst (valu l) --* expr_of g l) in
     381        let isol = big_inter f succs in
     382       
     383        let f l =
     384                let used_out = snd (valu l) in
     385                let used_out = match modified_at g l with
     386                | Some r when Register.Set.mem r used_out ->
     387                        Register.Set.union (Register.Set.remove r used_out) (vars_of g l)
     388                | _ -> used_out in
     389                Register.Set.union used_out (used_at g l) in
     390        let used = big_union f succs in
     391       
     392        (isol, used)
     393       
     394let compute_isolated_used
    335395    (f_def : internal_function)
    336396    (delayed : Fsing.valuation)
    337     : Fsing.valuation =
     397    : Fexprid.valuation =
    338398
    339399    let graph = f_def.f_graph in
    340400               
    341     Fsing.lfp (semantics_isolated graph (late graph delayed))
     401    Fexprid.lfp (semantics_isolated_used graph (late graph delayed))
    342402
    343403(* expressions that are optimally placed at point p, without being isolated *)
     
    354414                | _ -> false
    355415
     416(* mark instructions that modify an unused register *)
     417let unused g used lbl =
     418    match modified_at g lbl with
     419        | Some r when Register.Set.mem r (used lbl) ->
     420            false
     421        | Some r -> true
     422                                | _ -> false
     423
    356424(*------ PHASE 4 : place expressions, remove reduntant ones -------------*)
    357425
    358 let remove_redundant def is_redundant =
     426let remove_redundant def is_redundant is_unused =
    359427        let g = def.f_graph in
    360428        let types = RTLabsUtilities.computes_type_map def in
    361429        let f lbl stmt (g', s) =
     430                if is_unused lbl then
     431      let succ = List.hd (RTLabsUtilities.statement_successors stmt) in
     432                        (Label.Map.add lbl (St_skip succ) g', s) else
    362433                if is_redundant lbl then
    363434                        match modified_at_stmt stmt, expr_of_stmt stmt with
    364435                                | Some r, Some e ->
    365                                         let succs = RTLabsUtilities.statement_successors stmt in
     436                                        let succ = List.hd (RTLabsUtilities.statement_successors stmt) in
    366437                            let (s, (tmp, _)) =
    367438                                                try
     
    373444                                                                let s = ExprMap.add e (tmp, typ) s in
    374445                                                                (s, (tmp, typ)) in
    375                                         let new_stmt = St_op1 (Op_id, r, tmp, lbl) in
    376                             let new_stmt = RTLabsUtilities.fill_labels new_stmt succs in
     446                                        let new_stmt = St_op1 (Op_id, r, tmp, succ) in
    377447          (Label.Map.add lbl new_stmt g', s)
    378448        | _ -> assert false
     
    434504  (*Printf.printf "Late:\n";
    435505  print_valu_sing late f_def.f_graph f_def.f_entry;*)
    436   let isol = compute_isolated f_def delay in
     506  let isol_used = compute_isolated_used f_def delay in
     507        let isol = fun lbl -> fst (isol_used lbl) in
     508  let used = fun lbl -> snd (isol_used lbl) in
    437509  (*Printf.printf "isolated:\n";
    438510  print_valu_sing isol f_def.f_graph f_def.f_entry;*)
    439511        let opt = optimal late isol in
    440512        let redn = redundant f_def.f_graph late isol in
     513        let unusd = unused f_def.f_graph used in
    441514  (*Printf.printf "optimal:\n";
    442515  print_valu_sing opt f_def.f_graph f_def.f_entry;
     
    445518      Printf.printf "%s : %s\n" lbl (if redn lbl then "yes" else "no") in
    446519    RTLabsUtilities.dfs_iter f f_def.f_graph f_def.f_entry;*)
    447   store_optimal_computation (remove_redundant f_def redn) opt
     520        let f lbl _ s = Register.Set.union (used lbl) s in
     521        let regs_used =
     522                RTLabsUtilities.dfs_fold f f_def.f_graph f_def.f_entry Register.Set.empty in
     523        let filter (r, _) = Register.Set.mem r regs_used in
     524        let f_def = { f_def with f_locals = List.filter filter f_def.f_locals } in
     525        store_optimal_computation (remove_redundant f_def redn unusd) opt
     526       
    448527       
    449528let transform_funct = function
Note: See TracChangeset for help on using the changeset viewer.