blob: 1718b600939174f5ec2d05f0c25708369758544c (
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
|
module Main where
import qualified Data.Sequence as S
import Control.Monad.State
import Data.Word ( Word16 )
import Data.Maybe (isNothing)
import Data.Bits ( Bits((.&.), complement, shiftR) )
import Data.Sequence ((!?))
import Debug.Trace
data Machine = Machine {
pc :: Int,
registers :: S.Seq Int,
memory :: S.Seq Int
} deriving Show
mkMachine :: [String] -> Machine
mkMachine f = Machine 0 (S.replicate 8 0) (S.fromList $ map read f)
data MachineError = Halt | MemoryAccessError deriving (Show,Eq)
execute :: State Machine (Maybe MachineError)
execute = do
inst <- gets (S.lookup.pc<*>memory)
-- increment pc
-- modify $ Machine.((+1).pc)<*>memory<*>registers
regs <- gets registers
mem <- gets memory
pc <- gets $ (+1).pc
case inst of
Nothing -> return $ Just MemoryAccessError
Just inst ->
let Just regA = S.lookup (inst `shiftR` 19 .&. 0b111) regs
Just regB = S.lookup (inst `shiftR` 16 .&. 0b111) regs
destReg = inst .&. 0b111
offsetField = inst .&. 0b1111111111111111
wrapAdd x y = (fromIntegral (fromIntegral (x+y) :: Word16) :: Int)
in case inst `shiftR` 22 .&. 0b111 of
-- ADD
0 -> do
put $ Machine pc (S.update destReg (regA+regB) regs) mem
return Nothing
-- NAND
1 -> do
put $ Machine pc (S.update destReg (complement regA.&.regB) regs) mem
return Nothing
-- LW
2 -> do
case S.lookup (wrapAdd offsetField regA) mem of
Nothing -> return $ Just MemoryAccessError
Just v -> do
put $ Machine pc (S.update (inst `shiftR` 16 .&. 0b11) v regs) mem
return Nothing
-- SW
3 -> do
put $ Machine pc regs (S.update (wrapAdd offsetField regA) regB mem)
return Nothing
--- BEQ
4 -> do
if regA==regB then
put $ Machine (wrapAdd offsetField pc) regs mem
else put $ Machine pc regs mem
return Nothing
-- XXX
5 -> return Nothing
-- HALT
6 -> return $ Just Halt
-- NOOP
7 -> return Nothing
main :: IO ()
main = do
input <- getContents
let m = until ((/=Nothing).evalState execute) (execState execute) $ mkMachine (lines input)
case evalState execute m of
Just Halt -> putStrLn "Machine halted"
Just MemoryAccessError -> putStrLn "Out of bounds memory access"
print m
|
