David Eichmann pushed to branch wip/27162/ghc-codegen-panic at Glasgow Haskell Compiler / GHC Commits: a991fb06 by David Eichmann at 2026-04-16T16:33:21+01:00 WIP Fix windows dynamic linking panic: genForeignCall.assign_code many - - - - - 2 changed files: - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Utils/Panic/Plain.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -546,7 +546,7 @@ assignReg_I64Code (CmmLocal dst) valueTree = do assignReg_I64Code _ _ = panic "assignReg_I64Code(i386): invalid lvalue" -iselExpr64 :: HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock) +iselExpr64 :: HasCallStack => CmmExpr -> NatM (RegCode64 InstrBlock) iselExpr64 (CmmLit (CmmInt i _)) = do Reg64 rhi rlo <- getNewReg64 let @@ -855,12 +855,12 @@ iselExpr64ParallelBin op e1 e2 = do -------------------------------------------------------------------------------- -getRegister :: HasDebugCallStack => CmmExpr -> NatM Register +getRegister :: HasCallStack => CmmExpr -> NatM Register getRegister e = do platform <- getPlatform is32Bit <- is32BitPlatform getRegister' platform is32Bit e -getRegister' :: HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register +getRegister' :: HasCallStack => Platform -> Bool -> CmmExpr -> NatM Register getRegister' platform is32Bit (CmmReg reg) = case reg of @@ -3412,12 +3412,12 @@ intLoadCode instr mem = do -- Compute an expression into *any* register, adding the appropriate -- move instruction if necessary. -getAnyReg :: HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock) +getAnyReg :: HasCallStack => CmmExpr -> NatM (Reg -> InstrBlock) getAnyReg expr = do r <- getRegister expr anyReg r -anyReg :: HasDebugCallStack => Register -> NatM (Reg -> InstrBlock) +anyReg :: HasCallStack => Register -> NatM (Reg -> InstrBlock) anyReg (Any _ code) = return code anyReg (Fixed rep reg fcode) = do config <- getConfig @@ -3426,7 +3426,7 @@ anyReg (Fixed rep reg fcode) = do -- A bit like getSomeReg, but we want a reg that can be byte-addressed. -- Fixed registers might not be byte-addressable, so we make sure we've -- got a temporary, inserting an extra reg copy if necessary. -getByteReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock) +getByteReg :: HasCallStack => CmmExpr -> NatM (Reg, InstrBlock) getByteReg expr = do config <- getConfig is32Bit <- is32BitPlatform @@ -3448,7 +3448,7 @@ getByteReg expr = do -- Another variant: this time we want the result in a register that cannot -- be modified by code to evaluate an arbitrary expression. -getNonClobberedReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock) +getNonClobberedReg :: HasCallStack => CmmExpr -> NatM (Reg, InstrBlock) getNonClobberedReg expr = do r <- getRegister expr config <- getConfig @@ -4559,7 +4559,7 @@ loadIntoRegMightClobberOtherReg _ = True -- | Generate C call to the given function in ghc-prim genPrimCCall - :: BlockId + :: HasCallStack => BlockId -> FastString -> [CmmFormal] -> [CmmActual] @@ -4574,7 +4574,7 @@ genPrimCCall bid lbl_txt dsts args = do -- | Generate C call to the given function in libc genLibCCall - :: BlockId + :: HasCallStack => BlockId -> FastString -> [CmmFormal] -> [CmmActual] @@ -4592,7 +4592,7 @@ genLibCCall bid lbl_txt dsts args = do -- | Generate C call to the given function in the RTS genRTSCCall - :: BlockId + :: HasCallStack => BlockId -> FastString -> [CmmFormal] -> [CmmActual] @@ -4608,7 +4608,7 @@ genRTSCCall bid lbl_txt dsts args = do -- | Generate a real C call to the given address with the given convention genCCall - :: BlockId + :: HasCallStack => BlockId -> CmmExpr -> ForeignConvention -> [CmmFormal] @@ -4786,7 +4786,7 @@ genCCall32 addr _conv dest_regs args = do call `appOL` assign_code dest_regs) -genCCall64 :: CmmExpr -- ^ address of function to call +genCCall64 :: HasCallStack => CmmExpr -- ^ address of function to call -> ForeignConvention -- ^ calling convention -> [CmmFormal] -- ^ where to put the result -> [CmmActual] -- ^ arguments (of mixed type) ===================================== compiler/GHC/Utils/Panic/Plain.hs ===================================== @@ -92,12 +92,12 @@ showPlainGhcException = . s . showString "\n\n" . showString "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug\n" -throwPlainGhcException :: PlainGhcException -> a +throwPlainGhcException :: HasCallStack => PlainGhcException -> a throwPlainGhcException = Exception.throw -- | Panics and asserts. panic, sorry, pgmError :: HasCallStack => String -> a -panic x = unsafeDupablePerformIO $ throwPlainGhcException (PlainPanic x) +panic x = unsafeDupablePerformIO $ throwPlainGhcException (PlainPanic (unlines [x, show callStack])) sorry x = throwPlainGhcException (PlainSorry x) pgmError x = throwPlainGhcException (PlainProgramError x) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a991fb06632ab287f53a6bba62fde34b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a991fb06632ab287f53a6bba62fde34b... You're receiving this email because of your account on gitlab.haskell.org.