{-|
Copyright  :  (C) 2015-2016, University of Twente,
                  2017     , Google Inc.
                  2019     , Myrtle Software Ltd
License    :  BSD2 (see the file LICENSE)
Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>

= Initializing a BlockRAM with a data file #usingramfiles#

BlockRAM primitives that can be initialized with a data file. The BNF grammar
for this data file is simple:

@
FILE = LINE+
LINE = BIT+
BIT  = '0'
     | '1'
@

Consecutive @LINE@s correspond to consecutive memory addresses starting at @0@.
For example, a data file @memory.bin@ containing the 9-bit unsigned number
@7@ to @13@ looks like:

@
000000111
000001000
000001001
000001010
000001011
000001100
000001101
@

We can instantiate a BlockRAM using the content of the above file like so:

@
f
  :: Clock  dom
  -> Signal dom (Unsigned 3)
  -> Signal dom (Unsigned 9)
f clk rd = 'Clash.Class.BitPack.unpack' '<$>' 'blockRamFile' clk d7 \"memory.bin\" rd (signal Nothing)
@

In the example above, we basically treat the BlockRAM as an synchronous ROM.
We can see that it works as expected:

@
__>>> import qualified Data.List as L__
__>>> L.tail $ sampleN 4 $ f systemClockGen (fromList [3..5])__
[10,11,12]
@

However, we can also interpret the same data as a tuple of a 6-bit unsigned
number, and a 3-bit signed number:

@
g
  :: Clock  dom
  -> Signal dom (Unsigned 3)
  -> Signal dom (Unsigned 6,Signed 3)
g clk rd = 'Clash.Class.BitPack.unpack' '<$>' 'blockRamFile' clk d7 \"memory.bin\" rd (signal Nothing)
@

And then we would see:

@
__>>> import qualified Data.List as L__
__>>> L.tail $ sampleN 4 $ g systemClockGen (fromList [3..5])__
[(1,2),(1,3)(1,-4)]
@

-}

{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}

{-# LANGUAGE Unsafe #-}

{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- See: https://github.com/clash-lang/clash-compiler/commit/721fcfa9198925661cd836668705f817bddaae3c
-- as to why we need this.
{-# OPTIONS_GHC -fno-cpr-anal #-}

module Clash.Explicit.BlockRam.File
  ( -- * BlockRAM synchronized to an arbitrary clock
    blockRamFile
  , blockRamFilePow2
    -- * Internal
  , blockRamFile#
  , initMem
  )
where

import Data.Char             (digitToInt)
import Data.Maybe            (fromJust, isJust, listToMaybe)
import qualified Data.Vector as V
import GHC.Stack             (HasCallStack, withFrozenCallStack)
import GHC.TypeLits          (KnownNat)
import Numeric               (readInt)
import System.IO.Unsafe      (unsafePerformIO)

import Clash.Promoted.Nat    (SNat (..), pow2SNat)
import Clash.Sized.BitVector (BitVector)
import Clash.Signal.Internal
  (Clock(..), Signal (..), Enable, KnownDomain, fromEnable, (.&&.))
import Clash.Signal.Bundle   (unbundle)
import Clash.Sized.Unsigned  (Unsigned)
import Clash.XException      (errorX, maybeIsX, seqX)


-- | Create a blockRAM with space for 2^@n@ elements
--
-- * __NB__: Read value is delayed by 1 cycle
-- * __NB__: Initial output value is 'undefined'
-- * __NB__: This function might not work for specific combinations of
-- code-generation backends and hardware targets. Please check the support table
-- below:
--
--     @
--                    | VHDL     | Verilog  | SystemVerilog |
--     ===============+==========+==========+===============+
--     Altera/Quartus | Broken   | Works    | Works         |
--     Xilinx/ISE     | Works    | Works    | Works         |
--     ASIC           | Untested | Untested | Untested      |
--     ===============+==========+==========+===============+
--     @
--
-- Additional helpful information:
--
-- * See "Clash.Prelude.BlockRam#usingrams" for more information on how to use a
-- Block RAM.
-- * Use the adapter 'Clash.Explicit.BlockRam.readNew' for obtaining write-before-read semantics like this: @'Clash.Explicit.BlockRam.readNew' clk rst en (blockRamFilePow2' clk en file) rd wrM@.
-- * See "Clash.Explicit.BlockRam.File#usingramfiles" for more information on how
-- to instantiate a Block RAM with the contents of a data file.
-- * See "Clash.Explicit.Fixed#creatingdatafiles" for ideas on how to create your
-- own data files.
blockRamFilePow2
  :: forall dom n m
   . (KnownDomain dom, KnownNat m, KnownNat n, HasCallStack)
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Enable dom
  -- ^ Global enable
  -> FilePath
  -- ^ File describing the initial content of the blockRAM
  -> Signal dom (Unsigned n)
  -- ^ Read address @r@
  -> Signal dom (Maybe (Unsigned n, BitVector m))
  -- ^ (write address @w@, value to write)
  -> Signal dom (BitVector m)
  -- ^ Value of the @blockRAM@ at address @r@ from the previous clock cycle
blockRamFilePow2 :: Clock dom
-> Enable dom
-> FilePath
-> Signal dom (Unsigned n)
-> Signal dom (Maybe (Unsigned n, BitVector m))
-> Signal dom (BitVector m)
blockRamFilePow2 = \clk :: Clock dom
clk en :: Enable dom
en file :: FilePath
file rd :: Signal dom (Unsigned n)
rd wrM :: Signal dom (Maybe (Unsigned n, BitVector m))
wrM -> (HasCallStack => Signal dom (BitVector m))
-> Signal dom (BitVector m)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
  (Clock dom
-> Enable dom
-> SNat (2 ^ n)
-> FilePath
-> Signal dom (Unsigned n)
-> Signal dom (Maybe (Unsigned n, BitVector m))
-> Signal dom (BitVector m)
forall (dom :: Domain) (m :: Nat) addr (n :: Nat).
(KnownDomain dom, KnownNat m, Enum addr, HasCallStack) =>
Clock dom
-> Enable dom
-> SNat n
-> FilePath
-> Signal dom addr
-> Signal dom (Maybe (addr, BitVector m))
-> Signal dom (BitVector m)
blockRamFile Clock dom
clk Enable dom
en (SNat n -> SNat (2 ^ n)
forall (a :: Nat). SNat a -> SNat (2 ^ a)
pow2SNat (KnownNat n => SNat n
forall (n :: Nat). KnownNat n => SNat n
SNat @ n)) FilePath
file Signal dom (Unsigned n)
rd Signal dom (Maybe (Unsigned n, BitVector m))
wrM)
{-# INLINE blockRamFilePow2 #-}

-- | Create a blockRAM with space for @n@ elements
--
-- * __NB__: Read value is delayed by 1 cycle
-- * __NB__: Initial output value is 'undefined'
-- * __NB__: This function might not work for specific combinations of
-- code-generation backends and hardware targets. Please check the support table
-- below:
--
--     @
--                    | VHDL     | Verilog  | SystemVerilog |
--     ===============+==========+==========+===============+
--     Altera/Quartus | Broken   | Works    | Works         |
--     Xilinx/ISE     | Works    | Works    | Works         |
--     ASIC           | Untested | Untested | Untested      |
--     ===============+==========+==========+===============+
--     @
--
-- Additional helpful information:
--
-- * See "Clash.Explicit.BlockRam#usingrams" for more information on how to use a
-- Block RAM.
-- * Use the adapter 'Clash.Explicit.BlockRam.readNew' for obtaining write-before-read semantics like this: @'Clash.Explicit.BlockRam.readNew' clk rst en ('blockRamFile' clk en size file) rd wrM@.
-- * See "Clash.Explicit.BlockRam.File#usingramfiles" for more information on how
-- to instantiate a Block RAM with the contents of a data file.
-- * See "Clash.Sized.Fixed#creatingdatafiles" for ideas on how to create your
-- own data files.
blockRamFile
  :: (KnownDomain dom, KnownNat m, Enum addr, HasCallStack)
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Enable dom
  -- ^ Global enable
  -> SNat n
  -- ^ Size of the blockRAM
  -> FilePath
  -- ^ File describing the initial content of the blockRAM
  -> Signal dom addr
  -- ^ Read address @r@
  -> Signal dom (Maybe (addr, BitVector m))
  -- ^ (write address @w@, value to write)
  -> Signal dom (BitVector m)
  -- ^ Value of the @blockRAM@ at address @r@ from the previous
  -- clock cycle
blockRamFile :: Clock dom
-> Enable dom
-> SNat n
-> FilePath
-> Signal dom addr
-> Signal dom (Maybe (addr, BitVector m))
-> Signal dom (BitVector m)
blockRamFile = \clk :: Clock dom
clk gen :: Enable dom
gen sz :: SNat n
sz file :: FilePath
file rd :: Signal dom addr
rd wrM :: Signal dom (Maybe (addr, BitVector m))
wrM ->
  let en :: Signal dom Bool
en       = Maybe (addr, BitVector m) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (addr, BitVector m) -> Bool)
-> Signal dom (Maybe (addr, BitVector m)) -> Signal dom Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, BitVector m))
wrM
      (wr :: Signal dom addr
wr,din :: Signal dom (BitVector m)
din) = Signal dom (addr, BitVector m) -> Unbundled dom (addr, BitVector m)
forall a (dom :: Domain).
Bundle a =>
Signal dom a -> Unbundled dom a
unbundle (Maybe (addr, BitVector m) -> (addr, BitVector m)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (addr, BitVector m) -> (addr, BitVector m))
-> Signal dom (Maybe (addr, BitVector m))
-> Signal dom (addr, BitVector m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, BitVector m))
wrM)
  in  (HasCallStack => Signal dom (BitVector m))
-> Signal dom (BitVector m)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
      (Clock dom
-> Enable dom
-> SNat n
-> FilePath
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
forall (m :: Nat) (dom :: Domain) (n :: Nat).
(KnownDomain dom, KnownNat m, HasCallStack) =>
Clock dom
-> Enable dom
-> SNat n
-> FilePath
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
blockRamFile# Clock dom
clk Enable dom
gen SNat n
sz FilePath
file (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
rd) Signal dom Bool
en (addr -> Int
forall a. Enum a => a -> Int
fromEnum (addr -> Int) -> Signal dom addr -> Signal dom Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom addr
wr) Signal dom (BitVector m)
din)
{-# INLINE blockRamFile #-}

-- | blockRamFile primitive
blockRamFile#
  :: forall m dom n
   . (KnownDomain dom, KnownNat m, HasCallStack)
  => Clock dom
  -- ^ 'Clock' to synchronize to
  -> Enable dom
  -- ^ Global enable
  -> SNat n
  -- ^ Size of the blockRAM
  -> FilePath
  -- ^ File describing the initial content of the blockRAM
  -> Signal dom Int
  -- ^ Read address @r@
  -> Signal dom Bool
  -- ^ Write enable
  -> Signal dom Int
  -- ^ Write address @w@
  -> Signal dom (BitVector m)
  -- ^ Value to write (at address @w@)
  -> Signal dom (BitVector m)
  -- ^ Value of the @blockRAM@ at address @r@ from the previous clock cycle
blockRamFile# :: Clock dom
-> Enable dom
-> SNat n
-> FilePath
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
blockRamFile# (Clock _) ena :: Enable dom
ena _sz :: SNat n
_sz file :: FilePath
file rd :: Signal dom Int
rd wen :: Signal dom Bool
wen =
  Vector (BitVector m)
-> BitVector m
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
go
    Vector (BitVector m)
ramI
    ((HasCallStack => BitVector m) -> BitVector m
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (FilePath -> BitVector m
forall a. HasCallStack => FilePath -> a
errorX "blockRamFile#: intial value undefined"))
    (Enable dom -> Signal dom Bool
forall (dom :: Domain). Enable dom -> Signal dom Bool
fromEnable Enable dom
ena)
    Signal dom Int
rd
    (Enable dom -> Signal dom Bool
forall (dom :: Domain). Enable dom -> Signal dom Bool
fromEnable Enable dom
ena Signal dom Bool -> Signal dom Bool -> Signal dom Bool
forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
.&&. Signal dom Bool
wen)
  where
    -- clock enable
    go
      :: V.Vector (BitVector m)
      -> BitVector m
      -> Signal dom Bool
      -> Signal dom Int
      -> Signal dom Bool
      -> Signal dom Int
      -> Signal dom (BitVector m)
      -> Signal dom (BitVector m)
    go :: Vector (BitVector m)
-> BitVector m
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
go !Vector (BitVector m)
ram o :: BitVector m
o (re :: Bool
re :- res :: Signal dom Bool
res) (r :: Int
r :- rs :: Signal dom Int
rs) (e :: Bool
e :- en :: Signal dom Bool
en) (w :: Int
w :- wr :: Signal dom Int
wr) (d :: BitVector m
d :- din :: Signal dom (BitVector m)
din) =
      let ram' :: Vector (BitVector m)
ram' = Vector (BitVector m)
-> Bool -> Int -> BitVector m -> Vector (BitVector m)
forall a. Vector a -> Bool -> Int -> a -> Vector a
upd Vector (BitVector m)
ram Bool
e (Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
w) BitVector m
d
          o' :: BitVector m
o'   = if Bool
re then Vector (BitVector m)
ram Vector (BitVector m) -> Int -> BitVector m
forall a. Vector a -> Int -> a
V.! Int
r else BitVector m
o
      in  BitVector m
o BitVector m -> Signal dom (BitVector m) -> Signal dom (BitVector m)
forall a b. a -> b -> b
`seqX` BitVector m
o BitVector m -> Signal dom (BitVector m) -> Signal dom (BitVector m)
forall (dom :: Domain) a. a -> Signal dom a -> Signal dom a
:- Vector (BitVector m)
-> BitVector m
-> Signal dom Bool
-> Signal dom Int
-> Signal dom Bool
-> Signal dom Int
-> Signal dom (BitVector m)
-> Signal dom (BitVector m)
go Vector (BitVector m)
ram' BitVector m
o' Signal dom Bool
res Signal dom Int
rs Signal dom Bool
en Signal dom Int
wr Signal dom (BitVector m)
din

    upd :: Vector a -> Bool -> Int -> a -> Vector a
upd ram :: Vector a
ram we :: Bool
we waddr :: Int
waddr d :: a
d = case Bool -> Maybe Bool
forall a. NFData a => a -> Maybe a
maybeIsX Bool
we of
      Nothing -> case Int -> Maybe Int
forall a. NFData a => a -> Maybe a
maybeIsX Int
waddr of
        Nothing -> (a -> a) -> Vector a -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map (a -> a -> a
forall a b. a -> b -> a
const (Int -> a -> a
forall a b. a -> b -> b
seq Int
waddr a
d)) Vector a
ram
        Just wa :: Int
wa -> Vector a
ram Vector a -> [(Int, a)] -> Vector a
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
wa,a
d)]
      Just True -> case Int -> Maybe Int
forall a. NFData a => a -> Maybe a
maybeIsX Int
waddr of
        Nothing -> (a -> a) -> Vector a -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map (a -> a -> a
forall a b. a -> b -> a
const (Int -> a -> a
forall a b. a -> b -> b
seq Int
waddr a
d)) Vector a
ram
        Just wa :: Int
wa -> Vector a
ram Vector a -> [(Int, a)] -> Vector a
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
wa,a
d)]
      _ -> Vector a
ram

    content :: [BitVector m]
content = IO [BitVector m] -> [BitVector m]
forall a. IO a -> a
unsafePerformIO (FilePath -> IO [BitVector m]
forall (n :: Nat). KnownNat n => FilePath -> IO [BitVector n]
initMem FilePath
file)

    ramI :: V.Vector (BitVector m)
    ramI :: Vector (BitVector m)
ramI = [BitVector m] -> Vector (BitVector m)
forall a. [a] -> Vector a
V.fromList [BitVector m]
content
{-# NOINLINE blockRamFile# #-}

-- | __NB:__ Not synthesizable
initMem :: KnownNat n => FilePath -> IO [BitVector n]
initMem :: FilePath -> IO [BitVector n]
initMem = (FilePath -> [BitVector n]) -> IO FilePath -> IO [BitVector n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> BitVector n) -> [FilePath] -> [BitVector n]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> BitVector n
parseBV ([FilePath] -> [BitVector n])
-> (FilePath -> [FilePath]) -> FilePath -> [BitVector n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines) (IO FilePath -> IO [BitVector n])
-> (FilePath -> IO FilePath) -> FilePath -> IO [BitVector n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
readFile
  where
    parseBV :: FilePath -> BitVector n
parseBV s :: FilePath
s = case FilePath -> Maybe Integer
parseBV' FilePath
s of
                  Just i :: Integer
i  -> Integer -> BitVector n
forall a. Num a => Integer -> a
fromInteger Integer
i
                  Nothing -> FilePath -> BitVector n
forall a. HasCallStack => FilePath -> a
error ("Failed to parse: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s)
    parseBV' :: FilePath -> Maybe Integer
parseBV' = ((Integer, FilePath) -> Integer)
-> Maybe (Integer, FilePath) -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, FilePath) -> Integer
forall a b. (a, b) -> a
fst (Maybe (Integer, FilePath) -> Maybe Integer)
-> (FilePath -> Maybe (Integer, FilePath))
-> FilePath
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Integer, FilePath)] -> Maybe (Integer, FilePath)
forall a. [a] -> Maybe a
listToMaybe ([(Integer, FilePath)] -> Maybe (Integer, FilePath))
-> (FilePath -> [(Integer, FilePath)])
-> FilePath
-> Maybe (Integer, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer
-> (Char -> Bool)
-> (Char -> Int)
-> FilePath
-> [(Integer, FilePath)]
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt 2 (Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "01") Char -> Int
digitToInt
{-# NOINLINE initMem #-}