content: {-# LANGUAGE CPP #-}
  
  {-|
  Module      : Lion.Instruction
  Description : RISC-V ISA
  Copyright   : (c) David Cox, 2024
  License     : BSD-3-Clause
  Maintainer  : standardsemiconductor@gmail.com
  -}
  
  module Lion.Instruction where
  
  #if __GLASGOW_HASKELL__ > 902
  import Clash.Prelude hiding (Xor(Xor), And(And))
  #else
  import Clash.Prelude
  #endif
  import Data.Function ( on )
  
  data Exception = IllegalInstruction
    deriving stock (Generic, Show, Eq)
    deriving anyclass NFDataX
  
  -- | Writeback pipeline instruction
  data WbInstr = WbRegWr (Unsigned 5) (BitVector 32)
               | WbLoad Load (Unsigned 5) (BitVector 4)
               | WbStore
               | WbNop
    deriving stock (Generic, Show, Eq)
    deriving anyclass NFDataX
  
  -- | Memory pipeline instruction
  data MeInstr = MeRegWr      (Unsigned 5)
               | MeJump       (Unsigned 5) (BitVector 32)
               | MeBranch
               | MeStore                   (BitVector 32) (BitVector 4) (BitVector 32)
               | MeLoad  Load (Unsigned 5) (BitVector 32) (BitVector 4)
               | MeNop
    deriving stock (Generic, Show, Eq)
    deriving anyclass NFDataX
  
  -- | Execute pipeline instruction
  data ExInstr = Ex       ExOp   (Unsigned 5) (BitVector 32)
               | ExJump   Jump   (Unsigned 5) (BitVector 32)
               | ExBranch Branch              (BitVector 32)
               | ExStore  Store               (BitVector 32)
               | ExLoad   Load   (Unsigned 5) (BitVector 32)
               | ExAlu    Op     (Unsigned 5)
               | ExAluImm Op     (Unsigned 5) (BitVector 32)
    deriving stock (Generic, Show, Eq)
    deriving anyclass NFDataX
  
  -- | ALU operation
  data Op = Add
          | Sub
          | Sll
          | Slt
          | Sltu
          | Xor
          | Srl
          | Sra
          | Or
          | And
    deriving stock (Generic, Show, Eq)
    deriving anyclass NFDataX
  
  -- | Branch operation
  data Branch = Beq
              | Bne
              | Blt
              | Bge
              | Bltu
              | Bgeu
    deriving stock (Generic, Show, Eq)
    deriving anyclass NFDataX
  
  -- | branch calculation
  branch :: Branch -> BitVector 32 -> BitVector 32 -> Bool
  branch = \case
    Beq  -> not ... (/=)
    Bne  -> (/=)
    Bge  -> not ... (<) `on` sign
    Bgeu -> not ... (<)
    Blt  -> (<) `on` sign
    Bltu -> (<)
    where
      (...) = (.).(.)
      sign :: BitVector 32 -> Signed 32
      sign = unpack
  
  data ExOp = Lui
            | Auipc
    deriving stock (Generic, Show, Eq)
    deriving anyclass NFDataX
  
  data Jump = Jal | Jalr
    deriving stock (Generic, Show, Eq)
    deriving anyclass NFDataX
  
  -- | Store operation
  data Store = Sb
             | Sh
             | Sw
    deriving stock (Generic, Show, Eq)
    deriving anyclass NFDataX
  
  -- | Load operation
  data Load = Lb
            | Lh
            | Lw
            | Lbu
            | Lhu
    deriving stock (Generic, Show, Eq)
    deriving anyclass NFDataX
  
  parseInstr :: BitVector 32 -> Either Exception ExInstr
  parseInstr i = case i of
    $(bitPattern ".........................0110111") -> Right $ Ex Lui   rd immU -- lui
    $(bitPattern ".........................0010111") -> Right $ Ex Auipc rd immU -- auipc
    $(bitPattern ".........................1101111") -> Right $ ExJump Jal  rd immJ -- jal
    $(bitPattern ".................000.....1100111") -> Right $ ExJump Jalr rd immI -- jalr
    $(bitPattern ".................000.....1100011") -> Right $ ExBranch Beq  immB -- beq
    $(bitPattern ".................001.....1100011") -> Right $ ExBranch Bne  immB -- bne
    $(bitPattern ".................100.....1100011") -> Right $ ExBranch Blt  immB -- blt
    $(bitPattern ".................101.....1100011") -> Right $ ExBranch Bge  immB -- bge
    $(bitPattern ".................110.....1100011") -> Right $ ExBranch Bltu immB -- bltu
    $(bitPattern ".................111.....1100011") -> Right $ ExBranch Bgeu immB -- bgeu
    $(bitPattern ".................000.....0000011") -> Right $ ExLoad Lb  rd immI -- lb
    $(bitPattern ".................001.....0000011") -> Right $ ExLoad Lh  rd immI -- lh
    $(bitPattern ".................010.....0000011") -> Right $ ExLoad Lw  rd immI -- lw
    $(bitPattern ".................100.....0000011") -> Right $ ExLoad Lbu rd immI -- lbu
    $(bitPattern ".................101.....0000011") -> Right $ ExLoad Lhu rd immI -- lhu
    $(bitPattern ".................000.....0100011") -> Right $ ExStore Sb immS -- sb
    $(bitPattern ".................001.....0100011") -> Right $ ExStore Sh immS -- sh
    $(bitPattern ".................010.....0100011") -> Right $ ExStore Sw immS -- sw
    $(bitPattern ".................000.....0010011") -> Right $ ExAluImm Add  rd immI -- addi
    $(bitPattern ".................010.....0010011") -> Right $ ExAluImm Slt  rd immI -- slti
    $(bitPattern ".................011.....0010011") -> Right $ ExAluImm Sltu rd immI -- sltiu
    $(bitPattern ".................100.....0010011") -> Right $ ExAluImm Xor  rd immI -- xori
    $(bitPattern ".................110.....0010011") -> Right $ ExAluImm Or   rd immI -- ori
    $(bitPattern ".................111.....0010011") -> Right $ ExAluImm And  rd immI -- andi
    $(bitPattern "0000000..........001.....0010011") -> Right $ ExAluImm Sll  rd immI -- slli
    $(bitPattern "0000000..........101.....0010011") -> Right $ ExAluImm Srl  rd immI -- srli
    $(bitPattern "0100000..........101.....0010011") -> Right $ ExAluImm Sra  rd immI -- srai
    $(bitPattern "0000000..........000.....0110011") -> Right $ ExAlu Add  rd -- add
    $(bitPattern "0100000..........000.....0110011") -> Right $ ExAlu Sub  rd -- sub
    $(bitPattern "0000000..........001.....0110011") -> Right $ ExAlu Sll  rd -- sll
    $(bitPattern "0000000..........010.....0110011") -> Right $ ExAlu Slt  rd -- slt
    $(bitPattern "0000000..........011.....0110011") -> Right $ ExAlu Sltu rd -- sltu
    $(bitPattern "0000000..........100.....0110011") -> Right $ ExAlu Xor  rd -- xor
    $(bitPattern "0000000..........101.....0110011") -> Right $ ExAlu Srl  rd -- srl
    $(bitPattern "0100000..........101.....0110011") -> Right $ ExAlu Sra  rd -- sra
    $(bitPattern "0000000..........110.....0110011") -> Right $ ExAlu Or   rd -- or
    $(bitPattern "0000000..........111.....0110011") -> Right $ ExAlu And  rd -- and
    _ -> Left IllegalInstruction
    where
  --    npcB = immB + pc
  --    npcJ = immJ + pc
  
      rd = sliceRd i
  
      immI :: BitVector 32
      immI = signExtend $ slice d31 d20 i
  
      immS :: BitVector 32
      immS = signExtend $ slice d31 d25 i ++# slice d11 d7 i
  
      immB :: BitVector 32
      immB = signExtend (slice d31 d31 i ++# slice d7 d7 i ++# slice d30 d25 i ++# slice d11 d8 i) `shiftL` 1
  
      immU :: BitVector 32
      immU = slice d31 d12 i ++# 0
  
      immJ :: BitVector 32
      immJ = signExtend (slice d31 d31 i ++# slice d19 d12 i ++# slice d20 d20 i ++# slice d30 d25 i ++# slice d24 d21 i) `shiftL` 1
  
  
  sliceRd :: BitVector 32 -> Unsigned 5
  sliceRd = unpack . slice d11 d7
  
  sliceRs1 :: BitVector 32 -> Unsigned 5
  sliceRs1 = unpack . slice d19 d15
  
  sliceRs2 :: BitVector 32 -> Unsigned 5
  sliceRs2 = unpack . slice d24 d20
  
  sliceOpcode :: BitVector 32 -> BitVector 7
  sliceOpcode = slice d6 d0
  
  sliceFunct3 :: BitVector 32 -> BitVector 3
  sliceFunct3 = slice d14 d12
  
  sliceFunct7 :: BitVector 32 -> BitVector 7
  sliceFunct7 = slice d31 d25
  