{-|
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 GADTs #-}

{-# 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            (isJust, listToMaybe)
import qualified Data.Sequence as Seq
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, fromJustX)


-- | 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 = \Clock dom
clk Enable dom
en FilePath
file Signal dom (Unsigned n)
rd 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 = \Clock dom
clk Enable dom
gen SNat n
sz FilePath
file Signal dom addr
rd 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 :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (addr, BitVector m))
wrM
      (Signal dom addr
wr,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
fromJustX (Maybe (addr, BitVector m) -> (addr, BitVector m))
-> Signal dom (Maybe (addr, BitVector m))
-> Signal dom (addr, BitVector m)
forall (f :: Type -> Type) 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 :: Type -> Type) 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 :: Type -> Type) 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 SSymbol dom
_) Enable dom
ena !SNat n
_sz FilePath
file Signal dom Int
rd Signal dom Bool
wen =
  Seq (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
    Seq (BitVector m)
ramI
    ((HasCallStack => BitVector m) -> BitVector m
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (FilePath -> BitVector m
forall a. HasCallStack => FilePath -> a
errorX FilePath
"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 :: Type -> Type).
Applicative f =>
f Bool -> f Bool -> f Bool
.&&. Signal dom Bool
wen)
  where
    -- clock enable
    go
      :: Seq.Seq (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 :: Seq (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 !Seq (BitVector m)
ram BitVector m
o (Bool
re :- Signal dom Bool
res) (Int
r :- Signal dom Int
rs) (Bool
e :- Signal dom Bool
en) (Int
w :- Signal dom Int
wr) (BitVector m
d :- Signal dom (BitVector m)
din) =
      let ram' :: Seq (BitVector m)
ram' = Seq (BitVector m)
-> Bool -> Int -> BitVector m -> Seq (BitVector m)
forall a. Seq a -> Bool -> Int -> a -> Seq a
upd Seq (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 Seq (BitVector m)
ram Seq (BitVector m) -> Int -> BitVector m
forall a. Seq a -> Int -> a
`Seq.index` 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
:- Seq (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 Seq (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 :: Seq a -> Bool -> Int -> a -> Seq a
upd Seq a
ram Bool
we Int
waddr a
d = case Bool -> Maybe Bool
forall a. a -> Maybe a
maybeIsX Bool
we of
      Maybe Bool
Nothing -> case Int -> Maybe Int
forall a. a -> Maybe a
maybeIsX Int
waddr of
        Maybe Int
Nothing -> (a -> a) -> Seq a -> Seq a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a b. a -> b -> a
const (Int -> a -> a
seq Int
waddr a
d)) Seq a
ram
        Just Int
wa -> Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
wa a
d Seq a
ram
      Just Bool
True -> case Int -> Maybe Int
forall a. a -> Maybe a
maybeIsX Int
waddr of
        Maybe Int
Nothing -> (a -> a) -> Seq a -> Seq a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a b. a -> b -> a
const (Int -> a -> a
seq Int
waddr a
d)) Seq a
ram
        Just Int
wa -> Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
Seq.update Int
wa a
d Seq a
ram
      Maybe Bool
_ -> Seq 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 :: Seq.Seq (BitVector m)
    ramI :: Seq (BitVector m)
ramI = [BitVector m] -> Seq (BitVector m)
forall a. [a] -> Seq a
Seq.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 :: Type -> Type) 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 FilePath
s = case FilePath -> Maybe Integer
parseBV' FilePath
s of
                  Just Integer
i  -> Integer -> BitVector n
forall a. Num a => Integer -> a
fromInteger Integer
i
                  Maybe Integer
Nothing -> FilePath -> BitVector n
forall a. HasCallStack => FilePath -> a
error (FilePath
"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 :: Type -> Type) 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 Integer
2 (Char -> FilePath -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` FilePath
"01") Char -> Int
digitToInt
{-# NOINLINE initMem #-}