Write docs and tests for Mima.Vm.Word

This commit is contained in:
Joscha 2020-03-27 20:29:10 +00:00
parent a7d4eec3dd
commit 51317c0737
2 changed files with 132 additions and 5 deletions

View file

@ -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

89
test/Mima/Vm/WordSpec.hs Normal file
View file

@ -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