replace/update relevant fetch types and functions

This commit is contained in:
Yehowshua Immanuel 2025-03-04 23:43:35 -05:00
parent eb79210863
commit 30650b870c
2 changed files with 8 additions and 48 deletions

View file

@ -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 ->

View file

@ -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)