Joscha
ada200bf50
This commit introduces a few --pedantic warnings. Those will (hopefully) be fixed in the next commit.
120 lines
3.7 KiB
Haskell
120 lines
3.7 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Mima.Vm.Instruction
|
|
( SmallOpcode(..)
|
|
, LargeOpcode(..)
|
|
, argumentIsOptional
|
|
, Instruction(..)
|
|
, wordToInstruction
|
|
, instructionToWord
|
|
) where
|
|
|
|
import qualified Data.Map.Strict as Map
|
|
import qualified Data.Text as T
|
|
|
|
import Mima.Format
|
|
import Mima.Vm.Word
|
|
|
|
data SmallOpcode = LDC | LDV | STV | ADD | AND | OR | XOR | EQL
|
|
| JMP | JMN | LDIV | STIV | CALL | ADC
|
|
deriving (Show, Eq, Ord, Bounded, Enum)
|
|
|
|
instance ToText SmallOpcode where
|
|
toText = T.pack . show
|
|
|
|
smallOpcodeNr :: SmallOpcode -> Opcode
|
|
smallOpcodeNr LDC = 0
|
|
smallOpcodeNr LDV = 1
|
|
smallOpcodeNr STV = 2
|
|
smallOpcodeNr ADD = 3
|
|
smallOpcodeNr AND = 4
|
|
smallOpcodeNr OR = 5
|
|
smallOpcodeNr XOR = 6
|
|
smallOpcodeNr EQL = 7
|
|
smallOpcodeNr JMP = 8
|
|
smallOpcodeNr JMN = 9
|
|
smallOpcodeNr LDIV = 10
|
|
smallOpcodeNr STIV = 11
|
|
smallOpcodeNr CALL = 12
|
|
smallOpcodeNr ADC = 13
|
|
|
|
smallOpcodeMap :: Map.Map Opcode SmallOpcode
|
|
smallOpcodeMap = Map.fromList [(smallOpcodeNr so, so) | so <- [minBound..maxBound]]
|
|
|
|
data LargeOpcode = HALT | NOT | RAR | RET | LDRA | STRA | LDSP | STSP
|
|
| LDFP | STFP | LDRS | STRS | LDRF | STRF
|
|
deriving (Show, Eq, Ord, Bounded, Enum)
|
|
|
|
instance ToText LargeOpcode where
|
|
toText = T.pack . show
|
|
|
|
largeOpcodeNr :: LargeOpcode -> Opcode
|
|
largeOpcodeNr HALT = 0
|
|
largeOpcodeNr NOT = 1
|
|
largeOpcodeNr RAR = 2
|
|
largeOpcodeNr RET = 3
|
|
largeOpcodeNr LDRA = 4
|
|
largeOpcodeNr STRA = 5
|
|
largeOpcodeNr LDSP = 6
|
|
largeOpcodeNr STSP = 7
|
|
largeOpcodeNr LDFP = 8
|
|
largeOpcodeNr STFP = 9
|
|
largeOpcodeNr LDRS = 10
|
|
largeOpcodeNr STRS = 11
|
|
largeOpcodeNr LDRF = 12
|
|
largeOpcodeNr STRF = 13
|
|
|
|
largeOpcodeMap :: Map.Map Opcode LargeOpcode
|
|
largeOpcodeMap = Map.fromList [(largeOpcodeNr lo, lo) | lo <- [minBound..maxBound]]
|
|
|
|
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
|
|
deriving (Show, Eq)
|
|
|
|
wordToInstruction :: MimaWord -> Either T.Text Instruction
|
|
wordToInstruction mw = if getSmallOpcode mw == 0xF
|
|
then parseLargeInstruction mw
|
|
else parseSmallInstruction mw
|
|
|
|
parseSmallInstruction :: MimaWord -> Either T.Text Instruction
|
|
parseSmallInstruction mw = do
|
|
so <- parseSmallOpcode (getSmallOpcode mw)
|
|
pure $ SmallInstruction so (getLargeValue mw)
|
|
|
|
parseSmallOpcode :: Opcode -> Either T.Text SmallOpcode
|
|
parseSmallOpcode w = case smallOpcodeMap Map.!? w of
|
|
Just oc -> pure oc
|
|
Nothing -> Left $ "Unknown small opcode " <> toDec w <> " (" <> fixWidthHex 1 (toHex w)
|
|
<> ", " <> fixWidthBin 4 (toBin w) <> ")"
|
|
|
|
parseLargeInstruction :: MimaWord -> Either T.Text Instruction
|
|
parseLargeInstruction mw = do
|
|
lo <- parseLargeOpcode (getLargeOpcode mw)
|
|
pure $ LargeInstruction lo (getSmallValue mw)
|
|
|
|
parseLargeOpcode :: Opcode -> Either T.Text LargeOpcode
|
|
parseLargeOpcode w = case largeOpcodeMap Map.!? w of
|
|
Just oc -> pure oc
|
|
Nothing -> Left $ "Unknown large opcode " <> toDec w <> " (" <> fixWidthHex 1 (toHex w)
|
|
<> ", " <> fixWidthBin 4 (toBin w) <> ")"
|
|
|
|
instructionToWord :: Instruction -> MimaWord
|
|
instructionToWord (SmallInstruction so lv) = wordFromSmallOpcode (smallOpcodeNr so) lv
|
|
instructionToWord (LargeInstruction lo sv) = wordFromLargeOpcode (largeOpcodeNr lo) sv
|