(**********************************************************************)
(* (c) Greg Morrisett, Steve Zdancewic                                *)
(*     June 1998, all rights reserved.                                *)
(**********************************************************************)

(* cfgliveness.ml
 *
 * Performs liveness analysis on a Control Flow Graph
 *)

open Utilities
open Set
open Tal
open Cfg

(* Calculates the registers defined and used in the block b. *)
let def_use_block b =
  let add_info i (d, u) =
    let (d', u') = Cfginstr.def_use i in
    (union d d', union (diff u d') u')
  in
  let e = empty compare_regs in
  let (def, use) = vector_fold_rev add_info b.code (e, e) in
  begin
    b.def <- def;
    b.use <- use;
  end

let liveness cfg =
  let e = empty compare_regs in
  let stop = ref false in
  (* Initialize live_in and live_out to empty, set up def and use *)
  (* Add the registers defined and used to the set of registers mentioned by *)
  (* the function containing this block *)
  let init b _ = begin
    b.live_in <- e;
    b.live_out <- e;
    def_use_block b;
    add_regs cfg b.fun_lab (union b.def b.use)
  end in

  (* Performs one step of the analysis for a given block b.  Sets stop *)
  (* to (true & stop) if neither live_in or live_out has changed, false *)
  (* otherwise. *)
  let step b _ =
    let old_live_in = b.live_in in
    let old_live_out = b.live_out in
    let out (_, edge, l) set =
      let b' = get_block cfg l in
      let li = b'.live_in in
      let regs = 
      	match edge with
	  CallEdge -> intersect li (Cfg.get_args cfg l)
	| TailCall -> li
	| SelfTailCall -> li
	      (* The registers live across a return edge are just the return *)
	      (* registers for the function *)
	| Return -> Cfg.get_rets cfg b.fun_lab
	      (* The registers live across an unknown call are those used after *)
	      (* the call is done minus the return regs of the call unioned     *)
	      (* with the arguments to the call.                                *)
	| UnknownCall con ->
	    let args = Talutil.get_arg_registers con in
	    let rets = Talutil.get_ret_registers con in
	    union args (diff li rets)
	| Jump -> li
	| Branch -> li
	| Sequence -> li
	| CallSequence rets -> diff li rets
      in union set regs
    in
    begin
      b.live_in <- union b.use (diff b.live_out b.def);
      b.live_out <- Set.fold out b.succ (empty compare_regs);
      stop := (!stop) & (equals b.live_in old_live_in) &
	      (equals b.live_out old_live_out);
    end
  in
  begin
    print_string "LIVENESS\n";
    Format.print_flush();
    (* Get rid of old register information *)
    cfg.regs <- Dict.empty Identifier.id_compare;
    Cfg.fold init cfg ();
    while not (!stop) do 
      begin 
      	stop := true;
      	rev_fold step cfg ()
      end
    done
  end

(* EOF: cfgliveness.ml *)
