{-# LANGUAGE DataKinds #-} {-# LANGUAGE NumericUnderscores #-} module Fetch( fetchInstruction, debugInsn, FetchResult(..), ) where import Clash.Prelude import qualified Prelude as P import Types(Addr, Insn) import Bus(read) import Bus(Peripherals(..)) import BusTypes( ReadRequest(..), TransactionSize(..), BusVal(..), BusError(..)) import Exceptions(Exception(..)) import Util((|>)) data FetchResult = Instruction {insn :: Insn, insnAddr :: Addr} | InstructionException {exception :: Exception, addr :: Addr} deriving (Generic, Show, Eq, NFDataX) fetchInstruction :: Peripherals -> Addr -> IO FetchResult fetchInstruction peripherals addr = do readReasponse <-Bus.read (BusTypes.ReadRequest addr BusTypes.SizeFullWord) peripherals case readReasponse of Right (BusFullWord insn) -> pure |> Instruction insn addr Left UnAligned -> pure |> InstructionException InstructionAddressMisaligned addr Left UnMapped -> pure |> InstructionException InstructionAccessFault addr Right _ -> pure |> InstructionException InstructionAccessFault addr debugInsn :: FetchResult -> String debugInsn = show -- case fetchResult of -- Instruction insn -> -- "Instruction raw binary | " -- P.++ binaryInsn -- P.++ " (" P.++ show insn P.++ ")" -- where -- binaryInsn = show (bitCoerce insn :: BitVector 32) -- InstructionException e -> show e