MultiClockFifo.hs

{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}
module MultiClockFifo where

import CLaSH.Prelude
import CLaSH.Prelude.Explicit

fifoMem wclk rclk addrSize waddr raddr winc wfull wdata =
  asyncRam' wclk rclk
            (d2 `powSNat` addrSize)
            waddr raddr
            (winc .&&. not1 wfull)
            wdata

boolToBV :: (KnownNat n, KnownNat (n+1)) => Bool -> BitVector (n + 1)
boolToBV = zeroExtend . pack

ptrCompareT addrSize flagGen (bin,ptr,flag) (s_ptr,inc) = ((bin',ptr',flag')
                                                          ,(flag,addr,ptr))
  where
    -- GRAYSTYLE2 pointer
    bin' = bin + boolToBV (inc && not flag)
    ptr' = (bin' `shiftR` 1) `xor` bin'
    addr = slice (addrSize `subSNat` d1) d0 bin

    flag' = flagGen ptr' s_ptr

-- FIFO empty: when next pntr == synchronized wptr or on reset
isEmpty       = (==)
rptrEmptyInit = (0,0,True)

-- FIFO full: when next pntr == synchonized {~wptr[addrSize:addrSize-1],wptr[addrSize-1:0]}
isFull addrSize ptr s_ptr = ptr == (complement (slice addrSize (addrSize `subSNat` d1) s_ptr) ++#
                                   slice (addrSize `subSNat` d2) d0 s_ptr)
wptrFullInit        = (0,0,False)

-- Dual flip-flip synchroniser
ptrSync clk1 clk2 = register' clk2 0
                  . register' clk2 0
                  . unsafeSynchronizer clk1 clk2

-- Async FIFO synchroniser
fifo :: _
     => SNat addrSize -> SClock wclk -> SClock rclk
     -> Signal' wclk a -> Signal' wclk Bool
     -> Signal' rclk Bool
     -> (Signal' rclk a, Signal' rclk Bool, Signal' wclk Bool)
fifo addrSize wclk rclk wdata winc rinc = (rdata,rempty,wfull)
  where
    s_rptr = ptrSync rclk wclk rptr
    s_wptr = ptrSync wclk rclk wptr

    rdata = fifoMem wclk rclk addrSize waddr raddr winc wfull wdata

    (rempty,raddr,rptr) = mealyB' rclk (ptrCompareT addrSize isEmpty) rptrEmptyInit
                                  (s_wptr,rinc)

    (wfull,waddr,wptr)  = mealyB' wclk (ptrCompareT addrSize (isFull addrSize))
                                  wptrFullInit (s_rptr,winc)

type ClkADC = 'Clk "ADC"    45
type ClkFFT = 'Clk "FFT"    100

clkADC :: SClock ClkADC
clkADC = sclock

clkFFT :: SClock ClkFFT
clkFFT = sclock

topEntity :: (Signal' ClkADC (Signed 8)
             ,Signal' ClkADC Bool
             ,Signal' ClkFFT Bool)
          -> (Signal' ClkFFT (Signed 8)
             ,Signal' ClkFFT Bool
             ,Signal' ClkADC Bool)
-- Use 'asyncFIFOSynchronizer' instead of 'fifo' if you get the
-- error:
--
-- CLaSH.Netlist(169): Not in normal form: RHS of case-projection is not a variable: case CLaSH.Prelude.RAM.asyncRam#
topEntity (wdata,winc,rinc) = fifo d8 clkADC clkFFT wdata winc rinc

-- Always write the value 3, never read
testInput :: (Signal' ClkADC (Signed 8)
             ,Signal' ClkADC Bool
             ,Signal' ClkFFT Bool)
testInput = (signal 3,signal True,signal False)

-- Check that the value of the FIFO is 3.
-- Stop when the fifo is full
expectedOutput :: (Signal' ClkFFT (Signed 8)
                  ,Signal' ClkFFT Bool
                  ,Signal' ClkADC Bool)
               -> Signal' ClkFFT Bool
expectedOutput (rdata,rempty,wfull) =
    -- assert that the non-empty FIFO outputs '3'
    assert' clkFFT "fifoTest" validData 3
            (unsafeSynchronizer clkADC clkFFT wfull)
  where
    -- buffer data when fifo is not empty
    validData = regEn' clkFFT 3 (not1 rempty) rdata