diff --git a/hs/Decode/Opcodes.hs b/hs/Decode/Opcodes.hs deleted file mode 100644 index 6c48b4e..0000000 --- a/hs/Decode/Opcodes.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE NumericUnderscores #-} - -module Decode.Opcodes(Opcode(..)) where -import Clash.Prelude -import Data.Functor.Contravariant (Op) - -type FUNCT7 = Unsigned 7 -type RS2 = Unsigned 5 -type RS1 = Unsigned 5 -type FUNCT3 = Unsigned 3 -type RD = Unsigned 5 -type OPCODE = Unsigned 7 - -type IMM12 = Unsigned 12 -type IMM13 = Unsigned 13 -type IMM20 = Unsigned 20 -type IMM21 = Unsigned 21 - -data RTypeFields = RTypeFields OPCODE RD FUNCT3 RS1 RS2 FUNCT7 -data ITypeFields = ITypeFields OPCODE RD FUNCT3 RS1 IMM12 -data STypeFields = STypeFields OPCODE FUNCT3 RS1 RS2 IMM12 -data BTypeFields = BTypeFields OPCODE FUNCT3 RS1 RS2 IMM13 -data UTypeFields = UTypeFields OPCODE RD IMM20 -data JTypeFields = JTypeFields OPCODE RD IMM21 - -data Opcode - = ADD RTypeFields - | SUB RTypeFields - | XOR RTypeFields - | OR RTypeFields - | AND RTypeFields - | SLL RTypeFields - | SRL RTypeFields - | SRA RTypeFields - | SLT RTypeFields - | SLTU RTypeFields - | ADDRI ITypeFields - | XORI ITypeFields - | ORI ITypeFields - | ANDI ITypeFields - | SLLI ITypeFields - | SRLI ITypeFields - | SRAI ITypeFields - | SLTI ITypeFields - | SLTIU ITypeFields - | LB ITypeFields - | LH ITypeFields - | LW ITypeFields - | LBU ITypeFields - | LHU ITypeFields - diff --git a/hs/Fetch.hs b/hs/Fetch.hs index 2bcc296..612766d 100644 --- a/hs/Fetch.hs +++ b/hs/Fetch.hs @@ -4,13 +4,13 @@ module Fetch(fetchInstruction) where import Clash.Prelude -import Types(Mem, Addr, FullWord) +import Types(Mem, Addr, Insn) import Util(endianSwapWord) -data Insn = Instruction FullWord - | Misaligned Addr +data FetchResult = Instruction Insn + | Misaligned Addr -fetchInstruction :: KnownNat n => Mem n -> Addr -> Insn +fetchInstruction :: KnownNat n => Mem n -> Addr -> FetchResult fetchInstruction mem addr = let isWordAligned = addr .&. 3 == 0 diff --git a/hs/Isa/Decode.hs b/hs/Isa/Decode.hs new file mode 100644 index 0000000..edd6b70 --- /dev/null +++ b/hs/Isa/Decode.hs @@ -0,0 +1,192 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NumericUnderscores #-} + +module Isa.Decode(decode) where + +import Isa.Forms( + FUNCT7, RS2, RS1, FUNCT3, RD, OPCODE, + IMM12, IMM13, IMM20, IMM21, + + RTypeFields(..), ITypeFields(..), STypeFields(..), + BTypeFields(..), UTypeFields(..), JTypeFields(..), + + Opcode(..) + ) +import Clash.Prelude +import Data.Functor.Contravariant (Op) +import Types(Mem, Addr, Insn) +import Distribution.Backpack.FullUnitId (FullDb) + +getOpcode :: Insn -> Unsigned 7 +getOpcode instr = bitCoerce $ slice d6 d0 (pack instr) + +getImm12 :: Insn -> Unsigned 12 +getImm12 instr = bitCoerce $ slice d31 d20 (pack instr) + +getImm12SType :: Insn -> Unsigned 12 +getImm12SType instr = bitCoerce $ immediateUpper ++# immediateLower + where + immediateUpper = (slice d31 d25 (pack instr)) + immediateLower = (slice d11 d7 (pack instr)) + +getImm20UType :: Insn -> Unsigned 20 +getImm20UType instr = bitCoerce $ slice d31 d12 (pack instr) + +getImm13BType :: Insn -> Unsigned 13 +getImm13BType instr = bitCoerce $ imm12 ++# imm10_5 ++# imm4_1 ++# imm11 ++# zero + where + imm12 = slice d31 d31 (pack instr) -- imm[12] + imm10_5 = slice d30 d25 (pack instr) -- imm[10:5] + imm4_1 = slice d11 d8 (pack instr) -- imm[4:1] + imm11 = slice d7 d7 (pack instr) -- imm[11] + zero = 0 :: BitVector 1 -- LSB always zero for B-type + +getFunct3 :: Insn -> Unsigned 3 +getFunct3 instr = bitCoerce $ slice d14 d12 (pack instr) + +getFunct7 :: Insn -> Unsigned 7 +getFunct7 instr = bitCoerce $ slice d31 d25 (pack instr) + +getRd :: Insn -> Unsigned 5 +getRd instr = bitCoerce $ slice d11 d7 (pack instr) + +getRs2 :: Insn -> Unsigned 5 +getRs2 instr = bitCoerce $ slice d24 d20 (pack instr) + +getRs1 :: Insn -> Unsigned 5 +getRs1 instr = bitCoerce $ slice d19 d15 (pack instr) + +decodeRType :: Insn -> Opcode +decodeRType insn = + case funct3 of + 0x00 -> ADD (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x00 -> SUB (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x04 -> XOR (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x06 -> OR (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x07 -> AND (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x01 -> SLL (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x05 -> SRL (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x05 -> SRA (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x02 -> SLT (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x03 -> SLTU (RTypeFields opcode rd funct3 rs1 rs2 funct7) + _ -> Unimplemented + where + opcode = getOpcode insn + rd = getRd insn + funct3 = getFunct3 insn + rs1 = getRs1 insn + rs2 = getRs2 insn + funct7 = getFunct7 insn + +decodeIType :: Insn -> Opcode +decodeIType insn = case opcode of + 0b0010011 -> case funct3 of + 0x0 -> ADDI (ITypeFields opcode rd funct3 rs1 imm) + 0x4 -> XORI (ITypeFields opcode rd funct3 rs1 imm) + 0x6 -> ORI (ITypeFields opcode rd funct3 rs1 imm) + 0x7 -> ANDI (ITypeFields opcode rd funct3 rs1 imm) + 0x1 -> if slice d31 d25 (pack insn) == 0 + then SLLI (ITypeFields opcode rd funct3 rs1 imm) + else Unimplemented + 0x5 -> case slice d31 d25 (pack insn) of -- Distinguish SRLI and SRAI + 0x00 -> SRLI (ITypeFields opcode rd funct3 rs1 imm) + 0x20 -> SRAI (ITypeFields opcode rd funct3 rs1 imm) + _ -> Unimplemented + 0x2 -> SLTI (ITypeFields opcode rd funct3 rs1 imm) + 0x3 -> SLTIU (ITypeFields opcode rd funct3 rs1 imm) + _ -> Unimplemented + + 0b0000011 -> case funct3 of + 0x0 -> LB (ITypeFields opcode rd funct3 rs1 imm) + 0x1 -> LH (ITypeFields opcode rd funct3 rs1 imm) + 0x2 -> LW (ITypeFields opcode rd funct3 rs1 imm) + 0x4 -> LBU (ITypeFields opcode rd funct3 rs1 imm) + 0x5 -> LHU (ITypeFields opcode rd funct3 rs1 imm) + _ -> Unimplemented + + 0b1100111 -> case funct3 of + 0x0 -> JALR (ITypeFields opcode rd funct3 rs1 imm) + _ -> Unimplemented + + 0b1110011 -> case imm of + 0x000 -> ECALL (ITypeFields opcode rd funct3 rs1 imm) + 0x001 -> EBREAK (ITypeFields opcode rd funct3 rs1 imm) + _ -> Unimplemented + + _ -> Unimplemented + where + opcode = getOpcode insn + rd = getRd insn + funct3 = getFunct3 insn + rs1 = getRs1 insn + imm = getImm12 insn + +decodeSType :: Insn -> Opcode +decodeSType insn = case funct3 of + 0x0 -> SB (STypeFields opcode funct3 rs1 rs2 imm12) -- Store Byte + 0x1 -> SH (STypeFields opcode funct3 rs1 rs2 imm12) -- Store Halfword + 0x2 -> SW (STypeFields opcode funct3 rs1 rs2 imm12) -- Store Word + _ -> Unimplemented + where + opcode = getOpcode insn + funct3 = getFunct3 insn + rs1 = getRs1 insn + rs2 = getRs2 insn + imm12 = getImm12SType insn + +decodeBType :: Insn -> Opcode +decodeBType insn = case funct3 of + 0x0 -> BEQ (BTypeFields opcode funct3 rs1 rs2 imm13) -- Branch if equal + 0x1 -> BNE (BTypeFields opcode funct3 rs1 rs2 imm13) -- Branch if not equal + 0x4 -> BLT (BTypeFields opcode funct3 rs1 rs2 imm13) -- Branch if less than + 0x5 -> BGE (BTypeFields opcode funct3 rs1 rs2 imm13) -- Branch if greater or equal + 0x6 -> BLTU (BTypeFields opcode funct3 rs1 rs2 imm13) -- Branch if less than (unsigned) + 0x7 -> BGEU (BTypeFields opcode funct3 rs1 rs2 imm13) -- Branch if greater or equal (unsigned) + _ -> Unimplemented + where + opcode = getOpcode insn + funct3 = getFunct3 insn + rs1 = getRs1 insn + rs2 = getRs2 insn + imm13 = getImm13BType insn + +decodeUType :: Insn -> Opcode +decodeUType insn = case opcode of + 0b0110111 -> LUI (UTypeFields opcode rd imm20) -- LUI + 0b0010111 -> AUIPC (UTypeFields opcode rd imm20) -- AUIPC + _ -> Unimplemented + where + opcode = getOpcode insn + rd = getRd insn + imm20 = getImm20UType insn + +getImm21JType :: Insn -> Unsigned 21 +getImm21JType instr = bitCoerce $ imm20 ++# imm10_1 ++# imm11 ++# imm19_12 ++# zero + where + imm20 = slice d31 d31 (pack instr) -- imm[20] + imm10_1 = slice d30 d21 (pack instr) -- imm[10:1] + imm11 = slice d20 d20 (pack instr) -- imm[11] + imm19_12 = slice d19 d12 (pack instr) -- imm[19:12] + zero = 0 :: BitVector 1 -- LSB always zero for J-type + +decodeJType :: Insn -> Opcode +decodeJType insn = case getOpcode insn of + 0b1101111 -> JAL (JTypeFields opcode rd imm21) -- JAL + _ -> Unimplemented + where + opcode = getOpcode insn + rd = getRd insn + imm21 = getImm21JType insn + +orElse :: Opcode -> Opcode -> Opcode +orElse Unimplemented y = y +orElse x _ = x + +decode :: Insn -> Opcode +decode insn = + decodeRType insn `orElse` + decodeIType insn `orElse` + decodeSType insn `orElse` + decodeBType insn `orElse` + decodeUType insn `orElse` + decodeJType insn diff --git a/hs/Isa/Forms.hs b/hs/Isa/Forms.hs new file mode 100644 index 0000000..3963748 --- /dev/null +++ b/hs/Isa/Forms.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NumericUnderscores #-} + +module Isa.Forms( + FUNCT7, RS2, RS1, FUNCT3, RD, OPCODE, + IMM12, IMM13, IMM20, IMM21, + + RTypeFields(..), ITypeFields(..), STypeFields(..), + BTypeFields(..), UTypeFields(..), JTypeFields(..), + + Opcode(..) +) where +import Clash.Prelude +import Types(Mem, Addr, Insn) + +type FUNCT7 = Unsigned 7 +type RS2 = Unsigned 5 +type RS1 = Unsigned 5 +type FUNCT3 = Unsigned 3 +type RD = Unsigned 5 +type OPCODE = Unsigned 7 + +type IMM12 = Unsigned 12 +type IMM13 = Unsigned 13 +type IMM20 = Unsigned 20 +type IMM21 = Unsigned 21 + +data RTypeFields = RTypeFields OPCODE RD FUNCT3 RS1 RS2 FUNCT7 deriving (Generic, Show, Eq, NFDataX) +data ITypeFields = ITypeFields OPCODE RD FUNCT3 RS1 IMM12 deriving (Generic, Show, Eq, NFDataX) +data STypeFields = STypeFields OPCODE FUNCT3 RS1 RS2 IMM12 deriving (Generic, Show, Eq, NFDataX) +data BTypeFields = BTypeFields OPCODE FUNCT3 RS1 RS2 IMM13 deriving (Generic, Show, Eq, NFDataX) +data UTypeFields = UTypeFields OPCODE RD IMM20 deriving (Generic, Show, Eq, NFDataX) +data JTypeFields = JTypeFields OPCODE RD IMM21 deriving (Generic, Show, Eq, NFDataX) + +data Opcode + = + -- R-Type + ADD RTypeFields + | SUB RTypeFields + | XOR RTypeFields + | OR RTypeFields + | AND RTypeFields + | SLL RTypeFields + | SRL RTypeFields + | SRA RTypeFields + | SLT RTypeFields + | SLTU RTypeFields + + -- I-Type + | ADDI ITypeFields + | XORI ITypeFields + | ORI ITypeFields + | ANDI ITypeFields + | SLLI ITypeFields + | SRLI ITypeFields + | SRAI ITypeFields + | SLTI ITypeFields + | SLTIU ITypeFields + | LB ITypeFields + | LH ITypeFields + | LW ITypeFields + | LBU ITypeFields + | LHU ITypeFields + | ECALL ITypeFields + | EBREAK ITypeFields + + -- S-Type + | SB STypeFields + | SH STypeFields + | SW STypeFields + + -- B-Type + | BEQ BTypeFields + | BNE BTypeFields + | BLT BTypeFields + | BGE BTypeFields + | BLTU BTypeFields + | BGEU BTypeFields + + -- J-Type + | JAL JTypeFields + | JALR ITypeFields + + -- U-Type + | LUI UTypeFields + | AUIPC UTypeFields + + | Unimplemented + deriving (Generic, Show, Eq, NFDataX) diff --git a/hs/Simulation.hs b/hs/Simulation.hs index 023bc6e..d02b572 100644 --- a/hs/Simulation.hs +++ b/hs/Simulation.hs @@ -47,9 +47,6 @@ machine' machine = in machine { cpu = cpu', mem = mem' } -machineSignal :: HiddenClockResetEnable dom => Signal dom Machine -machineSignal = register machine (machine' <$> machineSignal) - simulationLoop :: Int -> Machine -> IO [Machine] simulationLoop 0 state = return [state] simulationLoop n state = do diff --git a/hs/Types.hs b/hs/Types.hs index 11300ee..50f1a38 100644 --- a/hs/Types.hs +++ b/hs/Types.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE NumericUnderscores #-} -module Types(Pc, BusVal(..), Mem, FullWord, Addr) where +module Types(Pc, BusVal(..), Mem, FullWord, Insn, Addr) where import Clash.Prelude @@ -10,6 +10,7 @@ type HalfWord = Unsigned 16 type FullWord = Unsigned 32 type DoubleWord = Unsigned 64 type QuadWord = Unsigned 128 +type Insn = FullWord data BusVal = BusByte Byte diff --git a/rv_formal.cabal b/rv_formal.cabal index f8ed3bd..b938969 100644 --- a/rv_formal.cabal +++ b/rv_formal.cabal @@ -87,7 +87,8 @@ library exposed-modules: Simulation other-modules: - Decode.Opcodes, + Isa.Decode, + Isa.Forms, Peripherals.Ram, Peripherals.UartCFFI, Peripherals.Setup,