diff --git a/hs/Fetch.hs b/hs/Fetch.hs index 120c13a..e0dfe28 100644 --- a/hs/Fetch.hs +++ b/hs/Fetch.hs @@ -3,9 +3,8 @@ module Fetch( fetchInstruction, - fetchInstruction1, FetchResult(..), - FetchResult1(..)) where + ) where import Clash.Prelude import Types(Mem, Addr, Insn) @@ -22,31 +21,15 @@ import GHC.IO (IO) import GHC.Base (Applicative(pure)) data FetchResult = Instruction Insn - | Misaligned Addr - -data FetchResult1 = Instruction1 Insn | InstructionException Exception -fetchInstruction :: KnownNat n => Mem n -> Addr -> FetchResult -fetchInstruction mem addr = - let - isWordAligned = addr .&. 3 == 0 - addrWordAligned = addr `shiftR` 2 - insn = mem !! addrWordAligned - -- TODO : check if instruction is word aligned and create type - -- to capture if its not. - in - case isWordAligned of - True -> Instruction insn - False -> Misaligned addr - -fetchInstruction1 :: Peripherals -> Addr -> IO FetchResult1 -fetchInstruction1 peripherals addr = +fetchInstruction :: Peripherals -> Addr -> IO FetchResult +fetchInstruction peripherals addr = do readReasponse <-Bus.read (BusTypes.Request addr BusTypes.SizeFullWord) peripherals case readReasponse of Right (BusFullWord insn) -> - pure $ Instruction1 insn + pure $ Instruction insn Left UnAligned -> pure $ InstructionException InstructionAddressMisaligned Left UnMapped -> diff --git a/hs/Simulation.hs b/hs/Simulation.hs index 13cbf43..e752d04 100644 --- a/hs/Simulation.hs +++ b/hs/Simulation.hs @@ -19,7 +19,7 @@ import Bus(Peripherals(..)) import Cpu( RISCVCPU(..), riscvCPUInit) -import Fetch(fetchInstruction, FetchResult (Instruction, Misaligned), fetchInstruction1, FetchResult1(..)) +import Fetch(fetchInstruction, FetchResult (..)) import Isa.Decode(decode) import Debug.Trace @@ -40,31 +40,10 @@ data Machine = Machine } deriving (Generic, Show, Eq, NFDataX) -machine' :: Machine -> Machine -machine' machine = - let - machinePeripherals = peripherals machine - machineMem = ram $ machinePeripherals - machineCPU = cpu machine - machinePC = pc machineCPU - 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' } - where - opcode = decode insn - Misaligned addr -> undefined - -debugInsn :: FetchResult1 -> String +debugInsn :: FetchResult -> String debugInsn fetchResult = case fetchResult of - Instruction1 insn -> + Instruction insn -> "Decoded instruction: " P.++ show opcode P.++ " | Binary: " P.++ binaryInsn P.++ " (" P.++ show insn P.++ ")" @@ -76,15 +55,13 @@ debugInsn fetchResult = simulationLoop :: Int -> Machine -> IO [Machine] simulationLoop 0 machine = return [machine] simulationLoop n machine = do - -- let newState = machine' machine let machinePeripherals = peripherals machine currPc = pc $ cpu machine - fetchResult <- fetchInstruction1 machinePeripherals currPc + fetchResult <- fetchInstruction machinePeripherals currPc putStrLn $ debugInsn fetchResult let pc' = currPc + 4 cpu' = (cpu machine) { pc = pc' } machine' = machine { cpu = cpu' } - -- let machine' = machine { cpu = cpu $ machine { pc = pc $ cpu machine + 4 } } rest <- simulationLoop (n - 1) machine' return (machine : rest)