module X86.Cond (
        Cond(..),
        condUnsigned,
        condToSigned,
        condToUnsigned,
        maybeFlipCond,
        maybeInvertCond
)

where

import GhcPrelude

data Cond
        = ALWAYS        -- What's really used? ToDo
        | EQQ
        | GE
        | GEU
        | GTT
        | GU
        | LE
        | LEU
        | LTT
        | LU
        | NE
        | NEG
        | POS
        | CARRY
        | OFLO
        | PARITY
        | NOTPARITY
        deriving Cond -> Cond -> Bool
(Cond -> Cond -> Bool) -> (Cond -> Cond -> Bool) -> Eq Cond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cond -> Cond -> Bool
$c/= :: Cond -> Cond -> Bool
== :: Cond -> Cond -> Bool
$c== :: Cond -> Cond -> Bool
Eq

condUnsigned :: Cond -> Bool
condUnsigned :: Cond -> Bool
condUnsigned GU  = Bool
True
condUnsigned LU  = Bool
True
condUnsigned GEU = Bool
True
condUnsigned LEU = Bool
True
condUnsigned _   = Bool
False


condToSigned :: Cond -> Cond
condToSigned :: Cond -> Cond
condToSigned GU  = Cond
GTT
condToSigned LU  = Cond
LTT
condToSigned GEU = Cond
GE
condToSigned LEU = Cond
LE
condToSigned x :: Cond
x   = Cond
x


condToUnsigned :: Cond -> Cond
condToUnsigned :: Cond -> Cond
condToUnsigned GTT = Cond
GU
condToUnsigned LTT = Cond
LU
condToUnsigned GE  = Cond
GEU
condToUnsigned LE  = Cond
LEU
condToUnsigned x :: Cond
x   = Cond
x

-- | @maybeFlipCond c@ returns @Just c'@ if it is possible to flip the
-- arguments to the conditional @c@, and the new condition should be @c'@.
maybeFlipCond :: Cond -> Maybe Cond
maybeFlipCond :: Cond -> Maybe Cond
maybeFlipCond cond :: Cond
cond  = case Cond
cond of
        EQQ   -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
EQQ
        NE    -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
NE
        LU    -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
GU
        GU    -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
LU
        LEU   -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
GEU
        GEU   -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
LEU
        LTT   -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
GTT
        GTT   -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
LTT
        LE    -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
GE
        GE    -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
LE
        _other :: Cond
_other -> Maybe Cond
forall a. Maybe a
Nothing

-- | If we apply @maybeInvertCond@ to the condition of a jump we turn
-- jumps taken into jumps not taken and vice versa.
--
-- Careful! If the used comparison and the conditional jump
-- don't match the above behaviour will NOT hold.
-- When used for FP comparisons this does not consider unordered
-- numbers.
-- Also inverting twice might return a synonym for the original condition.
maybeInvertCond :: Cond -> Maybe Cond
maybeInvertCond :: Cond -> Maybe Cond
maybeInvertCond cond :: Cond
cond  = case Cond
cond of
        ALWAYS  -> Maybe Cond
forall a. Maybe a
Nothing
        EQQ     -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
NE
        NE      -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
EQQ

        NEG     -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
POS
        POS     -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
NEG

        GEU     -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
LU
        LU      -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
GEU

        GE      -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
LTT
        LTT     -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
GE

        GTT     -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
LE
        LE      -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
GTT

        GU      -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
LEU
        LEU     -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
GU

        --GEU "==" NOTCARRY, they are synonyms
        --at the assembly level
        CARRY   -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
GEU

        OFLO    -> Maybe Cond
forall a. Maybe a
Nothing

        PARITY  -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
NOTPARITY
        NOTPARITY -> Cond -> Maybe Cond
forall a. a -> Maybe a
Just Cond
PARITY