{- | Pure machine-word helpers: fixed-width truncation/sign handling and
arithmetic that also reports overflow and carry. These operate on any
'IsWord' and are shared across the ISA implementations.
-}
module Wrench.Machine.Word (
    fitSigned,
    lShiftR,
    lShiftL,
    Ext (..),
    addExt,
    subExt,
    mulExt,
    b8,
    u5,
    u8,
    u16,
    u20,
    i8,
    i10,
    i12,
    i13,
    i15,
    i16,
    i17,
    i20,
    i21,
) where

import Data.Bits
import Relude
import Wrench.Machine.Types (FromSign (..), IsWord)

-- | Reduce a value to a fixed-width signed instruction field: keep the low @n@
-- bits and sign-extend from bit @n-1@ to the full machine word. Bits at or above
-- bit @n@ are silently discarded, modelling an immediate/offset that does not
-- fit its encoding field.
fitSigned :: (IsWord w) => Int -> w -> w
fitSigned :: forall w. IsWord w => Int -> w -> w
fitSigned Int
n w
x =
    let mask :: w
mask = Int -> w
forall a. Bits a => Int -> a
bit Int
n w -> w -> w
forall a. Num a => a -> a -> a
- w
1
        low :: w
low = w
x w -> w -> w
forall a. Bits a => a -> a -> a
.&. w
mask
     in if w -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit w
low (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) then w
low w -> w -> w
forall a. Bits a => a -> a -> a
.|. w -> w
forall a. Bits a => a -> a
complement w
mask else w
low

lShiftR :: (IsWord w) => w -> w -> w
lShiftR :: forall w. IsWord w => w -> w -> w
lShiftR w
x w
n = Unsign w -> w
forall w. FromSign w => Unsign w -> w
toSign (w -> Unsign w
forall w. FromSign w => w -> Unsign w
fromSign w
x Unsign w -> Int -> Unsign w
forall a. Bits a => a -> Int -> a
`shiftR` w -> Int
forall a. Enum a => a -> Int
fromEnum w
n)

lShiftL :: (IsWord w) => w -> w -> w
lShiftL :: forall w. IsWord w => w -> w -> w
lShiftL w
x w
n = Unsign w -> w
forall w. FromSign w => Unsign w -> w
toSign (w -> Unsign w
forall w. FromSign w => w -> Unsign w
fromSign w
x Unsign w -> Int -> Unsign w
forall a. Bits a => a -> Int -> a
`shiftL` w -> Int
forall a. Enum a => a -> Int
fromEnum w
n)

data Ext a = Ext {forall a. Ext a -> a
value :: a, forall a. Ext a -> Bool
overflow :: Bool, forall a. Ext a -> Bool
carry :: Bool}
    deriving (Ext a -> Ext a -> Bool
(Ext a -> Ext a -> Bool) -> (Ext a -> Ext a -> Bool) -> Eq (Ext a)
forall a. Eq a => Ext a -> Ext a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Ext a -> Ext a -> Bool
== :: Ext a -> Ext a -> Bool
$c/= :: forall a. Eq a => Ext a -> Ext a -> Bool
/= :: Ext a -> Ext a -> Bool
Eq, Int -> Ext a -> ShowS
[Ext a] -> ShowS
Ext a -> String
(Int -> Ext a -> ShowS)
-> (Ext a -> String) -> ([Ext a] -> ShowS) -> Show (Ext a)
forall a. Show a => Int -> Ext a -> ShowS
forall a. Show a => [Ext a] -> ShowS
forall a. Show a => Ext a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Ext a -> ShowS
showsPrec :: Int -> Ext a -> ShowS
$cshow :: forall a. Show a => Ext a -> String
show :: Ext a -> String
$cshowList :: forall a. Show a => [Ext a] -> ShowS
showList :: [Ext a] -> ShowS
Show)

addExt :: (IsWord w) => w -> w -> Ext w
addExt :: forall w. IsWord w => w -> w -> Ext w
addExt w
x w
y =
    let result :: w
result = w
x w -> w -> w
forall a. Num a => a -> a -> a
+ w
y
        overflow :: Bool
overflow = ((w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
> w
0 Bool -> Bool -> Bool
&& w
y w -> w -> Bool
forall a. Ord a => a -> a -> Bool
> w
0 Bool -> Bool -> Bool
&& w
result w -> w -> Bool
forall a. Ord a => a -> a -> Bool
< w
0) Bool -> Bool -> Bool
|| (w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
< w
0 Bool -> Bool -> Bool
&& w
y w -> w -> Bool
forall a. Ord a => a -> a -> Bool
< w
0 Bool -> Bool -> Bool
&& w
result w -> w -> Bool
forall a. Ord a => a -> a -> Bool
> w
0))
        carry :: Bool
carry = Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Unsign w -> Integer
forall a. Integral a => a -> Integer
toInteger (w -> Unsign w
forall w. FromSign w => w -> Unsign w
fromSign w
x) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Unsign w -> Integer
forall a. Integral a => a -> Integer
toInteger (w -> Unsign w
forall w. FromSign w => w -> Unsign w
fromSign w
y)) (w -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize w
x)
     in Ext{value :: w
value = w
result, Bool
overflow :: Bool
overflow :: Bool
overflow, Bool
carry :: Bool
carry :: Bool
carry}

subExt :: (IsWord w) => w -> w -> Ext w
subExt :: forall w. IsWord w => w -> w -> Ext w
subExt w
x w
y =
    let result :: w
result = w
x w -> w -> w
forall a. Num a => a -> a -> a
- w
y
        overflow :: Bool
overflow = ((w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
> w
0 Bool -> Bool -> Bool
&& w
y w -> w -> Bool
forall a. Ord a => a -> a -> Bool
< w
0 Bool -> Bool -> Bool
&& w
result w -> w -> Bool
forall a. Ord a => a -> a -> Bool
< w
0) Bool -> Bool -> Bool
|| (w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
< w
0 Bool -> Bool -> Bool
&& w
y w -> w -> Bool
forall a. Ord a => a -> a -> Bool
> w
0 Bool -> Bool -> Bool
&& w
result w -> w -> Bool
forall a. Ord a => a -> a -> Bool
> w
0))
        carry :: Bool
carry = w -> Unsign w
forall w. FromSign w => w -> Unsign w
fromSign w
x Unsign w -> Unsign w -> Bool
forall a. Ord a => a -> a -> Bool
< w -> Unsign w
forall w. FromSign w => w -> Unsign w
fromSign w
y
     in Ext{value :: w
value = w
result, Bool
overflow :: Bool
overflow :: Bool
overflow, Bool
carry :: Bool
carry :: Bool
carry}

mulExt :: (IsWord w) => w -> w -> Ext w
mulExt :: forall w. IsWord w => w -> w -> Ext w
mulExt w
x w
y =
    let result :: w
result = w
x w -> w -> w
forall a. Num a => a -> a -> a
* w
y
        overflow :: Bool
overflow = (w
x w -> w -> Bool
forall a. Eq a => a -> a -> Bool
/= w
0 Bool -> Bool -> Bool
&& w
y w -> w -> Bool
forall a. Eq a => a -> a -> Bool
/= w
0 Bool -> Bool -> Bool
&& w
result w -> w -> w
forall a. Integral a => a -> a -> a
`div` w
x w -> w -> Bool
forall a. Eq a => a -> a -> Bool
/= w
y)
        carry :: Bool
carry = (w -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral w
x Word -> Word -> Word
forall a. Num a => a -> a -> a
* w -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral w
y) Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> (Word
forall a. Bounded a => a
maxBound :: Word)
     in Ext{value :: w
value = w
result, Bool
overflow :: Bool
overflow :: Bool
overflow, Bool
carry :: Bool
carry :: Bool
carry}

-- Field guards: a value that does not fit the field it is encoded into stops
-- translation with the message the caller builds, instead of reaching the
-- simulator and being truncated there. One per field width the ISAs encode, so
-- a call site names the field rather than computing it.

-- | Any pattern a byte can spell, read as signed or unsigned -- the range the
-- @.byte@ directive accepts, so a byte-wide immediate and a byte of data agree
-- on what fits.
b8 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
b8 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
b8 Text -> Text
errMsgF w
x
    | -w
128 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
255 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

u5 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
u5 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
u5 Text -> Text
errMsgF w
x
    | w
0 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
31 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

u8 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
u8 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
u8 Text -> Text
errMsgF w
x
    | w
0 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
255 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

u16 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
u16 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
u16 Text -> Text
errMsgF w
x
    | w
0 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
65535 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

u20 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
u20 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
u20 Text -> Text
errMsgF w
x
    | w
0 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
1048575 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

i8 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
i8 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i8 Text -> Text
errMsgF w
x
    | -w
128 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
127 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

i10 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
i10 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i10 Text -> Text
errMsgF w
x
    | -w
512 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
511 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

i12 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
i12 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i12 Text -> Text
errMsgF w
x
    | -w
2048 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
2047 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

i13 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
i13 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i13 Text -> Text
errMsgF w
x
    | -w
4096 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
4095 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

i15 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
i15 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i15 Text -> Text
errMsgF w
x
    | -w
16384 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
16383 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

i16 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
i16 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i16 Text -> Text
errMsgF w
x
    | -w
32768 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
32767 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

i17 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
i17 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i17 Text -> Text
errMsgF w
x
    | -w
65536 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
65535 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

i20 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
i20 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i20 Text -> Text
errMsgF w
x
    | -w
524288 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
524287 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x

i21 :: (IsWord w) => (Text -> Text) -> w -> Either Text w
i21 :: forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i21 Text -> Text
errMsgF w
x
    | -w
1048576 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
x Bool -> Bool -> Bool
&& w
x w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
1048575 = w -> Either Text w
forall a b. b -> Either a b
Right w
x
    | Bool
otherwise = Text -> Either Text w
forall a b. a -> Either a b
Left (Text -> Either Text w) -> Text -> Either Text w
forall a b. (a -> b) -> a -> b
$ Text -> Text
errMsgF (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ w -> Text
forall b a. (Show a, IsString b) => a -> b
show w
x