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

where

import GHC.Prelude

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

import GHC.Cmm

import GHC.Data.OrdList
import GHC.Utils.Outputable
import GHC.Utils.Panic


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

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

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

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

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

      MachOp
_           -> do
                     Platform
platform <- NatM Platform
getPlatform
                     forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.CodeGen.CondCode.getCondCode" (forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
mop [CmmExpr
x,CmmExpr
y]))

getCondCode CmmExpr
other = do
   Platform
platform <- NatM Platform
getPlatform
   forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.CodeGen.CondCode.getCondCode" (forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform 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 CmmExpr
x (CmmLit (CmmInt Integer
y Width
_))
  | forall a. Integral a => a -> Bool
fits13Bits Integer
y
  = do
       (Reg
src1, InstrBlock
code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
x
       let
           src2 :: Imm
src2 = Int -> Imm
ImmInt (forall a. Num a => Integer -> a
fromInteger Integer
y)
           code' :: InstrBlock
code' = InstrBlock
code 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
       forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond -> InstrBlock -> CondCode
CondCode Bool
False Cond
cond InstrBlock
code')

condIntCode Cond
cond CmmExpr
x CmmExpr
y = do
    (Reg
src1, InstrBlock
code1) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
x
    (Reg
src2, InstrBlock
code2) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
y
    let
        code__2 :: InstrBlock
code__2 = InstrBlock
code1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
code2 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
    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 CmmExpr
x CmmExpr
y = do
    Platform
platform <- NatM Platform
getPlatform
    (Reg
src1, InstrBlock
code1) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
x
    (Reg
src2, InstrBlock
code2) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
y
    Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
FF64
    let
        promote :: Reg -> Instr
promote Reg
x = Format -> Format -> Reg -> Reg -> Instr
FxTOy Format
FF32 Format
FF64 Reg
x Reg
tmp

        pk1 :: CmmType
pk1   = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
x
        pk2 :: CmmType
pk2   = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
y

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