diff options
| author | Aleksey Veresov <aleksey@veresov.pro> | 2021-02-15 19:31:12 +0300 |
|---|---|---|
| committer | Aleksey Veresov <aleksey@veresov.pro> | 2021-02-15 19:31:12 +0300 |
| commit | 97bbb430e4f1460858b2f1baaffc2ef804c63086 (patch) | |
| tree | 4cbf88a77e471c6c21ea7935d6a54f71c72728e3 /src/Commands.hs | |
| parent | 0cdd25d921202030745069dbccd16ef856e16750 (diff) | |
| download | suem-97bbb430e4f1460858b2f1baaffc2ef804c63086.tar suem-97bbb430e4f1460858b2f1baaffc2ef804c63086.tar.xz suem-97bbb430e4f1460858b2f1baaffc2ef804c63086.zip | |
New style of command dispatcher! =)
Diffstat (limited to 'src/Commands.hs')
| -rw-r--r-- | src/Commands.hs | 50 |
1 files changed, 47 insertions, 3 deletions
diff --git a/src/Commands.hs b/src/Commands.hs index 1413c87..6d99b00 100644 --- a/src/Commands.hs +++ b/src/Commands.hs @@ -2,6 +2,7 @@ module Commands where import Control.Lens import Machine +import Utils doNothing :: Machine -> Machine doNothing m = Machine (Registers (pc r + 2) (sr r) (drs r) @@ -9,15 +10,15 @@ doNothing m = Machine (Registers (pc r + 2) (sr r) (drs r) (ram m) (rom m) where r = regs m -doUnlink :: Int -> Machine -> Machine -doUnlink 7 m = let r = regs m in if isSupervisor 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 +_doUnlink a m = let r = regs m av = getLong m (fromIntegral (ars r !! a)) newars = ars r & element (fromIntegral a) .~ av @@ -28,3 +29,46 @@ doUnlink a m = let 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 |