blob: 4ad6f2440035adb60d7752db9b9906cecb1f90cd (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
module Fig.Emulator.GB.Utils where
import Fig.Prelude
import Prelude (fromIntegral)
import qualified Text.Printf as Pr
import Data.Word (Word8, Word16)
import Data.Int (Int8)
import Data.Bits
show8 :: Word8 -> Text
show8 = pack . Pr.printf "%02X"
show16 :: Word8 -> Text
show16 = pack . Pr.printf "%04X"
w8w8 :: Word8 -> Word8 -> Word16
w8w8 high low = shiftL (fromIntegral high) 8 .|. fromIntegral low
w16hi :: Word16 -> Word8
w16hi v = fromIntegral $ shiftR v 8
w16lo :: Word16 -> Word8
w16lo v = fromIntegral $ v .&. 0xff
w8bit :: Int -> Word8 -> Bool
w8bit i v = shiftR v i .&. 0b1 == 1
w8bits2 :: Int -> Word8 -> Word8
w8bits2 i v = shiftR v (i - 1) .&. 0b11
w8bits3 :: Int -> Word8 -> Word8
w8bits3 i v = shiftR v (i - 2) .&. 0b111
w8bits4 :: Int -> Word8 -> Word8
w8bits4 i v = shiftR v (i - 3) .&. 0b1111
flagsw8 :: Bool -> Bool -> Bool -> Bool -> Word8
flagsw8 z n h c =
shiftL (if z then 1 else 0) 7
.|. shiftL (if n then 1 else 0) 6
.|. shiftL (if h then 1 else 0) 5
.|. shiftL (if c then 1 else 0) 4
w8flags :: Word8 -> (Bool, Bool, Bool, Bool)
w8flags x = (z, n, h, c)
where
z = w8bit 7 x
n = w8bit 6 x
h = w8bit 5 x
c = w8bit 4 x
zext :: Word8 -> Word16
zext = fromIntegral
sext :: Word8 -> Word16
sext x = fromIntegral y
where
y :: Int8
y = fromIntegral x
trunc :: Word16 -> Word8
trunc = fromIntegral
addC :: Bool -> Word8 -> Word8 -> (Word8, Bool)
addC c x y = (trunc res, shiftR res 8 .&. 1 == 1)
where
res :: Word16
res = zext x + zext y + if c then 1 else 0
addH :: Bool -> Word8 -> Word8 -> Bool
addH c x y = shiftR res 4 .&. 1 == 1
where
xlo = x .&. 0xf
ylo = y .&. 0xf
res :: Word8
res = xlo + ylo + if c then 1 else 0
subC :: Bool -> Word8 -> Word8 -> (Word8, Bool)
subC c x y = (trunc $ xs - ys, yz > xz)
where
xs = sext x
ys = sext y + if c then 1 else 0
xz = zext x
yz = zext y + if c then 1 else 0
subH :: Bool -> Word8 -> Word8 -> Bool
subH c x y = zext (w8bits4 3 x) < (zext (w8bits4 3 y) + if c then 1 else 0)
|
