RiscV-Formal/hs/Simulation.hs

85 lines
2.4 KiB
Haskell

{-# 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 Text.Printf (printf)
import Clash.Prelude
import Machine(
Machine(..),
RISCVCPU(..),
Peripherals(..),
machineInit, RISCVCPU (RISCVCPU))
import Fetch(fetchInstruction, FetchResult (Instruction, Misaligned))
import Isa.Decode(decode)
import Isa.Forms(Opcode(..))
import Peripherals.UartCFFI(writeCharToTerminal)
import Control.Concurrent (threadDelay)
import Debug.Trace
import Types (Mem, Addr)
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 }
instruction =
case (fetchInstruction machineMem machinePC) of
Instruction i -> i
_ -> undefined
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