Test bench rapidly consuming all of my memory

Clash Help
1

I have a few simple modules and a test bench I’ve put together, all non-recursive:

module CPU.Forward where

import Clash.Prelude

-- Forwards non-zero-register incoming data in place of original data when
-- register numbers match. Does not forward when incoming data is Nothing.
fwdMaybe :: (HiddenClockResetEnable dom, Eq addr, Num addr)
    => Signal dom (addr, value) -- Original source register and value
    -> Signal dom (Maybe (addr, value)) -- Incoming source register and value
    -> Signal dom (Bool, value) -- True if forward is used; resultant value
fwdMaybe original maybe_incoming = 
    let (org_addr, org_val) = unbundle original
        inc_unwrapped = sequence maybe_incoming
        in case inc_unwrapped of
            Nothing -> bundle (pure False, org_val)
            Just incoming -> let 
                    (inc_addr, inc_val) = unbundle incoming
                    use_incoming = inc_addr ./=. pure 0 .&&. inc_addr .==. org_addr
                in bundle (use_incoming, mux use_incoming inc_val org_val)

-- Forwards non-zero-register incoming data in place of original data when
-- register numbers match.
forwarder :: (HiddenClockResetEnable dom, Eq addr, Num addr)
    => Signal dom (addr, value) -- Original source register and value
    -> Signal dom (addr, value) -- Incoming source register and value
    -> Signal dom (Bool, value) -- True if forward is used; resultant value
forwarder org inc = fwdMaybe org (Just <$> inc)

module CPU.Regfile where

import qualified Prelude as P
import Clash.Prelude

import CPU.Forward

withZeroReg :: (Enum addr, HiddenClockResetEnable dom, NFDataX addr, Num addr, Eq addr, NFDataX a, Num a)
    => (SNat n -> Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a)
    -> (SNat n -> Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a)
withZeroReg backingMemory n addr write = mux (addr .==. pure 0)
    (pure 0)
    (backingMemory n addr write)

withForwarding :: (Enum addr, HiddenClockResetEnable dom, NFDataX addr, Num addr, Eq addr, NFDataX a, Num a)
    => (SNat n -> Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a)
    -> (SNat n -> Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a)
withForwarding backingMemory n addr write =
    let backed_value = backingMemory n addr write
        (_, result) = unbundle $ fwdMaybe (bundle (addr, backed_value)) write
    in result

asRegFile :: (Enum addr, HiddenClockResetEnable dom, NFDataX addr, NFDataX a)
    => (SNat n -> Signal dom addr -> Signal dom (Maybe (addr, a)) -> Signal dom a)
    -> SNat n -- number of registers to create
    -> Signal dom (Maybe (addr, a)) -- incoming write - Just (addr, data) if writing, Nothing otherwise
    -> [Signal dom addr] -- List of addresses to read
    -> [Signal dom a] -- List of values read
asRegFile backingMemory n write = P.map (\addr -> backingMemory n addr write)

molluscRegFile :: (Enum addr, HiddenClockResetEnable dom, NFDataX addr, Num addr, Eq addr, NFDataX a, Num a)
    => Signal dom (Maybe (addr, a))
    -> [Signal dom addr]
    -> [Signal dom a]
molluscRegFile = asRegFile (withForwarding (withZeroReg asyncRam)) (SNat @16)

module Tests.CPU.Regfile where

import qualified Prelude as P
import Clash.Prelude

import Test.Tasty
import Test.Tasty.HUnit

import CPU.Regfile

regfileTests :: TestTree
regfileTests = testGroup "Tests" [
        testCase "writeRead" $ let
                out = sampleN @System 3 (
                        P.head $ molluscRegFile (pure $ Just (3 :: Unsigned 4, 12345 :: Unsigned 32)) [3]
                    )
            in out P.!! 2 @?= 12345,
        testCase "writeReadZero" $ let
                out = sampleN @System 3 (
                        P.head $ molluscRegFile (pure $ Just (0 :: Unsigned 4, 12345 :: Unsigned 32)) [0]
                    )
            in out P.!! 2 @?= 0
    ]

main :: IO ()
main = defaultMain regfileTests

This compiles fine, but when running the test bench, my computer rapidly runs out of memory until my OS violently kills the process. Is there something obviously wrong I’m doing here? I don’t believe there should be any recursion in any of my code so I’m unclear why this is consuming infinite memory.

This code works with the withForwarding wrapper removed, so I suspect the issue is there - I will make more of an effort to isolate it later but I figured I’d put up a post before I went to bed in case someone can spot the issue offhand.

2

Update - with a bit more tinkering I was able to rewrite fwdMaybe as this:

fwdMaybe :: (HiddenClockResetEnable dom, Eq addr, Num addr, NFDataX value)
    => Signal dom (addr, value) -- Original source register and value
    -> Signal dom (Maybe (addr, value)) -- Incoming source register and value
    -> Signal dom (Bool, value) -- True if forward is used; resultant value
fwdMaybe original maybe_incoming = let
        (org_addr, org_val) = unbundle original
        (inc_addr, inc_val) = unbundle $ fromMaybe
                <$> bundle (pure 0, deepErrorX "Forwarded from nonexistent value")
                <*> maybe_incoming
        use_incoming = inc_addr ./=. pure 0 .&&. inc_addr .==. org_addr
    in bundle (use_incoming, mux use_incoming inc_val org_val)

This doesn’t give the issue described above while still giving me the behavior I want. This leads me to believe that sequence is the problem area. Is this a known issue?

3

Ah! I hadn’t looked closely before, but with that hint I get it!

So what this does:

maybe_incoming :: Signal dom (Maybe (addr, value))
inc_unwrapped = sequence maybe_incoming

is that it will search all samples in the signal for a Nothing, and if there is one, return Nothing. Otherwise it will collect all the Just samples and return them wrapped in a Maybe.

However, Signal is an infinite stream. So you’re asking GHC to determine if there is a Nothing in an infinite stream. So it will run the circuit until it encounters a Nothing. If all the values are Just, GHC will run forever; or until it runs out of memory, if memory use increases with each simulation step.

1 Like