Format and parse instructions with optional arguments correctly
This also fixes parsing of instructions with arguments
This commit is contained in:
parent
d082bc939e
commit
6712a9c32c
3 changed files with 40 additions and 14 deletions
|
|
@ -28,4 +28,7 @@ formatLargeOpcode = T.pack . show
|
|||
|
||||
formatInstruction :: Instruction -> T.Text
|
||||
formatInstruction (SmallInstruction so lv) = formatSmallOpcode so <> " " <> formatLargeValue lv
|
||||
formatInstruction (LargeInstruction lo sv) = formatLargeOpcode lo <> " " <> formatSmallValue sv
|
||||
formatInstruction (LargeInstruction lo sv) =
|
||||
if argumentIsOptional lo && sv == 0
|
||||
then formatLargeOpcode lo
|
||||
else formatLargeOpcode lo <> " " <> formatSmallValue sv
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
module Mima.Instruction
|
||||
( SmallOpcode(..)
|
||||
, LargeOpcode(..)
|
||||
, argumentIsOptional
|
||||
, Instruction(..)
|
||||
, wordToInstruction
|
||||
, instructionToWord
|
||||
|
|
@ -75,6 +76,22 @@ largeOpcodeNr STRF = 13
|
|||
largeOpcodeMap :: Map.Map Opcode LargeOpcode
|
||||
largeOpcodeMap = Map.fromList [(largeOpcodeNr lo, lo) | lo <- allLargeOpcodes]
|
||||
|
||||
argumentIsOptional :: LargeOpcode -> Bool
|
||||
argumentIsOptional HALT = True
|
||||
argumentIsOptional NOT = True
|
||||
argumentIsOptional RAR = True
|
||||
argumentIsOptional RET = True
|
||||
argumentIsOptional LDRA = True
|
||||
argumentIsOptional STRA = True
|
||||
argumentIsOptional LDSP = True
|
||||
argumentIsOptional STSP = True
|
||||
argumentIsOptional LDFP = True
|
||||
argumentIsOptional STFP = True
|
||||
argumentIsOptional LDRS = False
|
||||
argumentIsOptional STRS = False
|
||||
argumentIsOptional LDRF = False
|
||||
argumentIsOptional STRF = False
|
||||
|
||||
data Instruction
|
||||
= SmallInstruction !SmallOpcode !LargeValue
|
||||
| LargeInstruction !LargeOpcode !SmallValue
|
||||
|
|
|
|||
|
|
@ -6,8 +6,10 @@ module Mima.Parse.Assembly.RawInstruction
|
|||
, cookInstruction
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import qualified Data.Text as T
|
||||
import Text.Megaparsec
|
||||
import qualified Text.Megaparsec.Char as C
|
||||
|
||||
import Mima.Instruction
|
||||
import Mima.Parse.Assembly.Common
|
||||
|
|
@ -21,7 +23,7 @@ data RawInstruction a
|
|||
deriving (Show)
|
||||
|
||||
parseByName :: [(T.Text, a)] -> Parser a
|
||||
parseByName = foldl (<|>) empty . map (\(name, a) -> a <$ symbol' name)
|
||||
parseByName = foldl (<|>) empty . map (\(name, a) -> a <$ C.string' name)
|
||||
|
||||
smallOpcode :: Parser SmallOpcode
|
||||
smallOpcode = parseByName
|
||||
|
|
@ -53,25 +55,29 @@ largeOpcode = parseByName
|
|||
, ("stsp", STSP)
|
||||
, ("ldfp", LDFP)
|
||||
, ("stfp", STFP)
|
||||
]
|
||||
|
||||
largeOpcodeWithArgument :: Parser LargeOpcode
|
||||
largeOpcodeWithArgument = parseByName
|
||||
[ ("ldrs", LDRS)
|
||||
, ("ldrs", LDRS)
|
||||
, ("strs", STRS)
|
||||
, ("ldrf", LDRF)
|
||||
, ("strf", STRF)
|
||||
]
|
||||
|
||||
lRawInstruction :: Parser (RawInstruction Address)
|
||||
lRawInstruction = label "instruction" $
|
||||
(RawSmallInstruction <$> smallOpcode <*> addr)
|
||||
<|> (RawLargeInstruction <$> largeOpcode <*> optionalSv)
|
||||
<|> (RawLargeInstruction <$> largeOpcodeWithArgument <*> sv)
|
||||
lRawInstruction = label "instruction" $ smallInstruction <|> largeInstruction
|
||||
where
|
||||
addr = lexeme space *> lexeme address
|
||||
sv = lexeme space *> lexeme smallValue
|
||||
optionalSv = lexeme (lexeme space *> smallValue <|> pure 0)
|
||||
smallInstruction = do
|
||||
so <- smallOpcode
|
||||
void $ lSpace
|
||||
lv <- lexeme address
|
||||
pure $ RawSmallInstruction so lv
|
||||
largeInstruction = do
|
||||
lo <- largeOpcode
|
||||
if argumentIsOptional lo
|
||||
then do
|
||||
sv <- lexeme (try (lSpace *> smallValue) <|> pure 0)
|
||||
pure $ RawLargeInstruction lo sv
|
||||
else do
|
||||
sv <- lSpace *> lexeme smallValue
|
||||
pure $ RawLargeInstruction lo sv
|
||||
|
||||
cookInstruction :: RawInstruction MimaAddress -> Instruction
|
||||
cookInstruction (RawSmallInstruction so lv) = SmallInstruction so lv
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue