Skip to content

Commit 51d0ca7

Browse files
ProggerXProggerX
committed
refactor: Opcode type, CPU and Parser modules
1 parent a88c122 commit 51d0ca7

11 files changed

Lines changed: 423 additions & 305 deletions

File tree

‎chipi-chapa.cabal‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,8 +21,14 @@ library
2121
exposed-modules: ChipiChapa
2222
other-modules:
2323
ChipiChapa.Types,
24+
ChipiChapa.Types.Opcodes,
25+
ChipiChapa.Types.Font,
2426
ChipiChapa.GUI,
2527
ChipiChapa.CPU,
28+
ChipiChapa.CPU.Math,
29+
ChipiChapa.CPU.Flow,
30+
ChipiChapa.CPU.Input,
31+
ChipiChapa.CPU.Regs,
2632
ChipiChapa.Parser
2733
-- other-extensions:
2834
build-depends:

‎src/ChipiChapa/CPU.hs‎

Lines changed: 9 additions & 95 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,10 @@ import System.Random
1414
import Text.Parsec
1515
import Text.Printf
1616

17+
import ChipiChapa.CPU.Flow
18+
import ChipiChapa.CPU.Input
19+
import ChipiChapa.CPU.Math
20+
import ChipiChapa.CPU.Regs
1721
import ChipiChapa.Parser
1822
import ChipiChapa.Types
1923

@@ -68,112 +72,22 @@ update = do
6872
when (bs V.! pc) $ halted .= AtBreakpoint
6973
getOpcode
7074
>>= trace
71-
<&> (fromE . parse parseOpcode "" . showHex')
75+
<&> (fromE . parse opcode "" . showHex')
7276
>>= trace'
7377
>>= (\a -> pointer += 2 >> pure a)
7478
>>= \case
7579
None -> pure ()
80+
Flow f -> execFlow f
81+
Regs r -> execRegs r
82+
Math m -> execMath m
83+
Input i -> execInput i
7684
DispClear -> display .= V.replicate 64 0
77-
Goto nnn -> pointer .= nnn
78-
Return -> do
79-
use (stack . singular _head) >>= assign pointer
80-
stack %= drop 1
81-
Call nnn -> do
82-
ptr <- use pointer
83-
stack %= (ptr :)
84-
pointer .= nnn
85-
SkipIfEq x nn -> do
86-
cur <- use $ registers @ x
87-
when (cur == nn) $ pointer += 2
88-
SkipIfREq x y -> do
89-
vx <- use $ registers @ x
90-
vy <- use $ registers @ y
91-
when (vx == vy) $ pointer += 2
92-
SkipIfNotEq x nn -> do
93-
cur <- use $ registers @ x
94-
when (cur /= nn) $ pointer += 2
95-
SkipIfRNotEq x y -> do
96-
vx <- use $ registers @ x
97-
vy <- use $ registers @ y
98-
when (vx /= vy) $ pointer += 2
99-
RegSet x nn -> (registers @ x) .= nn
100-
CAdd x nn -> (registers @ x) += nn
101-
Move x y -> use (registers @ y) >>= assign (registers @ x)
102-
BOr x y ->
103-
use (registers @ y)
104-
>>= (\vx vy -> vx %= (.|.) vy) (registers @ x)
105-
BAnd x y ->
106-
use (registers @ y)
107-
>>= (\vx vy -> vx %= (.&.) vy) (registers @ x)
108-
BXor x y ->
109-
use (registers @ y)
110-
>>= (\vx vy -> vx %= xor vy) (registers @ x)
111-
Add x y -> do
112-
!vx <- use $ registers @ x
113-
!vy <- use $ registers @ y
114-
registers @ x += vy
115-
if fromIntegral @_ @Int vx + fromIntegral vy > 255
116-
then (registers @ 15) .= 1
117-
else (registers @ 15) .= 0
118-
Sub x y -> do
119-
!vx <- use $ registers @ x
120-
!vy <- use $ registers @ y
121-
registers @ x -= vy
122-
if vx >= vy
123-
then registers @ 15 .= 1
124-
else registers @ 15 .= 0
125-
SubFrom x y -> do
126-
!vx <- use $ registers @ x
127-
!vy <- use $ registers @ y
128-
registers @ x .= vy - vx
129-
if vy >= vx
130-
then registers @ 15 .= 1
131-
else registers @ 15 .= 0
132-
RShift x -> do
133-
registers @ x %= (`shiftR` 1)
134-
vx <- use (registers @ x)
135-
registers @ 15 .= fromIntegral (vx .&. 1)
136-
LShift x -> do
137-
registers @ x %= (`shiftL` 1)
138-
vx <- use (registers @ x)
139-
registers @ 15 .= fromIntegral (vx .&. bit 8)
140-
SetI nnn -> iReg .= nnn
141-
JmpV0Plus nnn -> do
142-
v0 <- fromIntegral <$> use (registers @ 0)
143-
pointer .= v0 + nnn
14485
RandomAnd x nn -> do
14586
rnd <- liftIO $ randomRIO (0, 255)
14687
registers @ x .= rnd .&. nn
14788
GetDelay x -> use dt >>= assign (registers @ x) . fromIntegral
14889
SetDelay x -> use (registers @ x) >>= assign dt . fromIntegral
14990
SetSound x -> use (registers @ x) >>= assign st . fromIntegral
150-
SkipIfNotPressed x -> do
151-
!vx <- use $ registers @ x
152-
isUp <- liftIO $ isKeyUp $ key vx
153-
when isUp $ pointer += 2
154-
SkipIfPressed x -> do
155-
!vx <- use $ registers @ x
156-
isDown <- liftIO $ isKeyDown $ key vx
157-
when isDown $ pointer += 2
158-
WaitForKey x -> halted .= Waiting x
159-
AddI x -> use (registers @ x) >>= (iReg +=) . fromIntegral
160-
StoreBCD x -> do
161-
vx <- use $ registers @ x
162-
163-
i <- use iReg
164-
memory @ (i + 2) .= vx `mod` 10
165-
memory @ (i + 1) .= vx `div` 10
166-
memory @ i .= vx `div` 100
167-
DumpRegs x -> do
168-
i <- use iReg
169-
forM_ [0 .. x] $ \l -> do
170-
r <- use $ registers @ l
171-
memory @ (i + l) .= r
172-
LoadRegs x -> do
173-
i <- use iReg
174-
forM_ [0 .. x] $ \l -> do
175-
r <- use $ memory @ (i + l)
176-
registers @ l .= r
17791
FontSprite x -> do
17892
vx <- use $ registers @ x
17993
iReg .= fromIntegral vx * 5

‎src/ChipiChapa/CPU/Flow.hs‎

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
{-# LANGUAGE LambdaCase #-}
2+
module ChipiChapa.CPU.Flow where
3+
4+
import ChipiChapa.Types
5+
import Control.Lens
6+
import Control.Monad
7+
import Control.Monad.State
8+
9+
execFlow :: (MonadState Chip8 m, MonadIO m) => Flow -> m ()
10+
execFlow = \case
11+
Return -> do
12+
use (stack . singular _head) >>= assign pointer
13+
stack %= drop 1
14+
Call nnn -> do
15+
ptr <- use pointer
16+
stack %= (ptr :)
17+
pointer .= nnn
18+
SkipIfEq x nn -> do
19+
cur <- use $ registers @ x
20+
when (cur == nn) $ pointer += 2
21+
SkipIfREq x y -> do
22+
vx <- use $ registers @ x
23+
vy <- use $ registers @ y
24+
when (vx == vy) $ pointer += 2
25+
SkipIfNotEq x nn -> do
26+
cur <- use $ registers @ x
27+
when (cur /= nn) $ pointer += 2
28+
SkipIfRNotEq x y -> do
29+
vx <- use $ registers @ x
30+
vy <- use $ registers @ y
31+
when (vx /= vy) $ pointer += 2
32+
33+
JmpV0Plus nnn -> do
34+
v0 <- fromIntegral <$> use (registers @ 0)
35+
pointer .= v0 + nnn
36+
37+
Goto nnn -> pointer .= nnn

‎src/ChipiChapa/CPU/Input.hs‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
{-# LANGUAGE LambdaCase #-}
2+
module ChipiChapa.CPU.Input where
3+
4+
import ChipiChapa.Types
5+
import Control.Lens
6+
import Control.Monad.IO.Class
7+
import Raylib.Core
8+
import Control.Monad.State
9+
import Control.Monad
10+
11+
execInput :: (MonadState Chip8 m, MonadIO m) => Input -> m ()
12+
execInput = \case
13+
SkipIfNotPressed x -> do
14+
!vx <- use $ registers @ x
15+
isUp <- liftIO $ isKeyUp $ key vx
16+
when isUp $ pointer += 2
17+
SkipIfPressed x -> do
18+
!vx <- use $ registers @ x
19+
isDown <- liftIO $ isKeyDown $ key vx
20+
when isDown $ pointer += 2
21+
WaitForKey x -> halted .= Waiting x

‎src/ChipiChapa/CPU/Math.hs‎

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
{-# LANGUAGE LambdaCase #-}
2+
module ChipiChapa.CPU.Math where
3+
4+
import ChipiChapa.Types
5+
import Control.Lens
6+
import Control.Monad
7+
import Control.Monad.State
8+
import Data.Bits
9+
10+
execMath :: (MonadState Chip8 m, MonadIO m) => Math -> m ()
11+
execMath = \case
12+
CAdd x nn -> (registers @ x) += nn
13+
BOr x y ->
14+
use (registers @ y)
15+
>>= (\vx vy -> vx %= (.|.) vy) (registers @ x)
16+
BAnd x y ->
17+
use (registers @ y)
18+
>>= (\vx vy -> vx %= (.&.) vy) (registers @ x)
19+
BXor x y ->
20+
use (registers @ y)
21+
>>= (\vx vy -> vx %= xor vy) (registers @ x)
22+
Add x y -> do
23+
!vx <- use $ registers @ x
24+
!vy <- use $ registers @ y
25+
registers @ x += vy
26+
if fromIntegral @_ @Int vx + fromIntegral vy > 255
27+
then (registers @ 15) .= 1
28+
else (registers @ 15) .= 0
29+
Sub x y -> do
30+
!vx <- use $ registers @ x
31+
!vy <- use $ registers @ y
32+
registers @ x -= vy
33+
if vx >= vy
34+
then registers @ 15 .= 1
35+
else registers @ 15 .= 0
36+
SubFrom x y -> do
37+
!vx <- use $ registers @ x
38+
!vy <- use $ registers @ y
39+
registers @ x .= vy - vx
40+
if vy >= vx
41+
then registers @ 15 .= 1
42+
else registers @ 15 .= 0
43+
RShift x -> do
44+
registers @ x %= (`shiftR` 1)
45+
vx <- use (registers @ x)
46+
registers @ 15 .= fromIntegral (vx .&. 1)
47+
LShift x -> do
48+
registers @ x %= (`shiftL` 1)
49+
vx <- use (registers @ x)
50+
registers @ 15 .= fromIntegral (vx .&. bit 8)

‎src/ChipiChapa/CPU/Regs.hs‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
{-# LANGUAGE LambdaCase #-}
2+
module ChipiChapa.CPU.Regs where
3+
4+
import ChipiChapa.Types
5+
import Control.Lens
6+
import Control.Monad
7+
import Control.Monad.State
8+
9+
10+
execRegs :: (MonadState Chip8 m, MonadIO m) => Regs -> m ()
11+
execRegs = \case
12+
RegSet x nn -> (registers @ x) .= nn
13+
Move x y -> use (registers @ y) >>= assign (registers @ x)
14+
SetI nnn -> iReg .= nnn
15+
AddI x -> use (registers @ x) >>= (iReg +=) . fromIntegral
16+
StoreBCD x -> do
17+
vx <- use $ registers @ x
18+
19+
i <- use iReg
20+
memory @ (i + 2) .= vx `mod` 10
21+
memory @ (i + 1) .= vx `div` 10
22+
memory @ i .= vx `div` 100
23+
DumpRegs x -> do
24+
i <- use iReg
25+
forM_ [0 .. x] $ \l -> do
26+
r <- use $ registers @ l
27+
memory @ (i + l) .= r
28+
LoadRegs x -> do
29+
i <- use iReg
30+
forM_ [0 .. x] $ \l -> do
31+
r <- use $ memory @ (i + l)
32+
registers @ l .= r

0 commit comments

Comments
 (0)