Add more conversions

src/Mima/Instruction.hs

@@ -5,6 +5,7 @@ module Mima.Instruction
   , LargeOpcode(..)
   , Instruction(..)
   , wordToInstruction
+  , instructionToWord
   ) where
 
 import qualified Data.Map.Strict as Map
@@ -105,3 +106,7 @@ parseLargeOpcode w = case largeOpcodeMap Map.!? w of
   Just oc -> pure oc
   Nothing -> Left $ "Unknown large opcode " <> T.pack (show w)
                      <> " (" <> integralToHex 1 w <> ")"
+
+instructionToWord :: Instruction -> MimaWord
+instructionToWord (SmallInstruction so lv) = wordFromSmallOpcode (smallOpcodeNr so) lv
+instructionToWord (LargeInstruction lo sv) = wordFromLargeOpcode (largeOpcodeNr lo) sv

src/Mima/State.hs

@@ -11,11 +11,12 @@ module Mima.State
   , addressRange
   , sparseAddressRange
   -- ** Converting
+  , mapToMemory
   , wordsToMemory
   , memoryToWords
   -- * State
   , MimaState(..)
-  , initialState
+  , basicState
   , AbortReason(..)
   , step
   , run
@@ -42,9 +43,11 @@ addressRange (MimaMemory m) =
 sparseAddressRange :: MimaMemory -> [MimaAddress]
 sparseAddressRange (MimaMemory m) = Map.keys m
 
+mapToMemory :: Map.Map MimaAddress MimaWord -> MimaMemory
+mapToMemory = MimaMemory . Map.filter (/= zeroBits)
+
 wordsToMemory :: [MimaWord] -> MimaMemory
-wordsToMemory = MimaMemory
+wordsToMemory = mapToMemory
-              . Map.filter (/= zeroBits)
               . Map.fromAscList
               . zip [minBound..]
 
@@ -68,17 +71,8 @@ data MimaState = MimaState
   , msMemory :: !MimaMemory
   } deriving (Show)
 
--- | A possible initial MiMa state, where every register is
+basicState :: MimaMemory -> MimaState
--- zeroed. Thus, execution starts at address 0x00000.
+basicState = MimaState zeroBits zeroBits zeroBits zeroBits zeroBits
-initialState :: MimaMemory -> MimaState
-initialState mem = MimaState
-  { msIAR    = zeroBits
-  , msACC    = zeroBits
-  , msRA     = zeroBits
-  , msSP     = zeroBits
-  , msFP     = zeroBits
-  , msMemory = mem
-  }
 
 data AbortReason = Halted | InvalidInstruction T.Text | InvalidNextIarAddress
   deriving (Show)

src/Mima/Word.hs

@@ -13,6 +13,8 @@ module Mima.Word
   , boolToWord
   , largeValueToWord
   , signedSmallValueToWord
+  , wordFromSmallOpcode
+  , wordFromLargeOpcode
   -- ** 'MimaWord' properties
   , getSmallOpcode
   , getLargeOpcode
@@ -59,6 +61,12 @@ signedSmallValueToWord sv
   | topBit sv = 0xFF0000 .|. fromIntegral sv
   | otherwise = fromIntegral sv
 
+wordFromSmallOpcode :: Opcode -> LargeValue -> MimaWord
+wordFromSmallOpcode so lv = shiftL (fromIntegral so) 20 .|. fromIntegral lv
+
+wordFromLargeOpcode :: Opcode -> SmallValue -> MimaWord
+wordFromLargeOpcode lo sv = 0xF00000 .|. shiftL (fromIntegral lo) 16 .|. fromIntegral sv
+
 getSmallOpcode :: MimaWord -> Opcode
 getSmallOpcode mw = fromIntegral $ shiftR mw 20