diff --git a/hs/Decode.hs b/hs/Decode.hs index 2411df3..5ca18d1 100644 --- a/hs/Decode.hs +++ b/hs/Decode.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE NumericUnderscores #-} -module Decode(decode) where +module Decode(decode, DecodeResult) where import DecodeTypes( RTypeFields(..), ITypeFields(..), STypeFields(..), @@ -12,6 +12,7 @@ import Clash.Prelude import Fetch(FetchResult (Instruction, InstructionException)) import Exceptions(Exception(..)) import Types(Insn) +import RegFiles(RegVal(..)) import Util((|>)) data DecodeResult = Opcode Opcode @@ -47,19 +48,19 @@ decodeRType insn = 0b0110011 -> case funct3 of 0x00 -> case funct7 of - 0x00 -> Just |> ADD (RTypeFields opcode rd funct3 rs1 rs2 funct7) - 0x20 -> Just |> SUB (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x00 -> Just |> ADD (RTypeFields rd funct3 rs1 rs2 funct7) + 0x20 -> Just |> SUB (RTypeFields rd funct3 rs1 rs2 funct7) _ -> Nothing - 0x04 -> Just |> XOR (RTypeFields opcode rd funct3 rs1 rs2 funct7) - 0x06 -> Just |> OR (RTypeFields opcode rd funct3 rs1 rs2 funct7) - 0x07 -> Just |> AND (RTypeFields opcode rd funct3 rs1 rs2 funct7) - 0x01 -> Just |> SLL (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x04 -> Just |> XOR (RTypeFields rd funct3 rs1 rs2 funct7) + 0x06 -> Just |> OR (RTypeFields rd funct3 rs1 rs2 funct7) + 0x07 -> Just |> AND (RTypeFields rd funct3 rs1 rs2 funct7) + 0x01 -> Just |> SLL (RTypeFields rd funct3 rs1 rs2 funct7) 0x05 -> case funct7 of - 0x00 -> Just |> SRL (RTypeFields opcode rd funct3 rs1 rs2 funct7) - 0x20 -> Just |> SRA (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x00 -> Just |> SRL (RTypeFields rd funct3 rs1 rs2 funct7) + 0x20 -> Just |> SRA (RTypeFields rd funct3 rs1 rs2 funct7) _ -> Nothing - 0x02 -> Just |> SLT (RTypeFields opcode rd funct3 rs1 rs2 funct7) - 0x03 -> Just |> SLTU (RTypeFields opcode rd funct3 rs1 rs2 funct7) + 0x02 -> Just |> SLT (RTypeFields rd funct3 rs1 rs2 funct7) + 0x03 -> Just |> SLTU (RTypeFields rd funct3 rs1 rs2 funct7) _ -> Nothing _ -> Nothing where @@ -73,36 +74,36 @@ decodeRType insn = decodeIType :: Insn -> Maybe Opcode decodeIType insn = case opcode of 0b0010011 -> case funct3 of - 0x0 -> Just |> ADDI (ITypeFields opcode rd funct3 rs1 imm) - 0x4 -> Just |> XORI (ITypeFields opcode rd funct3 rs1 imm) - 0x6 -> Just |> ORI (ITypeFields opcode rd funct3 rs1 imm) - 0x7 -> Just |> ANDI (ITypeFields opcode rd funct3 rs1 imm) + 0x0 -> Just |> ADDI (ITypeFields rd funct3 rs1 imm) + 0x4 -> Just |> XORI (ITypeFields rd funct3 rs1 imm) + 0x6 -> Just |> ORI (ITypeFields rd funct3 rs1 imm) + 0x7 -> Just |> ANDI (ITypeFields rd funct3 rs1 imm) 0x1 -> if slice d31 d25 (pack insn) == 0 - then Just |> SLLI (ITypeFields opcode rd funct3 rs1 imm) + then Just |> SLLI (ITypeFields rd funct3 rs1 imm) else Nothing 0x5 -> case slice d31 d25 (pack insn) of -- Distinguish SRLI and SRAI - 0x00 -> Just |> SRLI (ITypeFields opcode rd funct3 rs1 imm) - 0x20 -> Just |> SRAI (ITypeFields opcode rd funct3 rs1 imm) + 0x00 -> Just |> SRLI (ITypeFields rd funct3 rs1 imm) + 0x20 -> Just |> SRAI (ITypeFields rd funct3 rs1 imm) _ -> Nothing - 0x2 -> Just |> SLTI (ITypeFields opcode rd funct3 rs1 imm) - 0x3 -> Just |> SLTIU (ITypeFields opcode rd funct3 rs1 imm) + 0x2 -> Just |> SLTI (ITypeFields rd funct3 rs1 imm) + 0x3 -> Just |> SLTIU (ITypeFields rd funct3 rs1 imm) _ -> Nothing 0b0000011 -> case funct3 of - 0x0 -> Just |> LB (ITypeFields opcode rd funct3 rs1 imm) - 0x1 -> Just |> LH (ITypeFields opcode rd funct3 rs1 imm) - 0x2 -> Just |> LW (ITypeFields opcode rd funct3 rs1 imm) - 0x4 -> Just |> LBU (ITypeFields opcode rd funct3 rs1 imm) - 0x5 -> Just |> LHU (ITypeFields opcode rd funct3 rs1 imm) + 0x0 -> Just |> LB (ITypeFields rd funct3 rs1 imm) + 0x1 -> Just |> LH (ITypeFields rd funct3 rs1 imm) + 0x2 -> Just |> LW (ITypeFields rd funct3 rs1 imm) + 0x4 -> Just |> LBU (ITypeFields rd funct3 rs1 imm) + 0x5 -> Just |> LHU (ITypeFields rd funct3 rs1 imm) _ -> Nothing 0b1100111 -> case funct3 of - 0x0 -> Just |> JALR (ITypeFields opcode rd funct3 rs1 imm) + 0x0 -> Just |> JALR (ITypeFields rd funct3 rs1 imm) _ -> Nothing 0b1110011 -> case imm of - 0x000 -> Just |> ECALL (ITypeFields opcode rd funct3 rs1 imm) - 0x001 -> Just |> EBREAK (ITypeFields opcode rd funct3 rs1 imm) + 0x000 -> Just |> ECALL (ITypeFields rd funct3 rs1 imm) + 0x001 -> Just |> EBREAK (ITypeFields rd funct3 rs1 imm) _ -> Nothing _ -> Nothing @@ -117,9 +118,9 @@ decodeSType :: Insn -> Maybe Opcode decodeSType insn = case opcode of 0b0100011 -> case funct3 of - 0x0 -> Just |> SB (STypeFields opcode funct3 rs1 rs2 imm12) -- Store Byte - 0x1 -> Just |> SH (STypeFields opcode funct3 rs1 rs2 imm12) -- Store Halfword - 0x2 -> Just |> SW (STypeFields opcode funct3 rs1 rs2 imm12) -- Store Word + 0x0 -> Just |> SB (STypeFields funct3 rs1 rs2 imm12) -- Store Byte + 0x1 -> Just |> SH (STypeFields funct3 rs1 rs2 imm12) -- Store Halfword + 0x2 -> Just |> SW (STypeFields funct3 rs1 rs2 imm12) -- Store Word _ -> Nothing _ -> Nothing where @@ -133,12 +134,12 @@ decodeBType :: Insn -> Maybe Opcode decodeBType insn = case opcode of 0b1100011 -> case funct3 of - 0x0 -> Just |> BEQ (BTypeFields opcode funct3 rs1 rs2 imm13) -- Branch if equal - 0x1 -> Just |> BNE (BTypeFields opcode funct3 rs1 rs2 imm13) -- Branch if not equal - 0x4 -> Just |> BLT (BTypeFields opcode funct3 rs1 rs2 imm13) -- Branch if less than - 0x5 -> Just |> BGE (BTypeFields opcode funct3 rs1 rs2 imm13) -- Branch if greater or equal - 0x6 -> Just |> BLTU (BTypeFields opcode funct3 rs1 rs2 imm13) -- Branch if less than (unsigned) - 0x7 -> Just |> BGEU (BTypeFields opcode funct3 rs1 rs2 imm13) -- Branch if greater or equal (unsigned) + 0x0 -> Just |> BEQ (BTypeFields funct3 rs1 rs2 imm13) -- Branch if equal + 0x1 -> Just |> BNE (BTypeFields funct3 rs1 rs2 imm13) -- Branch if not equal + 0x4 -> Just |> BLT (BTypeFields funct3 rs1 rs2 imm13) -- Branch if less than + 0x5 -> Just |> BGE (BTypeFields funct3 rs1 rs2 imm13) -- Branch if greater or equal + 0x6 -> Just |> BLTU (BTypeFields funct3 rs1 rs2 imm13) -- Branch if less than (unsigned) + 0x7 -> Just |> BGEU (BTypeFields funct3 rs1 rs2 imm13) -- Branch if greater or equal (unsigned) _ -> Nothing _ -> Nothing where @@ -150,8 +151,8 @@ decodeBType insn = decodeUType :: Insn -> Maybe Opcode decodeUType insn = case opcode of - 0b0110111 -> Just |> LUI (UTypeFields opcode rd imm20) -- LUI - 0b0010111 -> Just |> AUIPC (UTypeFields opcode rd imm20) -- AUIPC + 0b0110111 -> Just |> LUI (UTypeFields rd imm20) -- LUI + 0b0010111 -> Just |> AUIPC (UTypeFields rd imm20) -- AUIPC _ -> Nothing where opcode = getOpcode insn @@ -161,7 +162,7 @@ decodeUType insn = case opcode of decodeJType :: Insn -> Maybe Opcode decodeJType insn = case opcode of - 0b1101111 -> Just |> JAL (JTypeFields opcode rd imm21) -- JAL + 0b1101111 -> Just |> JAL (JTypeFields rd imm21) -- JAL _ -> Nothing where opcode = getOpcode insn @@ -210,8 +211,8 @@ 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) +getRs2 :: Insn -> RegVal +getRs2 instr = Unpopulated |> bitCoerce |> slice d24 d20 (pack instr) -getRs1 :: Insn -> Unsigned 5 -getRs1 instr = bitCoerce |> slice d19 d15 (pack instr) +getRs1 :: Insn -> RegVal +getRs1 instr = Unpopulated |> bitCoerce |> slice d19 d15 (pack instr) diff --git a/hs/DecodeTypes.hs b/hs/DecodeTypes.hs index 396510b..032778a 100644 --- a/hs/DecodeTypes.hs +++ b/hs/DecodeTypes.hs @@ -11,12 +11,13 @@ module DecodeTypes( Opcode(..) ) where import Clash.Prelude +import RegFiles(RegFileIdx, RegVal) type FUNCT7 = Unsigned 7 -type RS2 = Unsigned 5 -type RS1 = Unsigned 5 +type RS2 = RegVal +type RS1 = RegVal +type RD = RegFileIdx type FUNCT3 = Unsigned 3 -type RD = Unsigned 5 type OPCODE = Unsigned 7 type IMM12 = Unsigned 12 @@ -24,12 +25,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 RTypeFields = RTypeFields RD FUNCT3 RS1 RS2 FUNCT7 deriving (Generic, Show, Eq, NFDataX) +data ITypeFields = ITypeFields RD FUNCT3 RS1 IMM12 deriving (Generic, Show, Eq, NFDataX) +data STypeFields = STypeFields FUNCT3 RS1 RS2 IMM12 deriving (Generic, Show, Eq, NFDataX) +data BTypeFields = BTypeFields FUNCT3 RS1 RS2 IMM13 deriving (Generic, Show, Eq, NFDataX) +data UTypeFields = UTypeFields RD IMM20 deriving (Generic, Show, Eq, NFDataX) +data JTypeFields = JTypeFields RD IMM21 deriving (Generic, Show, Eq, NFDataX) data Opcode = diff --git a/hs/Read.hs b/hs/Read.hs index f1f9c2f..d7e5a60 100644 --- a/hs/Read.hs +++ b/hs/Read.hs @@ -2,24 +2,33 @@ {-# LANGUAGE NumericUnderscores #-} module Read(Read.read) where +import DecodeTypes( + Opcode(..), + + RTypeFields(..), ITypeFields(..), STypeFields(..), + BTypeFields(..), UTypeFields(..), JTypeFields(..), + + ) import Clash.Prelude -import Types(DoubleWord, Addr) +import Decode(DecodeResult) +-- import Types(DoubleWord, RegFileIdx, Addr) -data RegVal = Value DoubleWord - | Borrowed - deriving (Generic, Show, Eq, NFDataX) -data SRC = GPR RegVal - | FPR RegVal - | CSR RegVal - | PC Addr - deriving (Generic, Show, Eq, NFDataX) +-- data SRC = GPR RegVal +-- | FPR RegVal +-- | CSR RegVal +-- | PC Addr +-- deriving (Generic, Show, Eq, NFDataX) -data ReadResult = ReadResult - { src1 :: SRC, - src2 :: SRC, - src3 :: SRC - } - deriving (Generic, Show, Eq, NFDataX) +-- data ReadResult = ReadResult +-- { src1 :: SRC, +-- src2 :: SRC, +-- src3 :: SRC +-- } +-- deriving (Generic, Show, Eq, NFDataX) read = 2 + +-- opcodeToReadResult :: Opcode -> ReadResult +-- opcodeToReadResult (ADD (RTypeFields _ rd funct3 rs1 rs2 funct7)) = undefined +-- opcodeToReadResult _ = undefined diff --git a/hs/RegFiles.hs b/hs/RegFiles.hs index 2d73508..0329faa 100644 --- a/hs/RegFiles.hs +++ b/hs/RegFiles.hs @@ -13,6 +13,8 @@ -- * Counter/Timer Registers for time/cycle counting. -- * Hypervisor Registers (HPR) for guest virtualization. module RegFiles( + RegFileIdx, + RegVal(..), GPR, FPR, CSR, @@ -23,6 +25,12 @@ module RegFiles( import Clash.Prelude import Util((|>)) +import Types(DoubleWord) + +type RegFileIdx = Unsigned 5 +data RegVal = Value RegFileIdx DoubleWord + | Unpopulated RegFileIdx + deriving (Generic, Show, Eq, NFDataX) type GPR = Vec 32 (Unsigned 64) -- General Purpose Registers type FPR = Vec 32 (Unsigned 64) -- Floating Point Registers diff --git a/hs/Types.hs b/hs/Types.hs index 6c53c00..df998a4 100644 --- a/hs/Types.hs +++ b/hs/Types.hs @@ -1,8 +1,10 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE NumericUnderscores #-} -module Types(Pc, Mem, Insn, Addr, - Byte, HalfWord, FullWord, DoubleWord, QuadWord) +module Types( + Pc, Mem, Insn, Addr, + Byte, HalfWord, FullWord, DoubleWord, QuadWord + ) where import Clash.Prelude @@ -12,8 +14,8 @@ type HalfWord = Unsigned 16 type FullWord = Unsigned 32 type DoubleWord = Unsigned 64 type QuadWord = Unsigned 128 -type Insn = FullWord +type Insn = FullWord -type Pc = DoubleWord -type Addr = DoubleWord -type Mem n = Vec n FullWord +type Pc = DoubleWord +type Addr = DoubleWord +type Mem n = Vec n FullWord