content: -- | Generates the JumpTableNoStackDealloc test
  --
  -- The test is a reproducer of #25733 where stack spill slots where wrongly
  -- deallocated for switch table jumps. This only happened when the initial
  -- stack (RESERVED_C_STACK_BYTES, 2048 * SIZEOF_LONG, 16k on most 64bit
  -- architectures) was full. I.e. we were breaking the assumptions explained in
  -- Note [extra spill slots].
  --
  -- The strategy of this test is to first fill the C stack by having many local
  -- variables that are used later. This leads to stack spilling. In the broken
  -- implemetation of the CodeGen, the invalid stack pointer led to a
  -- segmentation fault / core dump. Its absence, i.e. a suceessful run of this
  -- test, shows that the stack pointer is intact.
  --
  -- The calculations in this test are pretty randomly choosen: They are only
  -- made to prevent inlining and constant folding.
  --
  -- The real test can be generated by running:
  -- `ghc JumpTableNoStackDeallocGen.hs && ./JumpTableNoStackDeallocGen > JumpTableNoStackDealloc_cmm.cmm`
  module Main where
  
  import Control.Monad
  import Data.List
  
  printVarDecl :: Int -> IO ()
  printVarDecl i = do
    putStrLn $ "  I64 a" ++ show i ++ ";"
    putStrLn $ "  a" ++ show i ++ " = ((" ++ show i ++ " :: I64) " ++ op ++ " x) % (10 :: I64);"
    where
      -- Add some variance. Otherwise, GHC inlines the expressions.
      op = case i of
        _
          | even i -> "+"
          | odd i -> "-"
  
  addVars :: [Int] -> String
  addVars = opVars "+"
    where
      opVars :: String -> [Int] -> String
      opVars op is = concat $ intersperse op $ map ((++) "a" . show) is
  
  printCase :: Int -> IO ()
  printCase i = do
    putStrLn $ "    case " ++ show i ++ ": {"
    putStrLn $ "      ccall printf(\"Inside branch " ++ show i ++ "\\n\");"
    putStrLn $ "      res = a" ++ show i ++ ";"
    putStrLn $ "      ccall printf(\"Before jump " ++ show i ++ "\\n\");"
    putStrLn $ "      goto END;"
    putStrLn $ "    }"
  
  main :: IO ()
  main = do
    -- This number depends on the amount of available registers. 2048 works for
    -- AArch64, adding a bit more to be safe in case an architecture has more
    -- free fregisters.
    let varNums = [0 .. 2060]
    putStrLn "// Generated by JumpTableNoStackDeallocGen.hs\n"
    putStrLn "#include \"Cmm.h\""
    putStrLn "foo (I64 x) {"
    forM_ varNums printVarDecl
    putStrLn "\n  I64 res;"
    putStrLn "  ccall printf(\"Before switch\\n\");"
    putStrLn $ "  switch [0 .. 9] ((" ++ addVars varNums ++ ") % (10 :: I64)) {"
    forM_ [0 .. 8] printCase
    putStrLn "    default: {"
    putStrLn "      ccall printf(\"Inside default branch\\n\");"
    putStrLn "      res = x * (2 :: I64);"
    putStrLn "      ccall printf(\"Before jump default\\n\");"
    putStrLn "      goto END;"
    putStrLn "    }"
    putStrLn "  }"
    putStrLn "END:"
    putStrLn "  ccall printf(\"Return\\n\");"
    putStrLn "  ccall fflush(NULL);"
    putStrLn $ "  return (res);"
    putStrLn "}"
  