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

(* regalloc.ml
 *
 * Performs type-preserving register allocation on a given control flow graph.
 *)

open Set
open Tal
open Cfg

let debug = false
let matrices = false
let adjacencies = true 
let debugdo ifg = if debug then 
  Regifg.print_ifg ifg true matrices true true adjacencies
else ()

let precolored = from_list compare_regs [Eax; Ebx; Ecx; Edx; Esi; Edi; Ebp]

let rec regalloc' cfg n = 
  begin
    (* As a temporary measure, we first rewrite the code so that any return *)
    (* values are passed in Eax *)
    Cfgliveness.liveness cfg;         (* Calculate the liveness information *)
    print_string "ALLOCATING REGISTERS\n";
    Format.print_flush();
    let ifg = Regifg.build cfg n in  (* Build the interference graph *)
    begin
      debugdo ifg;
      Regifg.initialize_sets ifg;  (* Initialize the various live-range sets *)
      (* While there's still work to do, do it *)
      while (Regifg.simplifiable ifg ||
             Regifg.coalescable ifg ||
	     Regifg.freezable ifg ||
	     Regifg.splitable ifg ||
	     Regifg.spillable ifg)
      do begin
      	debugdo ifg;
	(* Simplify, then coalesce, freeze, split and spill *)
	if Regifg.simplifiable ifg then Regifg.simplify ifg
	else if Regifg.coalescable ifg then Regifg.coalesce_regs ifg
	else if Regifg.freezable ifg then Regifg.freeze ifg
	else if Regifg.splitable ifg then Regifg.split ifg
	else Regifg.spill ifg
      end
      done;
      (* For sanity's sake, print out the ifg info *)
      debugdo ifg;
      (* Attempt to color the interference graph, spilling if necessary *)
      let color = Regifg.color_regs ifg in begin
	(* Dump the map of assigned registers *)
	if debug then Regifg.print_regmap color else ();
      (* If there were actual spills, then we need to insert spill code *)
      (* and rerun the graph coloring scheme. *)
      	if Regifg.actual_spills ifg then 

(*	  let cfg' = Regrewrite.rewrite_spills cfg ifg in begin
  print_string "Finished rewriting spills"; print_newline ();
  cfg' 
  end  *)
	  regalloc' (Regrewrite.rewrite_spills cfg ifg) n
      (* Otherwise, we return a cleaned up version of the control flow graph *)
      (* with physical registers substituted for virtual registers *)
      	else Regrewrite.cleanup (Regrewrite.rewrite_regs cfg color)
      end
    end
  end

let regalloc cfg n = begin
  Cfgliveness.liveness cfg;          (* Calculate the liveness information     *)
  Cfgopt.remove_dead_code cfg;       (* Remove dead code and regs from types   *)
  Cfgliveness.liveness cfg;          (* Calculate the liveness information     *)
  Regrewrite.save_live_regs cfg;     (* Store live registers across calls      *)
  regalloc' cfg n;
  cfg
end


(* EOF: regalloc.ml *)
