diff --git a/package.yaml b/package.yaml index 2efbe3e..c473e8a 100644 --- a/package.yaml +++ b/package.yaml @@ -19,11 +19,10 @@ extra-source-files: description: Please see the README on GitHub at dependencies: -- base >= 4.7 && < 5 -- text >= 1.2.3 && < 1.3 -- containers >= 0.6.0 && < 0.7 -# - array >= 0.5.3 && < 0.6 -# - binary >= 0.8.6 && < 0.9 +- base >= 4.7 && < 5 +- bytestring >= 0.10.8 && < 0.11 +- containers >= 0.6.0 && < 0.7 +- text >= 1.2.3 && < 1.3 library: source-dirs: src diff --git a/src/Mima/Load.hs b/src/Mima/Load.hs new file mode 100644 index 0000000..ed3271a --- /dev/null +++ b/src/Mima/Load.hs @@ -0,0 +1,39 @@ +module Mima.Load + ( loadMemoryFromFile + , saveMemoryToFile + ) where + +import Data.Bits +import qualified Data.ByteString as BS +import Data.Word + +import Mima.Word +import Mima.State + +-- These two functions are implemented with explicit recursion. The +-- first because it was easier to write that way, and the second in +-- the hopes of better performance regarding list concatenation. + +bytesToWords :: [Word8] -> [MimaWord] +bytesToWords (w1:w2:w3:ws) = bytesToWord w1 w2 w3 : bytesToWords ws +bytesToWords [w1,w2] = [bytesToWord w1 w2 zeroBits] +bytesToWords [w1] = [bytesToWord w1 zeroBits zeroBits] +bytesToWords [] = [] + +wordsToBytes :: [MimaWord] -> [Word8] +wordsToBytes [] = [] +wordsToBytes (w:ws) = + let (w1, w2, w3) = wordToBytes w + in w1 : w2 : w3 : wordsToBytes ws + +bsToWords :: BS.ByteString -> [MimaWord] +bsToWords = bytesToWords . BS.unpack + +wordsToBs :: [MimaWord] -> BS.ByteString +wordsToBs = BS.pack . wordsToBytes + +loadMemoryFromFile :: FilePath -> IO MimaMemory +loadMemoryFromFile path = (wordsToMemory . bsToWords) <$> BS.readFile path + +saveMemoryToFile :: FilePath -> MimaMemory -> IO () +saveMemoryToFile path = BS.writeFile path . wordsToBs . memoryToWords diff --git a/src/Mima/State.hs b/src/Mima/State.hs index 1c3e8dc..84f7784 100644 --- a/src/Mima/State.hs +++ b/src/Mima/State.hs @@ -1,6 +1,7 @@ module Mima.State ( MimaMemory , wordsToMemory + , memoryToWords , readAt , writeAt , MimaState(..) @@ -12,6 +13,7 @@ module Mima.State import Data.Bits import qualified Data.Map as Map +import Data.Maybe import qualified Data.Text as T import Mima.Instruction @@ -23,6 +25,11 @@ newtype MimaMemory = MimaMemory (Map.Map MimaAddress MimaWord) wordsToMemory :: [MimaWord] -> MimaMemory wordsToMemory = MimaMemory . Map.fromAscList . zip [minBound..] +memoryToWords :: MimaMemory -> [MimaWord] +memoryToWords mem@(MimaMemory m) = + let maxAddr = fromMaybe minBound $ fst <$> Map.lookupMax m + in map (\addr -> readAt addr mem) [minBound..maxAddr] + readAt :: MimaAddress -> MimaMemory -> MimaWord readAt addr (MimaMemory m) = Map.findWithDefault zeroBits addr m @@ -80,7 +87,7 @@ executeSmallOpcode ADD addr ms = incrementIp ms{msAcc = addWords (msAcc ms) (rea executeSmallOpcode AND addr ms = incrementIp ms{msAcc = msAcc ms .&. readAt addr (msMemory ms)} executeSmallOpcode OR addr ms = incrementIp ms{msAcc = msAcc ms .|. readAt addr (msMemory ms)} executeSmallOpcode XOR addr ms = incrementIp ms{msAcc = msAcc ms `xor` readAt addr (msMemory ms)} -executeSmallOpcode EQL addr ms = incrementIp ms{msAcc = wordFromBool $ msAcc ms == readAt addr (msMemory ms)} +executeSmallOpcode EQL addr ms = incrementIp ms{msAcc = boolToWord $ msAcc ms == readAt addr (msMemory ms)} executeSmallOpcode JMP addr ms = pure ms{msIp = addr} executeSmallOpcode JMN addr ms = if topBit (msAcc ms) then pure ms{msIp = addr} else incrementIp ms diff --git a/src/Mima/Word.hs b/src/Mima/Word.hs index 090084e..b230fc1 100644 --- a/src/Mima/Word.hs +++ b/src/Mima/Word.hs @@ -2,7 +2,9 @@ module Mima.Word ( MimaWord - , wordFromBool + , bytesToWord + , wordToBytes + , boolToWord , topBit , upperOpcode , lowerOpcode @@ -73,9 +75,24 @@ instance Bits MimaWord where isSigned = const True popCount = popCount . toWord32 -wordFromBool :: Bool -> MimaWord -wordFromBool False = zeroBits -wordFromBool True = complement zeroBits +bytesToWord :: Word8 -> Word8 -> Word8 -> MimaWord +bytesToWord w1 w2 w3 = + let (w1', w2', w3') = (fromIntegral w1, fromIntegral w2, fromIntegral w3) + in fromWord32 $ w1' .|. shiftL w2' 8 .|. shiftL w3' 16 + +wordToBytes :: MimaWord -> (Word8, Word8, Word8) +wordToBytes mw = + let w = toWord32 mw + -- Mask for w1 not strictly necessary, since upper bytes are + -- already zero due to implementation of 'fromWord32'. + w1 = fromIntegral $ shiftR w 16 .&. 0xFF + w2 = fromIntegral $ shiftR w 8 .&. 0xFF + w3 = fromIntegral $ w .&. 0xFF + in (w1, w2, w3) + +boolToWord :: Bool -> MimaWord +boolToWord False = zeroBits +boolToWord True = complement zeroBits topBit :: MimaWord -> Bool topBit mw = testBit (toWord32 mw) (wordSize - 1)