Solving the constant crisis

[martijnbastiaan]

We currently hard code memory addresses all across our code base. As far as I can tell, they are scattered across three parts of our code base:

1. clash-vexriscv. It contains a (hard coded) reset vector (which we patch in this repo to be somewhere else, but that's another story).
2. Our hardware designs in bittide-instances
3. Our Rust code in firmware-binaries a. Pointers in the rust code b. contents of memory.x describing the addresses and sizes of available memories

This has always been undesirable, but lately it has been reaching a boiling point due our stack maturing and us wanting to do more and more in software. To solve this, we basically have two options:

1. Define a memory map, and integrate it in our hardware designs. This is what https://github.com/bittide/bittide-hardware/pull/315 has proposed, based on https://github.com/bittide/bittide-hardware/issues/47.

2. Use the power of Clash to create a protocol agnostic wrapper for memory mapped protocols, see a proposal below.

Originally (2) was just a weekend project of mine and I wouldn't have proposed it as an alternative to (1). However, during its implementation I found that:

• This would allow us to generate Rust data types / getters / setters for the contents of the registers, straight from the Haskell types.
• This would allow us to generate documentation straight from Haskell types (this would need some work, so that's not really a MVP goal).
• It doesn't rely on Clash constant folding in presence of HO-functions. (Alternatively worded: we're not restricted in the way we design our circuits.)
• We can change ONE thing (the circuit) and have the rest follow suit. That it, there is no way the DTS would get out of sync with the design.

I'm not sure how much work there is left to be done, but it seems worthwhile to at least investigate to see how much time it would take to get to an MVP.

---

Entirely untested hackery:

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}

-- | A protocol agnostic wrapper for memory mapped protocols. See 'MemoryMapped'
-- for more information. Throughout this module we'll refer to devices initiating
-- a transaction on a bus as \"managers\" and devices receiving a transaction as
-- \"subordinates\".
--
-- TODO:
--
--   * Provide examples on how to use the data structures protocols
--   * Provide standard memory map aware registers and interconnects
--   * Provide a way to generate human readable documentation
--   * Provide a way to generate data structures for target languages
--   * Provide a way to check whether memory maps are valid
--
module Protocols.MemoryMapped where

import Control.Monad (void, forM)
import Data.Bits (popCount)
import Data.Foldable (toList, Foldable (foldl'))
import GHC.Int (Int(I#))
import GHC.Integer.Logarithms (wordLog2#)
import GHC.Stack (HasCallStack)
import GHC.Word (Word(W#))

import Protocols.Internal (Protocol(Fwd, Bwd), Circuit(..))
import Control.Monad.Extra (when)
import Data.Tuple.Extra ((&&&))
import Data.List (sortOn)
import Clash.Explicit.Prelude (NFDataX(deepErrorX), Natural)

-- | Absolute address or offset in bytes
type Address = Integer

-- | Size in bytes
type Size = Integer

-- | A protocol agnostic wrapper for memory mapped protocols. It provides a way
-- for memory mapped subordinates to propagate their memory map to the top level,
-- possibly with interconnects merging multiple memory maps.
--
-- The current implementation has a few objectives:
--
--   1. Provide a way for memory mapped peripherals to define their memory layout
--
--   2. Make it possible for designers to define hardware designs without specifying
--      exact memory addresses if they can be mapped to arbitrary addresses, while
--      not giving up the ability to.
--
--   3. Provide a way to check whether memory maps are valid, i.e. whether
--      perhipherals do not overlap or exceed their allocated space.
--
--   4. Provide a way to generate human readable documentation
--
--   5. Provide a way to generate data structures for target languages. I.e., if
--      a designer instantiates a memory mapped register on type @a@, it should
--      be possible to generate an equivalent data structure in Rust or C.
--
data MemoryMapped a

instance Protocol a => Protocol (MemoryMapped a) where
  type Fwd (MemoryMapped a) = Fwd a
  type Bwd (MemoryMapped a) = (Named MemoryMap, Bwd a)

-- | Remove memory map information from a circuit
unMemoryMapped :: Circuit a (MemoryMapped a)
unMemoryMapped = Circuit $ \(fwdA, (_mm, bwdA)) -> (bwdA, fwdA)

-- | Add memory map information to a circuit
memoryMapped :: Named MemoryMap -> Circuit (MemoryMapped a) b
memoryMapped mm = Circuit $ \(fwdA, bwdA) -> ((mm, bwdA), fwdA)

-- | Extract the memory map from a circuit. Note that the circuit needs to be
-- lazy enough: if the memory map depends on any signals, this function will
-- error.
extractMemoryMap :: (NFDataX (Fwd a), NFDataX (Bwd b)) => Circuit (MemoryMapped a) b -> Named MemoryMap
extractMemoryMap (Circuit f) = fst $ fst $ f (deepErrorX "")

-- | Wrapper for \"things\" that have a name and a description. These are used
-- to generate documentation and data structures for target languages.
data Named a = Named
  { name :: String
   -- ^ Name of the 'thing'. Used as an identifier in generated data structures.
   --
   -- TODO: Only allow very basic names here to make sure it can be used in all
   --       common target languages. Provide a Template Haskell helper to make
   --       sure the name is valid at compile time?
  , description :: String
  -- ^ Description of the 'thing'. Used in generated documentation.
  , thing :: a
  }

-- | A tree structure that describes the memory map of a device. Its definitions
-- are using non-translatable constructs on purpose: Clash is currently pretty
-- bad at propagating contants properly, so designers should only /produce/
-- memory maps, not rely on constant folding to be able to extract addresses
-- from them to use in their designs.
data MemoryMap
  = Interconnect [(Address, Size, Named MemoryMap)]
  | Device [Named Register]

data Access
  = ReadOnly
  -- ^ Managers should only read from this register
  | WriteOnly
  -- ^ Managers should only write to this register
  | ReadWrite
  -- ^ Managers can read from and write to this register

data Register = Register
  { access :: Access
  , address :: Address
    -- ^ Address / offset of the register
  , fieldType :: FieldType
    -- ^ Type of the register. This is used to generate data structures for
    -- target languages.
  , reset :: Maybe Natural
    -- ^ Reset value (if any) of register
  }

data FieldType
  = BitVectorFieldType Word
  | SignedFieldType Word
  | SumOfProductFieldType [Named [Named FieldType]]
  | UnsignedFieldType Word
  | VecFieldType Word FieldType

type Name = String
type StackTrace = [Name]

-- | Upper bound (exclusive) of a range
type Upper = Integer

-- | Lower bound (inclusive) of a range
type Lower = Integer

-- | A range, with the lower bound being inclusive and the upper bound exclusive
type Range = (Lower, Upper)

mergeRange :: Range -> Range -> Range
mergeRange (l1, u1) (l2, u2) = (min l1 l2, max u1 u2)

mergeRanges :: [Range] -> Range
mergeRanges [] = (0, 0)
mergeRanges (r:rs) = foldl' mergeRange r rs

-- | Check whether a memory map is valid. A memory map is valid if:
--
--  1. No device its allocated space
--  2. No device overlaps with another
--
-- If the memory map is valid, this function returns @Right ()@. Otherwise, it
-- returns @Left error@, where @error@ is a human readable error message.
--
-- TODO: Check word alignment?
check :: Named MemoryMap -> Either String ()
check = void . goMemoryMap []
 where
  goMemoryMap :: StackTrace -> Named MemoryMap -> Either String Range
  goMemoryMap trace0 = \case
    named@Named{thing} ->
      case thing of
        Interconnect children -> do
          -- Check whether child sizes fit in allocated space
          childRanges <- forM children $ \(offset, size, child) -> do
            (lower, upper) <- goMemoryMap trace1 child
            when (upper - lower > size) $ Left $ "big no no: " <> show (name child : trace1)
            pure (name child, (lower + offset, upper + offset))

          -- Check whether child ranges overlap
          goRanges trace1 childRanges

        Device registers -> do
          -- Check whether register ranges overlap
          let registerRanges = map (name &&& goRegister) registers
          goRanges trace1 registerRanges

      where
        trace1 = name named : trace0

  goRegister :: Named Register -> Range
  goRegister Named{thing=Register{address, fieldType}} =
    (address, address + toInteger (fieldTypeSize fieldType))

  goRanges :: StackTrace -> [(Name, Range)] -> Either String Range
  goRanges trace = go . sortOn snd
   where
    go :: [(Name, Range)] -> Either String Range
    go [] = Right (0, 0)
    go [(_, r)] = Right r
    go ((n1, r1) : (n2, r2) : rs)
      | r1 `overlaps` r2 = Left $ "big no no: " <> show (n1:trace) <> " and " <> show (n2:trace)
      | otherwise = go ((n2, r2) : rs)

    overlaps :: Range -> Range -> Bool
    overlaps (l1, u1) (l2, u2) = l1 < u2 && l2 < u1

-- | Calculate the size of a field in bits
fieldTypeSize :: FieldType -> Word
fieldTypeSize = \case
  BitVectorFieldType w -> w
  SignedFieldType w -> w
  UnsignedFieldType w -> w
  VecFieldType n f -> n * fieldTypeSize f
  SumOfProductFieldType cs ->
      nConstructorsBits (wordLength cs)
    + maximum [sum [fieldTypeSize (thing f) | f <- thing con] | con <- toList cs]
 where
  wordLength :: Foldable f => f a -> Word
  wordLength = fromIntegral . length

  nConstructorsBits :: HasCallStack => Word -> Word
  nConstructorsBits 0 = 0
  nConstructorsBits v@(W# w)
    | isPowerOfTwo = r
    | otherwise = r + 1
    where
      isPowerOfTwo = popCount v == 1
      r = fromIntegral (I# (wordLog2# w))

[martijnbastiaan]

Having talked about this offline, we envision something like this possible:

-- A circuit mapping registers:
[foo, bar, wibble] <- mmInterconnect @8
    (  (0x0, 4)
    :> (0x4, 4)
    :> (0x8, 4)
    :> Nil 
    ) -< mainBus

mmReg "foo"    -< foo
mmReg "bar"    -< bar
mmReg "wibble" -< wibble

-- A circuit mapping devices:
[uartBus, timerBus, wibbleBus] <-
  mmInterconnect @16
    -- addr size
    ( (0xA, sMiB 1)  -- UART
   :> (0xC, sMiB 16) -- Timer
   :> (0x8, sMiB 32) -- Wibble
   :> Nil) -< mainBus

uartWb -< uartBus
timerWb -< timerBus
wibbleWb -< wibbleBus

where

mmReg :: String -> Circuit (MemoryMapped ...) ()

mmInterconnect :: Vec n (Offset, Size) -> Circuit (MemoryMapped ...) (Vec n (MemoryMapped ...))

Because we don't use the MemoryMap for the circuit, we sidestep any issues with Clash constant folding.

[bgamari]

FWIW, I have handled register space layout at the type level with seemingly good results in my (now mis-named) axi-register. Type inference is decent (although I think can be improved) and the RTL generated seems sensible.