(**********************************************************************)
(* (c) Greg Morrisett, Neal Glew, Frederick Smith,                    *)
(*     June 1998, all rights reserved.                                *)
(**********************************************************************)

(* poppeep.ml -- peephole optimizer for the stack based code generator. *)

open Numtypes;;
module T = Tal

(* peephole optimization *)
let optimize insts =
  let some_optimization = ref false in
  let rec click(insts) = (some_optimization := true; peephole insts)
  and peephole insts =
    match insts with
      [] -> []
    | (T.Mov(T.Reg T.Eax,(T.Prjr((T.Esp,[]),i1),[])))::
      (T.ArithBin(T.Add,T.Reg T.Esp,T.Immed i2))::rest
      when i1=$i32_0 & i2=$i32_4 ->
	click((T.Pop(T.Reg T.Eax))::rest)
    | (T.Mov(T.Reg T.Eax,(gop,[])))::(T.Push(T.Reg T.Eax,[]))::
      (T.Mov(T.Reg T.Eax,(gop2,[])))::(T.Pop(T.Reg r'))::rest ->
      	(match r' with
	  T.Eax -> click((T.Mov(T.Reg T.Eax,(gop,[])))::rest)
      	|	_ -> click((T.Mov(T.Reg r',(gop,[])))::
			      (T.Mov(T.Reg T.Eax,((match gop2 with
		                T.Prjr((T.Esp,[]),i) ->
				  T.Prjr((T.Esp,[]),i-$i32_4)
	                      | _ -> gop2),[])))::rest))
(* Cyclone *)
(* This changes an absolute call to a relative call,
   which causes bugs for Cyclone if the call is in a template;
   so we disable it temporarily. *)
(*
    | (T.Mov(T.Reg T.Eax,(T.Addr x,[])))::(T.Call(T.Reg T.Eax,c))::rest ->
      	click((T.Call(T.Addr x,c))::rest)
*)
(* End Cyclone *)
    | (T.Mov(T.Reg T.Eax,cgop))::(T.Push(T.Reg T.Eax,[]))::rest ->
      	click((T.Push(cgop))::rest)
    | (T.Mov(T.Reg T.Eax,(((T.Immed _) as gop),cs)))::
      (T.Mov(T.Prjr ((T.Ebx,[]),i),(T.Reg T.Eax,[])))::rest ->
	click((T.Mov(T.Prjr((T.Ebx,[]),i),(gop,cs)))::rest)
    | (T.ArithBin(T.Add,T.Reg T.Esp,T.Immed i))::
      (T.ArithBin(T.Add,T.Reg T.Esp,T.Immed j))::rest ->
      	click((T.ArithBin(T.Add,T.Reg T.Esp,T.Immed(i+$j)))::rest)
    | ((T.ArithBin(T.Add,T.Reg T.Esp,T.Immed i)) as i1)::
      (((T.Push(gop,cs))::rest) as tail) ->
	begin
	  let reduce = 
	    i >=$ i32_4 & 
	    (match gop with
	      (T.Immed _ | T.Addr _) -> true
	    | T.Reg T.Esp -> false
	    | T.Reg _ -> true
	    | _ -> false)
	  in
	  if reduce then
	    if i =$ i32_4 then
	      click((T.Mov(T.Prjr((T.Esp,[]),i32_0),(gop,cs)))::rest)
	    else 
	      click((T.ArithBin(T.Add,T.Reg T.Esp,T.Immed (i -$ i32_4)))::
		    (T.Mov(T.Prjr((T.Esp,[]),i32_0),(gop,cs)))::rest)
	  else if i =$ i32_0 then peephole tail
	  else i1::(peephole tail)
	end
    | (T.Mov(T.Reg T.Ebx,(T.Reg T.Eax,[])))::
      (T.Mov(T.Reg T.Eax,(T.Immed i',c)))::
      (T.Cmp(T.Reg T.Ebx,T.Reg T.Ecx))::
      (T.Setcc(cond,T.Reg T.Eax))::
      (T.Btagi(T.Eax,i,(lab,c2),cond2))::rest when i'=$i32_0 ->
      	click((T.Cmp(T.Reg T.Eax,T.Reg T.Ecx))::
		 (T.Jcc((if i =$ i32_0 then T.negate_condition cond 
	         else cond),(lab,c2)))::rest)
    | (T.Mov(T.Reg T.Eax,(gop,coercions)))::
      (T.Coerce(T.Eax,coercions2))::rest ->
      	click((T.Mov(T.Reg T.Eax,(gop,coercions2 @ coercions)))::rest)
    | (T.Mov(T.Reg T.Ebx,(T.Immed i,[])))::(T.Mov(T.Reg T.Eax,cgop))::
      (T.ArithBin(ab,T.Reg T.Eax,T.Reg T.Ebx))::rest ->
	(match ab with
	  T.Add when i=$i32_1 -> 
	    click((T.Mov(T.Reg T.Eax,cgop))::(T.ArithUn(T.Inc,T.Reg T.Eax))
		     ::rest)
	| T.Sub when i=$i32_1 ->
	    click((T.Mov(T.Reg T.Eax,cgop))::(T.ArithUn(T.Dec,T.Reg T.Eax))
		     ::rest)
	| _ -> click((T.Mov(T.Reg T.Eax,cgop))
			  ::(T.ArithBin(ab,T.Reg T.Eax,T.Immed i))::rest))
    | (T.Mov(T.Reg T.Ecx,(T.Immed i,[])))::(T.Mov(T.Reg T.Eax,cgop))::
      (T.Cmp(T.Reg T.Eax,T.Reg T.Ecx))::rest ->
      	click((T.Mov(T.Reg T.Eax,cgop))::(T.Cmp(T.Reg T.Eax,T.Immed i))
		 ::rest)
    | (T.Mov(T.Reg T.Eax,(T.Immed i,_)))::
      (T.Btagi(T.Eax,j,(l,c),T.Eq))::rest when i=$j ->
	[(T.Jmp(T.Addr l,c))]
    | (T.Jmp cgop)::_::_ -> click [(T.Jmp cgop)]
    | ((T.Mov(T.Prjr((T.Esp,[]),i),(T.Reg T.Eax,[]))) as i1)::
      ((T.Mov(T.Reg r,cgop)) as i2)::
      ((T.Mov(T.Reg T.Eax,(T.Prjr((T.Esp,[]),j),[]))) as i3)::rest ->
	(if i =$ j & r != T.Eax then click(i1::i2::rest)
	else if r = T.Eax then click(i1::i3::rest)
	else (i1::(peephole (List.tl insts))))
    | i::rest -> i::(peephole rest) in
  let rec optimize_loop insts = 
    (some_optimization := false;
     let insts = peephole insts in
     if !some_optimization then optimize_loop insts else insts)
  in optimize_loop insts
    
