diff options
author | Aleksey Veresov <aleksey@veresov.pro> | 2021-02-16 13:11:37 +0300 |
---|---|---|
committer | Aleksey Veresov <aleksey@veresov.pro> | 2021-02-16 13:11:37 +0300 |
commit | 7f59fd16534fc4fe417640130c415107008a638c (patch) | |
tree | b1dd2f6954f6590c3cd546c5548b26ab3ec1f105 /src/Commands.hs | |
parent | 97bbb430e4f1460858b2f1baaffc2ef804c63086 (diff) | |
download | suem-7f59fd16534fc4fe417640130c415107008a638c.tar suem-7f59fd16534fc4fe417640130c415107008a638c.tar.xz suem-7f59fd16534fc4fe417640130c415107008a638c.zip |
Now Machine is in Emulator which is a monad. =)
Diffstat (limited to 'src/Commands.hs')
-rw-r--r-- | src/Commands.hs | 99 |
1 files changed, 47 insertions, 52 deletions
diff --git a/src/Commands.hs b/src/Commands.hs index 6d99b00..e22981e 100644 --- a/src/Commands.hs +++ b/src/Commands.hs @@ -1,74 +1,69 @@ +-- This module describes the semantics of machine commands. module Commands where -import Control.Lens +import Prelude hiding (Word) import Machine import Utils +import Data.IORef -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 +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 :: Machine -> Machine -doReset = id +doReset :: Emulator () +doReset = return () -doStop :: Machine -> Machine -doStop = id +doStop :: Emulator () +doStop = return () -doRTE :: Machine -> Machine -doRTE = id +doRTE :: Emulator () +doRTE = return () -doRTS :: Machine -> Machine -doRTS = id +doRTS :: Emulator () +doRTS = return () -doTrapV :: Machine -> Machine -doTrapV = id +doTrapV :: Emulator () +doTrapV = return () -doRTR :: Machine -> Machine -doRTR = id +doRTR :: Emulator () +doRTR = return () -doIllegal :: Machine -> Machine -doIllegal = id +doIllegal :: Emulator () +doIllegal = return () -_doTAS :: Int -> Int -> Machine -> Machine -_doTAS _ _ = id -doTAS :: [Int] -> [Int] -> Machine -> Machine +_doTAS :: Int -> Int -> Emulator () +_doTAS _ _ = return () +doTAS :: [Int] -> [Int] -> Emulator () doTAS = args2 _doTAS -_doTST :: Int -> Int -> Int -> Machine -> Machine -_doTST _ _ _ = id -doTST :: [Int] -> [Int] -> [Int] -> Machine -> Machine +_doTST :: Int -> Int -> Int -> Emulator () +_doTST _ _ _ = return () +doTST :: [Int] -> [Int] -> [Int] -> Emulator () doTST = args3 _doTST -_doTrap :: Int -> Machine -> Machine -_doTrap _ = id -doTrap :: [Int] -> Machine -> Machine +_doTrap :: Int -> Emulator () +_doTrap _ = return () +doTrap :: [Int] -> Emulator () doTrap = _doTrap . fromBits -_doLink :: Int -> Machine -> Machine -_doLink _ = id -doLink :: [Int] -> Machine -> Machine +_doLink :: Int -> Emulator () +_doLink _ = return () +doLink :: [Int] -> Emulator () doLink = _doLink . fromBits |