content: WORK IN PROGRESS! MAY CHANGE! 
  
  === [Blog](https://yager.io)
  
  == Building a CPU
  
  === Part 2
  
  [Link to Part 1](https://yager.io/CPU1.html)
  
  Today, we're going to build a pipelined CPU. This will be more realistic and efficient than our previous model CPU. 
  
  As with last time, this entire webpage is a literate Haskell file. You can grab it [here](https://github.com/wyager/CPU/blob/master/CPU2.lhs).
  
  Again, you can play with this file by [installing CLaSH](http://www.clash-lang.org) and running `clashi CPU.lhs`, and hardware simulation instructions are provided below.
  
  
  
  === About This CPU
  
  This CPU will have a pipelined design, which is much more efficient than the previous serial design. 
  
  It will use block RAM, which is a real form of RAM that is available on most FPGAs.
  
  We will implement a branch predictor to help our CPU jump efficiently.
  
  === The Code
  
  ==== Imports
  
  First we're just going to import a bunch of stuff. 
  
  \begin{code}
  -- Allows GHC to automatically write code for mapping over register values,
  -- and to automatically write code to fully evaluate writer state outputs.
  {-# LANGUAGE DeriveFunctor, DeriveGeneric #-}
  
  module CPU where
  
  -- CLaSH-provided hardware stuff
  import CLaSH.Sized.Unsigned (Unsigned)
  import CLaSH.Sized.Vector (Vec((:>), Nil), 
          (!!), replace, repeat, (++))
  import CLaSH.Class.Resize (zeroExtend)
  import CLaSH.Sized.BitVector (BitVector, (++#), Bit)
  import CLaSH.Class.BitPack (pack, unpack)
  import CLaSH.Prelude (slice, mealy, moore, bundle, unbundle)
  import CLaSH.Promoted.Nat.Literals as Nat
  import CLaSH.Signal (Signal, register, sample, sampleN, signal, mux)
  import CLaSH.Sized.Index (Index)
  import CLaSH.Prelude.BlockRam (blockRam)
  
  -- Plain old Haskell stuff
  import Prelude (Show, Eq, print, (+), (-), (*), (==), (/=),
      ($), (.), filter, take, fmap, mapM_, Functor,
      Bool(True,False), not, Maybe(Just,Nothing), (<$>), (<*>), undefined)
  
  -- Used to make sure that something is fully evaluated.
  -- Good for making sure that our circuit 
  -- doesn't have any undefined behavior.
  import Control.DeepSeq (NFData, rnf)
  
  import qualified Test.QuickCheck as QC
  
  import GHC.Generics (Generic)
  
  \end{code}
  
  
  ==== Some CPU-related Types
  
  Our CPU will have 16 64-bit registers. We'll identify them by a register number. Instead of having a different constructor (like `R1`, `R2`, etc.) for each register ID, we'll use CLaSH's `Index` type, which is a number that is bounded at compile time. For example, an `Index 3` can be 0, 1, or 2, but not 3 or higher.
  
  \begin{code}
  data Register = Register (Index 16) deriving Show
  \end{code}
  
  Some wrapper types, as described in part 1:
  
  \begin{code}
  data RAMType = DataRAM | CodeRAM
  newtype Ptr (ram :: RAMType) = Ptr (Unsigned 64) deriving (Show)
  newtype Word = Word (Unsigned 64) deriving Show
  newtype Output = Output (Unsigned 64) deriving Show
  instance NFData Output where
      rnf (Output n) = rnf n
  \end{code}
  
  
  ==== Instruction Set
  
  The instruction set is the same as last time. However, we will leave the type of input registers as a variable, so that we can either store the register ID or the actual value inside the instruction, depending on which part of the pipeline we're in.
  
  \begin{code}
  data Instruction register
      = LoadIm Register (Unsigned 56)
      | Add register register Register
      | Sub register register Register
      | Mul register register Register
      | Load Register register
      | Store register register
      | Jmp register
      | JmpZ register register
      | Out register
      | Halt
      deriving (Show, Functor)
  
  \end{code}
  
  ==== CPU Structure
  
  Our CPU will have separate RAM for code (instruction RAM) and data (data RAM). Each RAM takes a full cycle to complete a read or write.
  
  Our CPU will have 4 stages.
  
  * Fetch (F):
  ** Keep track of the next program counter and dispatch read requests to instruction RAM.
  * Decode (D)
  ** Read the output of instruction RAM and load register values.
  * Execute (E):
  ** Perform any arithmetic operations. Dispatch RAM read/write requests.
  * Writeback (W):
  ** Read the output of data RAM if necessary. Write result values into registers.
  
  Depending on the design, pipelined CPUs may have as few as 2 or as many as 20 stages. Our 4-stage design is a good compromise that lets us observe some of the pitfalls of pipelining.
  
  We'll define the states of our four stages separately.
  
  \begin{code}
  
  data Validity = Valid | Invalid
  data Unused = Unused
  
  
  
  \end{code}
  
  
  We have two options for how to write our CPU hardware.
  
  We could do it like you would in a standard HDL, where each stage is its own circuit and the stages are connected via explicit wires.
  
  We could also do it more like you would in Haskell, where the entire CPU is defined by a single update function.
  
  The advantage of the first approach is that it's easier to understand where your clock domains lie and the relative stabilization times of different parts of your circuit.
  
  The advantage of the second approach is that it's typically easier to analyze and has less syntactic and cognitive overhead. It's also easier to debug because the entire state of your CPU is explicit.
  
  For this tutorial, I'm going to take the first approach with explicit wires to help us understand how we're physically breaking up the CPU into sub-circuits. In general, I prefer the second approach, but this is up to personal preference.
  
  \begin{code}
  readRegister :: Vec 16 a -> Register -> a
  readRegister regs (Register i) = regs !! i
  
  writeRegister :: Vec 16 a -> Register -> a -> Vec 16 a
  writeRegister regs (Register i) val = replace i val regs
  
  increment :: Ptr a -> Ptr a
  increment (Ptr address) = Ptr (address + 1)
  
  
  \end{code}
  
  
  
  
  ==== Machine Code Format
  
  The machine code format is the same as in Part 1.
  
  \begin{code}
  encodeInstruction :: Instruction Register -> Word
  encodeInstruction instr = Word $ unpack $ case instr of
      LoadIm r v -> tag 0 ++# encodeReg r ++# pack v          -- Pad with zeros
      Add  a b d -> tag 1 ++# encodeReg a ++# encodeReg b ++# encodeReg d ++# 0
      Sub  a b d -> tag 2 ++# encodeReg a ++# encodeReg b ++# encodeReg d ++# 0
      Mul  a b d -> tag 3 ++# encodeReg a ++# encodeReg b ++# encodeReg d ++# 0
      Load   v p -> tag 4 ++# encodeReg v ++# encodeReg p                 ++# 0
      Store  v p -> tag 5 ++# encodeReg v ++# encodeReg p                 ++# 0
      Jmp      p -> tag 6 ++# encodeReg p                                 ++# 0
      JmpZ   z d -> tag 7 ++# encodeReg z ++# encodeReg d                 ++# 0
      Out      v -> tag 8 ++# encodeReg v                                 ++# 0
      Halt       -> tag 9                                                 ++# 0
  
  -- This is just for clarity, and to specify how many bits a tag should be.
  tag :: BitVector 4 -> BitVector 4
  tag x = x
  
  -- We could have up to 16 regs (0 through 15),
  --  but we're only using 4 for now.
  encodeReg :: Register -> BitVector 4
  encodeReg (Register i) = pack i
  
  decodeInstruction :: Word -> Instruction Register
  decodeInstruction (Word val) = case tag of
      0 -> LoadIm a v
      1 -> Add    a b c
      2 -> Sub    a b c
      3 -> Mul    a b c
      4 -> Load   a b
      5 -> Store  a b
      6 -> Jmp    a
      7 -> JmpZ   a b
      8 -> Out    a
      9 -> Halt
      where
      tag = slice Nat.d63 Nat.d60 val
      a   = decodeReg $ slice Nat.d59 Nat.d56 val
      b   = decodeReg $ slice Nat.d55 Nat.d52 val
      c   = decodeReg $ slice Nat.d51 Nat.d48 val
      v   = unpack $ slice Nat.d55 Nat.d0  val
  
  decodeReg :: BitVector 4 -> Register
  decodeReg = Register . unpack
  
  \end{code}
  
  ![](CPU2Diagram.svg "CPU diagram")
  
  ![](stage.svg "Stage diagram")
  
  \begin{code}
  data DtoF = D_F_Stall | D_F_Jump (Ptr CodeRAM) | D_F_None
  
  data FetchState = FetchState {
          nextPC :: Ptr CodeRAM,
          instructionRAMOutputValid :: Validity
      }
  
  cpuBlock :: (toSelf -> fromPrev -> fromNext -> fromRAM -> (state, toPrev, toRAM)) 
           -> (state -> (toSelf, toNext))
           -> state 
           -> (Signal fromPrev, Signal fromNext, Signal fromRAM)
           -> (Signal toPrev, Signal toNext, Signal toRAM)
  cpuBlock update splitter initial (fromPrev, fromNext, fromRAM) = (toPrev, toNext, toRAM)
      where
      state = register initial state'
      (state', toPrev, toRAM) = unbundle (update <$> toSelf <*> fromPrev <*> fromNext <*> fromRAM)
      (toSelf,toNext) = unbundle (splitter <$> state)
  
  connect :: (Signal b2ram -> Signal ram2c)              -- RAM between B and C
          -> ((Signal a2b, Signal c2b, Signal ram2b)     -- Block B
              -> (Signal b2a, Signal b2c, Signal b2ram))
          -> ((Signal b2c, Signal d2c, Signal ram2c)     -- Block C
              -> (Signal c2b, Signal c2d, Signal c2ram))
          -> ((Signal a2b, Signal d2c, Signal ram2b)     -- Connected block
              -> (Signal b2a, Signal c2d, Signal c2ram))
  connect ram blockB blockC inputs = (b2a, c2d, c2ram)
      where
      (a2b, d2c, ram2b) = inputs
      (b2a, b2c, b2ram) = blockB (a2b, c2b, ram2b)
      (c2b, c2d, c2ram) = blockC (b2c, d2c, ram2c)
      ram2c = ram b2ram
  
  
  
  
  
  data CodeRAMRequest = CodeRAMStall | CodeRAMRead (Ptr CodeRAM)
  
  fetcher :: (Signal Unused, Signal DtoF, Signal Unused) 
          -> (Signal Unused, Signal Validity, Signal CodeRAMRequest)
  fetcher = cpuBlock fetcherUpdate fetcherSplitter (FetchState (Ptr 0) Invalid) 
  fetcherUpdate :: Ptr CodeRAM -> Unused -> DtoF -> Unused -> (FetchState, Unused, CodeRAMRequest)
  fetcherUpdate ptr Unused hazard Unused = (state', Unused, request)
      where
      state' = case hazard of
          D_F_Stall     -> FetchState ptr  Invalid
          D_F_Jump ptr' -> FetchState ptr' Invalid
          D_F_None      -> FetchState (increment ptr) Valid
      request = case hazard of
          D_F_Stall -> CodeRAMStall
          _         -> CodeRAMRead ptr
  fetcherSplitter :: FetchState -> (Ptr CodeRAM, Validity)
  fetcherSplitter (FetchState pc instr) = (pc, instr)
  
  \end{code}
  
  
  
  \begin{code}
  
  data DecodeState = DecodeState {
          regs :: Vec 16 (Unsigned 64),
          decodedInstruction :: Maybe (Instruction (Unsigned 64))
      }
  
  data EtoDHazard = E_D_Jump (Ptr CodeRAM) | E_D_Stall | E_D_None
  
  data CompletedWrite = CompletedWrite Register (Unsigned 64)
  
  data EtoD = EtoD EtoDHazard (Maybe CompletedWrite)
  
  
  decoder :: (Signal Validity, Signal EtoD, Signal Word)
          -> (Signal DtoF, Signal (Maybe (Instruction (Unsigned 64))), Signal Unused)
  decoder = cpuBlock decoderUpdate decoderSplitter (DecodeState (repeat 0) Nothing)
  
  decoderUpdate :: Vec 16 (Unsigned 64) -> Validity -> EtoD -> Word -> (DecodeState, DtoF, Unused)
  decoderUpdate regs validity eToD fromRAM = (state', dToF, Unused)
      where
      EtoD hazard completedWrite = eToD
      regs' = case completedWrite of
          Nothing -> regs
          Just (CompletedWrite reg val) -> writeRegister regs reg val
      decodedInstruction' = case hazard of
          E_D_Stall  -> Nothing
          E_D_Jump _ -> Nothing
          E_D_None   -> case validity of
              Invalid -> Nothing
              Valid -> Just
                     $ fmap (readRegister regs') 
                     $ decodeInstruction fromRAM
      state' = DecodeState regs' decodedInstruction'
      dToF = case hazard of
          E_D_Jump ptr -> D_F_Jump ptr
          E_D_Stall    -> D_F_Stall
          E_D_None     -> D_F_None
  
  decoderSplitter :: DecodeState -> (Vec 16 (Unsigned 64), Maybe (Instruction (Unsigned 64)))
  decoderSplitter (DecodeState regs instr) = (regs, instr)
  
  \end{code}
  
  
  \begin{code}
  
  data ExecuteState
      = E_Store Register (Unsigned 64)
      | E_ReadRAM Register
      | E_Nop
      | E_Out (Unsigned 64)
      | E_Halt
  
  data WtoE = W_E_Write (Maybe CompletedWrite) | W_E_Halt
  
  data DataRAMRequest = Read (Ptr DataRAM)
                      | Write (Ptr DataRAM) Word
  
  executer :: (Signal (Maybe (Instruction (Unsigned 64))), Signal WtoE, Signal Unused)
          -> (Signal EtoD, Signal ExecuteState, Signal DataRAMRequest)
  executer = cpuBlock executerUpdate executerSplitter E_Nop
  
  executerUpdate :: Unused -> Maybe (Instruction (Unsigned 64)) -> WtoE -> Unused -> (ExecuteState, EtoD, DataRAMRequest)
  executerUpdate Unused _             W_E_Halt         Unused = (E_Halt, (EtoD E_D_Stall Nothing), Read (Ptr 0))
  executerUpdate Unused decodedInstr (W_E_Write write) Unused = (state', eToD, request)
      where
      eToD = EtoD eToDHazard write
      (eToDHazard, state') = case decodedInstr of
          Nothing -> (E_D_None, E_Nop)
          Just instr -> case instr of
              LoadIm r v  -> (E_D_Stall, E_Store r (zeroExtend v))
              Add a b r   -> (E_D_Stall, E_Store r (a + b))
              Sub a b r   -> (E_D_Stall, E_Store r (a - b))
              Mul a b r   -> (E_D_Stall, E_Store r (a * b))
              Load r ptr  -> (E_D_Stall, E_ReadRAM r)
              Store r ptr -> (E_D_None, E_Nop)
              Jmp dest    -> (E_D_Jump (Ptr dest), E_Nop)
              JmpZ r dest -> (if r == 0 then E_D_Jump (Ptr dest) else E_D_None, E_Nop)
              Out v       -> (E_D_None, E_Out v)
              Halt        -> (E_D_None, E_Halt)
      request = case decodedInstr of
          Just (Load _ ptr) -> Read (Ptr ptr)
          Just (Store v ptr) -> Write (Ptr ptr) (Word v)
          _ -> Read (Ptr 0) -- Could also have a special constructor for "do nothing" if we wanted
  -- The write stage uses the entire execute state
  executerSplitter :: ExecuteState -> (Unused, ExecuteState)
  executerSplitter s = (Unused, s)
  
  \end{code}
  
  \begin{code}
  
  data IsHalted = IsHalted | NotHalted
  
  data WriteState
      = W_Nop
      | W_Out (Unsigned 64)
      | W_Halt deriving (Generic, Show, Eq)
  
  instance NFData WriteState
  
  
  writer :: (Signal ExecuteState, Signal Unused, Signal Word)
         -> (Signal WtoE, Signal WriteState, Signal Unused)
  writer = cpuBlock writerUpdate writerSplitter W_Nop
  writerUpdate :: IsHalted -> ExecuteState -> Unused -> Word -> (WriteState, WtoE, Unused)
  writerUpdate IsHalted  _            Unused _       = (W_Halt, W_E_Halt, Unused)
  writerUpdate NotHalted executeState Unused fromRAM = (state', wToE, Unused)
      where
      state' = case executeState of
          E_Out v -> W_Out v
          E_Halt  -> W_Halt
          _       -> W_Nop
      wToE = case executeState of
          E_Store r v -> W_E_Write (Just (CompletedWrite r v))
                          --- TESTME remove this
          E_ReadRAM r -> let Word v = fromRAM in W_E_Write (Just (CompletedWrite r v))
          _           -> W_E_Write Nothing
  writerSplitter :: WriteState -> (IsHalted, WriteState)
  writerSplitter s = (if s == W_Halt then IsHalted else NotHalted, s)
  
  \end{code}
  
  \begin{code}
  stallable :: Signal a -> Signal Bool -> Signal a
  stallable signal stall = output
      where
      stalled = register False stall
      delayed = register undefined output
      output = mux stalled delayed signal
  
  codeRAM :: Vec n Word -> Signal CodeRAMRequest -> Signal Word
  codeRAM contents input = output
      where
      output = stallable ram (stall <$> input)
      ram = blockRam contents (readAddr <$> input) (signal Nothing)
      readAddr CodeRAMStall = 0
      readAddr (CodeRAMRead (Ptr ptr)) = ptr
      stall CodeRAMStall = True
      stall (CodeRAMRead _) = False
  
  dataRAM :: Vec n Word -> Signal DataRAMRequest -> Signal Word
  dataRAM contents input = output
      where
      output = blockRam contents (read <$> input) (write <$> input)
      read (Read (Ptr ptr)) = ptr
      read (Write _ _)      = 0
      write (Read _)          = Nothing
      write (Write (Ptr p) v) = Just (p,v)
  
  noRAM :: Signal Unused -> Signal Unused
  noRAM x = x
  
  allConnected :: Vec n Word -> Vec m Word
               -> (Signal Unused, Signal Unused, Signal Unused)
               -> (Signal Unused, Signal WriteState, Signal Unused)
  allConnected code initialData = fetcher `f2d` decoder `d2e` executer `e2w` writer
      where
      f2d = connect (codeRAM code)
      d2e = connect noRAM
      e2w = connect (dataRAM initialData)
  
  cpu :: Vec n Word -> Vec m Word -> Signal WriteState
  cpu code initialData = output
      where
      (_, output, _) = allConnected code initialData (signal Unused, signal Unused, signal Unused)
  
  
  \end{code}
  
  
  \begin{code}
  program1 :: Vec 27 (Instruction Register)
  program1
      =  LoadIm (Register 1) 0     
      :> LoadIm (Register 2) 0x20
      :> Store (Register 1) (Register 2)
      :> LoadIm (Register 1) 1
      :> LoadIm (Register 2) 0x21
      :> Store (Register 1) (Register 2)
      :> LoadIm (Register 3) 0     
      :> LoadIm (Register 2) 0x20  
      :> Add (Register 2) (Register 3) (Register 2)         -- Get the address of the current first term ((Register 2) + (Register 3))
      :> Load (Register 4) (Register 2)           -- Load the first item into (Register 4)
      :> LoadIm (Register 1) 1 
      :> Add (Register 2) (Register 1) (Register 2)         -- Get the address of the second item ((Register 2) + (Register 3) + 1)
      :> Load (Register 1) (Register 2)           -- Load the second item into (Register 1)
      :> Add (Register 4) (Register 1) (Register 4)         -- Add up the first and second items into (Register 4)
      :> LoadIm (Register 1) 1
      :> Add (Register 2) (Register 1) (Register 2)         -- Get the address of the new item ((Register 2) + (Register 3) + 2)
      :> Store (Register 4) (Register 2)          -- Store the new item
      :> Out (Register 4)               -- Print the new item
      :> LoadIm (Register 1) 19
      :> Sub (Register 1) (Register 3) (Register 1)         -- (Register 1) = 19 - loop count
      :> LoadIm (Register 2) haltAddr   -- (Register 2) = Halt address
      :> JmpZ (Register 1) (Register 2)           -- Halt if (Register 1) == 0 (i.e. if loop count is 19)
      :> LoadIm (Register 1) 1
      :> Add (Register 3) (Register 1) (Register 3)         -- Increment loop counter
      :> LoadIm (Register 2) loopStart
      :> Jmp (Register 2)               -- Go back to loop start
      :> Halt
      :> Nil
      where
      haltAddr = 26
      loopStart = 7
  
  codeRAM1 :: Vec 1024 Word
  codeRAM1 = fmap encodeInstruction program1 ++ repeat (Word 0)
  
  
  defaultDataRAM :: Vec 2048 Word
  defaultDataRAM = repeat (Word 0)
  
  \end{code}
  
  
  \begin{code}
  
  type Logic state toSelf fromPrev toPrev fromNext toNext fromRAM toRAM
   = (toSelf -> fromPrev -> fromNext -> fromRAM -> (state, toPrev, toRAM), state -> (toSelf, toNext))
  
  connect' :: Logic sb      b2b           a2b b2a c2b b2c  ram2b         b2RAM
           -> Logic sc      c2c           b2c c2b d2c c2d  ram2c         c2RAM
           -> Logic (sb,sc) (b2b,b2c,c2c) a2b b2a d2c c2d (ram2b,ram2c) (b2RAM,c2RAM)
  connect' (u1, f1) (u2, f2) = (u,f)
      where
      u (from1to1, from1to2, from2to2) fromPrev1 fromNext2 (fromRAM1, fromRAM2) = ((s1',s2'),toPrev1,(toRAM1,toRAM2))
          where
          (s1', toPrev1, toRAM1) = u1 from1to1 fromPrev1 from2to1 fromRAM1
          -- Notice: The following line doesn't rely on anything
          -- from the above line, so there is no loop/recursion.
          -- Information can only flow directly in one direction (from stage 2 to stage 1)
          -- Any information from stage 1 to stage 2 has to pass through a register
          -- (in the form of s1), so there's no recursion. If s2 relied on s1' instead of s1,
          -- there would be recursion.
          (s2', from2to1, toRAM2) = u2 from2to2 from1to2 fromNext2 fromRAM2
      f (s1,s2)= ((from1to1, from1to2, from2to2),from2to3)
          where
          (from1to1,from1to2) = f1 s1
          (from2to2,from2to3) = f2 s2
  
  type TotalToSelf =  (Ptr CodeRAM, Validity,
                          (Vec 16 (Unsigned 64), Maybe (Instruction (Unsigned 64)),
                           (Unused, ExecuteState, IsHalted)))
  type TotalState = (FetchState, (DecodeState, (ExecuteState, WriteState)))
  type RAM2CPU = (Unused, (Word, (Unused, Word)))
  type CPU2RAM = (CodeRAMRequest, (Unused, (DataRAMRequest, Unused)))
  
  allConnected' :: Logic TotalState TotalToSelf Unused Unused Unused WriteState RAM2CPU CPU2RAM
  allConnected' = connect' (fetcherUpdate,  fetcherSplitter)  $
                  connect' (decoderUpdate,  decoderSplitter)  $
                  connect' (executerUpdate, executerSplitter) $
                           (writerUpdate,   writerSplitter)
  
  block' :: (Signal Unused, Signal Unused, Signal RAM2CPU)
         -> (Signal Unused, Signal WriteState, Signal CPU2RAM)
  block' = cpuBlock totalUpdate totalSplitter initialState
      where
      (totalUpdate, totalSplitter) = allConnected'
      initialState = ((FetchState (Ptr 0) Invalid),((DecodeState (repeat 0) Nothing),(E_Nop, W_Nop)))
  
  cpu' :: Vec n Word -> Vec m Word -> Signal WriteState
  cpu' code initialData = output
      where
      (_, output, cpu2ram) = block' (signal Unused, signal Unused, ram2cpu)
      shrink = \(c,(_,(d,_))) -> (c,d)
      expand = \(c,d) -> (Unused,(c,(Unused,d)))
      (cpu2code, cpu2data) = (unbundle . fmap shrink) cpu2ram
      ram2cpu = (fmap expand . bundle) (code2cpu, data2cpu)
      code2cpu = codeRAM code cpu2code
      data2cpu = dataRAM initialData cpu2data
  
  instance QC.Arbitrary Word where
      arbitrary = fmap Word QC.arbitrary
      shrink _ = []
  
  equivalent :: Vec 128 Word -> Vec 128 Word -> Bool
  equivalent code memory = sampleN 100 (cpu code memory) == sampleN 100 (cpu' code memory)
  
  \end{code}
  