module SPARC.CodeGen.CondCode (
        getCondCode,
        condIntCode,
        condFltCode
)

where

import GhcPrelude

import {-# SOURCE #-} SPARC.CodeGen.Gen32
import SPARC.CodeGen.Base
import SPARC.Instr
import SPARC.Regs
import SPARC.Cond
import SPARC.Imm
import SPARC.Base
import NCGMonad
import Format

import Cmm

import OrdList
import Outputable


getCondCode :: CmmExpr -> NatM CondCode
getCondCode :: CmmExpr -> NatM CondCode
getCondCode (CmmMachOp mop :: MachOp
mop [x :: CmmExpr
x, y :: CmmExpr
y])
  =
    case MachOp
mop of
      MO_F_Eq W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
EQQ CmmExpr
x CmmExpr
y
      MO_F_Ne W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
NE  CmmExpr
x CmmExpr
y
      MO_F_Gt W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GTT CmmExpr
x CmmExpr
y
      MO_F_Ge W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GE  CmmExpr
x CmmExpr
y
      MO_F_Lt W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
LTT CmmExpr
x CmmExpr
y
      MO_F_Le W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
LE  CmmExpr
x CmmExpr
y

      MO_F_Eq W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
EQQ CmmExpr
x CmmExpr
y
      MO_F_Ne W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
NE  CmmExpr
x CmmExpr
y
      MO_F_Gt W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GTT CmmExpr
x CmmExpr
y
      MO_F_Ge W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GE  CmmExpr
x CmmExpr
y
      MO_F_Lt W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
LTT CmmExpr
x CmmExpr
y
      MO_F_Le W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
LE  CmmExpr
x CmmExpr
y

      MO_Eq   _   -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
EQQ  CmmExpr
x CmmExpr
y
      MO_Ne   _   -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
NE   CmmExpr
x CmmExpr
y

      MO_S_Gt _   -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
GTT  CmmExpr
x CmmExpr
y
      MO_S_Ge _   -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
GE   CmmExpr
x CmmExpr
y
      MO_S_Lt _   -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
LTT  CmmExpr
x CmmExpr
y
      MO_S_Le _   -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
LE   CmmExpr
x CmmExpr
y

      MO_U_Gt _   -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
GU   CmmExpr
x CmmExpr
y
      MO_U_Ge _   -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
GEU  CmmExpr
x CmmExpr
y
      MO_U_Lt _   -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
LU   CmmExpr
x CmmExpr
y
      MO_U_Le _   -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
LEU  CmmExpr
x CmmExpr
y

      _           -> String -> SDoc -> NatM CondCode
forall a. HasCallStack => String -> SDoc -> a
pprPanic "SPARC.CodeGen.CondCode.getCondCode" (CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
mop [CmmExpr
x,CmmExpr
y]))

getCondCode other :: CmmExpr
other = String -> SDoc -> NatM CondCode
forall a. HasCallStack => String -> SDoc -> a
pprPanic "SPARC.CodeGen.CondCode.getCondCode" (CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
other)





-- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
-- passed back up the tree.

condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode cond :: Cond
cond x :: CmmExpr
x (CmmLit (CmmInt y :: Integer
y _))
  | Integer -> Bool
forall a. Integral a => a -> Bool
fits13Bits Integer
y
  = do
       (src1 :: Reg
src1, code :: InstrBlock
code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
x
       let
           src2 :: Imm
src2 = Int -> Imm
ImmInt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
y)
           code' :: InstrBlock
code' = InstrBlock
code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` Bool -> Bool -> Reg -> RI -> Reg -> Instr
SUB Bool
False Bool
True Reg
src1 (Imm -> RI
RIImm Imm
src2) Reg
g0
       CondCode -> NatM CondCode
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond -> InstrBlock -> CondCode
CondCode Bool
False Cond
cond InstrBlock
code')

condIntCode cond :: Cond
cond x :: CmmExpr
x y :: CmmExpr
y = do
    (src1 :: Reg
src1, code1 :: InstrBlock
code1) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
x
    (src2 :: Reg
src2, code2 :: InstrBlock
code2) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
y
    let
        code__2 :: InstrBlock
code__2 = InstrBlock
code1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
code2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
                  Bool -> Bool -> Reg -> RI -> Reg -> Instr
SUB Bool
False Bool
True Reg
src1 (Reg -> RI
RIReg Reg
src2) Reg
g0
    CondCode -> NatM CondCode
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond -> InstrBlock -> CondCode
CondCode Bool
False Cond
cond InstrBlock
code__2)


condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode cond :: Cond
cond x :: CmmExpr
x y :: CmmExpr
y = do
    DynFlags
dflags <- NatM DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    (src1 :: Reg
src1, code1 :: InstrBlock
code1) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
x
    (src2 :: Reg
src2, code2 :: InstrBlock
code2) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
y
    Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
FF64
    let
        promote :: Reg -> Instr
promote x :: Reg
x = Format -> Format -> Reg -> Reg -> Instr
FxTOy Format
FF32 Format
FF64 Reg
x Reg
tmp

        pk1 :: CmmType
pk1   = DynFlags -> CmmExpr -> CmmType
cmmExprType DynFlags
dflags CmmExpr
x
        pk2 :: CmmType
pk2   = DynFlags -> CmmExpr -> CmmType
cmmExprType DynFlags
dflags CmmExpr
y

        code__2 :: InstrBlock
code__2 =
                if CmmType
pk1 CmmType -> CmmType -> Bool
`cmmEqType` CmmType
pk2 then
                    InstrBlock
code1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
code2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
                    Bool -> Format -> Reg -> Reg -> Instr
FCMP Bool
True (CmmType -> Format
cmmTypeFormat CmmType
pk1) Reg
src1 Reg
src2
                else if CmmType -> Width
typeWidth CmmType
pk1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W32 then
                    InstrBlock
code1 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
promote Reg
src1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
code2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
                    Bool -> Format -> Reg -> Reg -> Instr
FCMP Bool
True Format
FF64 Reg
tmp Reg
src2
                else
                    InstrBlock
code1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
code2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
promote Reg
src2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
                    Bool -> Format -> Reg -> Reg -> Instr
FCMP Bool
True Format
FF64 Reg
src1 Reg
tmp
    CondCode -> NatM CondCode
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond -> InstrBlock -> CondCode
CondCode Bool
True Cond
cond InstrBlock
code__2)