David Eichmann pushed to branch wip/27162/ghc-codegen-panic at Glasgow Haskell Compiler / GHC

Commits:

2 changed files:

Changes:

  • compiler/GHC/CmmToAsm/X86/CodeGen.hs
    ... ... @@ -546,7 +546,7 @@ assignReg_I64Code (CmmLocal dst) valueTree = do
    546 546
     assignReg_I64Code _ _
    
    547 547
        = panic "assignReg_I64Code(i386): invalid lvalue"
    
    548 548
     
    
    549
    -iselExpr64 :: HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
    
    549
    +iselExpr64 :: HasCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
    
    550 550
     iselExpr64 (CmmLit (CmmInt i _)) = do
    
    551 551
       Reg64 rhi rlo <- getNewReg64
    
    552 552
       let
    
    ... ... @@ -855,12 +855,12 @@ iselExpr64ParallelBin op e1 e2 = do
    855 855
     
    
    856 856
     --------------------------------------------------------------------------------
    
    857 857
     
    
    858
    -getRegister :: HasDebugCallStack => CmmExpr -> NatM Register
    
    858
    +getRegister :: HasCallStack => CmmExpr -> NatM Register
    
    859 859
     getRegister e = do platform <- getPlatform
    
    860 860
                        is32Bit <- is32BitPlatform
    
    861 861
                        getRegister' platform is32Bit e
    
    862 862
     
    
    863
    -getRegister' :: HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register
    
    863
    +getRegister' :: HasCallStack => Platform -> Bool -> CmmExpr -> NatM Register
    
    864 864
     
    
    865 865
     getRegister' platform is32Bit (CmmReg reg)
    
    866 866
       = case reg of
    
    ... ... @@ -3412,12 +3412,12 @@ intLoadCode instr mem = do
    3412 3412
     
    
    3413 3413
     -- Compute an expression into *any* register, adding the appropriate
    
    3414 3414
     -- move instruction if necessary.
    
    3415
    -getAnyReg :: HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
    
    3415
    +getAnyReg :: HasCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
    
    3416 3416
     getAnyReg expr = do
    
    3417 3417
       r <- getRegister expr
    
    3418 3418
       anyReg r
    
    3419 3419
     
    
    3420
    -anyReg :: HasDebugCallStack => Register -> NatM (Reg -> InstrBlock)
    
    3420
    +anyReg :: HasCallStack => Register -> NatM (Reg -> InstrBlock)
    
    3421 3421
     anyReg (Any _ code)          = return code
    
    3422 3422
     anyReg (Fixed rep reg fcode) = do
    
    3423 3423
       config <- getConfig
    
    ... ... @@ -3426,7 +3426,7 @@ anyReg (Fixed rep reg fcode) = do
    3426 3426
     -- A bit like getSomeReg, but we want a reg that can be byte-addressed.
    
    3427 3427
     -- Fixed registers might not be byte-addressable, so we make sure we've
    
    3428 3428
     -- got a temporary, inserting an extra reg copy if necessary.
    
    3429
    -getByteReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
    
    3429
    +getByteReg :: HasCallStack => CmmExpr -> NatM (Reg, InstrBlock)
    
    3430 3430
     getByteReg expr = do
    
    3431 3431
       config <- getConfig
    
    3432 3432
       is32Bit <- is32BitPlatform
    
    ... ... @@ -3448,7 +3448,7 @@ getByteReg expr = do
    3448 3448
     
    
    3449 3449
     -- Another variant: this time we want the result in a register that cannot
    
    3450 3450
     -- be modified by code to evaluate an arbitrary expression.
    
    3451
    -getNonClobberedReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
    
    3451
    +getNonClobberedReg :: HasCallStack => CmmExpr -> NatM (Reg, InstrBlock)
    
    3452 3452
     getNonClobberedReg expr = do
    
    3453 3453
       r <- getRegister expr
    
    3454 3454
       config <- getConfig
    
    ... ... @@ -4559,7 +4559,7 @@ loadIntoRegMightClobberOtherReg _ = True
    4559 4559
     
    
    4560 4560
     -- | Generate C call to the given function in ghc-prim
    
    4561 4561
     genPrimCCall
    
    4562
    -  :: BlockId
    
    4562
    +  :: HasCallStack => BlockId
    
    4563 4563
       -> FastString
    
    4564 4564
       -> [CmmFormal]
    
    4565 4565
       -> [CmmActual]
    
    ... ... @@ -4574,7 +4574,7 @@ genPrimCCall bid lbl_txt dsts args = do
    4574 4574
     
    
    4575 4575
     -- | Generate C call to the given function in libc
    
    4576 4576
     genLibCCall
    
    4577
    -  :: BlockId
    
    4577
    +  :: HasCallStack => BlockId
    
    4578 4578
       -> FastString
    
    4579 4579
       -> [CmmFormal]
    
    4580 4580
       -> [CmmActual]
    
    ... ... @@ -4592,7 +4592,7 @@ genLibCCall bid lbl_txt dsts args = do
    4592 4592
     
    
    4593 4593
     -- | Generate C call to the given function in the RTS
    
    4594 4594
     genRTSCCall
    
    4595
    -  :: BlockId
    
    4595
    +  :: HasCallStack => BlockId
    
    4596 4596
       -> FastString
    
    4597 4597
       -> [CmmFormal]
    
    4598 4598
       -> [CmmActual]
    
    ... ... @@ -4608,7 +4608,7 @@ genRTSCCall bid lbl_txt dsts args = do
    4608 4608
     
    
    4609 4609
     -- | Generate a real C call to the given address with the given convention
    
    4610 4610
     genCCall
    
    4611
    -  :: BlockId
    
    4611
    +  :: HasCallStack => BlockId
    
    4612 4612
       -> CmmExpr
    
    4613 4613
       -> ForeignConvention
    
    4614 4614
       -> [CmmFormal]
    
    ... ... @@ -4786,7 +4786,7 @@ genCCall32 addr _conv dest_regs args = do
    4786 4786
                     call `appOL`
    
    4787 4787
                     assign_code dest_regs)
    
    4788 4788
     
    
    4789
    -genCCall64 :: CmmExpr           -- ^ address of function to call
    
    4789
    +genCCall64 :: HasCallStack => CmmExpr           -- ^ address of function to call
    
    4790 4790
                -> ForeignConvention -- ^ calling convention
    
    4791 4791
                -> [CmmFormal]       -- ^ where to put the result
    
    4792 4792
                -> [CmmActual]       -- ^ arguments (of mixed type)
    

  • compiler/GHC/Utils/Panic/Plain.hs
    ... ... @@ -92,12 +92,12 @@ showPlainGhcException =
    92 92
           . s . showString "\n\n"
    
    93 93
           . showString "Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug\n"
    
    94 94
     
    
    95
    -throwPlainGhcException :: PlainGhcException -> a
    
    95
    +throwPlainGhcException :: HasCallStack => PlainGhcException -> a
    
    96 96
     throwPlainGhcException = Exception.throw
    
    97 97
     
    
    98 98
     -- | Panics and asserts.
    
    99 99
     panic, sorry, pgmError :: HasCallStack => String -> a
    
    100
    -panic    x = unsafeDupablePerformIO $ throwPlainGhcException (PlainPanic x)
    
    100
    +panic    x = unsafeDupablePerformIO $ throwPlainGhcException (PlainPanic (unlines [x, show callStack]))
    
    101 101
     
    
    102 102
     sorry    x = throwPlainGhcException (PlainSorry x)
    
    103 103
     pgmError x = throwPlainGhcException (PlainProgramError x)