RiscV-Formal/hs/Decode.hs

219 lines
8 KiB
Haskell

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NumericUnderscores #-}
module Decode(decode, DecodeResult(..)) where
import DecodeTypes(
RTypeFields(..), ITypeFields(..), STypeFields(..),
BTypeFields(..), UTypeFields(..), JTypeFields(..),
Opcode(..)
)
import Clash.Prelude
import Fetch(FetchResult (Instruction, InstructionException))
import Exceptions(Exception(..))
import Types(Insn, Addr)
import RegFiles(RegVal(..))
import Util((|>))
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 addr) =
case insnToOpcode insn of
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 =
decodeRType insn `chainAndTry`
decodeIType insn `chainAndTry`
decodeSType insn `chainAndTry`
decodeBType insn `chainAndTry`
decodeUType insn `chainAndTry`
decodeJType insn
where
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 =
case opcode of
0b0110011 ->
case funct3 of
0x00 -> case funct7 of
0x00 -> Just |> ADD (RTypeFields rd funct3 rs1 rs2 funct7)
0x20 -> Just |> SUB (RTypeFields rd funct3 rs1 rs2 funct7)
_ -> Nothing
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 rd funct3 rs1 rs2 funct7)
0x20 -> Just |> SRA (RTypeFields rd funct3 rs1 rs2 funct7)
_ -> Nothing
0x02 -> Just |> SLT (RTypeFields rd funct3 rs1 rs2 funct7)
0x03 -> Just |> SLTU (RTypeFields rd funct3 rs1 rs2 funct7)
_ -> Nothing
_ -> Nothing
where
opcode = getOpcode insn
rd = getRd insn
funct3 = getFunct3 insn
rs1 = getRs1 insn
rs2 = getRs2 insn
funct7 = getFunct7 insn
decodeIType :: Insn -> Maybe Opcode
decodeIType insn = case opcode of
0b0010011 -> case funct3 of
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 rd funct3 rs1 imm)
else Nothing
0x5 -> case slice d31 d25 (pack insn) of -- Distinguish SRLI and SRAI
0x00 -> Just |> SRLI (ITypeFields rd funct3 rs1 imm)
0x20 -> Just |> SRAI (ITypeFields rd funct3 rs1 imm)
_ -> Nothing
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 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 rd funct3 rs1 imm)
_ -> Nothing
0b1110011 -> case imm of
0x000 -> Just |> ECALL (ITypeFields rd funct3 rs1 imm)
0x001 -> Just |> EBREAK (ITypeFields rd funct3 rs1 imm)
_ -> Nothing
_ -> Nothing
where
opcode = getOpcode insn
rd = getRd insn
funct3 = getFunct3 insn
rs1 = getRs1 insn
imm = getImm12 insn
decodeSType :: Insn -> Maybe Opcode
decodeSType insn =
case opcode of
0b0100011 -> case funct3 of
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
opcode = getOpcode insn
funct3 = getFunct3 insn
rs1 = getRs1 insn
rs2 = getRs2 insn
imm12 = getImm12SType insn
decodeBType :: Insn -> Maybe Opcode
decodeBType insn =
case opcode of
0b1100011 -> case funct3 of
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
opcode = getOpcode insn
funct3 = getFunct3 insn
rs1 = getRs1 insn
rs2 = getRs2 insn
imm13 = getImm13BType insn
decodeUType :: Insn -> Maybe Opcode
decodeUType insn = case opcode of
0b0110111 -> Just |> LUI (UTypeFields rd imm20) -- LUI
0b0010111 -> Just |> AUIPC (UTypeFields rd imm20) -- AUIPC
_ -> Nothing
where
opcode = getOpcode insn
rd = getRd insn
imm20 = getImm20UType insn
decodeJType :: Insn -> Maybe Opcode
decodeJType insn =
case opcode of
0b1101111 -> Just |> JAL (JTypeFields rd imm21) -- JAL
_ -> Nothing
where
opcode = getOpcode insn
rd = getRd insn
imm21 = getImm21JType 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
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 -> RegVal
getRs2 instr = Unpopulated |> bitCoerce |> slice d24 d20 (pack instr)
getRs1 :: Insn -> RegVal
getRs1 instr = Unpopulated |> bitCoerce |> slice d19 d15 (pack instr)