{- - Copyright (c) 2015, 2017 Peter Lebbing - All rights reserved. - - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions are met: - - 1. Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - - 2. Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - - THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - POSSIBILITY OF SUCH DAMAGE. - - - The implementation for blockram2p'' was written after looking at the source - for ClaSH.Prelude.BitIndex in clash-prelude 0.11. - That file is Copyright 2013-2016 University of Twente (and is under - 2-clause BSD as well). -} module Toolbox.Blockram2p where import CLaSH.Prelude import qualified Prelude as P import Data.Maybe import Toolbox.Misc (showCodeLoc) {- - Instantiate a black box dual port blockram with the following parameters: - - `aaw` - Address bus width of port A - `baw` - Address bus width of port B - `aw` - Data width of port A - `bw` - Data width of port B - - Both ports need to address the same amount of memory. So if you would, for - instance, have 4096 words of 4 bits on port A, and port B uses 16-bit data, - port B would need to address 1024 words. The type checker will error if this - constraint is not satisfied. - - The inputs are: - `aAddr` - Address bus port A - `aDIn` - Data in port A - `aWrEn` - Write enable for port A (read is always enabled) - ... and then similar for port B - - The outputs are: - `qA` - Data out port A - `qB` - Data out port B - - The blockram has registers preceding and registers following the actual - blockram. During a write, the old data from that address is on the output - port; this goes for both same-port and mixed-port access. - - Because of the registers, if you offer an address in clock cycle 0, you see - the data in clock cycle 2. Both reads and writes can be fully pipelined. - Write conflicts are unhandled and have undefined results. - - The current implementation instantiates an Altera M9K block (such as is - present in the Altera DE0-Nano board). For more details, look at the VHDL - that the blackbox instantiates and consult the Altera documentation. If you - swap out the blackbox for a different implementation, watch out for the - precise settings with regard to read-during-write and such details. -} blockram2p :: ( KnownNat aaw, KnownNat baw, KnownNat aw, KnownNat bw , KnownNat memw, KnownNat logaw, KnownNat logbw , ((2 ^ logaw) ~ aw) , ((2 ^ logbw) ~ bw) , (memw ~ ((2 ^ aaw) * aw)) , (memw ~ ((2 ^ baw) * bw))) => SNat aaw -> SNat baw -> SNat aw -> SNat bw -> ( Signal (Unsigned aaw), Signal (Unsigned aw), Signal Bool , Signal (Unsigned baw) , Signal (Unsigned bw), Signal Bool) -> (Signal (Unsigned aw), Signal (Unsigned bw)) blockram2p aaw baw aw bw (aAddr, aDIn, aWrEn, bAddr, bDIn, bWrEn) = blockram2p' aAddr aDIn aWrEn bAddr bDIn bWrEn {-# NOINLINE blockram2p' #-} blockram2p' :: ( BitPack a , BitPack b , KnownNat (BitSize a) , KnownNat (BitSize b) , KnownNat logaw , KnownNat logbw , KnownNat aaw , KnownNat baw , KnownNat memw , ((2 ^ logaw) ~ BitSize a) , ((2 ^ logbw) ~ BitSize b) , KnownNat (2 ^ aaw) , KnownNat (2 ^ baw) , (memw ~ ((2 ^ aaw) * BitSize a)) , (memw ~ ((2 ^ baw) * BitSize b))) => Signal (Unsigned aaw) -> Signal a -> Signal Bool -> Signal (Unsigned baw) -> Signal b -> Signal Bool -> (Signal a, Signal b) blockram2p' aAddr aDIn aWrEn bAddr bDIn bWrEn = (qA, qB) where (qA, qB) = unbundle $ register un o o = mealy (withSNat $ withSNat blockram2p'') 0 $ register (0,un,False,0,un,False) i i = bundle (aAddr, aDIn, aWrEn, bAddr, bDIn, bWrEn) un = errorX "blockram2p': intial value undefined" blockram2p'' :: ( BitPack a , BitPack b , KnownNat (BitSize a) , KnownNat (BitSize b) , KnownNat aw , KnownNat bw , KnownNat aaw , KnownNat baw , KnownNat memw , aw ~ BitSize a , bw ~ BitSize b , KnownNat (2 ^ aaw) , KnownNat (2 ^ baw) , (memw ~ ((2 ^ aaw) * BitSize a)) , (memw ~ ((2 ^ baw) * BitSize b))) => SNat aw -> SNat bw -> BitVector memw -> ( Unsigned aaw, a, Bool, Unsigned baw, b , Bool) -> (BitVector memw, (a, b)) blockram2p'' aw bw ram (aAddr, aDIn, aWrEn, bAddr, bDIn, bWrEn) = (ram', (qA, qB)) where qA = unpack $ readRam ram (fromIntegral aAddr) qB = unpack $ readRam ram (fromIntegral bAddr) aWritten | aWrEn = writeRam ram (fromIntegral aAddr) (pack aDIn) | otherwise = ram ram' | not bWrEn = aWritten | aWrEn && overlap = error ($(showCodeLoc) P.++ " blockram2p'': Write conflict") | otherwise = writeRam aWritten (fromIntegral bAddr) (pack bDIn) astart = (fromIntegral aAddr) * aw' aend = astart + aw' bstart = (fromIntegral bAddr) * bw' bend = bstart + bw' overlap = (bstart >= astart && bstart < aend) || (astart >= bstart && astart < bend) aw' = snatToNum aw :: Int bw' = snatToNum bw readRam = withSNat readRam' readRam' :: (KnownNat m, KnownNat n) => SNat n -> BitVector m -> Int -> BitVector n readRam' n bv i = resize $ shiftR bv (i * n') where n' = snatToNum n writeRam = withSNat writeRam' writeRam' :: (KnownNat m, KnownNat n) => SNat n -> BitVector m -> Int -> BitVector n -> BitVector m writeRam' n bv i x = (bv .&. mask) .|. x' where mask = complement (shiftL (2 ^ n' - 1) (i * n')) n' = snatToNum n x' = shiftL (resize x) (i * n')