Add machine words and instructions

src/Mima/Instruction.hs

@@ -0,0 +1,104 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Mima.Instruction
+  ( SmallOpcode(..)
+  , LargeOpcode(..)
+  , Instruction(..)
+  , instructionFromWord
+  ) where
+
+import           Data.Bits
+import qualified Data.Map as Map
+import qualified Data.Text as T
+import           Data.Word
+
+import           Mima.Util
+import           Mima.Word
+
+data SmallOpcode = LDC | LDV | STV | ADD | AND | OR | XOR | EQL | JMP | JMN
+  deriving (Show, Eq, Ord)
+
+instance ToText SmallOpcode where
+  toText = T.pack . show
+
+allSmallOpcodes :: [SmallOpcode]
+allSmallOpcodes = [LDC, LDV, STV, ADD, AND, OR, XOR, EQL, JMP, JMN]
+
+getSmallOpcode :: SmallOpcode -> Word32
+getSmallOpcode LDC = 0
+getSmallOpcode LDV = 1
+getSmallOpcode STV = 2
+getSmallOpcode ADD = 3
+getSmallOpcode AND = 4
+getSmallOpcode OR  = 5
+getSmallOpcode XOR = 6
+getSmallOpcode EQL = 7
+getSmallOpcode JMP = 8
+getSmallOpcode JMN = 9
+
+smallOpcodeMap :: Map.Map Word32 SmallOpcode
+smallOpcodeMap = Map.fromList [(getSmallOpcode oc, oc) | oc <- allSmallOpcodes]
+
+data LargeOpcode = HALT | NOT | RAR
+  deriving (Show, Eq, Ord)
+
+instance ToText LargeOpcode where
+  toText = T.pack . show
+
+allLargeOpcodes :: [LargeOpcode]
+allLargeOpcodes = [HALT, NOT, RAR]
+
+getLargeOpcode :: LargeOpcode -> Word32
+getLargeOpcode HALT = 0
+getLargeOpcode NOT  = 1
+getLargeOpcode RAR  = 2
+
+largeOpcodeMap :: Map.Map Word32 LargeOpcode
+largeOpcodeMap = Map.fromList [(getLargeOpcode oc, oc) | oc <- allLargeOpcodes]
+
+data Instruction
+  = SmallInstruction SmallOpcode MimaAddress
+  | LargeInstruction LargeOpcode
+  deriving (Show, Eq)
+
+instance ToText Instruction where
+  toText (SmallInstruction oc addr) = toText oc <> " " <> toText addr
+  toText (LargeInstruction oc)      = toText oc
+
+upperOpcode :: MimaWord -> Word32
+upperOpcode mw = shiftR (toWord32 mw) 20 .&. 0xF
+
+lowerOpcode :: MimaWord -> Word32
+lowerOpcode mw = shiftR (toWord32 mw) 16 .&. 0xF
+
+address :: MimaWord -> MimaAddress
+address = fromWord32 . toWord32 -- no shifting required
+
+instructionFromWord :: MimaWord -> Either T.Text Instruction
+instructionFromWord mw = if upperOpcode mw == 0xF
+                         then parseLargeInstruction mw
+                         else parseSmallInstruction mw
+
+parseSmallInstruction :: MimaWord -> Either T.Text Instruction
+parseSmallInstruction mw = do
+  oc <- parseSmallOpcode (upperOpcode mw)
+  pure $ SmallInstruction oc (address mw)
+
+-- Assumes that all bits not part of the opcode are zeroed. The opcode
+-- uses the lowest four bits.
+parseSmallOpcode :: Word32 -> Either T.Text SmallOpcode
+parseSmallOpcode w = case smallOpcodeMap Map.!? w of
+  Just oc -> pure oc
+  Nothing -> Left $ "Unknown small opcode " <> T.pack (show w)
+                     <> " (" <> toHex 2 w <> ")"
+
+parseLargeInstruction :: MimaWord -> Either T.Text Instruction
+parseLargeInstruction mw = LargeInstruction <$> parseLargeOpcode (lowerOpcode mw)
+
+-- Assumes that all bits not part of the opcode are zeroed. The opcode
+-- uses the lowest four bits.
+parseLargeOpcode :: Word32 -> Either T.Text LargeOpcode
+parseLargeOpcode w = case largeOpcodeMap Map.!? w of
+  Just oc -> pure oc
+  Nothing -> Left $ "Unknown large opcode " <> T.pack (show w)
+                     <> " (" <> toHex 2 w <> ")"

src/Mima/Util.hs

@@ -0,0 +1,23 @@
+module Mima.Util
+  ( ToText(..)
+  , toHex
+  ) where
+
+import qualified Data.Text as T
+import qualified Numeric as N
+
+-- | A class for types that can be converted to 'T.Text'.
+--
+-- This class does not mean to convert elements to text in a
+-- standardized way. It is just to reduce the clutter of functions
+-- with names like @somethingToText@.
+--
+-- Only create an instance of this class when there is an obvious,
+-- preferrable way of converting something to text! If there are
+-- multiple "obvious" options, create no instance of this class and
+-- instead name the functions individually.
+class ToText a where
+  toText :: a -> T.Text
+
+toHex :: (Integral a, Show a) => Int -> a -> T.Text
+toHex digits a = T.justifyRight digits '0' $ T.pack $ N.showHex a ""

src/Mima/Word.hs

@@ -0,0 +1,36 @@
+module Mima.Word where
+
+import           Data.Bits
+import           Data.Word
+
+import           Mima.Util
+
+class Word32Based t where
+  fromWord32 :: Word32 -> t
+  toWord32 :: t -> Word32
+
+-- The MiMa's words are 24 bits long. The smallest word they fit in is
+-- 'Word32'.
+
+newtype MimaWord = MimaWord Word32
+  deriving (Show, Eq)
+
+instance ToText MimaWord where
+  toText (MimaWord w) = toHex 6 w
+
+instance Word32Based MimaWord where
+  fromWord32 w = MimaWord $ w .&. 0x00FFFFFF
+  toWord32 (MimaWord w) = w
+
+-- The MiMa's addresses are 20 bits long. The smallest word they fit
+-- in is 'Word32'.
+
+newtype MimaAddress = MimaAddress Word32
+  deriving (Show, Eq)
+
+instance ToText MimaAddress where
+  toText (MimaAddress w) = toHex 5 w
+
+instance Word32Based MimaAddress where
+  fromWord32 w = MimaAddress $ w .&. 0x000FFFFF
+  toWord32 (MimaAddress w) = w