replace/update relevant fetch types and functions
This commit is contained in:
parent
eb79210863
commit
30650b870c
25
hs/Fetch.hs
25
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 ->
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
Loading…
Reference in a new issue