From 21e72420dd84635c7016c0fa9a3cdea1547ea6b3 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Sat, 9 Nov 2019 23:37:22 +0000
Subject: [PATCH] Add more conversions

---
 src/Mima/Instruction.hs |  5 +++++
 src/Mima/State.hs       | 22 ++++++++--------------
 src/Mima/Word.hs        |  8 ++++++++
 3 files changed, 21 insertions(+), 14 deletions(-)

diff --git a/src/Mima/Instruction.hs b/src/Mima/Instruction.hs
index da411e1..fc4ad08 100644
--- a/src/Mima/Instruction.hs
+++ b/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
diff --git a/src/Mima/State.hs b/src/Mima/State.hs
index 694a41e..f8bc425 100644
--- a/src/Mima/State.hs
+++ b/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
-              . Map.filter (/= zeroBits)
+wordsToMemory = mapToMemory
               . Map.fromAscList
               . zip [minBound..]
 
@@ -68,17 +71,8 @@ data MimaState = MimaState
   , msMemory :: !MimaMemory
   } deriving (Show)
 
--- | A possible initial MiMa state, where every register is
--- zeroed. Thus, execution starts at address 0x00000.
-initialState :: MimaMemory -> MimaState
-initialState mem = MimaState
-  { msIAR    = zeroBits
-  , msACC    = zeroBits
-  , msRA     = zeroBits
-  , msSP     = zeroBits
-  , msFP     = zeroBits
-  , msMemory = mem
-  }
+basicState :: MimaMemory -> MimaState
+basicState = MimaState zeroBits zeroBits zeroBits zeroBits zeroBits
 
 data AbortReason = Halted | InvalidInstruction T.Text | InvalidNextIarAddress
   deriving (Show)
diff --git a/src/Mima/Word.hs b/src/Mima/Word.hs
index 353c06a..d30c7ae 100644
--- a/src/Mima/Word.hs
+++ b/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