forked from Yehowshua/RiscV-Formal
72 lines
1.8 KiB
Haskell
72 lines
1.8 KiB
Haskell
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
|
|
module Simulation(
|
|
Args(..),
|
|
simulation,
|
|
RISCVCPU(..),
|
|
Machine(..),
|
|
Simulation(..)
|
|
) where
|
|
|
|
import Peripherals.Setup(setupPeripherals, InitializedPeripherals(..))
|
|
import Peripherals.Teardown(teardownPeripherals)
|
|
import Clash.Prelude
|
|
import Bus(Peripherals(..))
|
|
import Read(read)
|
|
import Cpu(
|
|
RISCVCPU(..),
|
|
riscvCPUInit)
|
|
import Fetch(fetchInstruction, debugInsn)
|
|
import Decode(decode)
|
|
import qualified Prelude as P
|
|
import Util((|>))
|
|
|
|
data Args = Args {
|
|
firmware :: FilePath
|
|
} deriving (Show)
|
|
|
|
data Simulation
|
|
= Success [Machine]
|
|
| Failure String
|
|
deriving (Show)
|
|
data Machine = Machine
|
|
{ cpu :: RISCVCPU,
|
|
peripherals :: Peripherals
|
|
}
|
|
deriving (Generic, Show, Eq, NFDataX)
|
|
|
|
|
|
simulationLoop :: Int -> Machine -> IO [Machine]
|
|
simulationLoop 0 machine = return [machine]
|
|
simulationLoop n machine = do
|
|
let machinePeripherals = peripherals machine
|
|
currPc = pc |> cpu machine
|
|
fetchResult <- fetchInstruction machinePeripherals currPc
|
|
let decodeResult = Read.read (decode fetchResult) (cpu machine)
|
|
putStrLn |> show decodeResult -- P.++ debugInsn fetchResult
|
|
let pc' = currPc + 4
|
|
cpu' = (cpu machine) { pc = pc' }
|
|
machine' = machine { cpu = cpu' }
|
|
rest <- simulationLoop (n - 1) machine'
|
|
return (machine : rest)
|
|
|
|
|
|
simulation :: Args -> IO Simulation
|
|
simulation args = do
|
|
initializedPeripherals <- setupPeripherals (firmware args)
|
|
case initializedPeripherals of
|
|
InitializationError e -> return |> Failure e
|
|
InitializedPeripherals ramDevice -> do
|
|
|
|
let initState =
|
|
Machine {
|
|
cpu = riscvCPUInit,
|
|
peripherals = Bus.Peripherals ramDevice
|
|
}
|
|
sim <- simulationLoop 15 initState
|
|
teardownPeripherals
|
|
return |> Success sim
|