blob: e22981edb63c0bec5574cb7a20c56258d7a54567 (
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
|
-- This module describes the semantics of machine commands.
module Commands where
import Prelude hiding (Word)
import Machine
import Utils
import Data.IORef
doNothing :: Emulator ()
doNothing = with pc $ \pc -> do
pcval <- readIORef pc
writeIORef pc (pcval + 2)
_doUnlink :: Int -> Emulator ()
_doUnlink a = do
addr <- readA a
val <- getLong addr
with pc $ \pc -> do
pcval <- readIORef pc
writeIORef pc (pcval + 2)
isSupervisor >>= \sup -> if sup
then with ssp $ \sp -> do
writeIORef sp (val + 4)
else with usp $ \sp -> do
writeIORef sp (val + 4)
doUnlink :: [Int] -> Emulator ()
doUnlink = _doUnlink . fromBits
doReset :: Emulator ()
doReset = return ()
doStop :: Emulator ()
doStop = return ()
doRTE :: Emulator ()
doRTE = return ()
doRTS :: Emulator ()
doRTS = return ()
doTrapV :: Emulator ()
doTrapV = return ()
doRTR :: Emulator ()
doRTR = return ()
doIllegal :: Emulator ()
doIllegal = return ()
_doTAS :: Int -> Int -> Emulator ()
_doTAS _ _ = return ()
doTAS :: [Int] -> [Int] -> Emulator ()
doTAS = args2 _doTAS
_doTST :: Int -> Int -> Int -> Emulator ()
_doTST _ _ _ = return ()
doTST :: [Int] -> [Int] -> [Int] -> Emulator ()
doTST = args3 _doTST
_doTrap :: Int -> Emulator ()
_doTrap _ = return ()
doTrap :: [Int] -> Emulator ()
doTrap = _doTrap . fromBits
_doLink :: Int -> Emulator ()
_doLink _ = return ()
doLink :: [Int] -> Emulator ()
doLink = _doLink . fromBits
|