blob: 6d99b00a6eac9d0e2bcd7b9bd3b9c8e89f84f566 (
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
|
module Commands where
import Control.Lens
import Machine
import Utils
doNothing :: Machine -> Machine
doNothing m = Machine (Registers (pc r + 2) (sr r) (drs r)
(ars r) (usp r) (ssp r))
(ram m) (rom m)
where r = regs m
_doUnlink :: Int -> Machine -> Machine
_doUnlink 7 m = let r = regs m in if isSupervisor m
then Machine (Registers (pc r + 2) (sr r) (drs r) (ars r)
(usp r) (getLong m (fromIntegral $ ssp r) + 4))
(ram m) (rom m)
else Machine (Registers (pc r + 2) (sr r) (drs r) (ars r)
(getLong m (fromIntegral $ usp r) + 4) (ssp r))
(ram m) (rom m)
_doUnlink a m = let
r = regs m
av = getLong m (fromIntegral (ars r !! a))
newars = ars r & element (fromIntegral a) .~ av
in if isSupervisor m
then Machine (Registers (pc r + 2) (sr r) (drs r)
newars (usp r) (av + 4))
(ram m) (rom m)
else Machine (Registers (pc r + 2) (sr r) (drs r)
newars (av + 4) (ssp r))
(ram m) (rom m)
doUnlink :: [Int] -> Machine -> Machine
doUnlink = _doUnlink . fromBits
doReset :: Machine -> Machine
doReset = id
doStop :: Machine -> Machine
doStop = id
doRTE :: Machine -> Machine
doRTE = id
doRTS :: Machine -> Machine
doRTS = id
doTrapV :: Machine -> Machine
doTrapV = id
doRTR :: Machine -> Machine
doRTR = id
doIllegal :: Machine -> Machine
doIllegal = id
_doTAS :: Int -> Int -> Machine -> Machine
_doTAS _ _ = id
doTAS :: [Int] -> [Int] -> Machine -> Machine
doTAS = args2 _doTAS
_doTST :: Int -> Int -> Int -> Machine -> Machine
_doTST _ _ _ = id
doTST :: [Int] -> [Int] -> [Int] -> Machine -> Machine
doTST = args3 _doTST
_doTrap :: Int -> Machine -> Machine
_doTrap _ = id
doTrap :: [Int] -> Machine -> Machine
doTrap = _doTrap . fromBits
_doLink :: Int -> Machine -> Machine
_doLink _ = id
doLink :: [Int] -> Machine -> Machine
doLink = _doLink . fromBits
|
