1module X86.Cond (
2        Cond(..),
3        condUnsigned,
4        condToSigned,
5        condToUnsigned,
6        maybeFlipCond,
7        maybeInvertCond
8)
9
10where
11
12import GhcPrelude
13
14data Cond
15        = ALWAYS        -- What's really used? ToDo
16        | EQQ           -- je/jz -> zf = 1
17        | GE            -- jge
18        | GEU           -- ae
19        | GTT           -- jg
20        | GU            -- ja
21        | LE            -- jle
22        | LEU           -- jbe
23        | LTT           -- jl
24        | LU            -- jb
25        | NE            -- jne
26        | NEG           -- js
27        | POS           -- jns
28        | CARRY         -- jc
29        | OFLO          -- jo
30        | PARITY        -- jp
31        | NOTPARITY     -- jnp
32        deriving Eq
33
34condUnsigned :: Cond -> Bool
35condUnsigned GU  = True
36condUnsigned LU  = True
37condUnsigned GEU = True
38condUnsigned LEU = True
39condUnsigned _   = False
40
41
42condToSigned :: Cond -> Cond
43condToSigned GU  = GTT
44condToSigned LU  = LTT
45condToSigned GEU = GE
46condToSigned LEU = LE
47condToSigned x   = x
48
49
50condToUnsigned :: Cond -> Cond
51condToUnsigned GTT = GU
52condToUnsigned LTT = LU
53condToUnsigned GE  = GEU
54condToUnsigned LE  = LEU
55condToUnsigned x   = x
56
57-- | @maybeFlipCond c@ returns @Just c'@ if it is possible to flip the
58-- arguments to the conditional @c@, and the new condition should be @c'@.
59maybeFlipCond :: Cond -> Maybe Cond
60maybeFlipCond cond  = case cond of
61        EQQ   -> Just EQQ
62        NE    -> Just NE
63        LU    -> Just GU
64        GU    -> Just LU
65        LEU   -> Just GEU
66        GEU   -> Just LEU
67        LTT   -> Just GTT
68        GTT   -> Just LTT
69        LE    -> Just GE
70        GE    -> Just LE
71        _other -> Nothing
72
73-- | If we apply @maybeInvertCond@ to the condition of a jump we turn
74-- jumps taken into jumps not taken and vice versa.
75--
76-- Careful! If the used comparison and the conditional jump
77-- don't match the above behaviour will NOT hold.
78-- When used for FP comparisons this does not consider unordered
79-- numbers.
80-- Also inverting twice might return a synonym for the original condition.
81maybeInvertCond :: Cond -> Maybe Cond
82maybeInvertCond cond  = case cond of
83        ALWAYS  -> Nothing
84        EQQ     -> Just NE
85        NE      -> Just EQQ
86
87        NEG     -> Just POS
88        POS     -> Just NEG
89
90        GEU     -> Just LU
91        LU      -> Just GEU
92
93        GE      -> Just LTT
94        LTT     -> Just GE
95
96        GTT     -> Just LE
97        LE      -> Just GTT
98
99        GU      -> Just LEU
100        LEU     -> Just GU
101
102        --GEU "==" NOTCARRY, they are synonyms
103        --at the assembly level
104        CARRY   -> Just GEU
105
106        OFLO    -> Nothing
107
108        PARITY  -> Just NOTPARITY
109        NOTPARITY -> Just PARITY
110