From 51317c0737570a74766777abece068dc75707f35 Mon Sep 17 00:00:00 2001 From: Joscha Date: Fri, 27 Mar 2020 20:29:10 +0000 Subject: [PATCH] Write docs and tests for Mima.Vm.Word --- src/Mima/Vm/Word.hs | 48 +++++++++++++++++++--- test/Mima/Vm/WordSpec.hs | 89 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 132 insertions(+), 5 deletions(-) create mode 100644 test/Mima/Vm/WordSpec.hs diff --git a/src/Mima/Vm/Word.hs b/src/Mima/Vm/Word.hs index aac410d..ea5c946 100644 --- a/src/Mima/Vm/Word.hs +++ b/src/Mima/Vm/Word.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + module Mima.Vm.Word ( -- * Types @@ -27,20 +29,42 @@ import Data.Bits import Data.Word import Data.Word.Odd -type MimaWord = Word24 -type MimaAddress = LargeValue -type LargeValue = Word20 -type SmallValue = Word16 -type Opcode = Word4 +-- | The MiMa operates on words with a width of 24 bits. +newtype MimaWord = MimaWord Word24 + deriving (Bounded, Enum, Eq, Integral, Num, Ord, Read, Real, Show, Bits, FiniteBits) +-- | MiMa adresses have a width of 20 bits. +type MimaAddress = LargeValue + +-- | A large value is the argument to a small opcode (4 bits). It has a width of +-- 20 bits. +newtype LargeValue = LargeValue Word20 + deriving (Bounded, Enum, Eq, Integral, Num, Ord, Read, Real, Show, Bits, FiniteBits) + +-- | A small value is the argument to a large opcode (8 bits). It has a width of +-- 16 bits. +newtype SmallValue = SmallValue Word16 + deriving (Bounded, Enum, Eq, Integral, Num, Ord, Read, Real, Show, Bits, FiniteBits) + +-- | A small opcode has a width of 4 bits. In the case of a large opcode with a +-- width of 8 bits, the most significant 4 bits are always 0xF, so large opcodes +-- can be represented by this data type too. +newtype Opcode = Opcode Word4 + deriving (Bounded, Enum, Eq, Integral, Num, Ord, Read, Real, Show, Bits, FiniteBits) + +-- | Return the most significant bit of the input value. topBit :: (FiniteBits b) => b -> Bool topBit b = testBit b $ finiteBitSize b - 1 +-- | Combine three bytes into a 'MimaWord'. The bytes are in big-endian order +-- (starting with the most significant byte). bytesToWord :: (Word8, Word8, Word8) -> MimaWord bytesToWord (w1, w2, w3) = let (w1', w2', w3') = (fromIntegral w1, fromIntegral w2, fromIntegral w3) in shiftL w1' 16 .|. shiftL w2' 8 .|. w3' +-- | Split up a 'MimaWord' into its component bytes. The bytes are in big-endian +-- order (starting with the most significant byte). wordToBytes :: MimaWord -> (Word8, Word8, Word8) wordToBytes mw = -- No masks necessary since converting to 'Word8' already cuts off @@ -50,37 +74,51 @@ wordToBytes mw = w3 = fromIntegral mw in (w1, w2, w3) +-- | This function behaves as if the boolean was the result of an equality check +-- for the @EQL@ command: 'False' is represented by only zeroes while 'True' is +-- represented by only ones. boolToWord :: Bool -> MimaWord boolToWord False = zeroBits boolToWord True = complement zeroBits +-- | Fills in the four most significant bits with zeroes. largeValueToWord :: LargeValue -> MimaWord largeValueToWord = fromIntegral +-- | Performs sign expansion. signedLargeValueToWord :: LargeValue -> MimaWord signedLargeValueToWord lv | topBit lv = 0xF00000 .|. fromIntegral lv | otherwise = fromIntegral lv +-- | Performs sign expansion. signedSmallValueToLargeValue :: SmallValue -> LargeValue signedSmallValueToLargeValue sv | topBit sv = 0xF0000 .|. fromIntegral sv | otherwise = fromIntegral sv +-- | Combine a small opcode and a large value into a 'MimaWord'. wordFromSmallOpcode :: Opcode -> LargeValue -> MimaWord wordFromSmallOpcode so lv = shiftL (fromIntegral so) 20 .|. fromIntegral lv +-- | Combine a large opcode and a small value into a 'MimaWord'. The four most +-- significant bits are set to ones. wordFromLargeOpcode :: Opcode -> SmallValue -> MimaWord wordFromLargeOpcode lo sv = 0xF00000 .|. shiftL (fromIntegral lo) 16 .|. fromIntegral sv +-- | Returns the four most significant bits of the word. getSmallOpcode :: MimaWord -> Opcode getSmallOpcode mw = fromIntegral $ shiftR mw 20 +-- | Returns the fifth to eigth most significant bits of the word. The four most +-- significant bits of the word should all be ones. getLargeOpcode :: MimaWord -> Opcode getLargeOpcode mw = fromIntegral $ shiftR mw 16 +-- | A word's 20 least significant bits. getLargeValue :: MimaWord -> LargeValue getLargeValue = fromIntegral +-- | A word's 16 least significant bits. getSmallValue :: MimaWord -> SmallValue getSmallValue = fromIntegral diff --git a/test/Mima/Vm/WordSpec.hs b/test/Mima/Vm/WordSpec.hs new file mode 100644 index 0000000..9886b45 --- /dev/null +++ b/test/Mima/Vm/WordSpec.hs @@ -0,0 +1,89 @@ +module Mima.Vm.WordSpec (spec) where + +import Data.Word +import Test.Hspec +import Test.QuickCheck + +import Mima.Vm.Word + +spec :: Spec +spec = do + describe "topBit" $ do + it "returns the top bit of 0x00" $ + topBit (0x00 :: Word8) `shouldBe` False + it "returns the top bit of 0xff" $ + topBit (0xff :: Word8) `shouldBe` True + it "returns the top bit of 0x7f" $ + topBit (0x7f :: Word8) `shouldBe` False + it "returns the top bit of 0x80" $ + topBit (0x80 :: Word8) `shouldBe` True + + describe "bytesToWord" $ do + it "converts (0xAB, 0xCD, 0xEF) to a word" $ + bytesToWord (0xAB, 0xCD, 0xEF) `shouldBe` 0xABCDEF + it "reverses wordToBytes" $ property $ \x -> + let word = fromInteger x + in bytesToWord (wordToBytes word) == word + + describe "wordToBytes" $ do + it "converts 0xABCDEF to bytes" $ + wordToBytes 0xABCDEF `shouldBe` (0xAB, 0xCD, 0xEF) + it "reverses bytesToWord" $ property $ \x -> + wordToBytes (bytesToWord x) == x + + describe "boolToWord" $ do + it "converts to words correctly" $ do + boolToWord False `shouldBe` 0x000000 + boolToWord True `shouldBe` 0xFFFFFF + it "is reversed by topBit" $ property $ \x -> + topBit (boolToWord x) `shouldBe` x + + describe "largeValueToWord" $ do + it "converts values correctly" $ do + largeValueToWord 0x00000 `shouldBe` 0x000000 + largeValueToWord 0x12345 `shouldBe` 0x012345 + largeValueToWord 0xABCDE `shouldBe` 0x0ABCDE + largeValueToWord 0xFFFFF `shouldBe` 0x0FFFFF + it "is inverted by getLargeValue" $ property $ \x -> + let lv = fromInteger x + in getLargeValue (largeValueToWord lv) `shouldBe` lv + + describe "signedLargeValueToWord" $ + it "converts values correctly" $ do + signedLargeValueToWord 0x00000 `shouldBe` 0x000000 + signedLargeValueToWord 0x12345 `shouldBe` 0x012345 + signedLargeValueToWord 0xABCDE `shouldBe` 0xFABCDE + signedLargeValueToWord 0xFFFFF `shouldBe` 0xFFFFFF + + describe "signedSmallValueToLargeValue" $ + it "converts values correctly" $ do + signedSmallValueToLargeValue 0x0000 `shouldBe` 0x00000 + signedSmallValueToLargeValue 0x1234 `shouldBe` 0x01234 + signedSmallValueToLargeValue 0xABCD `shouldBe` 0xFABCD + signedSmallValueToLargeValue 0xFFFF `shouldBe` 0xFFFFF + + describe "wordFromSmallOpcode" $ do + it "composes the words correctly" $ do + wordFromSmallOpcode 0x0 0x00000 `shouldBe` 0x000000 + wordFromSmallOpcode 0x0 0xFFFFF `shouldBe` 0x0FFFFF + wordFromSmallOpcode 0xF 0x00000 `shouldBe` 0xF00000 + wordFromSmallOpcode 0xF 0xFFFFF `shouldBe` 0xFFFFFF + wordFromSmallOpcode 0x1 0x23456 `shouldBe` 0x123456 + it "is reverted by getLargeOpcode and getSmallValue" $ property $ \(x, y) -> + let so = fromInteger x + lv = fromInteger y + word = wordFromSmallOpcode so lv + in getSmallOpcode word == so && getLargeValue word == lv + + describe "wordFromLargeOpcode" $ do + it "composes the words correctly" $ do + wordFromLargeOpcode 0x0 0x0000 `shouldBe` 0xF00000 + wordFromLargeOpcode 0x0 0xFFFF `shouldBe` 0xF0FFFF + wordFromLargeOpcode 0xF 0x0000 `shouldBe` 0xFF0000 + wordFromLargeOpcode 0xF 0xFFFF `shouldBe` 0xFFFFFF + wordFromLargeOpcode 0x1 0x2345 `shouldBe` 0xF12345 + it "is reverted by getLargeOpcode and getSmallValue" $ property $ \(x, y) -> + let lo = fromInteger x + sv = fromInteger y + word = wordFromLargeOpcode lo sv + in getLargeOpcode word == lo && getSmallValue word == sv