{-# 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 opcode of
    0b0110011 ->
      case funct3 of
        0x00 -> case funct7 of
                  0x00 -> ADD (RTypeFields opcode rd funct3 rs1 rs2 funct7)
                  0x20 -> SUB (RTypeFields opcode rd funct3 rs1 rs2 funct7)
                  _    -> Unimplemented
        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 -> case funct7 of
                  0x00 -> SRL (RTypeFields opcode rd funct3 rs1 rs2 funct7)
                  0x20 -> SRA (RTypeFields opcode rd funct3 rs1 rs2 funct7)
                  _    -> Unimplemented
        0x02 -> SLT  (RTypeFields opcode rd funct3 rs1 rs2 funct7)
        0x03 -> SLTU (RTypeFields opcode rd funct3 rs1 rs2 funct7)
        _    -> Unimplemented
    _ -> 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 opcode of
    0b0100011 -> 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
    _ -> Unimplemented
  where
    opcode = getOpcode insn
    funct3 = getFunct3 insn
    rs1    = getRs1    insn
    rs2    = getRs2    insn
    imm12  = getImm12SType insn

decodeBType :: Insn -> Opcode
decodeBType insn =
  case opcode of
    0b1100011 -> 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
    _ -> 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 opcode 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