Garmelon/mima-tools
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Execute a MiMa state

Browse source
This commit is contained in:
Joscha 2019-11-06 09:32:49 +00:00
parent f2ddf2e109
commit 2843cfd462
4 changed files with 157 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

74
src/Mima/State.hs Normal file
View file

@ -0,0 +1,74 @@
module Mima.State
( MimaMemory
, readAt
, writeAt
, MimaState(..)
) where
import Data.Bits
import qualified Data.Map as Map
import qualified Data.Text as T
import Mima.Instruction
import Mima.Word
newtype MimaMemory = MimaMemory (Map.Map MimaAddress MimaWord)
readAt :: MimaAddress -> MimaMemory -> MimaWord
readAt addr (MimaMemory m) = Map.findWithDefault zeroBits addr m
writeAt :: MimaAddress -> MimaWord -> MimaMemory -> MimaMemory
writeAt addr word (MimaMemory m)
| word == zeroBits = MimaMemory $ Map.delete addr m
| otherwise = MimaMemory $ Map.insert addr word m
data MimaState = MimaState
{ msIp :: !MimaAddress
, msAcc :: !MimaWord
, msMemory :: !MimaMemory
}
data AbortReason = Halted | InvalidInstruction T.Text | InvalidNextIpAddress
data ExecException = ExecException MimaAddress MimaWord AbortReason
incrementIp :: MimaState -> Either ExecException MimaState
incrementIp ms =
let addr = msIp ms
in if addr >= maxBound
then Left $ ExecException addr (readAt addr $ msMemory ms) InvalidNextIpAddress
else pure ms{msIp = succ addr}
wordToInstruction' :: MimaAddress -> MimaWord -> Either ExecException Instruction
wordToInstruction' addr word =
case wordToInstruction word of
Right instruction -> pure instruction
Left errorMsg -> Left $ ExecException addr word $ InvalidInstruction errorMsg
step :: MimaState -> Either ExecException MimaState
step ms = do
let addr = msIp ms
word = readAt addr (msMemory ms)
instruction <- wordToInstruction' addr word
case instruction of
(SmallInstruction oc instrAddr) -> executeSmallOpcode oc instrAddr ms
(LargeInstruction oc) -> executeLargeOpcode oc ms
executeSmallOpcode :: SmallOpcode -> MimaAddress -> MimaState -> Either ExecException MimaState
executeSmallOpcode LDC addr ms = incrementIp ms{msAcc = fromWord32 $ toWord32 addr}
executeSmallOpcode LDV addr ms = incrementIp ms{msAcc = readAt addr (msMemory ms)}
executeSmallOpcode STV addr ms = incrementIp ms{msMemory = writeAt addr (msAcc ms) (msMemory ms)}
executeSmallOpcode ADD addr ms = incrementIp ms{msAcc = addWords (msAcc ms) (readAt addr $ msMemory ms)}
executeSmallOpcode AND addr ms = incrementIp ms{msAcc = msAcc ms .&. readAt addr (msMemory ms)}
executeSmallOpcode OR addr ms = incrementIp ms{msAcc = msAcc ms .|. readAt addr (msMemory ms)}
executeSmallOpcode XOR addr ms = incrementIp ms{msAcc = msAcc ms `xor` readAt addr (msMemory ms)}
executeSmallOpcode EQL addr ms = incrementIp ms{msAcc = wordFromBool $ msAcc ms == readAt addr (msMemory ms)}
executeSmallOpcode JMP addr ms = pure ms{msIp = addr}
executeSmallOpcode JMN addr ms = if topBit (msAcc ms) then pure ms{msIp = addr} else incrementIp ms
executeLargeOpcode :: LargeOpcode -> MimaState -> Either ExecException MimaState
executeLargeOpcode HALT ms =
let addr = msIp ms
word = readAt addr (msMemory ms)
in Left $ ExecException addr word Halted
executeLargeOpcode NOT ms = incrementIp ms{msAcc = complement (msAcc ms)}
executeLargeOpcode RAR ms = incrementIp ms{msAcc = rotateR (msAcc ms) 1}