(* 
 * Note, this file contains conditional pattern matching rules.
 * You'll have to run it thru the tool wheregen 
 * (source for this is in the directory Tools/WhereGen) 
 * to generate the output.
 * 
 * -- Allen
 *)

local
 

   structure I =  
   struct
     include "x86Instr.sml" (* import instruction definitions *)
   end

in

functor X86Peephole
   (structure Instr : X86INSTR
    structure Eval  : MLTREE_EVAL
      (* sharing Instr.T = Eval.T *)
      where type T.Basis.cond = Instr.T.Basis.cond
        and type T.Basis.div_rounding_mode = Instr.T.Basis.div_rounding_mode
        and type T.Basis.ext = Instr.T.Basis.ext
        and type T.Basis.fcond = Instr.T.Basis.fcond
        and type T.Basis.rounding_mode = Instr.T.Basis.rounding_mode
        and type T.Constant.const = Instr.T.Constant.const
        and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) Instr.T.Extension.ccx
        and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) Instr.T.Extension.fx
        and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) Instr.T.Extension.rx
        and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) Instr.T.Extension.sx
        and type T.I.div_rounding_mode = Instr.T.I.div_rounding_mode
        and type T.Region.region = Instr.T.Region.region
        and type T.ccexp = Instr.T.ccexp
        and type T.fexp = Instr.T.fexp
        (* and type T.labexp = Instr.T.labexp *)
        and type T.mlrisc = Instr.T.mlrisc
        and type T.oper = Instr.T.oper
        and type T.rep = Instr.T.rep
        and type T.rexp = Instr.T.rexp
        and type T.stm = Instr.T.stm
   ) : PEEPHOLE =
struct
   structure I = Instr
   structure C = I.C
   structure CBase = CellsBasis

   (* IMPORTANT: instructions are given in forward order *)
   fun peephole instrs =
   let fun isStackPtr(I.Direct r) = CBase.sameColor(r, C.esp)
         | isStackPtr _ = false

       fun isZeroLE le = (Eval.valueOf le = 0) handle _ => false

       fun isZero(I.Immed n) = n = 0
         | isZero(I.ImmedLabel le) = isZeroLE le
         | isZero _ = false

       fun isZeroOpt NONE = true
         | isZeroOpt (SOME opn) = isZero opn

       fun loop(code, instrs) = 
           (case code of
             [] => instrs

              (* x <- x +/- 0; 
               *)
           | I.INSTR(I.BINARY{binOp=(I.ADDL | I.SUBL),
                              src=I.ImmedLabel le, ...})::rest 
               where isZeroLE le => loop(rest, instrs)

              (* remove lea 0(r), r *)
           | I.INSTR(I.LEA{r32, 
                        addr=I.Displace{base, disp=I.ImmedLabel le,...}})::rest
                where (isZeroLE le) andalso 
                      CBase.sameColor(r32,base) => loop(rest, instrs)

             (*   addl n, %esp; subl m, %esp
              * => addl (n-m), %esp     ;; when m < n
              * => -                    ;; when m = n
              * => subl (m-n), %esp     ;; when m > n
              *)
           | I.INSTR(I.BINARY{binOp=I.ADDL, src=I.Immed n, dst=I.Direct d_i})::
             I.INSTR(I.BINARY{binOp=I.SUBL, src=I.Immed m, dst=I.Direct d_j})::
             rest
                where CBase.sameColor(d_i, C.esp) andalso
                      CBase.sameColor(d_j, C.esp) =>
                  if (m = n) then loop (rest, instrs)
                  else if (m < n) then 
                    loop(rest,
                         I.binary{binOp=I.ADDL, src=I.Immed(n-m), 
                                  dst=I.Direct(C.esp)}::instrs)
                  else 
                    loop(rest,
                         I.binary{binOp=I.SUBL, src=I.Immed(m-n), 
                                  dst=I.Direct(C.esp)}::instrs)

             (* push folding:
              *   subl 4, %esp
              *   movl src, 0(%esp)  (where src <> %esp !!! )
              * => 
              *   pushl src
              *)
           | I.INSTR(I.BINARY{binOp=I.SUBL,src=I.Immed 4,dst=I.Direct dst_i}):: 
             I.INSTR(I.MOVE{mvOp=I.MOVL,src,
                            dst=I.Displace{base,disp=I.Immed 0,...}})
             ::rest 
               where CBase.sameColor(base, C.esp) andalso
                     CBase.sameColor(dst_i, C.esp) andalso
                     not(isStackPtr src) =>
               loop(rest, I.pushl src::instrs)
               
             (* pop folding: 
              *   movl 0(%esp), dst   (where dst <> %esp!!!!)
              *   addl 4, %esp
              * => 
              *   popl dst
              *)
           | I.INSTR(I.MOVE{mvOp=I.MOVL, 
                            src=I.Displace{base, disp=I.Immed 0, ...}, dst})::
             I.INSTR(I.BINARY{binOp=I.ADDL, src=I.Immed 4, 
                              dst=I.Direct dst_i}):: 
             rest 
               where CBase.sameColor(base, C.esp) andalso
                     CBase.sameColor(dst_i,C.esp) andalso
                     not(isStackPtr dst) =>
               loop(rest, I.pop dst::instrs)

           | I.INSTR(I.MOVE{mvOp=I.MOVL, src, dst as I.Direct _})::rest 
              where isZero src => 
                loop(rest, I.binary{binOp=I.XORL, src=dst, dst=dst}::instrs)

           | i::rest => loop(rest, i::instrs)
           )
   in  loop(instrs, [])
   end
end 

end
