lion 0.1.0.0 → 0.2.0.0

raw patch · 7 files changed

+419/−186 lines, 7 filesdep ~clash-preludedep ~ice40-primdep ~lensPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: clash-prelude, ice40-prim, lens, mtl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +12/−4
• lion.cabal +11/−8
• src/Lion/Alu.hs +103/−0
• src/Lion/Core.hs +53/−16
• src/Lion/Instruction.hs +22/−23
• src/Lion/Pipe.hs +212/−135

@@ -1,5 +1,11 @@ # Revision history for lion +## 0.2.0.0 -- 2021-03-27++* Update core/memory/peripheral interface+* Configurable ALU: choose between SB_MAC16 or generic (+) and (-)+* Optimize branch path for better fMax+ ## 0.1.0.0 -- 2021-02-28  * First version.

@@ -6,10 +6,11 @@  Lion is a formally verified, 5-stage pipeline [RISC-V](https://riscv.org) core. Lion targets the [VELDT FPGA development board](https://standardsemiconductor.com) and is written in Haskell using [Clash](https://clash-lang.org). -This repository contains three parts:+This repository contains four parts:   1. The Lion library: a pipelined RISC-V core.   2. [lion-formal](https://github.com/standardsemiconductor/lion/tree/main/lion-formal): formally verify the core using [riscv-formal](https://github.com/standardsemiconductor/riscv-formal/tree/lion).   3. [lion-soc](https://github.com/standardsemiconductor/lion/tree/main/lion-soc): a System-on-Chip demonstrating usage of the Lion core on the VELDT.+  4. [lion-metric](https://github.com/standardsemiconductor/lion/tree/main/lion-metric): Observe Yosys synthesis metrics on the Lion Core.  ## Lion library ### Usage:@@ -18,16 +19,23 @@  When connecting the `core` to memory and peripherals, ensure single cycle latency. +## Clone the repository+1. `git clone https://github.com/standardsemiconductor/lion.git`+2. `cd lion`+3. `git submodule update --init`+ ## Features ### Current Support-Architecture: RV32I (no FENCE, ECALL, EBREAK) -- Default configuration+* Architecture: RV32I (no FENCE, ECALL, EBREAK)+* Configurable ALU adder and subtractor: use a generic (+) and (-) or SB_MAC16 hard IP  ### Future Support -**All features will be added in a configurable manner extending the default configuration noted above**+**All features will be added in a configurable manner extending the base RV32I configuration noted above** * Zicsr, Control and Status Register (CSR) Instructions * CSR registers * RV32IM-* Hard IP ALU++Check out the [Lion Development project](https://github.com/standardsemiconductor/lion/projects/1) to see which features are in progress.  [hackage]:            <https://hackage.haskell.org/package/lion> [hackage-badge]:      <https://img.shields.io/hackage/v/lion.svg?color=success>

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               lion-version:            0.1.0.0+version:            0.2.0.0 synopsis:           RISC-V Core description:        Lion is a formally verified, 5-stage pipeline [RISC-V](https://riscv.org) core. Lion targets the [VELDT FPGA development board](https://standardsemiconductor.com) and is written in Haskell using [Clash](https://clash-lang.org). bug-reports:        https://github.com/standardsemiconductor/lion/issues@@ -21,18 +21,19 @@ library   exposed-modules: Lion.Core                  , Lion.Rvfi-  other-modules:   Lion.Instruction+  other-modules:   Lion.Alu+                 , Lion.Instruction                  , Lion.Pipe   hs-source-dirs: src   default-language: Haskell2010   build-depends: -    base >= 4.13 && < 4.15,+    base           >= 4.13  && < 4.15,     Cabal,-    generic-monoid >= 0.1 && < 0.2,-    mtl,-    lens,-    ice40-prim >= 0.1 && < 0.2,-    clash-prelude >= 1.2.5 && < 1.4,+    generic-monoid >= 0.1   && < 0.2,+    mtl            >= 2.2   && < 2.3,+    lens           >= 4.19  && < 5.1,+    ice40-prim     >= 0.3   && < 0.4,+    clash-prelude  >= 1.2.5 && < 1.5,     ghc-typelits-natnormalise,     ghc-typelits-extra,     ghc-typelits-knownnat@@ -57,11 +58,13 @@     GeneralizedNewtypeDeriving     LambdaCase     MagicHash+    MultiParamTypeClasses     MultiWayIf     NoImplicitPrelude     NoStarIsType     PolyKinds     RankNTypes+    ScopedTypeVariables     TemplateHaskell     TupleSections     TypeFamilies

@@ -0,0 +1,103 @@+{-| +Module      : Lion.Alu+Description : Lion arithmetic logic unit+Copyright   : (c) David Cox, 2021+License     : BSD-3-Clause+Maintainer  : standardsemiconductor@gmail.com++Configurable alu, choose between soft and hard adders/subtractors+-}++module Lion.Alu where++import Clash.Prelude+import Data.Function ( on )+import Data.Proxy+import Ice40.Mac +import Lion.Instruction++-- | ALU configuration+data AluConfig = Hard -- ^ use hard adder and subtractor from iCE40 SB_MAC16+               | Soft -- ^ use generic adder and subtractor: (+) and (-)+  deriving stock (Generic, Show, Eq)++class Alu (config :: AluConfig) where+  alu :: HiddenClockResetEnable dom +      => Proxy (config :: AluConfig)+      -> Signal dom Op+      -> Signal dom (BitVector 32)+      -> Signal dom (BitVector 32)+      -> Signal dom (BitVector 32)++instance Alu 'Soft where+  alu _ op in1 = register 0 . liftA3 aluFunc op in1 +    where+      aluFunc = \case +        Add  -> (+)+        Sub  -> (-)+        Sll  -> \x y -> x `shiftL` shamt y+        Slt  -> boolToBV ... (<) `on` sign+        Sltu -> boolToBV ... (<)+        Xor  -> xor+        Srl  -> \x y -> x `shiftR` shamt y+        Sra  -> \x y -> pack $ sign x `shiftR` shamt y+        Or   -> (.|.)+        And  -> (.&.)+        where+          shamt = unpack . resize . slice d4 d0+          sign = unpack :: BitVector 32 -> Signed 32+          (...) = (.).(.)+      +instance Alu 'Hard where+  alu _ op in1 in2 = mux isAddSub adderSubtractor $ register 0 $ baseAlu op in1 in2+    where+      isAdd = (Add == ) <$> op+      isSub = (Sub == ) <$> op+      isAddSub = delay False $ isAdd .||. isSub+      adderSubtractor = hardAddSub (boolToBit <$> isSub) in1 in2+  +baseAlu+  :: Signal dom Op+  -> Signal dom (BitVector 32)+  -> Signal dom (BitVector 32)+  -> Signal dom (BitVector 32)+baseAlu = liftA3 $ \case +  Add  -> \_ _ -> 0+  Sub  -> \_ _ -> 0+  Sll  -> \x y -> x `shiftL` shamt y+  Slt  -> boolToBV ... (<) `on` sign+  Sltu -> boolToBV ... (<)+  Xor  -> xor+  Srl  -> \x y -> x `shiftR` shamt y+  Sra  -> \x y -> pack $ sign x `shiftR` shamt y+  Or   -> (.|.)+  And  -> (.&.)+  where+    shamt = unpack . resize . slice d4 d0+    sign = unpack :: BitVector 32 -> Signed 32+    (...) = (.).(.)++-- | addSub32PipelinedUnsigned+hardAddSub+  :: HiddenClock dom+  => Signal dom Bit -- 0 = Add, 1 = Sub+  -> Signal dom (BitVector 32)+  -> Signal dom (BitVector 32)+  -> Signal dom (BitVector 32)+hardAddSub addSub x y = out+  where+    (out, _, _, _) = mac parameter input+    input = defaultInput{ a = slice d31 d16 <$> y+                        , b = slice d15 d0  <$> y+                        , c = slice d31 d16 <$> x+                        , d = slice d15 d0  <$> x+                        , addsubtop = addSub+                        , addsubbot = addSub+                        }+    parameter = defaultParameter{ topOutputSelect = 1+                                , topAddSubUpperInput = 1+                                , topAddSubCarrySelect = 2+                                , botOutputSelect = 1+                                , botAddSubUpperInput = 1+                                , mode8x8 = 1+                                }

@@ -5,47 +5,84 @@ License     : BSD-3-Clause Maintainer  : standardsemiconductor@gmail.com -The Lion core is a 32-bit RISC-V processor written in Haskell using [Clash](https://clash-lang.org). Note, all peripherals and memory must have single cycle latency. See [lion-soc](https://github.com/standardsemiconductor/lion/tree/main/lion-soc) for an example of using the Lion core in a system.+The Lion core is a 32-bit [RISC-V](https://riscv.org/about/) processor written in Haskell using [Clash](https://clash-lang.org). Note, all peripherals and memory must have single cycle latency. See [lion-soc](https://github.com/standardsemiconductor/lion/tree/main/lion-soc) for an example of using the Lion core in a system. -}  module Lion.Core    ( core+  , defaultCoreConfig+  , P.defaultPipeConfig+  , CoreConfig(..)+  , AluConfig(..)+  , P.PipeConfig(..)   , FromCore(..)-  , toMem-  , toRvfi   , P.ToMem(..)+  , P.MemoryAccess(..)+  , Alu   ) where  import Clash.Prelude-import Control.Lens+import Data.Proxy import Data.Maybe import Data.Monoid+import Lion.Alu import Lion.Rvfi import qualified Lion.Pipe as P+import qualified Lion.Instruction as I (Op(Add)) +-- | Core configuration+--+-- ALU configuration default: `Soft`+newtype CoreConfig (a :: AluConfig) = CoreConfig+  { pipeConfig :: P.PipeConfig -- ^ pipeline configuration+  }+  deriving stock (Generic, Show, Eq)++-- | Default core configuration+--+-- ALU configuration = `Soft`+--+-- `pipeConfig` = `defaultPipeConfig`+defaultCoreConfig :: CoreConfig 'Soft+defaultCoreConfig = CoreConfig+  { pipeConfig = P.defaultPipeConfig+  }+ -- | Core outputs data FromCore dom = FromCore-  { _toMem  :: Signal dom (Maybe P.ToMem) -- ^ shared memory and instruction bus, output from core to memory and peripherals-  , _toRvfi :: Signal dom Rvfi -- ^ formal verification interface output, see [lion-formal](https://github.com/standardsemiconductor/lion/tree/main/lion-formal) for usage+  { toMem  :: Signal dom (Maybe P.ToMem) -- ^ shared memory and instruction bus, output from core to memory and peripherals+  , toRvfi :: Signal dom Rvfi -- ^ formal verification interface output, see [lion-formal](https://github.com/standardsemiconductor/lion/tree/main/lion-formal) for usage   }-makeLenses ''FromCore --- | RISC-V Core+-- | RISC-V Core: RV32I core-  :: HiddenClockResetEnable dom-  => BitVector 32               -- ^ start address-  -> Signal dom (BitVector 32)  -- ^ core input, from memory/peripherals-  -> FromCore dom               -- ^ core output-core start toCore = FromCore-  { _toMem  = getFirst . P._toMem <$> fromPipe-  , _toRvfi = fromMaybe mkRvfi . getFirst . P._toRvfi <$> fromPipe+  :: forall a dom+   . HiddenClockResetEnable dom+  => Alu a+  => CoreConfig (a :: AluConfig) -- ^ core configuration+  -> Signal dom (BitVector 32)   -- ^ core input, from memory/peripherals+  -> FromCore dom                -- ^ core output+core config toCore = FromCore+  { toMem  = getFirst . P._toMem <$> fromPipe+  , toRvfi = fromMaybe mkRvfi . getFirst . P._toRvfi <$> fromPipe   }   where-    fromPipe = P.pipe start $ P.ToPipe <$> rs1Data <*> rs2Data <*> toCore+    -- alu connection+    aluOp = fromMaybe I.Add . getFirst . P._toAluOp     <$> fromPipe+    aluInput1 = fromMaybe 0 . getFirst . P._toAluInput1 <$> fromPipe+    aluInput2 = fromMaybe 0 . getFirst . P._toAluInput2 <$> fromPipe+    aluOutput = alu (Proxy :: Proxy a) aluOp aluInput1 aluInput2+    -- reg bank connection     rs1Addr = fromMaybe 0 . getFirst . P._toRs1Addr <$> fromPipe     rs2Addr = fromMaybe 0 . getFirst . P._toRs2Addr <$> fromPipe     rdWrM = getFirst . P._toRd <$> fromPipe     (rs1Data, rs2Data) = regBank rs1Addr rs2Addr rdWrM++    -- pipeline connection+    fromPipe = P.pipe (pipeConfig config) $ P.ToPipe <$> rs1Data +                                                     <*> rs2Data +                                                     <*> aluOutput+                                                     <*> toCore  -- | Register bank regBank

@@ -15,6 +15,7 @@   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@@ -22,14 +23,19 @@   deriving stock (Generic, Show, Eq)   deriving anyclass NFDataX -data MeInstr = MeRegWr      (Unsigned 5) (BitVector 32)+-- | 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)@@ -38,6 +44,7 @@   deriving stock (Generic, Show, Eq)   deriving anyclass NFDataX +-- | ALU operation data Op = Add         | Sub         | Sll@@ -51,23 +58,7 @@   deriving stock (Generic, Show, Eq)   deriving anyclass NFDataX -alu :: Op -> BitVector 32 -> BitVector 32 -> BitVector 32-alu = \case-  Add  -> (+)-  Sub  -> (-)-  Sll  -> \x y -> x `shiftL` shamt y-  Slt  -> boolToBV ... (<) `on` sign-  Sltu -> boolToBV ... (<)-  Xor  -> xor-  Srl  -> \x y -> x `shiftR` shamt y-  Sra  -> \x y -> pack $ sign x `shiftR` shamt y-  Or   -> (.|.)-  And  -> (.&.)-  where-    shamt = unpack . resize . slice d4 d0-    sign = unpack :: BitVector 32 -> Signed 32-    (...) = (.).(.)-+-- | Branch operation data Branch = Beq             | Bne             | Blt@@ -77,6 +68,7 @@   deriving stock (Generic, Show, Eq)   deriving anyclass NFDataX +-- | branch calculation branch :: Branch -> BitVector 32 -> BitVector 32 -> Bool branch = \case   Beq  -> not ... (/=)@@ -92,17 +84,21 @@  data ExOp = Lui           | Auipc-          | Jal-          | Jalr   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@@ -115,8 +111,8 @@ parseInstr i = case i of   $(bitPattern ".........................0110111") -> Right $ Ex Lui   rd immU -- lui   $(bitPattern ".........................0010111") -> Right $ Ex Auipc rd immU -- auipc-  $(bitPattern ".........................1101111") -> Right $ Ex Jal   rd immJ -- jal-  $(bitPattern ".................000.....1100111") -> Right $ Ex Jalr  rd immI -- jalr+  $(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@@ -152,6 +148,9 @@   $(bitPattern "0000000..........111.....0110011") -> Right $ ExAlu And  rd -- and   _ -> Left IllegalInstruction   where+--    npcB = immB + pc+--    npcJ = immJ + pc+     rd = sliceRd i      immI :: BitVector 32@@ -164,7 +163,7 @@     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+    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

@@ -16,35 +16,79 @@ import Lion.Instruction import Lion.Rvfi +-- | Pipeline configuration+newtype PipeConfig = PipeConfig+  { startPC :: BitVector 32 -- ^ initial Program Counter address, default = 0+  }+  deriving stock (Generic, Show, Eq)++-- | Default pipeline configuration+-- +-- `startPC` = 0+defaultPipeConfig :: PipeConfig+defaultPipeConfig = PipeConfig 0+ -- | Pipeline inputs data ToPipe = ToPipe   { _fromRs1 :: BitVector 32   , _fromRs2 :: BitVector 32+  , _fromAlu :: BitVector 32   , _fromMem :: BitVector 32   }   deriving stock (Generic, Show, Eq)   deriving anyclass NFDataX makeLenses ''ToPipe +-- | Memory access - Lion has a shared instruction/memory bus+data MemoryAccess = InstrMem -- ^ instruction access+                  | DataMem  -- ^ data access+  deriving stock (Generic, Show, Eq)+  deriving anyclass NFDataX+ -- | Memory bus------   Lion has a shared instruction/memory bus-data ToMem = InstrMem         -- ^ instruction read-               (BitVector 32) -- ^ instruction address-           | DataMem                  -- ^ data access-               (BitVector 32)         -- ^ data address-               (BitVector 4)          -- ^ data byte mask-               (Maybe (BitVector 32)) -- ^ read=Nothing write=(Just wr)+data ToMem = ToMem+  { memAccess   :: MemoryAccess         -- ^ memory access type+  , memAddress  :: BitVector 32         -- ^ memory address+  , memByteMask :: BitVector 4          -- ^ memory byte mask+  , memWrite    :: Maybe (BitVector 32) -- ^ read=Nothing write=Just wr+  }   deriving stock (Generic, Show, Eq)   deriving anyclass NFDataX +-- | Construct instruction memory access+instrMem +  :: BitVector 32 -- ^ instruction address+  -> ToMem+instrMem addr = ToMem+  { memAccess   = InstrMem+  , memAddress  = addr+  , memByteMask = 0xF+  , memWrite    = Nothing+  }++-- | Construct data memory access+dataMem +  :: BitVector 32         -- ^ memory address+  -> BitVector 4          -- ^ byte mask+  -> Maybe (BitVector 32) -- ^ write+  -> ToMem+dataMem addr mask wrM = ToMem+  { memAccess   = DataMem+  , memAddress  = addr+  , memByteMask = mask+  , memWrite    = wrM+  }+ -- | Pipeline outputs data FromPipe = FromPipe-  { _toMem     :: First ToMem-  , _toRs1Addr :: First (Unsigned 5)-  , _toRs2Addr :: First (Unsigned 5)-  , _toRd      :: First (Unsigned 5, BitVector 32)-  , _toRvfi    :: First Rvfi+  { _toMem       :: First ToMem+  , _toRs1Addr   :: First (Unsigned 5)+  , _toRs2Addr   :: First (Unsigned 5)+  , _toRd        :: First (Unsigned 5, BitVector 32)+  , _toAluOp     :: First Op+  , _toAluInput1 :: First (BitVector 32)+  , _toAluInput2 :: First (BitVector 32)+  , _toRvfi      :: First Rvfi   }   deriving stock (Generic, Show, Eq)   deriving anyclass NFDataX@@ -53,14 +97,15 @@ makeLenses ''FromPipe  data Control = Control-  { _firstCycle :: Bool                             -- ^ First cycle True, then always False-  , _branching  :: Maybe (BitVector 32)             -- ^ execute stage branch-  , _deLoad     :: Bool                             -- ^ decode stage load-  , _exLoad     :: Bool                             -- ^ execute stage load-  , _meMemory   :: Bool                             -- ^ memory stage load/store-  , _wbMemory   :: Bool                             -- ^ writeback stage load/store-  , _meRegFwd   :: Maybe (Unsigned 5, BitVector 32) -- ^ memory stage register forwarding-  , _wbRegFwd   :: Maybe (Unsigned 5, BitVector 32) -- ^ writeback stage register forwading+  { _firstCycle  :: Bool                             -- ^ First cycle True, then always False+  , _exBranching :: Maybe (BitVector 32)             -- ^ execute stage branch/jump+  , _meBranching :: Bool                             -- ^ memory stage branch/jump+  , _deLoad      :: Bool                             -- ^ decode stage load+  , _exLoad      :: Bool                             -- ^ execute stage load+  , _meMemory    :: Bool                             -- ^ memory stage load/store+  , _wbMemory    :: Bool                             -- ^ writeback stage load/store+  , _meRegFwd    :: Maybe (Unsigned 5, BitVector 32) -- ^ memory stage register forwarding+  , _wbRegFwd    :: Maybe (Unsigned 5, BitVector 32) -- ^ writeback stage register forwading   }   deriving stock (Generic, Show, Eq)   deriving anyclass NFDataX@@ -68,14 +113,15 @@  mkControl :: Control mkControl = Control -  { _firstCycle = True   -  , _branching  = Nothing-  , _deLoad     = False-  , _exLoad     = False-  , _meMemory   = False-  , _wbMemory   = False-  , _meRegFwd   = Nothing-  , _wbRegFwd   = Nothing+  { _firstCycle  = True   +  , _exBranching = Nothing+  , _meBranching = False+  , _deLoad      = False+  , _exLoad      = False+  , _meMemory    = False+  , _wbMemory    = False+  , _meRegFwd    = Nothing+  , _wbRegFwd    = Nothing   }  data Pipe = Pipe@@ -107,9 +153,9 @@   deriving anyclass NFDataX makeLenses ''Pipe -mkPipe :: BitVector 32 -> Pipe-mkPipe start = Pipe-  { _fetchPC = start  +mkPipe :: PipeConfig -> Pipe+mkPipe config = Pipe+  { _fetchPC = startPC config    -- decode stage    , _dePC    = 0@@ -137,34 +183,23 @@ -- | 5-Stage RISC-V pipeline pipe    :: HiddenClockResetEnable dom-  => BitVector 32+  => PipeConfig   -> Signal dom ToPipe   -> Signal dom FromPipe-pipe start = mealy pipeMealy (mkPipe start)+pipe config = mealy pipeMealy (mkPipe config)   where     pipeMealy s i = let ((), s', o) = runRWS pipeM i s                     in (s', o)  --- | reset control signals (except first cycle)-resetControl :: MonadState Pipe m => m ()-resetControl = do-  control.branching .= Nothing-  control.deLoad    .= False-  control.exLoad    .= False-  control.meMemory  .= False-  control.wbMemory  .= False-  control.meRegFwd  .= Nothing-  control.wbRegFwd  .= Nothing- -- | Monadic pipeline pipeM :: RWS ToPipe FromPipe Pipe () pipeM = do-  resetControl   writeback   memory   execute   decode   fetch+  control .= mkControl{ _firstCycle = False } -- reset control  -- | Writeback stage writeback :: RWS ToPipe FromPipe Pipe ()@@ -201,20 +236,28 @@   wbIR   .= Nothing   wbRvfi <~ use meRvfi   withInstr meIR $ \case-    MeRegWr rd wr -> do+    MeNop -> wbIR ?= WbNop+    MeRegWr rd -> do+      wr <- view fromAlu       control.meRegFwd ?= (rd, wr)       wbIR ?= WbRegWr rd wr-    MeNop -> wbIR ?= WbNop+    MeJump rd pc4 -> do+      control.meBranching .= True+      control.meRegFwd ?= (rd, pc4)+      wbIR ?= WbRegWr rd pc4+    MeBranch -> do+      control.meBranching .= True+      wbIR ?= WbNop     MeStore addr mask value -> do       control.meMemory .= True-      scribe toMem $ First $ Just $ DataMem addr mask $ Just value+      scribe toMem $ First $ Just $ dataMem addr mask $ Just value       wbRvfi.rvfiMemAddr  .= addr       wbRvfi.rvfiMemWMask .= mask       wbRvfi.rvfiMemWData .= value       wbIR ?= WbStore     MeLoad op rdAddr addr mask -> do       control.meMemory .= True-      scribe toMem $ First $ Just $ DataMem addr mask Nothing+      scribe toMem $ First $ Just $ dataMem addr mask Nothing       wbRvfi.rvfiMemAddr  .= addr       wbRvfi.rvfiMemRMask .= mask       wbIR ?= WbLoad op rdAddr mask@@ -224,30 +267,37 @@ execute = do   meIR .= Nothing   meRvfi <~ use exRvfi-  pc <- meRvfi.rvfiPcRData <<~ use exPC-  meRvfi.rvfiPcWData .= pc + 4+  pc  <- meRvfi.rvfiPcRData <<~ use exPC+  pc4 <- meRvfi.rvfiPcWData <.= pc + 4   rs1Data <- meRvfi.rvfiRs1Data <<~ regFwd exRs1 fromRs1 (control.meRegFwd) (control.wbRegFwd)   rs2Data <- meRvfi.rvfiRs2Data <<~ regFwd exRs2 fromRs2 (control.meRegFwd) (control.wbRegFwd)   withInstr exIR $ \case     Ex op rd imm -> case op of-      Lui -> meIR ?= MeRegWr rd imm-      Auipc -> meIR ?= MeRegWr rd (pc + imm) -      Jal -> do-        npc <- meRvfi.rvfiPcWData <.= pc + imm-        meRvfi.rvfiTrap ||= (npc .&. 0x3 /= 0)-        control.branching ?= npc-        meIR ?= MeRegWr rd (pc + 4)-      Jalr -> do-        npc <- meRvfi.rvfiPcWData <.= clearBit (rs1Data + imm) 0-        meRvfi.rvfiTrap ||= (npc .&. 0x3 /= 0)-        control.branching ?= npc-        meIR ?= MeRegWr rd (pc + 4)-    ExBranch op imm -> do-      npc <- meRvfi.rvfiPcWData <<~ if branch op rs1Data rs2Data-                                      then control.branching <?= (pc + imm)-                                      else return $ pc + 4-      meRvfi.rvfiTrap ||= (npc .&. 0x3 /= 0)-      meIR ?= MeNop+      Lui -> do +        scribeAlu Add 0 imm+        meIR ?= MeRegWr rd+      Auipc -> do+        scribeAlu Add pc imm+        meIR ?= MeRegWr rd+    ExJump jump rd imm -> do+      case jump of+        Jal -> do+          npc <- meRvfi.rvfiPcWData <<~ control.exBranching <?= pc + imm+          meRvfi.rvfiTrap ||= isMisaligned npc+          meIR ?= MeJump rd pc4+        Jalr -> do+          npc <- meRvfi.rvfiPcWData <<~ control.exBranching <?= clearBit (rs1Data + imm) 0+          meRvfi.rvfiTrap ||= isMisaligned npc+          meIR ?= MeJump rd pc4+    ExBranch op imm ->+      if branch op rs1Data rs2Data+        then do+          branchPC <- meRvfi.rvfiPcWData <<~ control.exBranching <?= pc + imm+          meRvfi.rvfiTrap ||= isMisaligned branchPC+          meIR ?= MeBranch+        else do+          meRvfi.rvfiTrap ||= isMisaligned pc4+          meIR ?= MeNop     ExStore op imm -> do       let addr = rs1Data + imm            -- unaligned           addr' = addr .&. complement 0x3 -- aligned@@ -255,11 +305,11 @@         Sb -> let wr = concatBitVector# $ replicate d4 $ slice d7 d0 rs2Data               in meIR ?= MeStore addr' (byteMask addr) wr         Sh -> do-          meRvfi.rvfiTrap ||= (addr .&. 0x1 /= 0) -- trap on half-word boundary+          meRvfi.rvfiTrap ||= isMisalignedHalf addr -- trap on half-word boundary           let wr = concatBitVector# $ replicate d2 $ slice d15 d0 rs2Data           meIR ?= MeStore addr' (halfMask addr) wr         Sw -> do-          meRvfi.rvfiTrap ||= (addr .&. 0x3 /= 0) -- trap on word boundary+          meRvfi.rvfiTrap ||= isMisaligned addr -- trap on word boundary           meIR ?= MeStore addr' 0xF rs2Data     ExLoad op rdAddr imm -> do       control.exLoad .= True@@ -267,15 +317,28 @@           addr' = addr .&. complement 0x3 -- aligned       if | op == Lb || op == Lbu -> meIR ?= MeLoad op rdAddr addr' (byteMask addr)          | op == Lh || op == Lhu -> do-             meRvfi.rvfiTrap ||= (addr .&. 0x1 /= 0) -- trap on half-word boundary+             meRvfi.rvfiTrap ||= isMisalignedHalf addr -- trap on half-word boundary              meIR ?= MeLoad op rdAddr addr' (halfMask addr)          | otherwise -> do -- Lw-             meRvfi.rvfiTrap ||= (addr .&. 0x3 /= 0) -- trap on word boundary+             meRvfi.rvfiTrap ||= isMisaligned addr -- trap on word boundary              meIR ?= MeLoad op rdAddr addr' 0xF-    ExAlu    op rd     -> meIR ?= MeRegWr rd (alu op rs1Data rs2Data)-    ExAluImm op rd imm -> meIR ?= MeRegWr rd (alu op rs1Data imm)+    ExAlu op rd -> do+      scribeAlu op rs1Data rs2Data+      meIR ?= MeRegWr rd+    ExAluImm op rd imm -> do+      scribeAlu op rs1Data imm+      meIR ?= MeRegWr rd   where-    guardZero :: MonadState s m => Lens' s (Unsigned 5) -> BitVector 32 -> m (BitVector 32)+    scribeAlu op in1 in2 = do+      scribe toAluOp     $ First $ Just op+      scribe toAluInput1 $ First $ Just in1+      scribe toAluInput2 $ First $ Just in2++    guardZero  -- register x0 always has value 0.+      :: MonadState s m +      => Lens' s (Unsigned 5) +      -> BitVector 32 +      -> m (BitVector 32)     guardZero rsAddr rsValue = do       isZero <- uses rsAddr (== 0)       return $ if isZero@@ -295,36 +358,37 @@ -- | Decode stage decode :: RWS ToPipe FromPipe Pipe () decode = do-  exIR   .= Nothing+  exIR .= Nothing   exRvfi .= mkRvfi-  isFirstCycle <- control.firstCycle <<.= False -- first memory output undefined-  isBranching  <- uses (control.branching) isJust-  isWbMemory   <- use $ control.wbMemory-  isExLoad     <- use $ control.exLoad-  unless (isFirstCycle || isBranching || isWbMemory || isExLoad) $ do-    mem <- view fromMem-    case parseInstr mem of-      Right instr -> do-        exIR ?= instr-        exPC <~ use dePC-        exRvfi.rvfiInsn .= mem-        control.deLoad .= case instr of-          ExLoad _ _ _ -> True-          _ -> False-        scribe toRs1Addr . First . Just =<< exRvfi.rvfiRs1Addr <<~ exRs1 <.= sliceRs1 mem-        scribe toRs2Addr . First . Just =<< exRvfi.rvfiRs2Addr <<~ exRs2 <.= sliceRs2 mem-      Left IllegalInstruction -> fetchPC <~ use dePC -- roll-back PC, should handle trap+  exPC <~ use dePC+  mem <- exRvfi.rvfiInsn <<~ view fromMem+  scribe toRs1Addr . First . Just =<< exRvfi.rvfiRs1Addr <<~ exRs1 <.= sliceRs1 mem+  scribe toRs2Addr . First . Just =<< exRvfi.rvfiRs2Addr <<~ exRs2 <.= sliceRs2 mem+  isFirstCycle  <- use $ control.firstCycle -- first memory output undefined+  isMeBranching <- use $ control.meBranching+  isWbMemory    <- use $ control.wbMemory+  isExLoad      <- use $ control.exLoad+  isExBranching <- uses (control.exBranching) isJust+  let bubble = isFirstCycle || isMeBranching || isWbMemory || isExLoad || isExBranching+  case parseInstr mem of+    Right instr -> unless bubble $ do+      exIR ?= instr+      control.deLoad .= case instr of+        ExLoad{} -> True+        _        -> False+    Left IllegalInstruction -> do -- trap and instr=Nop (addi x0 x0 0)+      unless bubble $ exIR ?= ExAlu Add 0+      exRvfi.rvfiTrap .= True         - -- | fetch instruction---   stalled when instruction in memory stage needs bus   fetch :: RWS ToPipe FromPipe Pipe () fetch = do-  use (control.branching) >>= mapM_ (assign fetchPC)-  scribe toMem . First . Just . InstrMem =<< dePC <<~ use fetchPC+  scribe toMem . First . Just . instrMem =<< use fetchPC   isMeMemory <- use $ control.meMemory   isDeLoad   <- use $ control.deLoad-  unless (isMeMemory || isDeLoad) $ fetchPC += 4  +  use (control.exBranching) >>= \case+    Just npc -> fetchPC .= npc+    Nothing  -> unless (isMeMemory || isDeLoad) $ dePC <~ fetchPC <<+= 4  ------------- -- Utility --@@ -362,19 +426,27 @@ -- | slice address based on mask sliceByte :: BitVector 4 -> BitVector 32 -> BitVector 8 sliceByte = \case-  $(bitPattern "0001") -> slice d7  d0-  $(bitPattern "0010") -> slice d15 d8-  $(bitPattern "0100") -> slice d23 d16-  $(bitPattern "1000") -> slice d31 d24+  $(bitPattern "...1") -> slice d7  d0+  $(bitPattern "..1.") -> slice d15 d8+  $(bitPattern ".1..") -> slice d23 d16+  $(bitPattern "1...") -> slice d31 d24   _ -> const 0  -- | slice address based on mask sliceHalf :: BitVector 4 -> BitVector 32 -> BitVector 16 sliceHalf = \case-  $(bitPattern "0011") -> slice d15 d0-  $(bitPattern "1100") -> slice d31 d16+  $(bitPattern "..11") -> slice d15 d0+  $(bitPattern "11..") -> slice d31 d16   _ -> const 0 +-- | check if memory address misaligned on word boundary+isMisaligned :: (Bits a, Num a) => a -> Bool+isMisaligned a = a .&. 0x3 /= 0++-- | check if memory address misaligned on half-word boundary+isMisalignedHalf :: (Bits a, Num a) => a -> Bool+isMisalignedHalf a = a .&. 0x1 /= 0+ -- | run monadic action when instruction is Just withInstr :: MonadState s m => Lens' s (Maybe a) -> (a -> m ()) -> m () withInstr l k = use l >>= mapM_ k@@ -382,22 +454,25 @@ -- | Hazards Note -- -- Key:--- J = Jump--- O = Bubble--- S = Store--- * = Stall--- B = Branch--- +-- J  = JAL+-- JR = JALR+-- O  = Bubble+-- S  = Store+-- *  = Stall+-- B  = Branch+-- -- Jump/Branch--- +----+-----+-----+----+----+--- | IF | DE  | EX  | ME | WB |--- +====+=====+=====+====+====+--- | 4  | --- | --- | -- | -- |   --- +----+-----+-----+----+----+--- | 8  | J15 | --- | -- | -- |--- +----+-----+-----+----+----+--- | 15 |  O  | J15 | -- | -- |--- +----+-----+-----+----+----++-- +----+------+------+------+----++-- | IF |  DE  |  EX  |  ME  | WB |+-- +====+======+======+======+====++-- | 4  | ---- | ---- | ---- | -- |+-- +----+------+------+------+----++-- | 8  | JR20 | ---- | ---- | -- |+-- +----+------+------+------+----++-- | 12 |  O   | JR20 | ---- | -- |+-- +----+------+------+------+----++-- | 20 |  O   |  O   | JR20 | -- |+-- +----+------+------+------+----+ -- -- Store -- +-------+------+------+------+----+@@ -409,22 +484,24 @@ -- +-------+------+------+------+----+ -- | 12    | J100 |  S   | ---- | -- | -- +-------+------+------+------+----+--- | *100* |  O   | J100 |  S   | -- |+-- | *16*  |  O   | J100 |  S   | -- | -- +-------+------+------+------+----+ -- |  100  |  O   |  O   | J100 | S  | -- +-------+------+------+------+----+ -- -- Load--- +------+------+------+----+----+--- | IF   |  DE  |  EX  | ME | WB |--- +======+======+======+====+====+--- | 4    | ---- | ---- | -- | -- |--- +------+------+------+----+----+--- | *8*  |  L   | ---- | -- | -- |--- +------+------+------+----+----+--- | 8    |  O   |  L   | -- | -- |--- +------+------+------+----+----+--- | *12* | B100 |  O   | L  | -- |--- +------+------+------+----+----+--- | 100  |  O   | B100 | O  | L  |--- +------+------+------+----+----++-- +------+------+------+------+----++-- | IF   |  DE  |  EX  |  ME  | WB |+-- +======+======+======+======+====++-- | 4    | ---- | ---- | ---- | -- |+-- +------+------+------+------+----++-- | *8*  |  L   | ---- | ---- | -- |+-- +------+------+------+------+----++-- | 8    |  O   |  L   | ---- | -- |+-- +------+------+------+------+----++-- | *12* | B100 |  O   |  L   | -- |+-- +------+------+------+------+----++-- |  12  |  O   | B100 |  O   | L  |+-- +------+------+------+------+----++-- | 100  |  O   |  O   | B100 | O  |+-- +------+------+------+------+----+