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

Implement new specification

Browse source
This commit is contained in:
Joscha 2019-11-10 18:17:21 +00:00
parent 75821abb2c
commit 957f65c380
5 changed files with 55 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

10
src/Mima/Assembler/Parser/RawInstruction.hs
View file

@ -27,8 +27,6 @@ parseByLiteral = foldl (<|>) empty . map (\(a, b) -> b <$ C.string' a)
smallOpcode' :: Parser SmallOpcode
smallOpcode' = parseByLiteral
[ ( "LDC", LDC)
, ("LDVR", LDVR) -- Needs to be before LDV
, ("STVR", STVR) -- Needs to be before STV
, ( "LDV", LDV)
, ( "STV", STV)
, ( "ADD", ADD)
@ -41,10 +39,16 @@ smallOpcode' = parseByLiteral
, ("LDIV", LDIV)
, ("STIV", STIV)
, ("CALL", CALL)
, ( "ADC", ADC)
]
largeOpcode' :: Parser LargeOpcode
largeOpcode' = parseByLiteral [( "ADC", ADC)]
largeOpcode' = parseByLiteral
[ ("STRS", STRS)
, ("LDRS", LDRS)
, ("STRF", STRF)
, ("LDRF", LDRF)
]
largeOptionalOpcode' :: Parser LargeOpcode
largeOptionalOpcode' = parseByLiteral

19
src/Mima/Instruction.hs
View file

@ -15,7 +15,7 @@ import Mima.Util
import Mima.Word
data SmallOpcode = LDC | LDV | STV | ADD | AND | OR | XOR | EQL
| JMP | JMN | LDIV | STIV | CALL | LDVR | STVR
| JMP | JMN | LDIV | STIV | CALL | ADC
deriving (Show, Eq, Ord)
instance ToText SmallOpcode where
@ -23,7 +23,7 @@ instance ToText SmallOpcode where
allSmallOpcodes :: [SmallOpcode]
allSmallOpcodes = [LDC, LDV, STV, ADD, AND, OR, XOR, EQL,
JMP, JMN, LDIV, STIV, CALL, LDVR, STVR]
JMP, JMN, LDIV, STIV, CALL, ADC]
smallOpcodeNr :: SmallOpcode -> Opcode
smallOpcodeNr LDC = 0
@ -39,21 +39,21 @@ smallOpcodeNr JMN = 9
smallOpcodeNr LDIV = 10
smallOpcodeNr STIV = 11
smallOpcodeNr CALL = 12
smallOpcodeNr LDVR = 13
smallOpcodeNr STVR = 14
smallOpcodeNr ADC = 13
smallOpcodeMap :: Map.Map Opcode SmallOpcode
smallOpcodeMap = Map.fromList [(smallOpcodeNr so, so) | so <- allSmallOpcodes]
data LargeOpcode = HALT | NOT | RAR | RET | LDRA | STRA
| LDSP | STSP | LDFP | STFP | ADC
data LargeOpcode = HALT | NOT | RAR | RET | LDRA | STRA | LDSP | STSP
| LDFP | STFP | LDRS | STRS | LDRF | STRF
deriving (Show, Eq, Ord)
instance ToText LargeOpcode where
toText = T.pack . show
allLargeOpcodes :: [LargeOpcode]
allLargeOpcodes = [HALT, NOT, RAR, RET, LDRA, STRA, LDSP, STSP, LDFP, STFP, ADC]
allLargeOpcodes = [HALT, NOT, RAR, RET, LDRA, STRA, LDSP, STSP,
LDFP, STFP, LDRS, STRS, LDRF, STRF]
largeOpcodeNr :: LargeOpcode -> Opcode
largeOpcodeNr HALT = 0
@ -66,7 +66,10 @@ largeOpcodeNr LDSP = 6
largeOpcodeNr STSP = 7
largeOpcodeNr LDFP = 8
largeOpcodeNr STFP = 9
largeOpcodeNr ADC = 10
largeOpcodeNr LDRS = 10
largeOpcodeNr STRS = 11
largeOpcodeNr LDRF = 12
largeOpcodeNr STRF = 13
largeOpcodeMap :: Map.Map Opcode LargeOpcode
largeOpcodeMap = Map.fromList [(largeOpcodeNr lo, lo) | lo <- allLargeOpcodes]

16
src/Mima/State.hs
View file

@ -122,8 +122,7 @@ doSmallOpcode STIV addr ms@MimaState{..} =
let indirAddr = getLargeValue $ readAt addr msMemory
in ms{msMemory = writeAt indirAddr msACC msMemory}
doSmallOpcode CALL addr ms@MimaState{..} = ms{msRA = msIAR, msIAR = addr}
doSmallOpcode LDVR addr ms@MimaState{..} = ms{msACC = readAt (msSP + addr) msMemory}
doSmallOpcode STVR addr ms@MimaState{..} = ms{msMemory = writeAt (msSP + addr) msACC msMemory}
doSmallOpcode ADC lv ms@MimaState{..} = ms{msACC = msACC + signedLargeValueToWord lv}
doLargeOpcode :: LargeOpcode -> SmallValue -> MimaState -> Either AbortReason MimaState
doLargeOpcode HALT _ _ = Left Halted
@ -136,7 +135,18 @@ doLargeOpcode LDSP _ ms@MimaState{..} = pure ms{msACC = largeValueToWord msSP}
doLargeOpcode STSP _ ms@MimaState{..} = pure ms{msSP = getLargeValue msACC}
doLargeOpcode LDFP _ ms@MimaState{..} = pure ms{msACC = largeValueToWord msFP}
doLargeOpcode STFP _ ms@MimaState{..} = pure ms{msFP = getLargeValue msACC}
doLargeOpcode ADC sv ms@MimaState{..} = pure ms{msACC = msACC + signedSmallValueToWord sv}
doLargeOpcode LDRS sv ms@MimaState{..} =
let indirAddr = msSP + signedSmallValueToLargeValue sv
in pure ms{msACC = readAt indirAddr msMemory}
doLargeOpcode STRS sv ms@MimaState{..} =
let indirAddr = msSP + signedSmallValueToLargeValue sv
in pure ms{msMemory = writeAt indirAddr msACC msMemory}
doLargeOpcode LDRF sv ms@MimaState{..} =
let indirAddr = msFP + signedSmallValueToLargeValue sv
in pure ms{msACC = readAt indirAddr msMemory}
doLargeOpcode STRF sv ms@MimaState{..} =
let indirAddr = msFP + signedSmallValueToLargeValue sv
in pure ms{msMemory = writeAt indirAddr msACC msMemory}
run :: MimaState -> (MimaState, AbortReason, Integer)
run ms = helper 0 ms

14
src/Mima/Word.hs
View file

@ -12,7 +12,8 @@ module Mima.Word
, wordToBytes
, boolToWord
, largeValueToWord
, signedSmallValueToWord
, signedLargeValueToWord
, signedSmallValueToLargeValue
, wordFromSmallOpcode
, wordFromLargeOpcode
-- ** 'MimaWord' properties
@ -56,9 +57,14 @@ boolToWord True = complement zeroBits
largeValueToWord :: LargeValue -> MimaWord
largeValueToWord = fromIntegral
signedSmallValueToWord :: SmallValue -> MimaWord
signedSmallValueToWord sv
| topBit sv = 0xFF0000 .|. fromIntegral sv
signedLargeValueToWord :: LargeValue -> MimaWord
signedLargeValueToWord lv
| topBit lv = 0xF00000 .|. fromIntegral lv
| otherwise = fromIntegral lv
signedSmallValueToLargeValue :: SmallValue -> LargeValue
signedSmallValueToLargeValue sv
| topBit sv = 0xF0000 .|. fromIntegral sv
| otherwise = fromIntegral sv
wordFromSmallOpcode :: Opcode -> LargeValue -> MimaWord