diff options
| -rw-r--r-- | compiler/codeGen/StgCmmCon.hs | 2 | ||||
| -rw-r--r-- | rts/Apply.cmm | 8 |
2 files changed, 9 insertions, 1 deletions
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index 641537093d..2368f146af 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -270,7 +270,7 @@ buildDynCon' dflags _ binder actually_bound ccs con args lgood lcall Nothing pprTrace "checkTagOnPtr" (ppr con $$ ppr (dataConRepType con)) emitLabel lcall emitRtsCall rtsUnitId - (fsLit "checkTagged") [(p, AddrHint)] False + (fsLit "checkBangTagged") [(p, AddrHint)] False emitLabel lgood checkTagOnPtr _ _ = pure () diff --git a/rts/Apply.cmm b/rts/Apply.cmm index 7bbf610323..1c7c7bd393 100644 --- a/rts/Apply.cmm +++ b/rts/Apply.cmm @@ -20,6 +20,14 @@ checkTagged ( P_ obj ) return(); } +checkBangTagged ( P_ obj ) +{ + if (GETTAG(obj)==0) { + ccall barf("BANG NOT TAGGED! ") never returns; + } + return(); +} + /* ---------------------------------------------------------------------------- * Evaluate a closure and return it. |