Use OddWords library

This commit is contained in:
Joscha 2019-11-08 18:33:08 +00:00
parent 63a32ff01a
commit 112a49a7b7
5 changed files with 120 additions and 292 deletions

View file

@ -9,7 +9,6 @@ module Mima.Instruction
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Text as T import qualified Data.Text as T
import Data.Word
import Mima.Util import Mima.Util
import Mima.Word import Mima.Word
@ -25,25 +24,25 @@ allSmallOpcodes :: [SmallOpcode]
allSmallOpcodes = [LDC, LDV, STV, ADD, AND, OR, XOR, EQL, allSmallOpcodes = [LDC, LDV, STV, ADD, AND, OR, XOR, EQL,
JMP, JMN, LDIV, STIV, CALL, LDVR, STVR] JMP, JMN, LDIV, STIV, CALL, LDVR, STVR]
smallOpcodeToWord32 :: SmallOpcode -> Word32 smallOpcodeNr :: SmallOpcode -> Opcode
smallOpcodeToWord32 LDC = 0 smallOpcodeNr LDC = 0
smallOpcodeToWord32 LDV = 1 smallOpcodeNr LDV = 1
smallOpcodeToWord32 STV = 2 smallOpcodeNr STV = 2
smallOpcodeToWord32 ADD = 3 smallOpcodeNr ADD = 3
smallOpcodeToWord32 AND = 4 smallOpcodeNr AND = 4
smallOpcodeToWord32 OR = 5 smallOpcodeNr OR = 5
smallOpcodeToWord32 XOR = 6 smallOpcodeNr XOR = 6
smallOpcodeToWord32 EQL = 7 smallOpcodeNr EQL = 7
smallOpcodeToWord32 JMP = 8 smallOpcodeNr JMP = 8
smallOpcodeToWord32 JMN = 9 smallOpcodeNr JMN = 9
smallOpcodeToWord32 LDIV = 10 smallOpcodeNr LDIV = 10
smallOpcodeToWord32 STIV = 11 smallOpcodeNr STIV = 11
smallOpcodeToWord32 CALL = 12 smallOpcodeNr CALL = 12
smallOpcodeToWord32 LDVR = 13 smallOpcodeNr LDVR = 13
smallOpcodeToWord32 STVR = 14 smallOpcodeNr STVR = 14
smallOpcodeMap :: Map.Map Word32 SmallOpcode smallOpcodeMap :: Map.Map Opcode SmallOpcode
smallOpcodeMap = Map.fromList [(smallOpcodeToWord32 so, so) | so <- allSmallOpcodes] smallOpcodeMap = Map.fromList [(smallOpcodeNr so, so) | so <- allSmallOpcodes]
data LargeOpcode = HALT | NOT | RAR | RET | LDRA | STRA data LargeOpcode = HALT | NOT | RAR | RET | LDRA | STRA
| LDSP | STSP | LDFP | STFP | ADC | LDSP | STSP | LDFP | STFP | ADC
@ -55,22 +54,21 @@ instance ToText LargeOpcode where
allLargeOpcodes :: [LargeOpcode] allLargeOpcodes :: [LargeOpcode]
allLargeOpcodes = [HALT, NOT, RAR, RET, LDRA, STRA, LDSP, STSP, LDFP, STFP, ADC] allLargeOpcodes = [HALT, NOT, RAR, RET, LDRA, STRA, LDSP, STSP, LDFP, STFP, ADC]
largeOpcodeToWord32 :: LargeOpcode -> Word32 largeOpcodeNr :: LargeOpcode -> Opcode
largeOpcodeToWord32 HALT = 0 largeOpcodeNr HALT = 0
largeOpcodeToWord32 NOT = 1 largeOpcodeNr NOT = 1
largeOpcodeToWord32 RAR = 2 largeOpcodeNr RAR = 2
largeOpcodeToWord32 RET = 3 largeOpcodeNr RET = 3
largeOpcodeNr LDRA = 4
largeOpcodeNr STRA = 5
largeOpcodeNr LDSP = 6
largeOpcodeNr STSP = 7
largeOpcodeNr LDFP = 8
largeOpcodeNr STFP = 9
largeOpcodeNr ADC = 10
largeOpcodeToWord32 LDRA = 4 largeOpcodeMap :: Map.Map Opcode LargeOpcode
largeOpcodeToWord32 STRA = 5 largeOpcodeMap = Map.fromList [(largeOpcodeNr lo, lo) | lo <- allLargeOpcodes]
largeOpcodeToWord32 LDSP = 6
largeOpcodeToWord32 STSP = 7
largeOpcodeToWord32 LDFP = 8
largeOpcodeToWord32 STFP = 9
largeOpcodeToWord32 ADC = 10
largeOpcodeMap :: Map.Map Word32 LargeOpcode
largeOpcodeMap = Map.fromList [(largeOpcodeToWord32 lo, lo) | lo <- allLargeOpcodes]
data Instruction data Instruction
= SmallInstruction !SmallOpcode !LargeValue = SmallInstruction !SmallOpcode !LargeValue
@ -89,7 +87,7 @@ parseSmallInstruction mw = do
-- Assumes that all bits not part of the opcode are zeroed. The opcode -- Assumes that all bits not part of the opcode are zeroed. The opcode
-- uses the lowest four bits. -- uses the lowest four bits.
parseSmallOpcode :: Word32 -> Either T.Text SmallOpcode parseSmallOpcode :: Opcode -> Either T.Text SmallOpcode
parseSmallOpcode w = case smallOpcodeMap Map.!? w of parseSmallOpcode w = case smallOpcodeMap Map.!? w of
Just oc -> pure oc Just oc -> pure oc
Nothing -> Left $ "Unknown small opcode " <> T.pack (show w) Nothing -> Left $ "Unknown small opcode " <> T.pack (show w)
@ -102,7 +100,7 @@ parseLargeInstruction mw = do
-- Assumes that all bits not part of the opcode are zeroed. The opcode -- Assumes that all bits not part of the opcode are zeroed. The opcode
-- uses the lowest four bits. -- uses the lowest four bits.
parseLargeOpcode :: Word32 -> Either T.Text LargeOpcode parseLargeOpcode :: Opcode -> Either T.Text LargeOpcode
parseLargeOpcode w = case largeOpcodeMap Map.!? w of parseLargeOpcode w = case largeOpcodeMap Map.!? w of
Just oc -> pure oc Just oc -> pure oc
Nothing -> Left $ "Unknown large opcode " <> T.pack (show w) Nothing -> Left $ "Unknown large opcode " <> T.pack (show w)

View file

@ -6,6 +6,7 @@ module Mima.Load
) where ) where
import Control.Applicative import Control.Applicative
import Control.Monad
import Data.Binary import Data.Binary
import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy as BS
@ -15,19 +16,15 @@ import Mima.State
-- To prevent orphan instances and keep the compiler happy -- To prevent orphan instances and keep the compiler happy
newtype LD t = LD { unLD :: t } newtype LD t = LD { unLD :: t }
instance Binary (LD (WB MimaWord_)) where instance Binary (LD MimaWord) where
put mw = do put mw = do
let (w1, w2, w3) = wordToBytes $ unLD mw let (w1, w2, w3) = wordToBytes $ unLD mw
put w1 forM_ [w1, w2, w3] put
put w2
put w3
get = do get = do
w1 <- get bytes <- (,,) <$> get <*> get <*> get
w2 <- get pure $ LD $ bytesToWord bytes
w3 <- get
pure $ LD $ bytesToWord w1 w2 w3
instance Binary (LD (WB LargeValue_)) where instance Binary (LD LargeValue) where
put = put . LD . largeValueToWord . unLD put = put . LD . largeValueToWord . unLD
get = (LD . getLargeValue) <$> unLD <$> get get = (LD . getLargeValue) <$> unLD <$> get

View file

@ -51,35 +51,6 @@ wordsToMemory = MimaMemory
memoryToWords :: MimaMemory -> [MimaWord] memoryToWords :: MimaMemory -> [MimaWord]
memoryToWords mem = map (\addr -> readAt addr mem) $ addressRange mem memoryToWords mem = map (\addr -> readAt addr mem) $ addressRange mem
{-
addrWordLegend :: T.Text
addrWordLegend = "SO: Small Opcode (bits 23-20) LO: Large Opcode (bits 19-16)\n"
<> "Addr (decimal) - Word ( decimal|SO,LO, Addr) - Instruction\n"
addrWordToText :: MimaAddress -> MimaWord -> T.Text
addrWordToText addr word =
let separator = " - "
addrText = addrToHex addr <> " (" <> addrToDec addr <> ")"
wordSplit = toDec 2 (upperOpcode word) <> ","
<> toDec 2 (lowerOpcode word) <> ","
<> addrToDec (address word)
wordText = wordToHex word <> " (" <> wordToDec word <> "|" <> wordSplit <> ")"
instrText = case wordToInstruction word of
Left _ -> ""
Right i -> separator <> toText i
in addrText <> separator <> wordText <> instrText
memoryToText :: Bool -> MimaMemory -> T.Text
memoryToText sparse mem@(MimaMemory m)
= (addrWordLegend <>)
$ T.intercalate "\n"
$ map (\addr -> addrWordToText addr (readAt addr mem))
$ addresses sparse
where
addresses False = addressRange mem
addresses True = Map.keys m
-}
readAt :: MimaAddress -> MimaMemory -> MimaWord readAt :: MimaAddress -> MimaMemory -> MimaWord
readAt addr (MimaMemory m) = Map.findWithDefault zeroBits addr m readAt addr (MimaMemory m) = Map.findWithDefault zeroBits addr m
@ -143,7 +114,7 @@ doSmallOpcode :: SmallOpcode -> LargeValue -> MimaState -> MimaState
doSmallOpcode LDC lv ms@MimaState{..} = ms{msACC = largeValueToWord lv} doSmallOpcode LDC lv ms@MimaState{..} = ms{msACC = largeValueToWord lv}
doSmallOpcode LDV addr ms@MimaState{..} = ms{msACC = readAt addr msMemory} doSmallOpcode LDV addr ms@MimaState{..} = ms{msACC = readAt addr msMemory}
doSmallOpcode STV addr ms@MimaState{..} = ms{msMemory = writeAt addr msACC msMemory} doSmallOpcode STV addr ms@MimaState{..} = ms{msMemory = writeAt addr msACC msMemory}
doSmallOpcode ADD addr ms@MimaState{..} = ms{msACC = addWords msACC $ readAt addr msMemory} doSmallOpcode ADD addr ms@MimaState{..} = ms{msACC = msACC + readAt addr msMemory}
doSmallOpcode AND addr ms@MimaState{..} = ms{msACC = msACC .&. readAt addr msMemory} doSmallOpcode AND addr ms@MimaState{..} = ms{msACC = msACC .&. readAt addr msMemory}
doSmallOpcode OR addr ms@MimaState{..} = ms{msACC = msACC .|. readAt addr msMemory} doSmallOpcode OR addr ms@MimaState{..} = ms{msACC = msACC .|. readAt addr msMemory}
doSmallOpcode XOR addr ms@MimaState{..} = ms{msACC = msACC `xor` readAt addr msMemory} doSmallOpcode XOR addr ms@MimaState{..} = ms{msACC = msACC `xor` readAt addr msMemory}
@ -151,14 +122,14 @@ doSmallOpcode EQL addr ms@MimaState{..} = ms{msACC = boolToWord $ msACC == read
doSmallOpcode JMP addr ms@MimaState{..} = ms{msIAR = addr} doSmallOpcode JMP addr ms@MimaState{..} = ms{msIAR = addr}
doSmallOpcode JMN addr ms@MimaState{..} = if topBit msACC then ms{msIAR = addr} else ms doSmallOpcode JMN addr ms@MimaState{..} = if topBit msACC then ms{msIAR = addr} else ms
doSmallOpcode LDIV addr ms@MimaState{..} = doSmallOpcode LDIV addr ms@MimaState{..} =
let indirAddr = getAddress $ readAt addr msMemory let indirAddr = getLargeValue $ readAt addr msMemory
in ms{msACC = readAt indirAddr msMemory} in ms{msACC = readAt indirAddr msMemory}
doSmallOpcode STIV addr ms@MimaState{..} = doSmallOpcode STIV addr ms@MimaState{..} =
let indirAddr = getAddress $ readAt addr msMemory let indirAddr = getLargeValue $ readAt addr msMemory
in ms{msMemory = writeAt indirAddr msACC msMemory} in ms{msMemory = writeAt indirAddr msACC msMemory}
doSmallOpcode CALL addr ms@MimaState{..} = ms{msRA = msIAR, msIAR = addr} doSmallOpcode CALL addr ms@MimaState{..} = ms{msRA = msIAR, msIAR = addr}
doSmallOpcode LDVR addr ms@MimaState{..} = ms{msACC = readAt (addLargeValues msSP addr) msMemory} doSmallOpcode LDVR addr ms@MimaState{..} = ms{msACC = readAt (msSP + addr) msMemory}
doSmallOpcode STVR addr ms@MimaState{..} = ms{msMemory = writeAt (addLargeValues msSP addr) msACC msMemory} doSmallOpcode STVR addr ms@MimaState{..} = ms{msMemory = writeAt (msSP + addr) msACC msMemory}
doLargeOpcode :: LargeOpcode -> SmallValue -> MimaState -> Either AbortReason MimaState doLargeOpcode :: LargeOpcode -> SmallValue -> MimaState -> Either AbortReason MimaState
doLargeOpcode HALT _ _ = Left Halted doLargeOpcode HALT _ _ = Left Halted
@ -166,12 +137,12 @@ doLargeOpcode NOT _ ms@MimaState{..} = pure ms{msACC = complement msACC}
doLargeOpcode RAR _ ms@MimaState{..} = pure ms{msACC = rotateR msACC 1} doLargeOpcode RAR _ ms@MimaState{..} = pure ms{msACC = rotateR msACC 1}
doLargeOpcode RET _ ms@MimaState{..} = pure ms{msIAR = msRA} doLargeOpcode RET _ ms@MimaState{..} = pure ms{msIAR = msRA}
doLargeOpcode LDRA _ ms@MimaState{..} = pure ms{msACC = largeValueToWord msRA} doLargeOpcode LDRA _ ms@MimaState{..} = pure ms{msACC = largeValueToWord msRA}
doLargeOpcode STRA _ ms@MimaState{..} = pure ms{msRA = getAddress msACC} doLargeOpcode STRA _ ms@MimaState{..} = pure ms{msRA = getLargeValue msACC}
doLargeOpcode LDSP _ ms@MimaState{..} = pure ms{msACC = largeValueToWord msSP} doLargeOpcode LDSP _ ms@MimaState{..} = pure ms{msACC = largeValueToWord msSP}
doLargeOpcode STSP _ ms@MimaState{..} = pure ms{msSP = getAddress msACC} doLargeOpcode STSP _ ms@MimaState{..} = pure ms{msSP = getLargeValue msACC}
doLargeOpcode LDFP _ ms@MimaState{..} = pure ms{msACC = largeValueToWord msFP} doLargeOpcode LDFP _ ms@MimaState{..} = pure ms{msACC = largeValueToWord msFP}
doLargeOpcode STFP _ ms@MimaState{..} = pure ms{msFP = getAddress msACC} doLargeOpcode STFP _ ms@MimaState{..} = pure ms{msFP = getLargeValue msACC}
doLargeOpcode ADC sv ms@MimaState{..} = pure ms{msACC = addWords msACC $ signedSmallValueToWord sv} doLargeOpcode ADC sv ms@MimaState{..} = pure ms{msACC = msACC + signedSmallValueToWord sv}
run :: MimaState -> (MimaState, AbortReason, Integer) run :: MimaState -> (MimaState, AbortReason, Integer)
run ms = helper 0 ms run ms = helper 0 ms

View file

@ -1,7 +1,11 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Mima.Util module Mima.Util
( ToText(..) (
-- * Formatting
ToText(..)
, HexLike(..) , HexLike(..)
, groupByTwoChars , groupByTwoChars
, integralToDec , integralToDec
@ -9,8 +13,12 @@ module Mima.Util
) where ) where
import qualified Data.Text as T import qualified Data.Text as T
import Data.Word
import Data.Word.Odd
import qualified Numeric as N import qualified Numeric as N
{- Formatting -}
-- | A class for types that can be converted to 'T.Text'. -- | A class for types that can be converted to 'T.Text'.
-- --
-- This class does not mean to convert elements to text in a -- This class does not mean to convert elements to text in a
@ -24,6 +32,8 @@ import qualified Numeric as N
class ToText a where class ToText a where
toText :: a -> T.Text toText :: a -> T.Text
-- | A class for number-like types that have a decimal and a
-- hexadecimal representation.
class HexLike a where class HexLike a where
toDec :: a -> T.Text toDec :: a -> T.Text
toHex :: a -> T.Text toHex :: a -> T.Text
@ -31,6 +41,23 @@ class HexLike a where
toHexBytes :: a -> T.Text toHexBytes :: a -> T.Text
toHexBytes = T.intercalate " " . groupByTwoChars . toHex toHexBytes = T.intercalate " " . groupByTwoChars . toHex
instance HexLike Word24 where
toHex = integralToHex 6
toDec = T.pack . show
instance HexLike Word20 where
toHex = integralToHex 5
toDec = T.pack . show
instance HexLike Word16 where
toHex = integralToHex 4
toDec = T.pack . show
instance HexLike Word4 where
toHex = integralToHex 1
toDec = T.pack . show
groupByTwoChars :: T.Text -> [T.Text] groupByTwoChars :: T.Text -> [T.Text]
groupByTwoChars = reverse . helper . T.unpack . T.reverse groupByTwoChars = reverse . helper . T.unpack . T.reverse
where where

View file

@ -1,237 +1,72 @@
{-# LANGUAGE OverloadedStrings #-}
module Mima.Word module Mima.Word
( topBit (
-- * 24-bit value -- * Types
, MimaWord MimaWord
-- ** Converting , MimaAddress
, LargeValue
, SmallValue
, Opcode
, topBit
-- * Converting between types
, bytesToWord , bytesToWord
, wordToBytes , wordToBytes
, boolToWord , boolToWord
-- ** Properties , largeValueToWord
, signedSmallValueToWord
-- ** 'MimaWord' properties
, getSmallOpcode , getSmallOpcode
, getLargeOpcode , getLargeOpcode
, getAddress
, getLargeValue , getLargeValue
, getSmallValue , getSmallValue
-- ** Operations
, addWords
-- * 20-bit value
, LargeValue
, MimaAddress
-- ** Converting
, bytesToLargeValue
, largeValueToBytes
, largeValueToWord
-- ** Operations
, addLargeValues
-- * 16-bit value
, SmallValue
-- ** Converting
, signedSmallValueToWord
-- * Underlying types
, WB
, MimaWord_
, LargeValue_
, SmallValue_
) where ) where
import Data.Bits import Data.Bits
import Data.Function
import qualified Data.Text as T
import Data.Word import Data.Word
import Data.Word.Odd
import Mima.Util type MimaWord = Word24
type MimaAddress = LargeValue
type LargeValue = Word20
type SmallValue = Word16
type Opcode = Word4
{- Type classes and instances for free! -} topBit :: (FiniteBits b) => b -> Bool
-- Get them now while they're hot! topBit b = testBit b $ finiteBitSize b
-- This typeclass is for automatic bit twiddling and enumification for bytesToWord :: (Word8, Word8, Word8) -> MimaWord
-- 'Word32' based types. bytesToWord (w1, w2, w3) =
class Word32Based t where
usedBits :: t -> Int
fromWord32 :: Word32 -> t
toWord32 :: t -> Word32
topBit :: (Word32Based t) => t -> Bool
topBit t = testBit (toWord32 t) (usedBits t - 1)
-- Required to make the compiler shut up (see
-- https://stackoverflow.com/a/17866970)
newtype WB t = WB { unWB :: t}
instance (Show t) => Show (WB t) where
show = show . unWB
instance (HexLike t) => HexLike (WB t) where
toDec = toDec . unWB
toHex = toHex . unWB
toHexBytes = toHexBytes . unWB
-- Kinda obvious, isn't it? :P
instance (Word32Based t) => Word32Based (WB t) where
usedBits = usedBits . unWB
fromWord32 = WB . fromWord32
toWord32 = toWord32 . unWB
instance (Word32Based t) => Eq (WB t) where
w1 == w2 = toWord32 (unWB w1) == toWord32 (unWB w2)
instance (Word32Based t) => Ord (WB t) where
compare = compare `on` toWord32
(<) = (<) `on` toWord32
(<=) = (<=) `on` toWord32
(>) = (>) `on` toWord32
(>=) = (>=) `on` toWord32
instance (Word32Based t) => Bits (WB t) where
t1 .&. t2 = fromWord32 $ toWord32 t1 .&. toWord32 t2
t1 .|. t2 = fromWord32 $ toWord32 t1 .|. toWord32 t2
t1 `xor` t2 = fromWord32 $ toWord32 t1 `xor` toWord32 t2
complement = fromWord32 . complement . toWord32
shiftL t i = fromWord32 $ shiftL (toWord32 t) i
shiftR t i = fromWord32 $
let rightShifted = shiftR (toWord32 t) i
leftOver = max 0 (usedBits t - i)
in if topBit t
then shiftL (complement zeroBits) leftOver .|. rightShifted
else rightShifted
rotateL t i = rotateR t (usedBits t - i)
rotateR t i =
let i' = i `mod` usedBits t
w = toWord32 t
in fromWord32 $ shiftR w i' .|. shiftL w (usedBits t - i')
zeroBits = fromWord32 zeroBits
bit = fromWord32 . bit
testBit t = testBit (toWord32 t)
bitSize = usedBits
bitSizeMaybe = Just . usedBits
isSigned = const True
popCount = popCount . toWord32
instance (Word32Based t) => Bounded (WB t) where
minBound = fromWord32 zeroBits
maxBound = fromWord32 (complement zeroBits)
instance (Word32Based t) => Enum (WB t) where
toEnum i =
let lower = fromEnum $ toWord32 (minBound :: MimaAddress)
upper = fromEnum $ toWord32 (maxBound :: MimaAddress)
in if lower <= i && i <= upper
then fromWord32 $ toEnum i
else error $ "Enum.toEnum: tag (" ++ show i
++ ") is out of bounds " ++ show (lower, upper)
fromEnum = fromEnum . toWord32
-- See 'Enum' laws for types with a 'Bounded' instance
enumFrom x = enumFromTo x maxBound
enumFromThen x y = enumFromThenTo x y bound
where
bound | fromEnum y >= fromEnum x = maxBound
| otherwise = minBound
{- The types -}
type MimaWord = WB MimaWord_
newtype MimaWord_ = MimaWord_ Word32
instance Word32Based MimaWord_ where
usedBits _ = 24
fromWord32 w = MimaWord_ $ w .&. 0xFFFFFF
toWord32 (MimaWord_ w) = w
instance HexLike MimaWord_ where
toDec = T.pack . show . toWord32
toHex = integralToHex 6 . toWord32
instance Show MimaWord_ where
show mw = T.unpack $ "MimaWord_ 0x" <> toHex mw
bytesToWord :: Word8 -> Word8 -> Word8 -> MimaWord
bytesToWord w1 w2 w3 =
let (w1', w2', w3') = (fromIntegral w1, fromIntegral w2, fromIntegral w3) let (w1', w2', w3') = (fromIntegral w1, fromIntegral w2, fromIntegral w3)
in fromWord32 $ shiftL w1' 16 .|. shiftL w2' 8 .|. w3' in shiftL w1' 16 .|. shiftL w2' 8 .|. w3'
wordToBytes :: MimaWord -> (Word8, Word8, Word8) wordToBytes :: MimaWord -> (Word8, Word8, Word8)
wordToBytes mw = wordToBytes mw =
let w = toWord32 mw -- No masks necessary since converting to 'Word8' already cuts off
-- Mask for w1 not strictly necessary, since upper bytes are -- all higher bits.
-- already zero due to implementation of 'fromWord32'. let w1 = fromIntegral $ shiftR mw 16
w1 = fromIntegral $ shiftR w 16 .&. 0xFF w2 = fromIntegral $ shiftR mw 8
w2 = fromIntegral $ shiftR w 8 .&. 0xFF w3 = fromIntegral mw
w3 = fromIntegral $ w .&. 0xFF
in (w1, w2, w3) in (w1, w2, w3)
boolToWord :: Bool -> MimaWord boolToWord :: Bool -> MimaWord
boolToWord False = zeroBits boolToWord False = zeroBits
boolToWord True = complement zeroBits boolToWord True = complement zeroBits
getSmallOpcode :: MimaWord -> Word32
getSmallOpcode mw = shiftR (toWord32 mw) 20 .&. 0xF
getLargeOpcode :: MimaWord -> Word32
getLargeOpcode mw = shiftR (toWord32 mw) 16 .&. 0xF
getAddress :: MimaWord -> MimaAddress
getAddress = getLargeValue
getLargeValue :: MimaWord -> LargeValue
getLargeValue = fromWord32 . toWord32
getSmallValue :: MimaWord -> SmallValue
getSmallValue = fromWord32 . toWord32
addWords :: MimaWord -> MimaWord -> MimaWord
addWords w1 w2 = fromWord32 $ toWord32 w1 + toWord32 w2
type MimaAddress = LargeValue
type LargeValue = WB LargeValue_
newtype LargeValue_ = LargeValue_ Word32
instance Word32Based LargeValue_ where
usedBits _ = 20
fromWord32 w = LargeValue_ $ w .&. 0xFFFFF
toWord32 (LargeValue_ w) = w
instance HexLike LargeValue_ where
toDec = T.pack . show . toWord32
toHex = integralToHex 5 . toWord32
instance Show LargeValue_ where
show lv = T.unpack $ "LargeValue_ 0x" <> toHex lv
bytesToLargeValue :: Word8 -> Word8 -> Word8 -> LargeValue
bytesToLargeValue w1 w2 w3 = getAddress $ bytesToWord w1 w2 w3
largeValueToBytes :: LargeValue -> (Word8, Word8, Word8)
largeValueToBytes = wordToBytes . largeValueToWord
largeValueToWord :: LargeValue -> MimaWord largeValueToWord :: LargeValue -> MimaWord
largeValueToWord = fromWord32 . toWord32 largeValueToWord = fromIntegral
addLargeValues :: LargeValue -> LargeValue -> LargeValue
addLargeValues lv1 lv2 = getLargeValue $ addWords (largeValueToWord lv1) (largeValueToWord lv2)
type SmallValue = WB SmallValue_
newtype SmallValue_ = SmallValue_ Word32
instance Word32Based SmallValue_ where
usedBits _ = 16
fromWord32 w = SmallValue_ $ w .&. 0xFFFF
toWord32 (SmallValue_ w) = w
instance HexLike SmallValue_ where
toDec = T.pack . show . toWord32
toHex = integralToHex 5 . toWord32
instance Show SmallValue_ where
show sv = T.unpack $ "SmallValue_ 0x" <> toHex sv
signedSmallValueToWord :: SmallValue -> MimaWord signedSmallValueToWord :: SmallValue -> MimaWord
signedSmallValueToWord sv signedSmallValueToWord sv
| topBit sv = fromWord32 $ 0xFFFF0000 .|. toWord32 sv | topBit sv = 0xFF0000 .|. fromIntegral sv
| otherwise = fromWord32 $ toWord32 sv | otherwise = fromIntegral sv
getSmallOpcode :: MimaWord -> Opcode
getSmallOpcode mw = fromIntegral $ shiftR mw 20
getLargeOpcode :: MimaWord -> Opcode
getLargeOpcode mw = fromIntegral $ shiftR mw 16
getLargeValue :: MimaWord -> LargeValue
getLargeValue = fromIntegral
getSmallValue :: MimaWord -> SmallValue
getSmallValue = fromIntegral