-- Copyright (c) 1982-1999 Lennart Augustsson, Thomas Johnsson
-- See LICENSE for the full license.
--
module -- mtrans
--
--
#include "../mcode/mcodedef_t.t"
#include "../mcode/mutil1.t"
#include "tmp.h"
export mtrans2,isfloatimm;
rec rc add (const n) = n>(-256) & n <256        --- Conservative
||  rc sub (const n) = n>(-256) & n <256        --- Conservative
||  rc dfsub (fconst n) = isfloatimm n
||  rc dfadd (fconst n) = isfloatimm n
||  rc dfmul (fconst n) = isfloatimm n
||  rc dfdiv (fconst n) = isfloatimm n
||  rc sfsub (fconst n) = isfloatimm n
||  rc sfadd (fconst n) = isfloatimm n
||  rc sfmul (fconst n) = isfloatimm n
||  rc sfdiv (fconst n) = isfloatimm n
||  rc _   (reg _)   = true
||  rc _   _         = false

and isfloatimm n = (n = 0.0)
                 | (n = 1.0)
                 | (n = 2.0)
                 | (n = 3.0)
                 | (n = 4.0)
                 | (n = 5.0)
                 | (n = 0.5)
                 | (n = 10.0)
#if 0 
-- FIX
                 | (n = -1.0)
                 | (n = -2.0)
                 | (n = -3.0)
                 | (n = -4.0)
                 | (n = -5.0)
                 | (n = -0.5)
                 | (n = -10.0)
#endif

and getmoveinfo dfsub = (Mmovedf,ftmp1,ftmp2)
||  getmoveinfo dfadd = (Mmovedf,ftmp1,ftmp2)
||  getmoveinfo dfmul = (Mmovedf,ftmp1,ftmp2)
||  getmoveinfo dfdiv = (Mmovedf,ftmp1,ftmp2)
||  getmoveinfo dfneg = (Mmovedf,ftmp1,ftmp2)
||  getmoveinfo sfsub = (Mmovesf,ftmp1,ftmp2)
||  getmoveinfo sfadd = (Mmovesf,ftmp1,ftmp2)
||  getmoveinfo sfmul = (Mmovesf,ftmp1,ftmp2)
||  getmoveinfo sfdiv = (Mmovesf,ftmp1,ftmp2)
||  getmoveinfo sfneg = (Mmovedf,ftmp1,ftmp2)
||  getmoveinfo _     = (Mmove,dtmp1,dtmp2)


and op31 op a1 a2 a3 & (rc op a1) =
    let (move,tmp1,tmp2) = getmoveinfo op 
    in op32 move tmp1 tmp2 op a1 a2 a3
||  op31 op a1 a2 a3 =
    let (move,tmp1,tmp2) = getmoveinfo op 
    in move a1 tmp1 . op32 move tmp1 tmp2 op tmp1 a2 a3

and op32 move tmp1 tmp2 op a1 (a2 as reg _) a3 = op33 move tmp1 op a1 a2 a3
||  op32 move tmp1 tmp2 op a1 a2 a3 = move a2 tmp2 . op33 move tmp1 op a1 tmp2 a3

and op33 move tmp1 op a1 a2 (a3 as reg _) = [Mop3 op a1 a2 a3]
||  op33 move tmp1 op a1 a2 a3 = [Mop3 op a1 a2 tmp1; move tmp1 a3]

-- Insert temp regs.
and mr (Mmove (retaddr s) a2) = [Mmove (idlit s) (reg Ret); Mmove (reg Ret) a2]
||  mr (m as Mmove (reg _) _) = [m]
||  mr (m as Mmove _ (reg _)) = [m]
||  mr (Mmove a1 a2) = [Mmove a1 dtmp1; Mmove dtmp1 a2]

||  mr (m as Mmovedf (reg _) _) = [m]
||  mr (m as Mmovedf _ (reg _)) = [m]
||  mr (Mmovedf a1 a2) = [Mmovedf a1 ftmp1; Mmovedf ftmp1 a2]

||  mr (m as Mmovesf (reg _) _) = [m]
||  mr (m as Mmovesf _ (reg _)) = [m]
||  mr (Mmovesf a1 a2) = [Mmovesf a1 ftmp1; Mmovesf ftmp1 a2]

||  mr (m as Mcompare (reg _) (reg _)) = [m]
||  mr (Mcompare (reg r) (const n)) & (n>(-256) & n <256) = [Mcompare (reg r) (const n)]
||  mr (Mcompare a1 a2) & (rc add a1) = [Mmove a2 dtmp2; Mcompare a1 dtmp2]
||  mr (Mcompare a1 a2) & (rc add a2) = [Mmove a1 dtmp1; Mcompare dtmp1 a2]
||  mr (Mcompare a1 a2) = [Mmove a1 dtmp1; Mmove a2 dtmp2; Mcompare dtmp1 dtmp2]

||  mr (m as Mcomparedf (reg _) (reg _)) = [m]
||  mr (Mcomparedf (reg r) (fconst n)) & (isfloatimm n) = [Mcomparedf (reg r) (fconst n)]
||  mr (Mcomparedf a1 a2) & (rc add a1) = [Mmovedf a2 ftmp2; Mcomparedf a1 ftmp2]
||  mr (Mcomparedf a1 a2) & (rc add a2) = [Mmovedf a1 ftmp1; Mcomparedf ftmp1 a2]
||  mr (Mcomparedf a1 a2) = [Mmovedf a1 ftmp1; Mmovedf a2 ftmp2; Mcomparedf ftmp1 ftmp2]

||  mr (m as Mcomparesf (reg _) (reg _)) = [m]
||  mr (Mcomparesf (reg r) (fconst n)) & (isfloatimm n) = [Mcomparesf (reg r) (fconst n)]
||  mr (Mcomparesf a1 a2) & (rc add a1) = [Mmovesf a2 ftmp2; Mcomparesf a1 ftmp2]
||  mr (Mcomparesf a1 a2) & (rc add a2) = [Mmovesf a1 ftmp1; Mcomparesf ftmp1 a2]
||  mr (Mcomparesf a1 a2) = [Mmovesf a1 ftmp1; Mmovesf a2 ftmp2; Mcomparesf ftmp1 ftmp2]


||  mr (m as Mop2 op a1 a2) & (op = itodf | op = itosf) =
    let move = if op = itodf then Mmovedf else Mmovesf
    in case (a1,a2)
       in (reg _,reg _) : [m]
       || (_    ,reg _) : [Mmove a1 dtmp1; Mop2 op dtmp1 a2]
       || (reg _,_    ) : [Mop2 op a1 ftmp2; move ftmp2 a2]
       || (_    ,_    ) : [Mmove a1 dtmp1; Mop2 op dtmp1 ftmp2; move ftmp2 a2]
       end


||  mr (m as Mop2 op a1 a2) & (op = dftoi | op = sftoi) =
    let move = if op = dftoi then Mmovedf else Mmovesf
    in case (a1,a2)
       in (reg _,reg _) : [m]
       || (_    ,reg _) : [move a1 ftmp1; Mop2 op ftmp1 a2]
       || (reg _,_    ) : [Mop2 op a1 dtmp2; Mmove dtmp2 a2]
       || (_    ,_    ) : [move a1 ftmp1; Mop2 op ftmp1 dtmp2; Mmove dtmp2 a2]
       end

||  mr (m as Mop2 op a1 a2) & (op = dftoi | op = sftoi) =
    let move = if op = dftoi then Mmovedf else Mmovesf
    in case (a1,a2)
       in (reg _,reg _) : [m]
       || (_    ,reg _) : [move a1 ftmp1; Mop2 op ftmp1 a2]
       || (reg _,_    ) : [Mop2 op a1 dtmp2; Mmove dtmp2 a2]
       || (_    ,_    ) : [move a1 ftmp1; Mop2 op ftmp1 dtmp2; Mmove dtmp2 a2]
       end

||  mr (Mop2 sftodf a1 a2) =
       case a1
       in (reg _) : [Mmovedf a1 a2]
       || (_    ) : [Mmovesf a1 ftmp1; Mmovedf ftmp1 a2]
       end

||  mr (Mop2 dftosf a1 a2) =
       case a1
       in (reg _) : [Mmovesf a1 a2]
       || (_    ) : [Mmovedf a1 ftmp1; Mmovesf ftmp1 a2]
       end

||  mr (m as Mop2 op (reg _) (reg _)) & (op = neg | op = sfneg | op = dfneg) = [m]
||  mr (Mop2 op (a1 as reg _) a2)  & (op = neg | op = sfneg | op = dfneg) =
        let (move,tmp1,tmp2) = getmoveinfo op
        in [Mop2 op a1 tmp2; move tmp2 a2]
||  mr (Mop2 op a1 (a2 as reg _))  & (op = neg | op = sfneg | op = dfneg) =
        let (move,tmp1,tmp2) = getmoveinfo op
        in [move a1 tmp1; Mop2 op tmp1 a2]
||  mr (Mop2 op a1 a2)  & (op = neg | op = sfneg | op = dfneg) =
        let (move,tmp1,tmp2) = getmoveinfo op
        in [move a1 tmp1; Mop2 op tmp1 tmp2; move tmp2 a2]


||  mr (m as Mop2 op a1 (reg _)) & (rc op a1) = [m]
||  mr (Mop2 op a1 a2) & (rc op a1) =   -- Dangerous if two op reach this case
        let (move,tmp1,tmp2) = getmoveinfo op
        in [move a2 tmp2; Mop2 op a1 tmp2; move tmp2 a2]
||  mr (Mop2 op a1 (a2 as reg _)) = 
        let (move,tmp1,tmp2) = getmoveinfo op
	in [move a1 tmp1; Mop2 op tmp1 a2]
||  mr (Mop2 op a1 a2) = 
        let (move,tmp1,tmp2) = getmoveinfo op
	in [move a1 tmp1; move a2 tmp2; Mop2 op tmp1 tmp2; move tmp2 a2]

||  mr (Mop3 add (const n) a1 a2) & (n<0) = op31 sub (const (-n)) a1 a2
||  mr (Mop3 add a1 (const n) a2) & (n<0) = op31 sub (const (-n)) a1 a2
||  mr (Mop3 sub (const n) a1 a2) & (n<0) = op31 add (const (-n)) a1 a2

#if 0
||  mr (Mop3 dfadd a1 (fconst n) a2) & (n<0) = op31 dfsub a1 a2 (const (-n))
||  mr (Mop3 dfsub a1 (fconst n) a2) & (n<0) = op31 dfadd a1 a2 (const (-n))
||  mr (Mop3 sfadd a1 (fconst n) a2) & (n<0) = op31 sfsub a1 a2 (const (-n))
||  mr (Mop3 sfsub a1 (fconst n) a2) & (n<0) = op31 sfadd a1 a2 (const (-n))
#endif

||  mr (Mop3 op a1 a2 a3) = op31 op a1 a2 a3

||  mr (m as Mcase (reg _) x1 x2 x3 x4 x5) = [m]
||  mr (m as Mboolcc cc (reg _)) = [m]
||  mr (Mboolcc cc a) = [Mboolcc cc dtmp1; Mmove dtmp1 a]
||  mr m = [m]

and mt (Mmove (regrel r1 0) (reg r2)) & (r1=r2) = 
	[]
||  mt (Mmove (regrel r1 0) (reg r2)) = 
	[Mmove (reg r1) (reg r2)]
||  mt (Mmove (regrel r1 n) (reg r2)) = 
           if n > 0 then [Mop3 add (const (4*  n))  (reg r1) (reg r2)]
	   else          [Mop3 sub (const (4*(-n))) (reg r1) (reg r2)]
||  mt (Mop3 mul a1 a2 a3) & (a2=a3) = 
           if a1 ~=a3 then [Mop3 mul a2 a1 a3]
	   else [Mop3 mul a1 a2 (reg Ret); Mmove (reg Ret) a3]
||  mt (Mop2 mul a1 a2) = 
           if a1 ~=a2 then [Mop3 mul a2 a1 a2]
	   else [Mop3 mul a1 a2 (reg Ret); Mmove (reg Ret) a2]
||  mt m = [m]
and mm (Mcompare (glob "_ehp") a2) = Mcompare (reg Ehpr) a2
||  mm (Mcompare a1 (glob "_ehp")) = Mcompare a1 (reg Ehpr)
||  mm m = m
and mtrans2 ms = concmap mr (concmap mt (concmap mr (concmap mt (map mm ms))))

end