diff options
| author | Gabor Greif <ggreif@gmail.com> | 2018-02-08 15:55:38 +0100 |
|---|---|---|
| committer | Gabor Greif <ggreif@gmail.com> | 2018-02-08 15:55:38 +0100 |
| commit | fbb63fcb8bf8424ae5c07bc0d9257609794b16ce (patch) | |
| tree | 7883a4a2339d2726bedf02f885149c0a2105e917 | |
| parent | d54c6d7d27a9b3ba71b03d814d6a846736228fc5 (diff) | |
| download | haskell-wip/T14626.tar.gz | |
WIP: barf differently when a banged field is not taggedwip/T14626
| -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. |