GitLab

Magnus pushed to branch wip/mangoiv/9.12.5-rc3-fixes at Glasgow Haskell Compiler / GHC

Commits:

71481e34

by Cheng Shao at 2026-07-01T15:21:19+02:00

compiler: fix missing handling of CmmUnsafeForeignCall node in LayoutStack

This patch fixes missing handling of `CmmUnsafeForeignCall` middle
node in the `LayoutStack` pass.

Before proc-points splitting, this pass computes liveliness of local
registers, and spills those alive across a Cmm native call onto the
stack. It need to traverse all middle nodes in each block and check
whether a local register is an assignee, if so then the previous
mapping in `sm_regs` is invalidated and needs to be dropped. However,
it didn't handle `CmmUnsafeForeignCall` node which may also assign to
a local register. When proc-points splitting is enabled, this can
produce an invalid basic block that doesn't properly backup the
updated local register to the stack before doing a Cmm call, resulting
in completely invalid runtime behavior.

The patch also adds a `T27447` regression test. With no-TNTC or with
LLVM backend, without the fix the test case would output a stale
0x1111111111111111 value, instead of the expected 0x2222222222222222
output.

Fixes #27447.

Co-authored-by: Codex <codex@openai.com>
(cherry picked from commit 3f00f234d0d5b3b3b2a23a5dc70ce372eb9bbdb4)

6 changed files:

+ changelog.d/fix-layout-stack-fcall
compiler/GHC/Cmm/LayoutStack.hs
+ testsuite/tests/cmm/should_run/T27447.hs
+ testsuite/tests/cmm/should_run/T27447.stdout
+ testsuite/tests/cmm/should_run/T27447_cmm.cmm
testsuite/tests/cmm/should_run/all.T

Changes:

changelog.d/fix-layout-stack-fcall

 +section: compiler
 +synopsis: Fix invalid cmm basic block output when proc-point splitting is enabled (wasm/llvm/unregisterised)
 +issues: #27447
 +mrs: !16271

compiler/GHC/Cmm/LayoutStack.hs

@@ -407,6 +407,8 @@ procMiddle stackmaps node sm
          where loc = getStackLoc area off stackmaps
       CmmAssign (CmmLocal r) _other
         -> sm { sm_regs = delFromUFM (sm_regs sm) r }
 +     CmmUnsafeForeignCall _ results _
 +       -> sm { sm_regs = delListFromUFM (sm_regs sm) results }
       _other
         -> sm

testsuite/tests/cmm/should_run/T27447.hs

 +{-# LANGUAGE GHCForeignImportPrim #-}
 +{-# LANGUAGE MagicHash #-}
 +{-# LANGUAGE UnboxedTuples #-}
 +{-# LANGUAGE UnliftedFFITypes #-}
++
 +import Foreign
 +import GHC.Exts
 +import GHC.IO
 +import GHC.Word
 +import Text.Printf
++
 +foreign import prim "t27447_repro"
 +  t27447_repro# :: Addr# -> State# RealWorld -> (# State# RealWorld, Word64# #)
++
 +expected :: Word64
 +expected = 0x2222222222222222
++
 +stale :: Word64
 +stale = 0x1111111111111111
++
 +runCmm :: Ptr a -> IO Word64
 +runCmm (Ptr p#) = IO $ \s ->
 +  case t27447_repro# p# s of
 +    (# s', w# #) -> (# s', W64# w# #)
++
 +main :: IO ()
 +main = allocaBytesAligned 48 8 $ \raw -> do
 +  let node0 = raw
 +      node1 = raw `plusPtr` 24
++
 +  pokeByteOff node0 0 (1 :: Word64)
 +  pokeByteOff node0 8 node1
 +  pokeByteOff node0 16 stale
++
 +  pokeByteOff node1 0 (0 :: Word64)
 +  pokeByteOff node1 8 node1
 +  pokeByteOff node1 16 expected
++
 +  got <- runCmm node0
 +  printf "0x%016x\n" got

testsuite/tests/cmm/should_run/T27447.stdout

+0x2222222222222222

testsuite/tests/cmm/should_run/T27447_cmm.cmm

 +#include "Cmm.h"
++
 +t27447_repro (W_ x) {
 +  I64 ty;
 +  W_ old;
++
 +again:
 +  ty = I64[x];
 +  switch [0 .. 2] (ty) {
 +    case 0: {
 +      return (I64[x + 16]);
 +    }
 +    case 1: {
 +      old = x;
 +      x = %acquire W_[x + 8];
 +      I64[old] = 0;
 +      goto again;
 +    }
 +    case 2: {
 +      STK_CHK_GEN();
 +      goto again;
 +    }
 +  }
 +}

testsuite/tests/cmm/should_run/all.T

@@ -33,7 +33,7 @@ test('T22871',
  test('JumpTableNoStackDealloc',
       [    extra_run_opts('"' + config.libdir + '"')
 -     ,    req_cmm
 +     ,    req_cmm
       ,    when(arch('wasm32'), skip) # wasm32 doesn't support the printf() calls
       ,    when(arch('i386'), skip) # i386 doesn't support `MO_U_Rem W64` (`_c1::I64 % 10 :: W64`)
       ],
@@ -52,3 +52,11 @@ test('T25601',
       [req_cmm],
       multi_compile_and_run,
       ['T25601', [('T25601a.cmm', '')], ''])
++
 +test('T27447',
 +     [ req_cmm
 +     , extra_ways(['optasm'])
 +     , when(have_llvm(), extra_ways(['optasm', 'optllvm']))
 +     ],
 +     multi_compile_and_run,
 +     ['T27447', [('T27447_cmm.cmm', '')], ''])