diff --git a/hs/Decode.hs b/hs/Decode.hs index d5e67fb..cb72494 100644 --- a/hs/Decode.hs +++ b/hs/Decode.hs @@ -30,17 +30,17 @@ decode (Fetch.InstructionException exception) = insnToOpcode :: Insn -> Maybe Opcode insnToOpcode insn = - decodeRType insn `orElse` - decodeIType insn `orElse` - decodeSType insn `orElse` - decodeBType insn `orElse` - decodeUType insn `orElse` + decodeRType insn `chainAndTry` + decodeIType insn `chainAndTry` + decodeSType insn `chainAndTry` + decodeBType insn `chainAndTry` + decodeUType insn `chainAndTry` decodeJType insn where - orElse :: Maybe Opcode -> Maybe Opcode -> Maybe Opcode - orElse (Just left) _ = Just left - orElse Nothing (Just right) = Just right - orElse _ _ = Nothing + chainAndTry :: Maybe Opcode -> Maybe Opcode -> Maybe Opcode + chainAndTry (Just left) _ = Just left + chainAndTry Nothing (Just right) = Just right + chainAndTry _ _ = Nothing decodeRType :: Insn -> Maybe Opcode decodeRType insn = diff --git a/hs/Read.hs b/hs/Read.hs index 10026cd..48b3591 100644 --- a/hs/Read.hs +++ b/hs/Read.hs @@ -16,42 +16,82 @@ import RegFiles (RegVal(..), GPR) read :: DecodeResult -> RISCVCPU -> DecodeResult read (Opcode opc) riscvCPU = - case opc of - ADD fields -> Opcode (ADD (readRTypeFields fields (gpr riscvCPU))) - SUB fields -> Opcode (SUB (readRTypeFields fields (gpr riscvCPU))) - XOR fields -> Opcode (XOR (readRTypeFields fields (gpr riscvCPU))) - OR fields -> Opcode (OR (readRTypeFields fields (gpr riscvCPU))) - AND fields -> Opcode (AND (readRTypeFields fields (gpr riscvCPU))) - SLL fields -> Opcode (SLL (readRTypeFields fields (gpr riscvCPU))) - SRL fields -> Opcode (SRL (readRTypeFields fields (gpr riscvCPU))) - SRA fields -> Opcode (SRA (readRTypeFields fields (gpr riscvCPU))) - SLT fields -> Opcode (SLT (readRTypeFields fields (gpr riscvCPU))) - SLTU fields -> Opcode (SLTU (readRTypeFields fields (gpr riscvCPU))) - _ -> undefined + 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)) + + -- 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 + + -- S-Type + SB fields -> Opcode (SB (readSTypeFields fields gprRegFile)) + SH fields -> Opcode (SH (readSTypeFields fields gprRegFile)) + SW fields -> Opcode (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)) + + -- U-Type + LUI fields -> Opcode (LUI (readUTypeFields fields gprRegFile)) + AUIPC fields -> Opcode (AUIPC (readUTypeFields fields gprRegFile)) + + -- J-Type + JAL fields -> Opcode (JAL (readJTypeFields fields gprRegFile)) read (DecodeException e) _ = DecodeException e read (InstructionException e) _ = InstructionException e readRTypeFields :: RTypeFields -> GPR -> RTypeFields readRTypeFields (RTypeFields rd funct3 rs1 rs2 funct7) gprRegFile = - let rs1_val = fetchRegVal rs1 gprRegFile - rs2_val = fetchRegVal rs2 gprRegFile + let rs1_val = fetchGPRRegVal rs1 gprRegFile + rs2_val = fetchGPRRegVal rs2 gprRegFile in RTypeFields rd funct3 rs1_val rs2_val funct7 readITypeFields :: ITypeFields -> GPR -> ITypeFields -readITypeFields (ITypeFields rd funct3 rs1 imm) gpr = - let rs1_val = fetchRegVal rs1 gpr +readITypeFields (ITypeFields rd funct3 rs1 imm) gprRegFile = + let rs1_val = fetchGPRRegVal rs1 gprRegFile in ITypeFields rd funct3 rs1_val imm readSTypeFields :: STypeFields -> GPR -> STypeFields -readSTypeFields (STypeFields funct3 rs1 rs2 imm12) gpr = - let rs1_val = fetchRegVal rs1 gpr - rs2_val = fetchRegVal rs2 gpr +readSTypeFields (STypeFields funct3 rs1 rs2 imm12) gprRegFile = + let rs1_val = fetchGPRRegVal rs1 gprRegFile + rs2_val = fetchGPRRegVal rs2 gprRegFile in STypeFields funct3 rs1_val rs2_val imm12 readBTypeFields :: BTypeFields -> GPR -> BTypeFields -readBTypeFields (BTypeFields funct3 rs1 rs2 imm13) gpr = - let rs1_val = fetchRegVal rs1 gpr - rs2_val = fetchRegVal rs2 gpr +readBTypeFields (BTypeFields funct3 rs1 rs2 imm13) gprRegFile = + let rs1_val = fetchGPRRegVal rs1 gprRegFile + rs2_val = fetchGPRRegVal rs2 gprRegFile in BTypeFields funct3 rs1_val rs2_val imm13 readUTypeFields :: UTypeFields -> GPR -> UTypeFields @@ -60,7 +100,6 @@ readUTypeFields fields@(UTypeFields rd imm20) _ = fields readJTypeFields :: JTypeFields -> GPR -> JTypeFields readJTypeFields fields@(JTypeFields rd imm21) _ = fields --- Helper function to fetch register value -fetchRegVal :: RegVal -> GPR -> RegVal -fetchRegVal (Unpopulated idx) gprVal = Value idx (gprVal !! idx) -fetchRegVal val@(Value _ _) _ = val -- Already populated, no change \ No newline at end of file +fetchGPRRegVal :: RegVal -> GPR -> RegVal +fetchGPRRegVal (Unpopulated idx) gprVal = Value idx (gprVal !! idx) +fetchGPRRegVal val@(Value _ _) _ = val -- Already populated, no change \ No newline at end of file diff --git a/hs/RegFiles.hs b/hs/RegFiles.hs index 0329faa..ff9bd52 100644 --- a/hs/RegFiles.hs +++ b/hs/RegFiles.hs @@ -28,8 +28,11 @@ import Util((|>)) import Types(DoubleWord) type RegFileIdx = Unsigned 5 -data RegVal = Value RegFileIdx DoubleWord - | Unpopulated RegFileIdx +data RegVal = Value { + regFileIdx :: RegFileIdx, + regVal :: DoubleWord + } + | Unpopulated {regFileIdx :: RegFileIdx} deriving (Generic, Show, Eq, NFDataX) type GPR = Vec 32 (Unsigned 64) -- General Purpose Registers diff --git a/hs/Simulation.hs b/hs/Simulation.hs index d3dbd65..52130f8 100644 --- a/hs/Simulation.hs +++ b/hs/Simulation.hs @@ -15,6 +15,7 @@ import Peripherals.Setup(setupPeripherals, InitializedPeripherals(..)) import Peripherals.Teardown(teardownPeripherals) import Clash.Prelude import Bus(Peripherals(..)) +import Read(read) import Cpu( RISCVCPU(..), riscvCPUInit) @@ -44,8 +45,8 @@ simulationLoop n machine = do let machinePeripherals = peripherals machine currPc = pc |> cpu machine fetchResult <- fetchInstruction machinePeripherals currPc - let decodeResult = decode fetchResult - putStrLn |> show decodeResult P.++ debugInsn fetchResult + let decodeResult = Read.read (decode fetchResult) (cpu machine) + putStrLn |> show decodeResult -- P.++ debugInsn fetchResult let pc' = currPc + 4 cpu' = (cpu machine) { pc = pc' } machine' = machine { cpu = cpu' }