{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

-- | Inspired by VLIW architectures and RISC-V
module Wrench.Isa.VliwIv (
    VliwIvIsa (..),
    VliwIvSt (..),
    Register (..),
    VliwLoadAcc,
    emptyVliwLoad,
) where

import Data.Bits (bit, shiftL, shiftR, (.&.), (.|.))
import Data.Default
import Data.IntMap.Strict qualified as IM
import Data.Text qualified as T
import Relude
import Relude.Extra
import System.Random (StdGen, uniformR)
import Text.Megaparsec (choice, getOffset, setOffset)
import Text.Megaparsec.Char (char, hspace, string)
import Wrench.Machine.Memory
import Wrench.Machine.Types (
    ByteSizeT (..),
    InitState (..),
    Inspectable (..),
    IoMem (..),
    Machine (..),
    MemOf,
    StateEnv (..),
    fromSign,
    halted,
 )
import Wrench.Machine.Word (fitSigned, i10, i15, i17, i20, lShiftR, u20)
import Wrench.Report
import Wrench.Report.View (Stat (..), withRenames)
import Wrench.Translator.Parser.Misc (comma, eol', reference, referenceWithDirective, wordLiteral)
import Wrench.Translator.Parser.Types
import Wrench.Translator.Types

-- * Registers

data Register
    = Zero
    | Ra
    | Sp
    | Gp
    | Tp
    | T0
    | T1
    | T2
    | S0Fp
    | S1
    | A0
    | A1
    | A2
    | A3
    | A4
    | A5
    | A6
    | A7
    | S2
    | S3
    | S4
    | S5
    | S6
    | S7
    | S8
    | S9
    | S10
    | S11
    | T3
    | T4
    | T5
    | T6
    deriving (Int -> Register
Register -> Int
Register -> [Register]
Register -> Register
Register -> Register -> [Register]
Register -> Register -> Register -> [Register]
(Register -> Register)
-> (Register -> Register)
-> (Int -> Register)
-> (Register -> Int)
-> (Register -> [Register])
-> (Register -> Register -> [Register])
-> (Register -> Register -> [Register])
-> (Register -> Register -> Register -> [Register])
-> Enum Register
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Register -> Register
succ :: Register -> Register
$cpred :: Register -> Register
pred :: Register -> Register
$ctoEnum :: Int -> Register
toEnum :: Int -> Register
$cfromEnum :: Register -> Int
fromEnum :: Register -> Int
$cenumFrom :: Register -> [Register]
enumFrom :: Register -> [Register]
$cenumFromThen :: Register -> Register -> [Register]
enumFromThen :: Register -> Register -> [Register]
$cenumFromTo :: Register -> Register -> [Register]
enumFromTo :: Register -> Register -> [Register]
$cenumFromThenTo :: Register -> Register -> Register -> [Register]
enumFromThenTo :: Register -> Register -> Register -> [Register]
Enum, Register -> Register -> Bool
(Register -> Register -> Bool)
-> (Register -> Register -> Bool) -> Eq Register
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Register -> Register -> Bool
== :: Register -> Register -> Bool
$c/= :: Register -> Register -> Bool
/= :: Register -> Register -> Bool
Eq, (forall x. Register -> Rep Register x)
-> (forall x. Rep Register x -> Register) -> Generic Register
forall x. Rep Register x -> Register
forall x. Register -> Rep Register x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Register -> Rep Register x
from :: forall x. Register -> Rep Register x
$cto :: forall x. Rep Register x -> Register
to :: forall x. Rep Register x -> Register
Generic, ReadPrec [Register]
ReadPrec Register
Int -> ReadS Register
ReadS [Register]
(Int -> ReadS Register)
-> ReadS [Register]
-> ReadPrec Register
-> ReadPrec [Register]
-> Read Register
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Register
readsPrec :: Int -> ReadS Register
$creadList :: ReadS [Register]
readList :: ReadS [Register]
$creadPrec :: ReadPrec Register
readPrec :: ReadPrec Register
$creadListPrec :: ReadPrec [Register]
readListPrec :: ReadPrec [Register]
Read, Int -> Register -> String -> String
[Register] -> String -> String
Register -> String
(Int -> Register -> String -> String)
-> (Register -> String)
-> ([Register] -> String -> String)
-> Show Register
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Register -> String -> String
showsPrec :: Int -> Register -> String -> String
$cshow :: Register -> String
show :: Register -> String
$cshowList :: [Register] -> String -> String
showList :: [Register] -> String -> String
Show)

allRegisters :: [Register]
allRegisters =
    [ Register
Zero
    , Register
Ra
    , Register
Sp
    , Register
Gp
    , Register
Tp
    , Register
T0
    , Register
T1
    , Register
T2
    , Register
S0Fp
    , Register
S1
    , Register
A0
    , Register
A1
    , Register
A2
    , Register
A3
    , Register
A4
    , Register
A5
    , Register
A6
    , Register
A7
    , Register
S2
    , Register
S3
    , Register
S4
    , Register
S5
    , Register
S6
    , Register
S7
    , Register
S8
    , Register
S9
    , Register
S10
    , Register
S11
    , Register
T3
    , Register
T4
    , Register
T5
    , Register
T6
    ]

instance Hashable Register where
    hashWithSalt :: Int -> Register -> Int
hashWithSalt Int
salt = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Int -> Int) -> (Register -> Int) -> Register -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Register -> Int
forall a. Enum a => a -> Int
fromEnum

instance (Default w) => Default (HashMap Register w) where
    def :: HashMap Register w
def = [Item (HashMap Register w)] -> HashMap Register w
forall l. IsList l => [Item l] -> l
fromList ([Item (HashMap Register w)] -> HashMap Register w)
-> [Item (HashMap Register w)] -> HashMap Register w
forall a b. (a -> b) -> a -> b
$ (Register -> (Register, w)) -> [Register] -> [(Register, w)]
forall a b. (a -> b) -> [a] -> [b]
map (,w
forall a. Default a => a
def) [Register]
allRegisters

-- * Slot Operations

data MemoryOp w l
    = Lw {forall w l. MemoryOp w l -> Register
lwRd :: Register, forall w l. MemoryOp w l -> MemRef w
lwOffsetRs1 :: MemRef w}
    | Lb {forall w l. MemoryOp w l -> Register
lbRd :: Register, forall w l. MemoryOp w l -> MemRef w
lbOffsetRs1 :: MemRef w}
    | Sw {forall w l. MemoryOp w l -> Register
swRs2 :: Register, forall w l. MemoryOp w l -> MemRef w
swOffsetRs1 :: MemRef w}
    | Sb {forall w l. MemoryOp w l -> Register
sbRs2 :: Register, forall w l. MemoryOp w l -> MemRef w
sbOffsetRs1 :: MemRef w}
    | NopM
    deriving (Int -> MemoryOp w l -> String -> String
[MemoryOp w l] -> String -> String
MemoryOp w l -> String
(Int -> MemoryOp w l -> String -> String)
-> (MemoryOp w l -> String)
-> ([MemoryOp w l] -> String -> String)
-> Show (MemoryOp w l)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall w l. Show w => Int -> MemoryOp w l -> String -> String
forall w l. Show w => [MemoryOp w l] -> String -> String
forall w l. Show w => MemoryOp w l -> String
$cshowsPrec :: forall w l. Show w => Int -> MemoryOp w l -> String -> String
showsPrec :: Int -> MemoryOp w l -> String -> String
$cshow :: forall w l. Show w => MemoryOp w l -> String
show :: MemoryOp w l -> String
$cshowList :: forall w l. Show w => [MemoryOp w l] -> String -> String
showList :: [MemoryOp w l] -> String -> String
Show)

data AluOp w l
    = Addi {forall w l. AluOp w l -> Register
addiRd, forall w l. AluOp w l -> Register
addiRs1 :: Register, forall w l. AluOp w l -> l
addiK :: l}
    | Add {forall w l. AluOp w l -> Register
addRd, forall w l. AluOp w l -> Register
addRs1, forall w l. AluOp w l -> Register
addRs2 :: Register}
    | Sub {forall w l. AluOp w l -> Register
subRd, forall w l. AluOp w l -> Register
subRs1, forall w l. AluOp w l -> Register
subRs2 :: Register}
    | Mul {forall w l. AluOp w l -> Register
mulRd, forall w l. AluOp w l -> Register
mulRs1, forall w l. AluOp w l -> Register
mulRs2 :: Register}
    | Mulh {forall w l. AluOp w l -> Register
mulhRd, forall w l. AluOp w l -> Register
mulhRs1, forall w l. AluOp w l -> Register
mulhRs2 :: Register}
    | Div {forall w l. AluOp w l -> Register
divRd, forall w l. AluOp w l -> Register
divRs1, forall w l. AluOp w l -> Register
divRs2 :: Register}
    | Rem {forall w l. AluOp w l -> Register
remRd, forall w l. AluOp w l -> Register
remRs1, forall w l. AluOp w l -> Register
remRs2 :: Register}
    | Sll {forall w l. AluOp w l -> Register
sllRd, forall w l. AluOp w l -> Register
sllRs1, forall w l. AluOp w l -> Register
sllRs2 :: Register}
    | Srl {forall w l. AluOp w l -> Register
srlRd, forall w l. AluOp w l -> Register
srlRs1, forall w l. AluOp w l -> Register
srlRs2 :: Register}
    | Sra {forall w l. AluOp w l -> Register
sraRd, forall w l. AluOp w l -> Register
sraRs1, forall w l. AluOp w l -> Register
sraRs2 :: Register}
    | And {forall w l. AluOp w l -> Register
andRd, forall w l. AluOp w l -> Register
andRs1, forall w l. AluOp w l -> Register
andRs2 :: Register}
    | Or {forall w l. AluOp w l -> Register
orRd, forall w l. AluOp w l -> Register
orRs1, forall w l. AluOp w l -> Register
orRs2 :: Register}
    | Xor {forall w l. AluOp w l -> Register
xorRd, forall w l. AluOp w l -> Register
xorRs1, forall w l. AluOp w l -> Register
xorRs2 :: Register}
    | Slti {forall w l. AluOp w l -> Register
sltiRd, forall w l. AluOp w l -> Register
sltiRs1 :: Register, forall w l. AluOp w l -> l
sltiK :: l}
    | Lui {forall w l. AluOp w l -> Register
luiRd :: Register, forall w l. AluOp w l -> l
luiK :: l}
    | Mv {forall w l. AluOp w l -> Register
mvRd, forall w l. AluOp w l -> Register
mvRs :: Register}
    | NopA
    deriving (Int -> AluOp w l -> String -> String
[AluOp w l] -> String -> String
AluOp w l -> String
(Int -> AluOp w l -> String -> String)
-> (AluOp w l -> String)
-> ([AluOp w l] -> String -> String)
-> Show (AluOp w l)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall w l. Show l => Int -> AluOp w l -> String -> String
forall w l. Show l => [AluOp w l] -> String -> String
forall w l. Show l => AluOp w l -> String
$cshowsPrec :: forall w l. Show l => Int -> AluOp w l -> String -> String
showsPrec :: Int -> AluOp w l -> String -> String
$cshow :: forall w l. Show l => AluOp w l -> String
show :: AluOp w l -> String
$cshowList :: forall w l. Show l => [AluOp w l] -> String -> String
showList :: [AluOp w l] -> String -> String
Show)

data ControlOp w l
    = J {forall w l. ControlOp w l -> l
jK :: l}
    | Jal {forall w l. ControlOp w l -> Register
jalRd :: Register, forall w l. ControlOp w l -> l
jalK :: l}
    | Jalr {forall w l. ControlOp w l -> Register
jalrRd, forall w l. ControlOp w l -> Register
jalrRs1 :: Register, forall w l. ControlOp w l -> l
jalrK :: l}
    | Beqz {forall w l. ControlOp w l -> Register
beqzRs1 :: Register, forall w l. ControlOp w l -> l
beqzK :: l}
    | Bnez {forall w l. ControlOp w l -> Register
bnezRs1 :: Register, forall w l. ControlOp w l -> l
bnezK :: l}
    | Blt {forall w l. ControlOp w l -> Register
bltRs1, forall w l. ControlOp w l -> Register
bltRs2 :: Register, forall w l. ControlOp w l -> l
bltK :: l}
    | Bge {forall w l. ControlOp w l -> Register
bgeRs1, forall w l. ControlOp w l -> Register
bgeRs2 :: Register, forall w l. ControlOp w l -> l
bgeK :: l}
    | Bltu {forall w l. ControlOp w l -> Register
bltuRs1, forall w l. ControlOp w l -> Register
bltuRs2 :: Register, forall w l. ControlOp w l -> l
bltuK :: l}
    | Bgeu {forall w l. ControlOp w l -> Register
bgeuRs1, forall w l. ControlOp w l -> Register
bgeuRs2 :: Register, forall w l. ControlOp w l -> l
bgeuK :: l}
    | Beq {forall w l. ControlOp w l -> Register
beqRs1, forall w l. ControlOp w l -> Register
beqRs2 :: Register, forall w l. ControlOp w l -> l
beqK :: l}
    | Bne {forall w l. ControlOp w l -> Register
bneRs1, forall w l. ControlOp w l -> Register
bneRs2 :: Register, forall w l. ControlOp w l -> l
bneK :: l}
    | Halt
    | NopC
    deriving (Int -> ControlOp w l -> String -> String
[ControlOp w l] -> String -> String
ControlOp w l -> String
(Int -> ControlOp w l -> String -> String)
-> (ControlOp w l -> String)
-> ([ControlOp w l] -> String -> String)
-> Show (ControlOp w l)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall w l. Show l => Int -> ControlOp w l -> String -> String
forall w l. Show l => [ControlOp w l] -> String -> String
forall w l. Show l => ControlOp w l -> String
$cshowsPrec :: forall w l. Show l => Int -> ControlOp w l -> String -> String
showsPrec :: Int -> ControlOp w l -> String -> String
$cshow :: forall w l. Show l => ControlOp w l -> String
show :: ControlOp w l -> String
$cshowList :: forall w l. Show l => [ControlOp w l] -> String -> String
showList :: [ControlOp w l] -> String -> String
Show)

-- * ISA Bundle

data VliwIvIsa w l = VliwIvIsa
    { forall w l. VliwIvIsa w l -> MemoryOp w l
memOp :: MemoryOp w l
    , forall w l. VliwIvIsa w l -> AluOp w l
alu1Op :: AluOp w l
    , forall w l. VliwIvIsa w l -> AluOp w l
alu2Op :: AluOp w l
    , forall w l. VliwIvIsa w l -> ControlOp w l
ctrlOp :: ControlOp w l
    }
    deriving (Int -> VliwIvIsa w l -> String -> String
[VliwIvIsa w l] -> String -> String
VliwIvIsa w l -> String
(Int -> VliwIvIsa w l -> String -> String)
-> (VliwIvIsa w l -> String)
-> ([VliwIvIsa w l] -> String -> String)
-> Show (VliwIvIsa w l)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall w l.
(Show w, Show l) =>
Int -> VliwIvIsa w l -> String -> String
forall w l. (Show w, Show l) => [VliwIvIsa w l] -> String -> String
forall w l. (Show w, Show l) => VliwIvIsa w l -> String
$cshowsPrec :: forall w l.
(Show w, Show l) =>
Int -> VliwIvIsa w l -> String -> String
showsPrec :: Int -> VliwIvIsa w l -> String -> String
$cshow :: forall w l. (Show w, Show l) => VliwIvIsa w l -> String
show :: VliwIvIsa w l -> String
$cshowList :: forall w l. (Show w, Show l) => [VliwIvIsa w l] -> String -> String
showList :: [VliwIvIsa w l] -> String -> String
Show)

-- * Load-level accumulator

-- | Per-run histogram of how many slots were active in each executed bundle.
--   @vlByLoad@ maps active-slot count (0..4) to the number of bundles with
--   that load. Used by the @vliw:*@ report variables to summarise how well
--   the program exploits the four-wide pipeline.
newtype VliwLoadAcc = VliwLoadAcc {VliwLoadAcc -> IntMap Int
vlByLoad :: IntMap Int}
    deriving (VliwLoadAcc -> VliwLoadAcc -> Bool
(VliwLoadAcc -> VliwLoadAcc -> Bool)
-> (VliwLoadAcc -> VliwLoadAcc -> Bool) -> Eq VliwLoadAcc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VliwLoadAcc -> VliwLoadAcc -> Bool
== :: VliwLoadAcc -> VliwLoadAcc -> Bool
$c/= :: VliwLoadAcc -> VliwLoadAcc -> Bool
/= :: VliwLoadAcc -> VliwLoadAcc -> Bool
Eq, Int -> VliwLoadAcc -> String -> String
[VliwLoadAcc] -> String -> String
VliwLoadAcc -> String
(Int -> VliwLoadAcc -> String -> String)
-> (VliwLoadAcc -> String)
-> ([VliwLoadAcc] -> String -> String)
-> Show VliwLoadAcc
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> VliwLoadAcc -> String -> String
showsPrec :: Int -> VliwLoadAcc -> String -> String
$cshow :: VliwLoadAcc -> String
show :: VliwLoadAcc -> String
$cshowList :: [VliwLoadAcc] -> String -> String
showList :: [VliwLoadAcc] -> String -> String
Show)

emptyVliwLoad :: VliwLoadAcc
emptyVliwLoad :: VliwLoadAcc
emptyVliwLoad = IntMap Int -> VliwLoadAcc
VliwLoadAcc IntMap Int
forall a. Monoid a => a
mempty

isMemActive :: MemoryOp w l -> Bool
isMemActive :: forall w l. MemoryOp w l -> Bool
isMemActive MemoryOp w l
NopM = Bool
False
isMemActive MemoryOp w l
_ = Bool
True

isAluActive :: AluOp w l -> Bool
isAluActive :: forall w l. AluOp w l -> Bool
isAluActive AluOp w l
NopA = Bool
False
isAluActive AluOp w l
_ = Bool
True

isCtrlActive :: ControlOp w l -> Bool
isCtrlActive :: forall w l. ControlOp w l -> Bool
isCtrlActive ControlOp w l
NopC = Bool
False
isCtrlActive ControlOp w l
_ = Bool
True

bundleActiveCount :: VliwIvIsa w l -> Int
bundleActiveCount :: forall w l. VliwIvIsa w l -> Int
bundleActiveCount VliwIvIsa{MemoryOp w l
memOp :: forall w l. VliwIvIsa w l -> MemoryOp w l
memOp :: MemoryOp w l
memOp, AluOp w l
alu1Op :: forall w l. VliwIvIsa w l -> AluOp w l
alu1Op :: AluOp w l
alu1Op, AluOp w l
alu2Op :: forall w l. VliwIvIsa w l -> AluOp w l
alu2Op :: AluOp w l
alu2Op, ControlOp w l
ctrlOp :: forall w l. VliwIvIsa w l -> ControlOp w l
ctrlOp :: ControlOp w l
ctrlOp} =
    Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 Int
1 (MemoryOp w l -> Bool
forall w l. MemoryOp w l -> Bool
isMemActive MemoryOp w l
memOp)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 Int
1 (AluOp w l -> Bool
forall w l. AluOp w l -> Bool
isAluActive AluOp w l
alu1Op)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 Int
1 (AluOp w l -> Bool
forall w l. AluOp w l -> Bool
isAluActive AluOp w l
alu2Op)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 Int
1 (ControlOp w l -> Bool
forall w l. ControlOp w l -> Bool
isCtrlActive ControlOp w l
ctrlOp)

recordBundle :: VliwIvIsa w l -> VliwLoadAcc -> VliwLoadAcc
recordBundle :: forall w l. VliwIvIsa w l -> VliwLoadAcc -> VliwLoadAcc
recordBundle VliwIvIsa w l
isa (VliwLoadAcc IntMap Int
m) =
    IntMap Int -> VliwLoadAcc
VliwLoadAcc (IntMap Int -> VliwLoadAcc) -> IntMap Int -> VliwLoadAcc
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> Int -> IntMap Int -> IntMap Int
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (VliwIvIsa w l -> Int
forall w l. VliwIvIsa w l -> Int
bundleActiveCount VliwIvIsa w l
isa) Int
1 IntMap Int
m

vliwLoadPercent :: VliwLoadAcc -> Int
vliwLoadPercent :: VliwLoadAcc -> Int
vliwLoadPercent (VliwLoadAcc IntMap Int
m) =
    let total :: Int
total = IntMap Int -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum IntMap Int
m
        active :: Int
active = [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum [Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n | (Int
k, Int
n) <- IntMap Int -> [(Int, Int)]
forall t a b. (IsList t, Item t ~ (a, b)) => t -> [(a, b)]
toPairs IntMap Int
m]
     in if Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else (Int
active Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)

-- | Average number of active slots (processing units) used per executed
--   bundle, rendered with two decimal places. An empty histogram renders as
--   @"0.00"@.
vliwAvgLoad :: VliwLoadAcc -> Text
vliwAvgLoad :: VliwLoadAcc -> Text
vliwAvgLoad (VliwLoadAcc IntMap Int
m) =
    let total :: Int
total = IntMap Int -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum IntMap Int
m
        active :: Int
active = [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum [Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n | (Int
k, Int
n) <- IntMap Int -> [(Int, Int)]
forall t a b. (IsList t, Item t ~ (a, b)) => t -> [(a, b)]
toPairs IntMap Int
m]
     in if Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then Text
"0.00"
            else
                let scaled :: Int
scaled = (Int
active Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
total
                    whole :: Int
whole = Int
scaled Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100
                    frac :: Int
frac = Int
scaled Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100
                 in Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
whole Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Int
frac Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 then Text
"0" else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
frac

-- | Render the per-load histogram as @"K:N (P%)"@ pairs separated by commas,
--   one per non-empty bucket. @K@ is the active-slot count, @N@ is the
--   number of bundles in that bucket, @P@ is its percent share of executed
--   bundles. Empty buckets are omitted; an empty histogram renders as @"-"@.
renderBundlesByLoad :: VliwLoadAcc -> Text
renderBundlesByLoad :: VliwLoadAcc -> Text
renderBundlesByLoad (VliwLoadAcc IntMap Int
m) =
    let nonZero :: [(Int, Int)]
nonZero = [(Int
k, Int
Val (IntMap Int)
n) | Int
k <- [Int
0 .. Int
4 :: Int], let n :: Val (IntMap Int)
n = Val (IntMap Int)
-> Key (IntMap Int) -> IntMap Int -> Val (IntMap Int)
forall t. StaticMap t => Val t -> Key t -> t -> Val t
lookupDefault Int
Val (IntMap Int)
0 Int
Key (IntMap Int)
k IntMap Int
m, Int
Val (IntMap Int)
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
        total :: Int
total = [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
nonZero)
        pct :: Int -> Int
pct Int
n = if Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
total
        fmt :: (Int, Int) -> Text
fmt (Int
k, Int
n) =
            (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
k :: Text) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Int -> Int
pct Int
n) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%)"
     in if [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nonZero then Text
"-" else Text -> [Text] -> Text
T.intercalate Text
", " (((Int, Int) -> Text) -> [(Int, Int)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Text
fmt [(Int, Int)]
nonZero)

-- * Parser Helpers

-- | Assembly names of the registers, in parser order (@s10@ before @s1@).
registerNames :: [(Text, Register)]
registerNames :: [(Text, Register)]
registerNames =
    [ (Text
"zero", Register
Zero)
    , (Text
"a0", Register
A0)
    , (Text
"a1", Register
A1)
    , (Text
"a2", Register
A2)
    , (Text
"a3", Register
A3)
    , (Text
"a4", Register
A4)
    , (Text
"a5", Register
A5)
    , (Text
"a6", Register
A6)
    , (Text
"a7", Register
A7)
    , (Text
"s2", Register
S2)
    , (Text
"s3", Register
S3)
    , (Text
"ra", Register
Ra)
    , (Text
"s4", Register
S4)
    , (Text
"s5", Register
S5)
    , (Text
"s6", Register
S6)
    , (Text
"s7", Register
S7)
    , (Text
"s8", Register
S8)
    , (Text
"s9", Register
S9)
    , (Text
"s10", Register
S10)
    , (Text
"s11", Register
S11)
    , (Text
"t3", Register
T3)
    , (Text
"t4", Register
T4)
    , (Text
"sp", Register
Sp)
    , (Text
"t5", Register
T5)
    , (Text
"t6", Register
T6)
    , (Text
"gp", Register
Gp)
    , (Text
"tp", Register
Tp)
    , (Text
"t0", Register
T0)
    , (Text
"t1", Register
T1)
    , (Text
"t2", Register
T2)
    , (Text
"s0fp", Register
S0Fp)
    , (Text
"s1", Register
S1)
    ]

register :: Parser Register
register :: Parser Register
register = [Parser Register] -> Parser Register
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text -> String
forall a. ToString a => a -> String
toString Text
name) ParsecT Void String Identity (Tokens String)
-> Parser Register -> Parser Register
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Register -> Parser Register
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Register
r | (Text
name, Register
r) <- [(Text, Register)]
registerNames]

data MemRef w = MemRef {forall w. MemRef w -> w
mrOffset :: w, forall w. MemRef w -> Register
mrReg :: Register} deriving (Int -> MemRef w -> String -> String
[MemRef w] -> String -> String
MemRef w -> String
(Int -> MemRef w -> String -> String)
-> (MemRef w -> String)
-> ([MemRef w] -> String -> String)
-> Show (MemRef w)
forall w. Show w => Int -> MemRef w -> String -> String
forall w. Show w => [MemRef w] -> String -> String
forall w. Show w => MemRef w -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall w. Show w => Int -> MemRef w -> String -> String
showsPrec :: Int -> MemRef w -> String -> String
$cshow :: forall w. Show w => MemRef w -> String
show :: MemRef w -> String
$cshowList :: forall w. Show w => [MemRef w] -> String -> String
showList :: [MemRef w] -> String -> String
Show)

-- | Check the offset against the field it is encoded into while parsing, so the
-- caret lands under the operand. The memory slot takes a bare number rather
-- than a label, so there is nothing to resolve first.
requireSignedField :: (IsWord w) => Int -> Int -> w -> Parser w
requireSignedField :: forall w. IsWord w => Int -> Int -> w -> Parser w
requireSignedField Int
fieldBits Int
operandPos w
value
    | w
value w -> w -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> w -> w
forall w. IsWord w => Int -> w -> w
fitSigned Int
fieldBits w
value = w -> ParsecT Void String Identity w
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return w
value
    | Bool
otherwise = do
        Int -> ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
operandPos
        String -> ParsecT Void String Identity w
forall a. String -> ParsecT Void String Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Void String Identity w)
-> String -> ParsecT Void String Identity w
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ String
"offset "
                , w -> String
forall b a. (Show a, IsString b) => a -> b
show w
value
                , String
" doesn't fit the "
                , Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
fieldBits
                , String
"-bit signed field of a 14 byte bundle, expected "
                , Integer -> String
forall b a. (Show a, IsString b) => a -> b
show Integer
lo
                , String
".."
                , Integer -> String
forall b a. (Show a, IsString b) => a -> b
show Integer
hi
                ]
    where
        hi :: Integer
hi = Int -> Integer
forall a. Bits a => Int -> a
bit (Int
fieldBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 :: Integer
        lo :: Integer
lo = Integer -> Integer
forall a. Num a => a -> a
negate (Int -> Integer
forall a. Bits a => Int -> a
bit (Int
fieldBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) :: Integer

memRef :: (IsWord w) => Parser (MemRef w)
memRef :: forall w. IsWord w => Parser (MemRef w)
memRef = [ParsecT Void String Identity (MemRef w)]
-> ParsecT Void String Identity (MemRef w)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT Void String Identity (MemRef w)
regWithOffset, Parser Register
register Parser Register
-> (Register -> MemRef w)
-> ParsecT Void String Identity (MemRef w)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> w -> Register -> MemRef w
forall w. w -> Register -> MemRef w
MemRef w
0]
    where
        memRefOffsetBits :: Int
memRefOffsetBits = Int
11
        regWithOffset :: ParsecT Void String Identity (MemRef w)
regWithOffset = do
            operandPos <- ParsecT Void String Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
            offset <- wordLiteral
            void $ char '('
            mrReg <- register
            void $ char ')'
            mrOffset <- requireSignedField memRefOffsetBits operandPos offset
            return MemRef{mrOffset, mrReg}

instance CommentStart (VliwIvIsa _a _b) where
    commentStart :: String
commentStart = String
";"

parseMemOp :: (IsWord w) => Parser (MemoryOp w (Ref w))
parseMemOp :: forall w. IsWord w => Parser (MemoryOp w (Ref w))
parseMemOp =
    [ParsecT Void String Identity (MemoryOp w (Ref w))]
-> ParsecT Void String Identity (MemoryOp w (Ref w))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ String
-> (Register -> MemRef w -> MemoryOp w (Ref w))
-> Parser Register
-> ParsecT Void String Identity (MemRef w)
-> ParsecT Void String Identity (MemoryOp w (Ref w))
forall {a} {a} {b}.
String
-> (a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd2args String
"lw" Register -> MemRef w -> MemoryOp w (Ref w)
forall w l. Register -> MemRef w -> MemoryOp w l
Lw Parser Register
register ParsecT Void String Identity (MemRef w)
forall w. IsWord w => Parser (MemRef w)
memRef
        , String
-> (Register -> MemRef w -> MemoryOp w (Ref w))
-> Parser Register
-> ParsecT Void String Identity (MemRef w)
-> ParsecT Void String Identity (MemoryOp w (Ref w))
forall {a} {a} {b}.
String
-> (a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd2args String
"lb" Register -> MemRef w -> MemoryOp w (Ref w)
forall w l. Register -> MemRef w -> MemoryOp w l
Lb Parser Register
register ParsecT Void String Identity (MemRef w)
forall w. IsWord w => Parser (MemRef w)
memRef
        , String
-> (Register -> MemRef w -> MemoryOp w (Ref w))
-> Parser Register
-> ParsecT Void String Identity (MemRef w)
-> ParsecT Void String Identity (MemoryOp w (Ref w))
forall {a} {a} {b}.
String
-> (a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd2args String
"sw" Register -> MemRef w -> MemoryOp w (Ref w)
forall w l. Register -> MemRef w -> MemoryOp w l
Sw Parser Register
register ParsecT Void String Identity (MemRef w)
forall w. IsWord w => Parser (MemRef w)
memRef
        , String
-> (Register -> MemRef w -> MemoryOp w (Ref w))
-> Parser Register
-> ParsecT Void String Identity (MemRef w)
-> ParsecT Void String Identity (MemoryOp w (Ref w))
forall {a} {a} {b}.
String
-> (a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd2args String
"sb" Register -> MemRef w -> MemoryOp w (Ref w)
forall w l. Register -> MemRef w -> MemoryOp w l
Sb Parser Register
register ParsecT Void String Identity (MemRef w)
forall w. IsWord w => Parser (MemRef w)
memRef
        , Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"nop" ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity (MemoryOp w (Ref w))
-> ParsecT Void String Identity (MemoryOp w (Ref w))
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MemoryOp w (Ref w)
-> ParsecT Void String Identity (MemoryOp w (Ref w))
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return MemoryOp w (Ref w)
forall w l. MemoryOp w l
NopM
        , MemoryOp w (Ref w)
-> ParsecT Void String Identity (MemoryOp w (Ref w))
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemoryOp w (Ref w)
forall w l. MemoryOp w l
NopM
        ]

parseAluOp :: (IsWord w) => Parser (AluOp w (Ref w))
parseAluOp :: forall w. IsWord w => Parser (AluOp w (Ref w))
parseAluOp =
    [ParsecT Void String Identity (AluOp w (Ref w))]
-> ParsecT Void String Identity (AluOp w (Ref w))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ String
-> (Register -> Register -> Ref w -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"addi" Register -> Register -> Ref w -> AluOp w (Ref w)
forall w l. Register -> Register -> l -> AluOp w l
Addi Parser Register
register Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
referenceWithDirective
        , String
-> (Register -> Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"add" Register -> Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> Register -> AluOp w l
Add Parser Register
register Parser Register
register Parser Register
register
        , String
-> (Register -> Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"sub" Register -> Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> Register -> AluOp w l
Sub Parser Register
register Parser Register
register Parser Register
register
        , String
-> (Register -> Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"mul" Register -> Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> Register -> AluOp w l
Mul Parser Register
register Parser Register
register Parser Register
register
        , String
-> (Register -> Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"mulh" Register -> Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> Register -> AluOp w l
Mulh Parser Register
register Parser Register
register Parser Register
register
        , String
-> (Register -> Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"div" Register -> Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> Register -> AluOp w l
Div Parser Register
register Parser Register
register Parser Register
register
        , String
-> (Register -> Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"rem" Register -> Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> Register -> AluOp w l
Rem Parser Register
register Parser Register
register Parser Register
register
        , String
-> (Register -> Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"sll" Register -> Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> Register -> AluOp w l
Sll Parser Register
register Parser Register
register Parser Register
register
        , String
-> (Register -> Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"srl" Register -> Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> Register -> AluOp w l
Srl Parser Register
register Parser Register
register Parser Register
register
        , String
-> (Register -> Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"sra" Register -> Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> Register -> AluOp w l
Sra Parser Register
register Parser Register
register Parser Register
register
        , String
-> (Register -> Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"and" Register -> Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> Register -> AluOp w l
And Parser Register
register Parser Register
register Parser Register
register
        , String
-> (Register -> Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"or" Register -> Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> Register -> AluOp w l
Or Parser Register
register Parser Register
register Parser Register
register
        , String
-> (Register -> Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"xor" Register -> Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> Register -> AluOp w l
Xor Parser Register
register Parser Register
register Parser Register
register
        , String
-> (Register -> Register -> Ref w -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"slti" Register -> Register -> Ref w -> AluOp w (Ref w)
forall w l. Register -> Register -> l -> AluOp w l
Slti Parser Register
register Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
referenceWithDirective
        , String
-> (Register -> Ref w -> AluOp w (Ref w))
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {b}.
String
-> (a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd2args String
"lui" Register -> Ref w -> AluOp w (Ref w)
forall w l. Register -> l -> AluOp w l
Lui Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
referenceWithDirective
        , String
-> (Register -> Register -> AluOp w (Ref w))
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (AluOp w (Ref w))
forall {a} {a} {b}.
String
-> (a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd2args String
"mv" Register -> Register -> AluOp w (Ref w)
forall w l. Register -> Register -> AluOp w l
Mv Parser Register
register Parser Register
register
        , Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"nop" ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity (AluOp w (Ref w))
-> ParsecT Void String Identity (AluOp w (Ref w))
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AluOp w (Ref w) -> ParsecT Void String Identity (AluOp w (Ref w))
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AluOp w (Ref w)
forall w l. AluOp w l
NopA
        , AluOp w (Ref w) -> ParsecT Void String Identity (AluOp w (Ref w))
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AluOp w (Ref w)
forall w l. AluOp w l
NopA
        ]

parseCtrlOp :: (IsWord w) => Parser (ControlOp w (Ref w))
parseCtrlOp :: forall w. IsWord w => Parser (ControlOp w (Ref w))
parseCtrlOp =
    [ParsecT Void String Identity (ControlOp w (Ref w))]
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Tokens String
-> (Ref w -> ControlOp w (Ref w))
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall {s} {f :: * -> *} {e} {a} {b}.
(Token s ~ Char, MonadParsec e s f, Semigroup (Tokens s),
 IsString (Tokens s)) =>
Tokens s -> (a -> b) -> f a -> f b
cmd1args Tokens String
"j" Ref w -> ControlOp w (Ref w)
forall w l. l -> ControlOp w l
J ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
        , String
-> (Register -> Ref w -> ControlOp w (Ref w))
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall {a} {a} {b}.
String
-> (a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd2args String
"jal" Register -> Ref w -> ControlOp w (Ref w)
forall w l. Register -> l -> ControlOp w l
Jal Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
        , String
-> (Register -> Register -> Ref w -> ControlOp w (Ref w))
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"jalr" Register -> Register -> Ref w -> ControlOp w (Ref w)
forall w l. Register -> Register -> l -> ControlOp w l
Jalr Parser Register
register Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
referenceWithDirective
        , String
-> (Register -> Ref w -> ControlOp w (Ref w))
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall {a} {a} {b}.
String
-> (a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd2args String
"beqz" Register -> Ref w -> ControlOp w (Ref w)
forall w l. Register -> l -> ControlOp w l
Beqz Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
        , String
-> (Register -> Ref w -> ControlOp w (Ref w))
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall {a} {a} {b}.
String
-> (a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd2args String
"bnez" Register -> Ref w -> ControlOp w (Ref w)
forall w l. Register -> l -> ControlOp w l
Bnez Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
        , String
-> (Register -> Register -> Ref w -> ControlOp w (Ref w))
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"blt" Register -> Register -> Ref w -> ControlOp w (Ref w)
forall w l. Register -> Register -> l -> ControlOp w l
Blt Parser Register
register Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
        , String
-> (Register -> Register -> Ref w -> ControlOp w (Ref w))
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"bge" Register -> Register -> Ref w -> ControlOp w (Ref w)
forall w l. Register -> Register -> l -> ControlOp w l
Bge Parser Register
register Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
        , String
-> (Register -> Register -> Ref w -> ControlOp w (Ref w))
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"bltu" Register -> Register -> Ref w -> ControlOp w (Ref w)
forall w l. Register -> Register -> l -> ControlOp w l
Bltu Parser Register
register Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
        , String
-> (Register -> Register -> Ref w -> ControlOp w (Ref w))
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"bgeu" Register -> Register -> Ref w -> ControlOp w (Ref w)
forall w l. Register -> Register -> l -> ControlOp w l
Bgeu Parser Register
register Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
        , String
-> (Register -> Register -> Ref w -> ControlOp w (Ref w))
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"beq" Register -> Register -> Ref w -> ControlOp w (Ref w)
forall w l. Register -> Register -> l -> ControlOp w l
Beq Parser Register
register Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
        , String
-> (Register -> Register -> Ref w -> ControlOp w (Ref w))
-> Parser Register
-> Parser Register
-> ParsecT Void String Identity (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall {a} {a} {a} {b}.
String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args String
"bne" Register -> Register -> Ref w -> ControlOp w (Ref w)
forall w l. Register -> Register -> l -> ControlOp w l
Bne Parser Register
register Parser Register
register ParsecT Void String Identity (Ref w)
forall w. IsWord w => Parser (Ref w)
reference
        , Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"halt" ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity (ControlOp w (Ref w))
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ControlOp w (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ControlOp w (Ref w)
forall w l. ControlOp w l
Halt
        , Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"nop" ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity (ControlOp w (Ref w))
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ControlOp w (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall a. a -> ParsecT Void String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ControlOp w (Ref w)
forall w l. ControlOp w l
NopC
        , ControlOp w (Ref w)
-> ParsecT Void String Identity (ControlOp w (Ref w))
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlOp w (Ref w)
forall w l. ControlOp w l
NopC
        ]

instance (IsWord w) => MnemonicParser (VliwIvIsa w (Ref w)) where
    mnemonic :: Parser (VliwIvIsa w (Ref w))
mnemonic = do
        ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
        alu1Op <- Parser (AluOp w (Ref w))
forall w. IsWord w => Parser (AluOp w (Ref w))
parseAluOp
        hspace >> string "/" >> hspace
        alu2Op <- parseAluOp
        hspace >> string "/" >> hspace
        memOp <- parseMemOp
        hspace >> string "/" >> hspace
        ctrlOp <- parseCtrlOp
        eol' (commentStart @(VliwIvIsa _ _))
        return VliwIvIsa{memOp, alu1Op, alu2Op, ctrlOp}

aluImmErr :: Text -> Text -> Text
aluImmErr :: Text -> Text -> Text
aluImmErr Text
m Text
x = Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": ALU imm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not in -65536..65535"

instance DerefMnemonic (MemoryOp w) w where
    derefMnemonic :: (Text -> Maybe w) -> w -> MemoryOp w (Ref w) -> MemoryOp w w
derefMnemonic Text -> Maybe w
_ w
_ MemoryOp w (Ref w)
NopM = MemoryOp w w
forall w l. MemoryOp w l
NopM
    derefMnemonic Text -> Maybe w
_ w
_ (Lw Register
lwRd MemRef w
lwOffsetRs1) = Register -> MemRef w -> MemoryOp w w
forall w l. Register -> MemRef w -> MemoryOp w l
Lw Register
lwRd MemRef w
lwOffsetRs1
    derefMnemonic Text -> Maybe w
_ w
_ (Lb Register
lbRd MemRef w
lbOffsetRs1) = Register -> MemRef w -> MemoryOp w w
forall w l. Register -> MemRef w -> MemoryOp w l
Lb Register
lbRd MemRef w
lbOffsetRs1
    derefMnemonic Text -> Maybe w
_ w
_ (Sw Register
swRs2 MemRef w
swOffsetRs1) = Register -> MemRef w -> MemoryOp w w
forall w l. Register -> MemRef w -> MemoryOp w l
Sw Register
swRs2 MemRef w
swOffsetRs1
    derefMnemonic Text -> Maybe w
_ w
_ (Sb Register
sbRs2 MemRef w
sbOffsetRs1) = Register -> MemRef w -> MemoryOp w w
forall w l. Register -> MemRef w -> MemoryOp w l
Sb Register
sbRs2 MemRef w
sbOffsetRs1

luiImmErr :: Text -> Text -> Text
luiImmErr :: Text -> Text -> Text
luiImmErr Text
m Text
x = Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": U-type imm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not in 0..1048575"

instance (IsWord w) => DerefMnemonic (AluOp w) w where
    derefMnemonic :: (Text -> Maybe w) -> w -> AluOp w (Ref w) -> AluOp w w
derefMnemonic Text -> Maybe w
f w
_ (Addi Register
addiRd Register
addiRs1 Ref w
addiK) = Register -> Register -> w -> AluOp w w
forall w l. Register -> Register -> l -> AluOp w l
Addi Register
addiRd Register
addiRs1 (w -> AluOp w w) -> w -> AluOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i17 (Text -> Text -> Text
aluImmErr Text
"addi")) Text -> Maybe w
f Ref w
addiK
    derefMnemonic Text -> Maybe w
f w
_ (Slti Register
sltiRd Register
sltiRs1 Ref w
sltiK) = Register -> Register -> w -> AluOp w w
forall w l. Register -> Register -> l -> AluOp w l
Slti Register
sltiRd Register
sltiRs1 (w -> AluOp w w) -> w -> AluOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i17 (Text -> Text -> Text
aluImmErr Text
"slti")) Text -> Maybe w
f Ref w
sltiK
    derefMnemonic Text -> Maybe w
f w
_ (Lui Register
luiRd Ref w
luiK) = Register -> w -> AluOp w w
forall w l. Register -> l -> AluOp w l
Lui Register
luiRd (w -> AluOp w w) -> w -> AluOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
u20 (Text -> Text -> Text
luiImmErr Text
"lui")) Text -> Maybe w
f Ref w
luiK
    derefMnemonic Text -> Maybe w
_ w
_ (Add Register
addRd Register
addRs1 Register
addRs2) = Register -> Register -> Register -> AluOp w w
forall w l. Register -> Register -> Register -> AluOp w l
Add Register
addRd Register
addRs1 Register
addRs2
    derefMnemonic Text -> Maybe w
_ w
_ (Sub Register
subRd Register
subRs1 Register
subRs2) = Register -> Register -> Register -> AluOp w w
forall w l. Register -> Register -> Register -> AluOp w l
Sub Register
subRd Register
subRs1 Register
subRs2
    derefMnemonic Text -> Maybe w
_ w
_ (Mul Register
mulRd Register
mulRs1 Register
mulRs2) = Register -> Register -> Register -> AluOp w w
forall w l. Register -> Register -> Register -> AluOp w l
Mul Register
mulRd Register
mulRs1 Register
mulRs2
    derefMnemonic Text -> Maybe w
_ w
_ (Mulh Register
mulhRd Register
mulhRs1 Register
mulhRs2) = Register -> Register -> Register -> AluOp w w
forall w l. Register -> Register -> Register -> AluOp w l
Mulh Register
mulhRd Register
mulhRs1 Register
mulhRs2
    derefMnemonic Text -> Maybe w
_ w
_ (Div Register
divRd Register
divRs1 Register
divRs2) = Register -> Register -> Register -> AluOp w w
forall w l. Register -> Register -> Register -> AluOp w l
Div Register
divRd Register
divRs1 Register
divRs2
    derefMnemonic Text -> Maybe w
_ w
_ (Rem Register
remRd Register
remRs1 Register
remRs2) = Register -> Register -> Register -> AluOp w w
forall w l. Register -> Register -> Register -> AluOp w l
Rem Register
remRd Register
remRs1 Register
remRs2
    derefMnemonic Text -> Maybe w
_ w
_ (Sll Register
sllRd Register
sllRs1 Register
sllRs2) = Register -> Register -> Register -> AluOp w w
forall w l. Register -> Register -> Register -> AluOp w l
Sll Register
sllRd Register
sllRs1 Register
sllRs2
    derefMnemonic Text -> Maybe w
_ w
_ (Srl Register
srlRd Register
srlRs1 Register
srlRs2) = Register -> Register -> Register -> AluOp w w
forall w l. Register -> Register -> Register -> AluOp w l
Srl Register
srlRd Register
srlRs1 Register
srlRs2
    derefMnemonic Text -> Maybe w
_ w
_ (Sra Register
sraRd Register
sraRs1 Register
sraRs2) = Register -> Register -> Register -> AluOp w w
forall w l. Register -> Register -> Register -> AluOp w l
Sra Register
sraRd Register
sraRs1 Register
sraRs2
    derefMnemonic Text -> Maybe w
_ w
_ (And Register
andRd Register
andRs1 Register
andRs2) = Register -> Register -> Register -> AluOp w w
forall w l. Register -> Register -> Register -> AluOp w l
And Register
andRd Register
andRs1 Register
andRs2
    derefMnemonic Text -> Maybe w
_ w
_ (Or Register
orRd Register
orRs1 Register
orRs2) = Register -> Register -> Register -> AluOp w w
forall w l. Register -> Register -> Register -> AluOp w l
Or Register
orRd Register
orRs1 Register
orRs2
    derefMnemonic Text -> Maybe w
_ w
_ (Xor Register
xorRd Register
xorRs1 Register
xorRs2) = Register -> Register -> Register -> AluOp w w
forall w l. Register -> Register -> Register -> AluOp w l
Xor Register
xorRd Register
xorRs1 Register
xorRs2
    derefMnemonic Text -> Maybe w
_ w
_ (Mv Register
mvRd Register
mvRs) = Register -> Register -> AluOp w w
forall w l. Register -> Register -> AluOp w l
Mv Register
mvRd Register
mvRs
    derefMnemonic Text -> Maybe w
_ w
_ AluOp w (Ref w)
NopA = AluOp w w
forall w l. AluOp w l
NopA

branchDispErr, linkDispErr, jumpDispErr, ctrlImmErr :: Text -> Text -> Text
branchDispErr :: Text -> Text -> Text
branchDispErr Text
m Text
x = Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": CTRL disp " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not in -512..511"
ctrlImmErr :: Text -> Text -> Text
ctrlImmErr Text
m Text
x = Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": CTRL imm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not in -512..511"
linkDispErr :: Text -> Text -> Text
linkDispErr Text
m Text
x = Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": CTRL disp " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not in -16384..16383"
jumpDispErr :: Text -> Text -> Text
jumpDispErr Text
m Text
x = Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": CTRL disp " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not in -524288..524287"

instance (IsWord w) => DerefMnemonic (ControlOp w) w where
    derefMnemonic :: (Text -> Maybe w) -> w -> ControlOp w (Ref w) -> ControlOp w w
derefMnemonic Text -> Maybe w
f w
offset (J Ref w
jK) = w -> ControlOp w w
forall w l. l -> ControlOp w l
J (w -> ControlOp w w) -> w -> ControlOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i20 (Text -> Text -> Text
jumpDispErr Text
"j") (w -> Either Text w) -> (w -> w) -> w -> Either Text w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w -> w
forall a. Num a => a -> a -> a
subtract w
offset) Text -> Maybe w
f Ref w
jK
    derefMnemonic Text -> Maybe w
f w
offset (Jal Register
jalRd Ref w
jalK) = Register -> w -> ControlOp w w
forall w l. Register -> l -> ControlOp w l
Jal Register
jalRd (w -> ControlOp w w) -> w -> ControlOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i15 (Text -> Text -> Text
linkDispErr Text
"jal") (w -> Either Text w) -> (w -> w) -> w -> Either Text w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w -> w
forall a. Num a => a -> a -> a
subtract w
offset) Text -> Maybe w
f Ref w
jalK
    derefMnemonic Text -> Maybe w
f w
_ (Jalr Register
jalrRd Register
jalrRs1 Ref w
jalrK) = Register -> Register -> w -> ControlOp w w
forall w l. Register -> Register -> l -> ControlOp w l
Jalr Register
jalrRd Register
jalrRs1 (w -> ControlOp w w) -> w -> ControlOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i10 (Text -> Text -> Text
ctrlImmErr Text
"jalr")) Text -> Maybe w
f Ref w
jalrK
    derefMnemonic Text -> Maybe w
f w
offset (Beqz Register
beqzRs1 Ref w
beqzK) = Register -> w -> ControlOp w w
forall w l. Register -> l -> ControlOp w l
Beqz Register
beqzRs1 (w -> ControlOp w w) -> w -> ControlOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i15 (Text -> Text -> Text
linkDispErr Text
"beqz") (w -> Either Text w) -> (w -> w) -> w -> Either Text w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w -> w
forall a. Num a => a -> a -> a
subtract w
offset) Text -> Maybe w
f Ref w
beqzK
    derefMnemonic Text -> Maybe w
f w
offset (Bnez Register
bnezRs1 Ref w
bnezK) = Register -> w -> ControlOp w w
forall w l. Register -> l -> ControlOp w l
Bnez Register
bnezRs1 (w -> ControlOp w w) -> w -> ControlOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i15 (Text -> Text -> Text
linkDispErr Text
"bnez") (w -> Either Text w) -> (w -> w) -> w -> Either Text w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w -> w
forall a. Num a => a -> a -> a
subtract w
offset) Text -> Maybe w
f Ref w
bnezK
    derefMnemonic Text -> Maybe w
f w
offset (Blt Register
bltRs1 Register
bltRs2 Ref w
bltK) = Register -> Register -> w -> ControlOp w w
forall w l. Register -> Register -> l -> ControlOp w l
Blt Register
bltRs1 Register
bltRs2 (w -> ControlOp w w) -> w -> ControlOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i10 (Text -> Text -> Text
branchDispErr Text
"blt") (w -> Either Text w) -> (w -> w) -> w -> Either Text w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w -> w
forall a. Num a => a -> a -> a
subtract w
offset) Text -> Maybe w
f Ref w
bltK
    derefMnemonic Text -> Maybe w
f w
offset (Bge Register
bgeRs1 Register
bgeRs2 Ref w
bgeK) = Register -> Register -> w -> ControlOp w w
forall w l. Register -> Register -> l -> ControlOp w l
Bge Register
bgeRs1 Register
bgeRs2 (w -> ControlOp w w) -> w -> ControlOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i10 (Text -> Text -> Text
branchDispErr Text
"bge") (w -> Either Text w) -> (w -> w) -> w -> Either Text w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w -> w
forall a. Num a => a -> a -> a
subtract w
offset) Text -> Maybe w
f Ref w
bgeK
    derefMnemonic Text -> Maybe w
f w
offset (Bltu Register
bltuRs1 Register
bltuRs2 Ref w
bltuK) = Register -> Register -> w -> ControlOp w w
forall w l. Register -> Register -> l -> ControlOp w l
Bltu Register
bltuRs1 Register
bltuRs2 (w -> ControlOp w w) -> w -> ControlOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i10 (Text -> Text -> Text
branchDispErr Text
"bltu") (w -> Either Text w) -> (w -> w) -> w -> Either Text w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w -> w
forall a. Num a => a -> a -> a
subtract w
offset) Text -> Maybe w
f Ref w
bltuK
    derefMnemonic Text -> Maybe w
f w
offset (Bgeu Register
bgeuRs1 Register
bgeuRs2 Ref w
bgeuK) = Register -> Register -> w -> ControlOp w w
forall w l. Register -> Register -> l -> ControlOp w l
Bgeu Register
bgeuRs1 Register
bgeuRs2 (w -> ControlOp w w) -> w -> ControlOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i10 (Text -> Text -> Text
branchDispErr Text
"bgeu") (w -> Either Text w) -> (w -> w) -> w -> Either Text w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w -> w
forall a. Num a => a -> a -> a
subtract w
offset) Text -> Maybe w
f Ref w
bgeuK
    derefMnemonic Text -> Maybe w
f w
offset (Beq Register
beqRs1 Register
beqRs2 Ref w
beqK) = Register -> Register -> w -> ControlOp w w
forall w l. Register -> Register -> l -> ControlOp w l
Beq Register
beqRs1 Register
beqRs2 (w -> ControlOp w w) -> w -> ControlOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i10 (Text -> Text -> Text
branchDispErr Text
"beq") (w -> Either Text w) -> (w -> w) -> w -> Either Text w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w -> w
forall a. Num a => a -> a -> a
subtract w
offset) Text -> Maybe w
f Ref w
beqK
    derefMnemonic Text -> Maybe w
f w
offset (Bne Register
bneRs1 Register
bneRs2 Ref w
bneK) = Register -> Register -> w -> ControlOp w w
forall w l. Register -> Register -> l -> ControlOp w l
Bne Register
bneRs1 Register
bneRs2 (w -> ControlOp w w) -> w -> ControlOp w w
forall a b. (a -> b) -> a -> b
$ (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
forall w. (w -> Either Text w) -> (Text -> Maybe w) -> Ref w -> w
resolveRef ((Text -> Text) -> w -> Either Text w
forall w. IsWord w => (Text -> Text) -> w -> Either Text w
i10 (Text -> Text -> Text
branchDispErr Text
"bne") (w -> Either Text w) -> (w -> w) -> w -> Either Text w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> w -> w
forall a. Num a => a -> a -> a
subtract w
offset) Text -> Maybe w
f Ref w
bneK
    derefMnemonic Text -> Maybe w
_ w
_ ControlOp w (Ref w)
Halt = ControlOp w w
forall w l. ControlOp w l
Halt
    derefMnemonic Text -> Maybe w
_ w
_ ControlOp w (Ref w)
NopC = ControlOp w w
forall w l. ControlOp w l
NopC

instance (IsWord w) => DerefMnemonic (VliwIvIsa w) w where
    derefMnemonic :: (Text -> Maybe w) -> w -> VliwIvIsa w (Ref w) -> VliwIvIsa w w
derefMnemonic Text -> Maybe w
f w
offset i :: VliwIvIsa w (Ref w)
i@VliwIvIsa{MemoryOp w (Ref w)
memOp :: forall w l. VliwIvIsa w l -> MemoryOp w l
memOp :: MemoryOp w (Ref w)
memOp, AluOp w (Ref w)
alu1Op :: forall w l. VliwIvIsa w l -> AluOp w l
alu1Op :: AluOp w (Ref w)
alu1Op, AluOp w (Ref w)
alu2Op :: forall w l. VliwIvIsa w l -> AluOp w l
alu2Op :: AluOp w (Ref w)
alu2Op, ControlOp w (Ref w)
ctrlOp :: forall w l. VliwIvIsa w l -> ControlOp w l
ctrlOp :: ControlOp w (Ref w)
ctrlOp} =
        VliwIvIsa w (Ref w)
i
            { memOp = derefMnemonic f offset memOp
            , alu1Op = derefMnemonic f offset alu1Op
            , alu2Op = derefMnemonic f offset alu2Op
            , ctrlOp = derefMnemonic f offset ctrlOp
            }

instance ByteSize (VliwIvIsa w l) where
    byteSize :: VliwIvIsa w l -> Int
byteSize VliwIvIsa w l
_ = Int
14

cmdMnemonic :: Tokens s -> f (Tokens s)
cmdMnemonic Tokens s
mnemonic = Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens s
mnemonic Tokens s -> Tokens s -> Tokens s
forall a. Semigroup a => a -> a -> a
<> Tokens s
" ") f (Tokens s) -> f (Tokens s) -> f (Tokens s)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens s
mnemonic Tokens s -> Tokens s -> Tokens s
forall a. Semigroup a => a -> a -> a
<> Tokens s
"\t")

cmd1args :: Tokens s -> (a -> b) -> f a -> f b
cmd1args Tokens s
mnemonic a -> b
constructor f a
a =
    a -> b
constructor (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens s -> f (Tokens s)
forall {f :: * -> *} {e} {s}.
(MonadParsec e s f, Semigroup (Tokens s), IsString (Tokens s)) =>
Tokens s -> f (Tokens s)
cmdMnemonic Tokens s
mnemonic f (Tokens s) -> f () -> f ()
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace f () -> f a -> f a
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a
a)

cmd2args :: Tokens String
-> (a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd2args Tokens String
mnemonic a -> a -> b
constructor ParsecT Void String Identity a
a ParsecT Void String Identity a
b =
    a -> a -> b
constructor
        (a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens String -> ParsecT Void String Identity (Tokens String)
forall {f :: * -> *} {e} {s}.
(MonadParsec e s f, Semigroup (Tokens s), IsString (Tokens s)) =>
Tokens s -> f (Tokens s)
cmdMnemonic Tokens String
mnemonic ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void String Identity ()
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity a
a)
        ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void String Identity ()
comma ParsecT Void String Identity ()
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity a
b)

cmd3args :: Tokens String
-> (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity a
-> ParsecT Void String Identity b
cmd3args Tokens String
mnemonic a -> a -> a -> b
constructor ParsecT Void String Identity a
a ParsecT Void String Identity a
b ParsecT Void String Identity a
c =
    a -> a -> a -> b
constructor
        (a -> a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity (a -> a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens String -> ParsecT Void String Identity (Tokens String)
forall {f :: * -> *} {e} {s}.
(MonadParsec e s f, Semigroup (Tokens s), IsString (Tokens s)) =>
Tokens s -> f (Tokens s)
cmdMnemonic Tokens String
mnemonic ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void String Identity ()
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity a
a)
        ParsecT Void String Identity (a -> a -> b)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity (a -> b)
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void String Identity ()
comma ParsecT Void String Identity ()
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity a
b)
        ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall a b.
ParsecT Void String Identity (a -> b)
-> ParsecT Void String Identity a -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void String Identity ()
comma ParsecT Void String Identity ()
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity a
c)

-- * Machine

data VliwIvSt w = VliwIvSt
    { forall w. VliwIvSt w -> Int
pc :: Int
    , forall w. VliwIvSt w -> IoMem (VliwIvIsa w w) w
mem :: IoMem (VliwIvIsa w w) w
    , forall w. VliwIvSt w -> HashMap Register w
regs :: HashMap Register w
    , forall w. VliwIvSt w -> Bool
stopped :: Bool
    , forall w. VliwIvSt w -> Maybe Text
internalError :: Maybe Text
    , forall w. VliwIvSt w -> StdGen
randomGen :: !StdGen
    , forall w. VliwIvSt w -> VliwLoadAcc
vliwLoad :: !VliwLoadAcc
    }
    deriving (Int -> VliwIvSt w -> String -> String
[VliwIvSt w] -> String -> String
VliwIvSt w -> String
(Int -> VliwIvSt w -> String -> String)
-> (VliwIvSt w -> String)
-> ([VliwIvSt w] -> String -> String)
-> Show (VliwIvSt w)
forall w. Show w => Int -> VliwIvSt w -> String -> String
forall w. Show w => [VliwIvSt w] -> String -> String
forall w. Show w => VliwIvSt w -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall w. Show w => Int -> VliwIvSt w -> String -> String
showsPrec :: Int -> VliwIvSt w -> String -> String
$cshow :: forall w. Show w => VliwIvSt w -> String
show :: VliwIvSt w -> String
$cshowList :: forall w. Show w => [VliwIvSt w] -> String -> String
showList :: [VliwIvSt w] -> String -> String
Show)

getRandoms :: forall w. Int -> State (VliwIvSt w) [Int]
getRandoms :: forall w. Int -> State (VliwIvSt w) [Int]
getRandoms Int
n = do
    st@VliwIvSt{randomGen} <- StateT (VliwIvSt w) Identity (VliwIvSt w)
forall s (m :: * -> *). MonadState s m => m s
get
    let (xs, gen) = runState (replicateM n (state (uniformR (0, maxBound)))) randomGen
    put st{randomGen = gen}
    return xs

setPc :: forall w. Int -> State (VliwIvSt w) ()
setPc :: forall w. Int -> State (VliwIvSt w) ()
setPc Int
addr = (VliwIvSt w -> VliwIvSt w) -> StateT (VliwIvSt w) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((VliwIvSt w -> VliwIvSt w) -> StateT (VliwIvSt w) Identity ())
-> (VliwIvSt w -> VliwIvSt w) -> StateT (VliwIvSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ \VliwIvSt w
st -> VliwIvSt w
st{pc = addr}

nextPc :: forall w. State (VliwIvSt w) ()
nextPc :: forall w. State (VliwIvSt w) ()
nextPc = do
    VliwIvSt{pc} <- StateT (VliwIvSt w) Identity (VliwIvSt w)
forall s (m :: * -> *). MonadState s m => m s
get
    setPc (pc + 14) -- Bundle size 14 bytes

raiseInternalError :: Text -> State (VliwIvSt w) ()
raiseInternalError :: forall w. Text -> State (VliwIvSt w) ()
raiseInternalError Text
msg = (VliwIvSt w -> VliwIvSt w) -> StateT (VliwIvSt w) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((VliwIvSt w -> VliwIvSt w) -> StateT (VliwIvSt w) Identity ())
-> (VliwIvSt w -> VliwIvSt w) -> StateT (VliwIvSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ \VliwIvSt w
st -> VliwIvSt w
st{internalError = Just msg}

getReg :: Register -> StateT (VliwIvSt b) Identity b
getReg Register
r = do
    VliwIvSt{regs} <- StateT (VliwIvSt b) Identity (VliwIvSt b)
forall s (m :: * -> *). MonadState s m => m s
get
    case regs !? r of
        Just Val (HashMap Register b)
value -> b -> StateT (VliwIvSt b) Identity b
forall a. a -> StateT (VliwIvSt b) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return b
Val (HashMap Register b)
value
        Maybe (Val (HashMap Register b))
Nothing -> do
            Text -> State (VliwIvSt b) ()
forall w. Text -> State (VliwIvSt w) ()
raiseInternalError (Text -> State (VliwIvSt b) ()) -> Text -> State (VliwIvSt b) ()
forall a b. (a -> b) -> a -> b
$ Text
"wrong register: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Register -> Text
forall b a. (Show a, IsString b) => a -> b
show Register
r
            b -> StateT (VliwIvSt b) Identity b
forall a. a -> StateT (VliwIvSt b) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return b
forall a. Default a => a
def

setReg :: Register -> w -> m ()
setReg Register
Zero w
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
setReg Register
r w
value = (VliwIvSt w -> VliwIvSt w) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((VliwIvSt w -> VliwIvSt w) -> m ())
-> (VliwIvSt w -> VliwIvSt w) -> m ()
forall a b. (a -> b) -> a -> b
$ \st :: VliwIvSt w
st@VliwIvSt{HashMap Register w
regs :: forall w. VliwIvSt w -> HashMap Register w
regs :: HashMap Register w
regs} -> VliwIvSt w
st{regs = insert r value regs}

getWord :: Int -> StateT (VliwIvSt b) Identity b
getWord Int
addr = do
    st@VliwIvSt{mem} <- StateT (VliwIvSt b) Identity (VliwIvSt b)
forall s (m :: * -> *). MonadState s m => m s
get
    case readWord mem addr of
        Right (IoMem (VliwIvIsa b b) b
mem', b
w) -> do
            VliwIvSt b -> StateT (VliwIvSt b) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put VliwIvSt b
st{mem = mem'}
            b -> StateT (VliwIvSt b) Identity b
forall a. a -> StateT (VliwIvSt b) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return b
w
        Left Text
err -> do
            Text -> StateT (VliwIvSt b) Identity ()
forall w. Text -> State (VliwIvSt w) ()
raiseInternalError (Text -> StateT (VliwIvSt b) Identity ())
-> Text -> StateT (VliwIvSt b) Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"memory access error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
            b -> StateT (VliwIvSt b) Identity b
forall a. a -> StateT (VliwIvSt b) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return b
forall a. Default a => a
def

setWord :: Int -> w -> StateT (VliwIvSt w) Identity ()
setWord Int
addr w
w = do
    st@VliwIvSt{mem} <- StateT (VliwIvSt w) Identity (VliwIvSt w)
forall s (m :: * -> *). MonadState s m => m s
get
    case writeWord mem addr w of
        Right IoMem (VliwIvIsa w w) w
mem' -> do
            VliwIvSt w -> StateT (VliwIvSt w) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put VliwIvSt w
st{mem = mem'}
        Left Text
err -> Text -> StateT (VliwIvSt w) Identity ()
forall w. Text -> State (VliwIvSt w) ()
raiseInternalError (Text -> StateT (VliwIvSt w) Identity ())
-> Text -> StateT (VliwIvSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"memory access error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err

getByte :: Int -> StateT (VliwIvSt w) Identity Word8
getByte Int
addr = do
    st@VliwIvSt{mem} <- StateT (VliwIvSt w) Identity (VliwIvSt w)
forall s (m :: * -> *). MonadState s m => m s
get
    case readByte mem addr of
        Right (IoMem (VliwIvIsa w w) w
mem', Word8
b) -> do
            VliwIvSt w -> StateT (VliwIvSt w) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put VliwIvSt w
st{mem = mem'}
            Word8 -> StateT (VliwIvSt w) Identity Word8
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
b
        Left Text
err -> do
            Text -> StateT (VliwIvSt w) Identity ()
forall w. Text -> State (VliwIvSt w) ()
raiseInternalError (Text -> StateT (VliwIvSt w) Identity ())
-> Text -> StateT (VliwIvSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"memory access error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
            Word8 -> StateT (VliwIvSt w) Identity Word8
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
0

setByte :: Int -> Word8 -> StateT (VliwIvSt w) Identity ()
setByte Int
addr Word8
byte = do
    st@VliwIvSt{mem} <- StateT (VliwIvSt w) Identity (VliwIvSt w)
forall s (m :: * -> *). MonadState s m => m s
get
    case writeByte mem addr byte of
        Right IoMem (VliwIvIsa w w) w
mem' -> do
            VliwIvSt w -> StateT (VliwIvSt w) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put VliwIvSt w
st{mem = mem'}
        Left Text
err -> Text -> StateT (VliwIvSt w) Identity ()
forall w. Text -> State (VliwIvSt w) ()
raiseInternalError (Text -> StateT (VliwIvSt w) Identity ())
-> Text -> StateT (VliwIvSt w) Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"memory access error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err

type instance MemOf (VliwIvSt w) = IoMem (VliwIvIsa w w) w

instance (IsWord w) => InitState (VliwIvSt w) where
    initState :: Int -> MemOf (VliwIvSt w) -> StdGen -> VliwIvSt w
initState Int
pc MemOf (VliwIvSt w)
dump StdGen
randomGen =
        VliwIvSt
            { Int
pc :: Int
pc :: Int
pc
            , mem :: IoMem (VliwIvIsa w w) w
mem = MemOf (VliwIvSt w)
dump{mInstrFetchReads = const 1}
            , regs :: HashMap Register w
regs = HashMap Register w
forall a. Default a => a
def
            , stopped :: Bool
stopped = Bool
False
            , internalError :: Maybe Text
internalError = Maybe Text
forall a. Maybe a
Nothing
            , StdGen
randomGen :: StdGen
randomGen :: StdGen
randomGen
            , vliwLoad :: VliwLoadAcc
vliwLoad = VliwLoadAcc
emptyVliwLoad
            }

instance (IsWord w) => Inspectable (VliwIvSt w) where
    type WordOf (VliwIvSt w) = w
    type IsaOf (VliwIvSt w) = VliwIvIsa w w

    programCounter :: VliwIvSt w -> Int
programCounter VliwIvSt{Int
pc :: forall w. VliwIvSt w -> Int
pc :: Int
pc} = Int
pc
    memoryDump :: VliwIvSt w -> MemOf (VliwIvSt w)
memoryDump VliwIvSt{IoMem (VliwIvIsa w w) w
mem :: forall w. VliwIvSt w -> IoMem (VliwIvIsa w w) w
mem :: IoMem (VliwIvIsa w w) w
mem} = IoMem (VliwIvIsa w w) w
MemOf (VliwIvSt w)
mem
    ioStreams :: VliwIvSt w -> IntMap ([WordOf (VliwIvSt w)], [WordOf (VliwIvSt w)])
ioStreams VliwIvSt{mem :: forall w. VliwIvSt w -> IoMem (VliwIvIsa w w) w
mem = IoMem{IntMap ([w], [w])
mIoStreams :: IntMap ([w], [w])
mIoStreams :: forall isa w. IoMem isa w -> IntMap ([w], [w])
mIoStreams}} = IntMap ([w], [w])
IntMap ([WordOf (VliwIvSt w)], [WordOf (VliwIvSt w)])
mIoStreams
    isHalted :: VliwIvSt w -> Bool
isHalted VliwIvSt{Bool
stopped :: forall w. VliwIvSt w -> Bool
stopped :: Bool
stopped} = Bool
stopped

    views :: [View (StateEnv (VliwIvSt w))]
views =
        [(Text, Text)]
-> [View (StateEnv (VliwIvSt w))] -> [View (StateEnv (VliwIvSt w))]
forall env. [(Text, Text)] -> [View env] -> [View env]
withRenames
            [(Register -> Text
forall b a. (Show a, IsString b) => a -> b
show Register
r, Text
name) | Register
r <- [Register]
allRegisters, Text
name : [Text]
_ <- [Register -> [Text]
asmNames Register
r]]
            [ Text
-> Text
-> (StateEnv (VliwIvSt w) -> w)
-> View (StateEnv (VliwIvSt w))
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
name (Text
"Register `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"`/`" (Register -> [Text]
asmNames Register
r) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`.") (w -> Maybe w -> w
forall a. a -> Maybe a -> a
fromMaybe w
0 (Maybe w -> w)
-> (StateEnv (VliwIvSt w) -> Maybe w) -> StateEnv (VliwIvSt w) -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Register w
-> Key (HashMap Register w) -> Maybe (Val (HashMap Register w))
forall t. StaticMap t => t -> Key t -> Maybe (Val t)
!? Key (HashMap Register w)
Register
r) (HashMap Register w -> Maybe w)
-> (StateEnv (VliwIvSt w) -> HashMap Register w)
-> StateEnv (VliwIvSt w)
-> Maybe w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VliwIvSt w -> HashMap Register w
forall w. VliwIvSt w -> HashMap Register w
regs (VliwIvSt w -> HashMap Register w)
-> (StateEnv (VliwIvSt w) -> VliwIvSt w)
-> StateEnv (VliwIvSt w)
-> HashMap Register w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateEnv (VliwIvSt w) -> VliwIvSt w
forall st. StateEnv st -> st
seState)
            | Register
r <- [Register]
allRegisters
            , Text
name <- Register -> [Text]
asmNames Register
r
            ]
        where
            asmNames :: Register -> [Text]
asmNames Register
r = [Text
n | (Text
n, Register
r') <- [(Text, Register)]
registerNames, Register
r' Register -> Register -> Bool
forall a. Eq a => a -> a -> Bool
== Register
r]

    isaStats :: [Stat (StateEnv (VliwIvSt w))]
isaStats =
        [ Text
-> Text
-> (StateEnv (VliwIvSt w) -> Text)
-> Stat (StateEnv (VliwIvSt w))
forall env. Text -> Text -> (env -> Text) -> Stat env
Stat Text
"vliw:load-percent" Text
"Average slot use over the run, in percent of the four slots." ((StateEnv (VliwIvSt w) -> Text) -> Stat (StateEnv (VliwIvSt w)))
-> (StateEnv (VliwIvSt w) -> Text) -> Stat (StateEnv (VliwIvSt w))
forall a b. (a -> b) -> a -> b
$ \StateEnv{VliwIvSt w
seFinal :: VliwIvSt w
seFinal :: forall st. StateEnv st -> st
seFinal} ->
            Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (VliwLoadAcc -> Int
vliwLoadPercent (VliwIvSt w -> VliwLoadAcc
forall w. VliwIvSt w -> VliwLoadAcc
vliwLoad VliwIvSt w
seFinal)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"
        , Text
-> Text
-> (StateEnv (VliwIvSt w) -> Text)
-> Stat (StateEnv (VliwIvSt w))
forall env. Text -> Text -> (env -> Text) -> Stat env
Stat Text
"vliw:avg-load" Text
"Average active slots per executed bundle, `0.00`-`4.00`." (VliwLoadAcc -> Text
vliwAvgLoad (VliwLoadAcc -> Text)
-> (StateEnv (VliwIvSt w) -> VliwLoadAcc)
-> StateEnv (VliwIvSt w)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VliwIvSt w -> VliwLoadAcc
forall w. VliwIvSt w -> VliwLoadAcc
vliwLoad (VliwIvSt w -> VliwLoadAcc)
-> (StateEnv (VliwIvSt w) -> VliwIvSt w)
-> StateEnv (VliwIvSt w)
-> VliwLoadAcc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateEnv (VliwIvSt w) -> VliwIvSt w
forall st. StateEnv st -> st
seFinal)
        , Text
-> Text
-> (StateEnv (VliwIvSt w) -> Text)
-> Stat (StateEnv (VliwIvSt w))
forall env. Text -> Text -> (env -> Text) -> Stat env
Stat
            Text
"vliw:bundles-by-load"
            Text
"Executed bundles by active slot count: `K:N (P%)`."
            (VliwLoadAcc -> Text
renderBundlesByLoad (VliwLoadAcc -> Text)
-> (StateEnv (VliwIvSt w) -> VliwLoadAcc)
-> StateEnv (VliwIvSt w)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VliwIvSt w -> VliwLoadAcc
forall w. VliwIvSt w -> VliwLoadAcc
vliwLoad (VliwIvSt w -> VliwLoadAcc)
-> (StateEnv (VliwIvSt w) -> VliwIvSt w)
-> StateEnv (VliwIvSt w)
-> VliwLoadAcc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateEnv (VliwIvSt w) -> VliwIvSt w
forall st. StateEnv st -> st
seFinal)
        ]

instance (IsWord w) => Machine (VliwIvSt w) (VliwIvIsa w w) w where
    instructionFetch :: State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w))
instructionFetch = do
        st <- StateT (VliwIvSt w) Identity (VliwIvSt w)
forall s (m :: * -> *). MonadState s m => m s
get
        case st of
            VliwIvSt{stopped :: forall w. VliwIvSt w -> Bool
stopped = Bool
True} -> Either Text (Int, VliwIvIsa w w)
-> State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w))
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, VliwIvIsa w w)
 -> State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w)))
-> Either Text (Int, VliwIvIsa w w)
-> State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Int, VliwIvIsa w w)
forall a b. a -> Either a b
Left Text
halted
            VliwIvSt{internalError :: forall w. VliwIvSt w -> Maybe Text
internalError = Just Text
err} -> Either Text (Int, VliwIvIsa w w)
-> State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w))
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, VliwIvIsa w w)
 -> State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w)))
-> Either Text (Int, VliwIvIsa w w)
-> State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Int, VliwIvIsa w w)
forall a b. a -> Either a b
Left Text
err
            VliwIvSt{Int
pc :: forall w. VliwIvSt w -> Int
pc :: Int
pc, IoMem (VliwIvIsa w w) w
mem :: forall w. VliwIvSt w -> IoMem (VliwIvIsa w w) w
mem :: IoMem (VliwIvIsa w w) w
mem} ->
                case IoMem (VliwIvIsa w w) w
-> Int -> Either Text (IoMem (VliwIvIsa w w) w, VliwIvIsa w w)
forall m isa w. Memory m isa w => m -> Int -> Either Text (m, isa)
readInstruction IoMem (VliwIvIsa w w) w
mem Int
pc of
                    Left Text
err -> Either Text (Int, VliwIvIsa w w)
-> State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w))
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, VliwIvIsa w w)
 -> State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w)))
-> Either Text (Int, VliwIvIsa w w)
-> State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Int, VliwIvIsa w w)
forall a b. a -> Either a b
Left Text
err
                    Right (IoMem (VliwIvIsa w w) w
mem', VliwIvIsa w w
instruction) -> do
                        VliwIvSt w -> State (VliwIvSt w) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put VliwIvSt w
st{mem = mem'}
                        Either Text (Int, VliwIvIsa w w)
-> State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w))
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Int, VliwIvIsa w w)
 -> State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w)))
-> Either Text (Int, VliwIvIsa w w)
-> State (VliwIvSt w) (Either Text (Int, VliwIvIsa w w))
forall a b. (a -> b) -> a -> b
$ (Int, VliwIvIsa w w) -> Either Text (Int, VliwIvIsa w w)
forall a b. b -> Either a b
Right (Int
pc, VliwIvIsa w w
instruction)

    instructionExecute :: Int -> VliwIvIsa w w -> State (VliwIvSt w) ()
instructionExecute Int
_pc bundle :: VliwIvIsa w w
bundle@VliwIvIsa{MemoryOp w w
memOp :: forall w l. VliwIvIsa w l -> MemoryOp w l
memOp :: MemoryOp w w
memOp, AluOp w w
alu1Op :: forall w l. VliwIvIsa w l -> AluOp w l
alu1Op :: AluOp w w
alu1Op, AluOp w w
alu2Op :: forall w l. VliwIvIsa w l -> AluOp w l
alu2Op :: AluOp w w
alu2Op, ControlOp w w
ctrlOp :: forall w l. VliwIvIsa w l -> ControlOp w l
ctrlOp :: ControlOp w w
ctrlOp} = do
        -- Tally per-bundle slot usage for the vliw:* report variables.
        (VliwIvSt w -> VliwIvSt w) -> State (VliwIvSt w) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((VliwIvSt w -> VliwIvSt w) -> State (VliwIvSt w) ())
-> (VliwIvSt w -> VliwIvSt w) -> State (VliwIvSt w) ()
forall a b. (a -> b) -> a -> b
$ \VliwIvSt w
st -> VliwIvSt w
st{vliwLoad = recordBundle bundle (vliwLoad st)}
        -- Phase 1: Read all source operands and compute results (without modifying state)
        memResult <- MemoryOp w w -> State (VliwIvSt w) (Maybe (Register, w))
computeMem MemoryOp w w
memOp
        alu1OpResult <- computeAlu alu1Op
        alu2OpResult <- computeAlu alu2Op

        -- Phase 2: Apply all register writes simultaneously in random order
        let results = [Maybe (Register, w) -> State (VliwIvSt w) ()
applyMemResult Maybe (Register, w)
memResult, Maybe (Register, w) -> State (VliwIvSt w) ()
applyAluResult Maybe (Register, w)
alu1OpResult, Maybe (Register, w) -> State (VliwIvSt w) ()
applyAluResult Maybe (Register, w)
alu2OpResult]
        shuffledResults <- shuffleList results
        forM_ shuffledResults id

        -- Phase 3: Execute control operation (always last, may branch)
        branched <- execCtrl ctrlOp

        -- If no branch taken, advance PC
        unless branched nextPc
        where
            shuffleList :: [a] -> State (VliwIvSt w) [a]
            shuffleList :: forall a. [a] -> State (VliwIvSt w) [a]
shuffleList [] = [a] -> StateT (VliwIvSt w) Identity [a]
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
            shuffleList [a
x] = [a] -> StateT (VliwIvSt w) Identity [a]
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [a
x]
            shuffleList [a]
xs = do
                indices <- Int -> State (VliwIvSt w) [Int]
forall w. Int -> State (VliwIvSt w) [Int]
getRandoms ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)
                return $ shuffle xs (map (`mod` length xs) indices)

            shuffle :: [a] -> [Int] -> [a]
            shuffle :: forall a. [a] -> [Int] -> [a]
shuffle [] [Int]
_ = []
            shuffle [a
x] [Int]
_ = [a
x]
            shuffle [a]
xs (Int
idx : [Int]
rest) =
                case Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
idx [a]
xs of
                    ([a]
before, a
item : [a]
after) -> a
item a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [Int] -> [a]
forall a. [a] -> [Int] -> [a]
shuffle ([a]
before [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
after) [Int]
rest
                    ([a], [a])
_ -> [a]
xs
            shuffle [a]
xs [] = [a]
xs

            -- Compute memory operation result without applying it
            computeMem :: MemoryOp w w -> State (VliwIvSt w) (Maybe (Register, w))
            computeMem :: MemoryOp w w -> State (VliwIvSt w) (Maybe (Register, w))
computeMem MemoryOp w w
NopM = Maybe (Register, w) -> State (VliwIvSt w) (Maybe (Register, w))
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Register, w)
forall a. Maybe a
Nothing
            computeMem (Lw Register
lwRd (MemRef w
mrOffset Register
mrReg)) = do
                rs1' <- Register -> StateT (VliwIvSt w) Identity w
forall {b}. Default b => Register -> StateT (VliwIvSt b) Identity b
getReg Register
mrReg
                w <- getWord $ fromEnum (mrOffset + rs1')
                return $ Just (lwRd, w)
            computeMem (Lb Register
lbRd (MemRef w
mrOffset Register
mrReg)) = do
                rs1' <- Register -> StateT (VliwIvSt w) Identity w
forall {b}. Default b => Register -> StateT (VliwIvSt b) Identity b
getReg Register
mrReg
                b <- getByte $ fromEnum (mrOffset + rs1')
                return $ Just (lbRd, fromIntegral (fromIntegral b :: Int8))
            computeMem (Sw Register
swRs2 (MemRef w
mrOffset Register
mrReg)) = do
                rs2' <- Register -> StateT (VliwIvSt w) Identity w
forall {b}. Default b => Register -> StateT (VliwIvSt b) Identity b
getReg Register
swRs2
                mrReg' <- getReg mrReg
                setWord (fromEnum (mrReg' + mrOffset)) rs2'
                return Nothing
            computeMem (Sb Register
sbRs2 (MemRef w
mrOffset Register
mrReg)) = do
                rs2' <- Register -> StateT (VliwIvSt w) Identity w
forall {b}. Default b => Register -> StateT (VliwIvSt b) Identity b
getReg Register
sbRs2
                mrReg' <- getReg mrReg
                setByte (fromEnum (mrReg' + mrOffset)) $ fromIntegral rs2'
                return Nothing

            -- Apply memory operation result
            applyMemResult :: Maybe (Register, w) -> State (VliwIvSt w) ()
            applyMemResult :: Maybe (Register, w) -> State (VliwIvSt w) ()
applyMemResult Maybe (Register, w)
Nothing = () -> State (VliwIvSt w) ()
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            applyMemResult (Just (Register
reg, w
val)) = Register -> w -> State (VliwIvSt w) ()
forall {m :: * -> *} {w}.
MonadState (VliwIvSt w) m =>
Register -> w -> m ()
setReg Register
reg w
val

            -- Compute ALU operation result without applying it
            computeAlu :: AluOp w w -> State (VliwIvSt w) (Maybe (Register, w))
            computeAlu :: AluOp w w -> State (VliwIvSt w) (Maybe (Register, w))
computeAlu AluOp w w
NopA = Maybe (Register, w) -> State (VliwIvSt w) (Maybe (Register, w))
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Register, w)
forall a. Maybe a
Nothing
            computeAlu (Addi Register
addiRd Register
addiRs1 w
addiK) = do
                rs1' <- Register -> StateT (VliwIvSt w) Identity w
forall {b}. Default b => Register -> StateT (VliwIvSt b) Identity b
getReg Register
addiRs1
                return $ Just (addiRd, rs1' + addiK)
            computeAlu (Add Register
addRd Register
addRs1 Register
addRs2) = Register
-> Register
-> Register
-> (w -> w)
-> (w -> w)
-> (w -> w -> w)
-> State (VliwIvSt w) (Maybe (Register, w))
forall {a} {a} {t} {t} {b}.
Default a =>
a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute Register
addRd Register
addRs1 Register
addRs2 w -> w
forall a. a -> a
id w -> w
forall a. a -> a
id w -> w -> w
forall a. Num a => a -> a -> a
(+)
            computeAlu (Sub Register
subRd Register
subRs1 Register
subRs2) = Register
-> Register
-> Register
-> (w -> w)
-> (w -> w)
-> (w -> w -> w)
-> State (VliwIvSt w) (Maybe (Register, w))
forall {a} {a} {t} {t} {b}.
Default a =>
a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute Register
subRd Register
subRs1 Register
subRs2 w -> w
forall a. a -> a
id w -> w
forall a. a -> a
id (-)
            computeAlu (Mul Register
mulRd Register
mulRs1 Register
mulRs2) = Register
-> Register
-> Register
-> (w -> w)
-> (w -> w)
-> (w -> w -> w)
-> State (VliwIvSt w) (Maybe (Register, w))
forall {a} {a} {t} {t} {b}.
Default a =>
a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute Register
mulRd Register
mulRs1 Register
mulRs2 w -> w
forall a. a -> a
id w -> w
forall a. a -> a
id w -> w -> w
forall a. Num a => a -> a -> a
(*)
            computeAlu (Mulh Register
mulhRd Register
mulhRs1 Register
mulhRs2) =
                Register
-> Register
-> Register
-> (w -> Integer)
-> (w -> Integer)
-> (Integer -> Integer -> w)
-> State (VliwIvSt w) (Maybe (Register, w))
forall {a} {a} {t} {t} {b}.
Default a =>
a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute
                    Register
mulhRd
                    Register
mulhRs1
                    Register
mulhRs2
                    w -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                    w -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                    ( \(Integer
r1 :: Integer) Integer
r2 ->
                        let x :: Integer
x = Integer
r1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r2
                            shift :: Int
shift = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall t. ByteSizeT t => Int
byteSizeT @w
                         in Integer -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
shift)
                    )
            computeAlu (Div Register
divRd Register
divRs1 Register
divRs2) = Register
-> Register
-> Register
-> (w -> w)
-> (w -> w)
-> (w -> w -> w)
-> State (VliwIvSt w) (Maybe (Register, w))
forall {a} {a} {t} {t} {b}.
Default a =>
a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute Register
divRd Register
divRs1 Register
divRs2 w -> w
forall a. a -> a
id w -> w
forall a. a -> a
id ((w -> w -> w) -> State (VliwIvSt w) (Maybe (Register, w)))
-> (w -> w -> w) -> State (VliwIvSt w) (Maybe (Register, w))
forall a b. (a -> b) -> a -> b
$ \w
r1 w
r2 -> case w
r2 of
                w
0 -> -w
1
                -1 | w
r1 w -> w -> Bool
forall a. Eq a => a -> a -> Bool
== w
forall a. Bounded a => a
minBound -> w
r1
                w
_ -> w -> w -> w
forall a. Integral a => a -> a -> a
quot w
r1 w
r2
            computeAlu (Rem Register
remRd Register
remRs1 Register
remRs2) = Register
-> Register
-> Register
-> (w -> w)
-> (w -> w)
-> (w -> w -> w)
-> State (VliwIvSt w) (Maybe (Register, w))
forall {a} {a} {t} {t} {b}.
Default a =>
a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute Register
remRd Register
remRs1 Register
remRs2 w -> w
forall a. a -> a
id w -> w
forall a. a -> a
id ((w -> w -> w) -> State (VliwIvSt w) (Maybe (Register, w)))
-> (w -> w -> w) -> State (VliwIvSt w) (Maybe (Register, w))
forall a b. (a -> b) -> a -> b
$ \w
r1 w
r2 -> case w
r2 of
                w
0 -> w
r1
                -1 | w
r1 w -> w -> Bool
forall a. Eq a => a -> a -> Bool
== w
forall a. Bounded a => a
minBound -> w
0
                w
_ -> w -> w -> w
forall a. Integral a => a -> a -> a
rem w
r1 w
r2
            computeAlu (Sll Register
sllRd Register
sllRs1 Register
sllRs2) = Register
-> Register
-> Register
-> (w -> w)
-> (w -> w)
-> (w -> w -> w)
-> State (VliwIvSt w) (Maybe (Register, w))
forall {a} {a} {t} {t} {b}.
Default a =>
a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute Register
sllRd Register
sllRs1 Register
sllRs2 w -> w
forall a. a -> a
id w -> w
forall a. a -> a
id (\w
r1 w
r2 -> w
r1 w -> Int -> w
forall a. Bits a => a -> Int -> a
`shiftL` (w -> Int
forall a. Enum a => a -> Int
fromEnum w
r2 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1F))
            computeAlu (Srl Register
srlRd Register
srlRs1 Register
srlRs2) = Register
-> Register
-> Register
-> (w -> w)
-> (w -> w)
-> (w -> w -> w)
-> State (VliwIvSt w) (Maybe (Register, w))
forall {a} {a} {t} {t} {b}.
Default a =>
a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute Register
srlRd Register
srlRs1 Register
srlRs2 w -> w
forall a. a -> a
id w -> w
forall a. a -> a
id (\w
r1 w
r2 -> w -> w -> w
forall w. IsWord w => w -> w -> w
lShiftR w
r1 (w
r2 w -> w -> w
forall a. Bits a => a -> a -> a
.&. w
0x1F))
            computeAlu (Sra Register
sraRd Register
sraRs1 Register
sraRs2) = Register
-> Register
-> Register
-> (w -> w)
-> (w -> w)
-> (w -> w -> w)
-> State (VliwIvSt w) (Maybe (Register, w))
forall {a} {a} {t} {t} {b}.
Default a =>
a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute Register
sraRd Register
sraRs1 Register
sraRs2 w -> w
forall a. a -> a
id w -> w
forall a. a -> a
id (\w
r1 w
r2 -> w
r1 w -> Int -> w
forall a. Bits a => a -> Int -> a
`shiftR` (w -> Int
forall a. Enum a => a -> Int
fromEnum w
r2 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1F))
            computeAlu (And Register
andRd Register
andRs1 Register
andRs2) = Register
-> Register
-> Register
-> (w -> w)
-> (w -> w)
-> (w -> w -> w)
-> State (VliwIvSt w) (Maybe (Register, w))
forall {a} {a} {t} {t} {b}.
Default a =>
a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute Register
andRd Register
andRs1 Register
andRs2 w -> w
forall a. a -> a
id w -> w
forall a. a -> a
id w -> w -> w
forall a. Bits a => a -> a -> a
(.&.)
            computeAlu (Or Register
orRd Register
orRs1 Register
orRs2) = Register
-> Register
-> Register
-> (w -> w)
-> (w -> w)
-> (w -> w -> w)
-> State (VliwIvSt w) (Maybe (Register, w))
forall {a} {a} {t} {t} {b}.
Default a =>
a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute Register
orRd Register
orRs1 Register
orRs2 w -> w
forall a. a -> a
id w -> w
forall a. a -> a
id w -> w -> w
forall a. Bits a => a -> a -> a
(.|.)
            computeAlu (Xor Register
xorRd Register
xorRs1 Register
xorRs2) = Register
-> Register
-> Register
-> (w -> w)
-> (w -> w)
-> (w -> w -> w)
-> State (VliwIvSt w) (Maybe (Register, w))
forall {a} {a} {t} {t} {b}.
Default a =>
a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute Register
xorRd Register
xorRs1 Register
xorRs2 w -> w
forall a. a -> a
id w -> w
forall a. a -> a
id w -> w -> w
forall a. Bits a => a -> a -> a
xor
            computeAlu (Slti Register
sltiRd Register
sltiRs1 w
sltiK) = do
                rs1' <- Register -> StateT (VliwIvSt w) Identity w
forall {b}. Default b => Register -> StateT (VliwIvSt b) Identity b
getReg Register
sltiRs1
                return $ Just (sltiRd, if rs1' < sltiK then 1 else 0)
            computeAlu (Lui Register
luiRd w
luiK) = Maybe (Register, w) -> State (VliwIvSt w) (Maybe (Register, w))
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Register, w) -> State (VliwIvSt w) (Maybe (Register, w)))
-> Maybe (Register, w) -> State (VliwIvSt w) (Maybe (Register, w))
forall a b. (a -> b) -> a -> b
$ (Register, w) -> Maybe (Register, w)
forall a. a -> Maybe a
Just (Register
luiRd, w
luiK w -> Int -> w
forall a. Bits a => a -> Int -> a
`shiftL` Int
12)
            computeAlu (Mv Register
mvRd Register
mvRs) = do
                val <- Register -> StateT (VliwIvSt w) Identity w
forall {b}. Default b => Register -> StateT (VliwIvSt b) Identity b
getReg Register
mvRs
                return $ Just (mvRd, val)

            -- Apply ALU operation result
            applyAluResult :: Maybe (Register, w) -> State (VliwIvSt w) ()
            applyAluResult :: Maybe (Register, w) -> State (VliwIvSt w) ()
applyAluResult Maybe (Register, w)
Nothing = () -> State (VliwIvSt w) ()
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            applyAluResult (Just (Register
reg, w
val)) = Register -> w -> State (VliwIvSt w) ()
forall {m :: * -> *} {w}.
MonadState (VliwIvSt w) m =>
Register -> w -> m ()
setReg Register
reg w
val

            -- Helper for ALU operations with two source registers
            aluOpCompute :: a
-> Register
-> Register
-> (a -> t)
-> (a -> t)
-> (t -> t -> b)
-> StateT (VliwIvSt a) Identity (Maybe (a, b))
aluOpCompute a
rd Register
rs1 Register
rs2 a -> t
f1 a -> t
f2 t -> t -> b
fd = do
                r1 <- a -> t
f1 (a -> t)
-> StateT (VliwIvSt a) Identity a -> StateT (VliwIvSt a) Identity t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Register -> StateT (VliwIvSt a) Identity a
forall {b}. Default b => Register -> StateT (VliwIvSt b) Identity b
getReg Register
rs1
                r2 <- f2 <$> getReg rs2
                return $ Just (rd, fd r1 r2)

            execCtrl :: ControlOp w w -> StateT (VliwIvSt w) Identity Bool
execCtrl ControlOp w w
NopC = Bool -> StateT (VliwIvSt w) Identity Bool
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            execCtrl (J w
jK) = do
                VliwIvSt{pc} <- StateT (VliwIvSt w) Identity (VliwIvSt w)
forall s (m :: * -> *). MonadState s m => m s
get
                setPc (pc + fromEnum jK)
                return True
            execCtrl (Jal Register
jalRd w
jalK) = do
                VliwIvSt{pc} <- StateT (VliwIvSt w) Identity (VliwIvSt w)
forall s (m :: * -> *). MonadState s m => m s
get
                setReg jalRd (toEnum pc + 14)
                setPc (pc + fromEnum jalK)
                return True
            execCtrl (Jalr Register
jalrRd Register
jalrRs1 w
jalrK) = do
                VliwIvSt{pc} <- StateT (VliwIvSt w) Identity (VliwIvSt w)
forall s (m :: * -> *). MonadState s m => m s
get
                rs1' <- getReg jalrRs1
                setReg jalrRd (toEnum pc + 14)
                setPc (fromEnum (rs1' + jalrK))
                return True
            execCtrl (Beqz Register
beqzRs1 w
beqzK) = Register -> w -> (w -> Bool) -> StateT (VliwIvSt w) Identity Bool
forall {w} {a}.
(Default w, Enum a) =>
Register -> a -> (w -> Bool) -> StateT (VliwIvSt w) Identity Bool
branchIf Register
beqzRs1 w
beqzK (w -> w -> Bool
forall a. Eq a => a -> a -> Bool
== w
0)
            execCtrl (Bnez Register
bnezRs1 w
bnezK) = Register -> w -> (w -> Bool) -> StateT (VliwIvSt w) Identity Bool
forall {w} {a}.
(Default w, Enum a) =>
Register -> a -> (w -> Bool) -> StateT (VliwIvSt w) Identity Bool
branchIf Register
bnezRs1 w
bnezK (w -> w -> Bool
forall a. Eq a => a -> a -> Bool
/= w
0)
            execCtrl (Blt Register
bltRs1 Register
bltRs2 w
bltK) = Register
-> Register
-> w
-> (w -> w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
forall {w} {a}.
(Default w, Enum a) =>
Register
-> Register
-> a
-> (w -> w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
branchIf2 Register
bltRs1 Register
bltRs2 w
bltK w -> w -> Bool
forall a. Ord a => a -> a -> Bool
(<)
            execCtrl (Bge Register
bgeRs1 Register
bgeRs2 w
bgeK) = Register
-> Register
-> w
-> (w -> w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
forall {w} {a}.
(Default w, Enum a) =>
Register
-> Register
-> a
-> (w -> w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
branchIf2 Register
bgeRs1 Register
bgeRs2 w
bgeK w -> w -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
            execCtrl (Bltu Register
bltuRs1 Register
bltuRs2 w
bltuK) = Register
-> Register
-> w
-> (Unsign w -> Unsign w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
forall {w} {a}.
(FromSign w, Default w, Enum a) =>
Register
-> Register
-> a
-> (Unsign w -> Unsign w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
branchIf2u Register
bltuRs1 Register
bltuRs2 w
bltuK Unsign w -> Unsign w -> Bool
forall a. Ord a => a -> a -> Bool
(<)
            execCtrl (Bgeu Register
bgeuRs1 Register
bgeuRs2 w
bgeuK) = Register
-> Register
-> w
-> (Unsign w -> Unsign w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
forall {w} {a}.
(FromSign w, Default w, Enum a) =>
Register
-> Register
-> a
-> (Unsign w -> Unsign w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
branchIf2u Register
bgeuRs1 Register
bgeuRs2 w
bgeuK Unsign w -> Unsign w -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
            execCtrl (Beq Register
beqRs1 Register
beqRs2 w
beqK) = Register
-> Register
-> w
-> (w -> w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
forall {w} {a}.
(Default w, Enum a) =>
Register
-> Register
-> a
-> (w -> w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
branchIf2 Register
beqRs1 Register
beqRs2 w
beqK w -> w -> Bool
forall a. Eq a => a -> a -> Bool
(==)
            execCtrl (Bne Register
bneRs1 Register
bneRs2 w
bneK) = Register
-> Register
-> w
-> (w -> w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
forall {w} {a}.
(Default w, Enum a) =>
Register
-> Register
-> a
-> (w -> w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
branchIf2 Register
bneRs1 Register
bneRs2 w
bneK w -> w -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
            execCtrl ControlOp w w
Halt = do
                (VliwIvSt w -> VliwIvSt w) -> State (VliwIvSt w) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((VliwIvSt w -> VliwIvSt w) -> State (VliwIvSt w) ())
-> (VliwIvSt w -> VliwIvSt w) -> State (VliwIvSt w) ()
forall a b. (a -> b) -> a -> b
$ \VliwIvSt w
st -> VliwIvSt w
st{stopped = True}
                Bool -> StateT (VliwIvSt w) Identity Bool
forall a. a -> StateT (VliwIvSt w) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

            branchIf :: Register -> a -> (w -> Bool) -> StateT (VliwIvSt w) Identity Bool
branchIf Register
rs1 a
k w -> Bool
cond = do
                VliwIvSt{pc} <- StateT (VliwIvSt w) Identity (VliwIvSt w)
forall s (m :: * -> *). MonadState s m => m s
get
                rs1' <- getReg rs1
                if cond rs1'
                    then do
                        setPc (pc + fromEnum k)
                        return True
                    else return False

            branchIf2 :: Register
-> Register
-> a
-> (w -> w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
branchIf2 Register
rs1 Register
rs2 a
k w -> w -> Bool
cond = do
                VliwIvSt{pc} <- StateT (VliwIvSt w) Identity (VliwIvSt w)
forall s (m :: * -> *). MonadState s m => m s
get
                rs1' <- getReg rs1
                rs2' <- getReg rs2
                if cond rs1' rs2'
                    then do
                        setPc (pc + fromEnum k)
                        return True
                    else return False

            branchIf2u :: Register
-> Register
-> a
-> (Unsign w -> Unsign w -> Bool)
-> StateT (VliwIvSt w) Identity Bool
branchIf2u Register
rs1 Register
rs2 a
k Unsign w -> Unsign w -> Bool
cond = do
                VliwIvSt{pc} <- StateT (VliwIvSt w) Identity (VliwIvSt w)
forall s (m :: * -> *). MonadState s m => m s
get
                rs1' <- fromSign <$> getReg rs1
                rs2' <- fromSign <$> getReg rs2
                if cond rs1' rs2'
                    then do
                        setPc (pc + fromEnum k)
                        return True
                    else return False