{-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ConstraintKinds #-} module Simulation(Args(..), simulation, Simulation(..)) where import qualified Prelude as P import Peripherals.Setup(setupPeripherals, InitializedPeripherals(..)) import Peripherals.Teardown(teardownPeripherals) import Clash.Prelude import Machine( Machine(..), RISCVCPU(..), Peripherals(..), machineInit, RISCVCPU (RISCVCPU)) import Fetch(fetchInstruction, FetchResult (Instruction, Misaligned)) import Isa.Decode(decode) import Debug.Trace data Args = Args { firmware :: FilePath } deriving (Show) data Simulation = Success [Machine] | Failure String deriving (Show) -- machine :: Machine -- machine = machineInit machine' :: Machine -> Machine machine' machine = let machinePeripherals = peripherals machine machineMem = ram $ machinePeripherals machineCPU = cpu machine machinePC = pc machineCPU addr = 0 :: Integer mem' = replace addr (3) machineMem peripherals' = machinePeripherals { ram = mem' } cpu' = machineCPU { pc = machinePC + 4 } in case (fetchInstruction machineMem machinePC) of Instruction insn -> let binaryInsn = show (bitCoerce insn :: BitVector 32) in trace ("Decoded instruction: " P.++ show opcode P.++ " | Binary: " P.++ binaryInsn P.++ " (" P.++ show insn P.++ ")") $ machine { cpu = cpu', peripherals = peripherals' } where opcode = decode insn Misaligned addr -> undefined simulationLoop :: Int -> Machine -> IO [Machine] simulationLoop 0 state = return [state] simulationLoop n state = do let newState = machine' state rest <- simulationLoop (n - 1) newState return (state : rest) simulation :: Args -> IO Simulation simulation args = do initializedPeripherals <- setupPeripherals (firmware args) case initializedPeripherals of InitializationError e -> return $ Failure e InitializedPeripherals ram -> do let initState = machineInit $ Machine.Peripherals ram sim <- simulationLoop 15 initState teardownPeripherals return $ Success sim