Very large phi instructions cause wrong and/or corrupted value arrays passed to addIncoming

[Ralith]

The following program either segfaults, asserts, or runs successfully depending on the value of count. I've had successes as high as 500 and failures as low as 256 (there doesn't appear to be any connection to powers of 2, that was just the lowest one I tried that failed). Inspection in gdb shows the second argument (the value) passed to PHINode::addIncoming is either garbage or equal to the first argument (the basic block).

module Main where

import LLVM.General.Context
import LLVM.General.AST
import qualified LLVM.General.Module as M
import qualified LLVM.General.AST.Global as G
import qualified LLVM.General.AST.Constant as C

import Data.Word
import Debug.Trace

main :: IO ()
main = do
  str <- withContext $ \context -> M.withModuleFromAST context (traceShow ast ast) M.moduleString
  case str of
    Left s -> putStrLn s
    Right s -> putStrLn s

spamBBs :: Int -> Word -> Name -> [BasicBlock]
spamBBs count nameStart end = spamBBs' count nameStart
    where
      spamBBs' 0 _ = []
      spamBBs' n c =
          BasicBlock (UnName c) [] (Do $ Br end []) : spamBBs' (n - 1) (c + 1)

ast :: Module
ast = Module "test" Nothing Nothing
      [ GlobalDefinition $ functionDefaults
        { G.name = Name "foo"
        , G.returnType = IntegerType 32
        , G.parameters = ([Parameter (IntegerType 32) (UnName 0) []], False)
        , G.basicBlocks =
            [ BasicBlock (UnName 1) [] (Do $ Switch (LocalReference $ UnName 0) (Name "end") cbps [])
            ] ++ spamBBs (fromIntegral count) start (Name "end")
          ++[ BasicBlock (Name "end")
                [ Name "val" := Phi (IntegerType 32) vbps [] ]
                (Do $ Ret (Just (LocalReference (Name "val"))) []) ]
        }
      ]
    where
      count = 450
      start = 4
      vbps = (zip (map (ConstantOperand . C.Int 32) [0..]) (map UnName (1:[start..count + start - 1])))
      cbps = (zip (map (C.Int 32) [0..]) (map UnName ([start..count + start - 1])))

[Ralith]

I've identified the issue. Consider this excerpt from Codiing.hs

instance (Monad m, EncodeM m h c, Storable c, MonadAnyCont IO m) => EncodeM m [h] (CUInt, Ptr c) where
  encodeM hs = do
    hs <- mapM encodeM hs
    (anyContToM $ \x -> Foreign.Marshal.Array.withArrayLen hs $ \n hs -> x (fromIntegral n, hs))

The documentation for withArrayLen indicates that it behaves like with, i.e. hs is freed immediately in \n hs -> x (fromIntegral n, hs) and cannot be used. It's only a matter of luck that this has worked so far.

[bscarlet]

Not that I'm 100% sure your problem isn't related, but your diagnosis is too simple. The AnyContT monad (or the ContT monad, on which it is based) is precisely about this issue. It lets you write functions that are "inside" the with-like function as following actions using monadic syntax. The array won't be freed until, working up the call tree, you exit a runAnyContT or a scopeAnyCont (which calls runAnyContT).

More specifically, everything "after" a call to this instance of encodeM is actually in "x".

[Ralith]

Aw, guess I didn't look close enough. There's no way the addIncoming could be executed outside the dynamic extent of the withArrayLen?

Test case is still good, anyway.

[bscarlet]

Well, everything "after" a call to that instance of encodeM would have been "x" if I hadn't completely circumvented the whole mechanism. Bleah. It's uncircumvented now. Should work.