diff --git a/hs/Bus.hs b/hs/Bus.hs index efb254a..ecda7d8 100644 --- a/hs/Bus.hs +++ b/hs/Bus.hs @@ -15,6 +15,7 @@ import Peripherals.Uart(UartAddr, read, write) import BusTypes( BusError(..), TransactionSize(..), + WriteRequest(..), ReadRequest(..), BusVal(..), ) @@ -53,7 +54,7 @@ alignCheck addr SizeQuadWord = addr `mod` 16 == 0 -- reading/writing from/to UART is implemented as reading/writing -- from/to stdin/stdout, so we need IO. read :: ReadRequest -> Peripherals -> IO ReadResponse -read (Request addr size) peripherals +read (ReadRequest addr size) peripherals | not (alignCheck addr size) = return |> Left UnAligned | (addr >= ramStart) && (addr <= ramEnd) = return |> Right |> Peripherals.Ram.read size ramWordAddr (ram peripherals) @@ -71,8 +72,8 @@ read (Request addr size) peripherals uartAddr :: UartAddr uartAddr = resize uartAddrNoOffset -write :: BusVal -> Addr -> Peripherals -> IO WriteResponse -write val addr peripherals +write :: WriteRequest -> Peripherals -> IO WriteResponse +write (WriteRequest addr val) peripherals | not (alignCheck addr |> busValToTransactionSize val) = return |> Left UnAligned | (addr >= uartStart) && (addr <= uartEnd) = do diff --git a/hs/BusTypes.hs b/hs/BusTypes.hs index 0c59679..2a2260c 100644 --- a/hs/BusTypes.hs +++ b/hs/BusTypes.hs @@ -3,6 +3,7 @@ module BusTypes( BusError(..), TransactionSize(..), ReadRequest(..), + WriteRequest(..), BusVal(..), ) where @@ -23,9 +24,14 @@ data TransactionSize | SizeQuadWord deriving (Generic, Show, Eq, NFDataX) -data ReadRequest = Request Addr TransactionSize +data ReadRequest = ReadRequest Addr TransactionSize deriving (Generic, Show, Eq, NFDataX) +data WriteRequest = WriteRequest Addr BusVal + deriving (Generic, Show, Eq, NFDataX) + +-- data WriteRequest + data BusVal = BusByte Byte | BusHalfWord HalfWord diff --git a/hs/Decode.hs b/hs/Decode.hs index cb72494..13ef89d 100644 --- a/hs/Decode.hs +++ b/hs/Decode.hs @@ -11,22 +11,22 @@ import DecodeTypes( import Clash.Prelude import Fetch(FetchResult (Instruction, InstructionException)) import Exceptions(Exception(..)) -import Types(Insn) +import Types(Insn, Addr) import RegFiles(RegVal(..)) import Util((|>)) -data DecodeResult = Opcode Opcode - | DecodeException Exception - | InstructionException Exception +data DecodeResult = Opcode {opcode :: Opcode, insnAddr :: Addr} + | DecodeException {exception :: Exception, insnAddr :: Addr} + | InstructionException {exception :: Exception, insnAddr :: Addr} deriving (Generic, Show, Eq, NFDataX) decode :: FetchResult -> DecodeResult -decode (Instruction insn) = +decode (Instruction insn addr) = case insnToOpcode insn of - Just opcode -> Opcode opcode - Nothing -> DecodeException |> IllegalInstruction insn -decode (Fetch.InstructionException exception) = - Decode.InstructionException exception + Just opcode -> Opcode opcode addr + Nothing -> DecodeException (IllegalInstruction insn) addr +decode (Fetch.InstructionException exception addr) = + Decode.InstructionException exception addr insnToOpcode :: Insn -> Maybe Opcode insnToOpcode insn = diff --git a/hs/Exceptions.hs b/hs/Exceptions.hs index e2a213f..2a18975 100644 --- a/hs/Exceptions.hs +++ b/hs/Exceptions.hs @@ -18,9 +18,9 @@ data Exception = | SupervisorExternalInterrupt | MachineExternalInterrupt | CounterOverflowInterrupt - | InstructionAddressMisaligned Addr - | InstructionAccessFault Addr - | IllegalInstruction Insn + | InstructionAddressMisaligned + | InstructionAccessFault + | IllegalInstruction {insn :: Insn} | Breakpoint | LoadAddressMisaligned | LoadAccessFault @@ -45,8 +45,8 @@ exceptionCode MachineTimerInterrupt = 7 exceptionCode SupervisorExternalInterrupt = 9 exceptionCode MachineExternalInterrupt = 11 exceptionCode CounterOverflowInterrupt = 13 -exceptionCode (InstructionAddressMisaligned _) = 0 -exceptionCode (InstructionAccessFault _) = 1 +exceptionCode InstructionAddressMisaligned = 0 +exceptionCode InstructionAccessFault = 1 exceptionCode (IllegalInstruction _) = 2 exceptionCode Breakpoint = 3 exceptionCode LoadAddressMisaligned = 4 @@ -71,8 +71,8 @@ isSynchronousException MachineTimerInterrupt = False isSynchronousException SupervisorExternalInterrupt = False isSynchronousException MachineExternalInterrupt = False isSynchronousException CounterOverflowInterrupt = False -isSynchronousException (InstructionAddressMisaligned _) = True -isSynchronousException (InstructionAccessFault _) = True +isSynchronousException InstructionAddressMisaligned = True +isSynchronousException InstructionAccessFault = True isSynchronousException (IllegalInstruction _) = True isSynchronousException Breakpoint = True isSynchronousException LoadAddressMisaligned = True diff --git a/hs/Execute.hs b/hs/Execute.hs index dbeaf13..2694391 100644 --- a/hs/Execute.hs +++ b/hs/Execute.hs @@ -3,4 +3,21 @@ module Execute(execute) where -execute = 1 \ No newline at end of file +import Clash.Prelude +import Decode(DecodeResult(..)) +import DecodeTypes(Opcode(..)) + +import Types(Addr, DoubleWord) +import BusTypes( + WriteRequest(..), + ReadRequest(..), + ) +import RegFiles(RegFileIdx) +import Util((|>)) + +data ExecuteResult = ReadRequest {readRequest :: ReadRequest, insnAddr :: Addr} + | WriteRequest {writeRequest :: WriteRequest, insnAddr :: Addr} + | WriteBackGPR {idx :: RegFileIdx, val :: DoubleWord} + +execute :: DecodeResult -> ExecuteResult +execute = undefined \ No newline at end of file diff --git a/hs/Fetch.hs b/hs/Fetch.hs index d6088e2..760d8de 100644 --- a/hs/Fetch.hs +++ b/hs/Fetch.hs @@ -20,32 +20,32 @@ import BusTypes( import Exceptions(Exception(..)) import Util((|>)) -data FetchResult = Instruction Insn - | InstructionException Exception +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.Request addr BusTypes.SizeFullWord) peripherals + readReasponse <-Bus.read (BusTypes.ReadRequest addr BusTypes.SizeFullWord) peripherals case readReasponse of Right (BusFullWord insn) -> - pure |> Instruction insn + pure |> Instruction insn addr Left UnAligned -> - pure |> InstructionException (InstructionAddressMisaligned addr) + pure |> InstructionException InstructionAddressMisaligned addr Left UnMapped -> - pure |> InstructionException (InstructionAccessFault addr) + pure |> InstructionException InstructionAccessFault addr Right _ -> - pure |> InstructionException (InstructionAccessFault addr) + pure |> InstructionException InstructionAccessFault addr debugInsn :: FetchResult -> String -debugInsn fetchResult = - 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 +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 diff --git a/hs/Read.hs b/hs/Read.hs index 48b3591..3d9681a 100644 --- a/hs/Read.hs +++ b/hs/Read.hs @@ -15,61 +15,65 @@ import Cpu(RISCVCPU(..)) import RegFiles (RegVal(..), GPR) read :: DecodeResult -> RISCVCPU -> DecodeResult -read (Opcode opc) riscvCPU = - let gprRegFile = gpr riscvCPU - in case opc of - -- R-Type - ADD fields -> Opcode (ADD (readRTypeFields fields gprRegFile)) - SUB fields -> Opcode (SUB (readRTypeFields fields gprRegFile)) - XOR fields -> Opcode (XOR (readRTypeFields fields gprRegFile)) - OR fields -> Opcode (OR (readRTypeFields fields gprRegFile)) - AND fields -> Opcode (AND (readRTypeFields fields gprRegFile)) - SLL fields -> Opcode (SLL (readRTypeFields fields gprRegFile)) - SRL fields -> Opcode (SRL (readRTypeFields fields gprRegFile)) - SRA fields -> Opcode (SRA (readRTypeFields fields gprRegFile)) - SLT fields -> Opcode (SLT (readRTypeFields fields gprRegFile)) - SLTU fields -> Opcode (SLTU (readRTypeFields fields gprRegFile)) +read (Opcode opcode addr) riscvCPU = + let + gprRegFile = gpr riscvCPU + opcode' = case opcode of + -- R-Type + ADD fields -> (ADD (readRTypeFields fields gprRegFile)) + SUB fields -> (SUB (readRTypeFields fields gprRegFile)) + XOR fields -> (XOR (readRTypeFields fields gprRegFile)) + OR fields -> (OR (readRTypeFields fields gprRegFile)) + AND fields -> (AND (readRTypeFields fields gprRegFile)) + SLL fields -> (SLL (readRTypeFields fields gprRegFile)) + SRL fields -> (SRL (readRTypeFields fields gprRegFile)) + SRA fields -> (SRA (readRTypeFields fields gprRegFile)) + SLT fields -> (SLT (readRTypeFields fields gprRegFile)) + SLTU fields -> (SLTU (readRTypeFields fields gprRegFile)) - -- I-Type - ADDI fields -> Opcode (ADDI (readITypeFields fields gprRegFile)) - XORI fields -> Opcode (XORI (readITypeFields fields gprRegFile)) - ORI fields -> Opcode (ORI (readITypeFields fields gprRegFile)) - ANDI fields -> Opcode (ANDI (readITypeFields fields gprRegFile)) - SLLI fields -> Opcode (SLLI (readITypeFields fields gprRegFile)) - SRLI fields -> Opcode (SRLI (readITypeFields fields gprRegFile)) - SRAI fields -> Opcode (SRAI (readITypeFields fields gprRegFile)) - SLTI fields -> Opcode (SLTI (readITypeFields fields gprRegFile)) - SLTIU fields -> Opcode (SLTIU (readITypeFields fields gprRegFile)) - LB fields -> Opcode (LB (readITypeFields fields gprRegFile)) - LH fields -> Opcode (LH (readITypeFields fields gprRegFile)) - LW fields -> Opcode (LW (readITypeFields fields gprRegFile)) - LBU fields -> Opcode (LBU (readITypeFields fields gprRegFile)) - LHU fields -> Opcode (LHU (readITypeFields fields gprRegFile)) - JALR fields -> Opcode (JALR (readITypeFields fields gprRegFile)) - ECALL fields -> Opcode (ECALL (readITypeFields fields gprRegFile)) -- No regs needed, but consistent - EBREAK fields -> Opcode (EBREAK (readITypeFields fields gprRegFile)) -- Ditto + -- I-Type + ADDI fields -> (ADDI (readITypeFields fields gprRegFile)) + XORI fields -> (XORI (readITypeFields fields gprRegFile)) + ORI fields -> (ORI (readITypeFields fields gprRegFile)) + ANDI fields -> (ANDI (readITypeFields fields gprRegFile)) + SLLI fields -> (SLLI (readITypeFields fields gprRegFile)) + SRLI fields -> (SRLI (readITypeFields fields gprRegFile)) + SRAI fields -> (SRAI (readITypeFields fields gprRegFile)) + SLTI fields -> (SLTI (readITypeFields fields gprRegFile)) + SLTIU fields -> (SLTIU (readITypeFields fields gprRegFile)) + LB fields -> (LB (readITypeFields fields gprRegFile)) + LH fields -> (LH (readITypeFields fields gprRegFile)) + LW fields -> (LW (readITypeFields fields gprRegFile)) + LBU fields -> (LBU (readITypeFields fields gprRegFile)) + LHU fields -> (LHU (readITypeFields fields gprRegFile)) + JALR fields -> (JALR (readITypeFields fields gprRegFile)) + ECALL fields -> (ECALL (readITypeFields fields gprRegFile)) -- No regs needed, but consistent + EBREAK fields -> (EBREAK (readITypeFields fields gprRegFile)) -- Ditto - -- S-Type - SB fields -> Opcode (SB (readSTypeFields fields gprRegFile)) - SH fields -> Opcode (SH (readSTypeFields fields gprRegFile)) - SW fields -> Opcode (SW (readSTypeFields fields gprRegFile)) + -- S-Type + SB fields -> (SB (readSTypeFields fields gprRegFile)) + SH fields -> (SH (readSTypeFields fields gprRegFile)) + SW fields -> (SW (readSTypeFields fields gprRegFile)) - -- B-Type - BEQ fields -> Opcode (BEQ (readBTypeFields fields gprRegFile)) - BNE fields -> Opcode (BNE (readBTypeFields fields gprRegFile)) - BLT fields -> Opcode (BLT (readBTypeFields fields gprRegFile)) - BGE fields -> Opcode (BGE (readBTypeFields fields gprRegFile)) - BLTU fields -> Opcode (BLTU (readBTypeFields fields gprRegFile)) - BGEU fields -> Opcode (BGEU (readBTypeFields fields gprRegFile)) + -- B-Type + BEQ fields -> (BEQ (readBTypeFields fields gprRegFile)) + BNE fields -> (BNE (readBTypeFields fields gprRegFile)) + BLT fields -> (BLT (readBTypeFields fields gprRegFile)) + BGE fields -> (BGE (readBTypeFields fields gprRegFile)) + BLTU fields -> (BLTU (readBTypeFields fields gprRegFile)) + BGEU fields -> (BGEU (readBTypeFields fields gprRegFile)) - -- U-Type - LUI fields -> Opcode (LUI (readUTypeFields fields gprRegFile)) - AUIPC fields -> Opcode (AUIPC (readUTypeFields fields gprRegFile)) + -- U-Type + LUI fields -> (LUI (readUTypeFields fields gprRegFile)) + AUIPC fields -> (AUIPC (readUTypeFields fields gprRegFile)) - -- J-Type - JAL fields -> Opcode (JAL (readJTypeFields fields gprRegFile)) -read (DecodeException e) _ = DecodeException e -read (InstructionException e) _ = InstructionException e + -- J-Type + JAL fields -> (JAL (readJTypeFields fields gprRegFile)) + in + Opcode opcode' addr + +read (DecodeException e addr) _ = DecodeException e addr +read (InstructionException e addr) _ = InstructionException e addr readRTypeFields :: RTypeFields -> GPR -> RTypeFields readRTypeFields (RTypeFields rd funct3 rs1 rs2 funct7) gprRegFile =