RiscV-Formal/hs/Simulation.hs

{-# 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