summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Marlow <simonmar@microsoft.com>2006-03-14 11:25:50 +0000
committerSimon Marlow <simonmar@microsoft.com>2006-03-14 11:25:50 +0000
commit960a5e6a6f604aa01f5f74b80fb0f61ceffd7ed3 (patch)
tree833e1b1db46d1998c612cabe5fd88fe5846bf346
parenta9dc96582699e24c7d67eec9e4296b80dee53e92 (diff)
downloadhaskell-960a5e6a6f604aa01f5f74b80fb0f61ceffd7ed3.tar.gz
Make it a fatal error to try to enter a PAP
This is just an assertion, in effect: we should never enter a PAP, but for convenience we previously attached the PAP apply code to the PAP info table. The problem with this was that it makes it harder to track down bugs that result in entering a PAP...
-rw-r--r--ghc/includes/StgMiscClosures.h1
-rw-r--r--ghc/rts/Apply.cmm3
-rw-r--r--ghc/utils/genapply/GenApply.hs2
3 files changed, 5 insertions, 1 deletions
diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h
index 844c846d1a..62a7ed33de 100644
--- a/ghc/includes/StgMiscClosures.h
+++ b/ghc/includes/StgMiscClosures.h
@@ -424,6 +424,7 @@ RTS_FUN(stg_ap_pppv_fast);
RTS_FUN(stg_ap_pppp_fast);
RTS_FUN(stg_ap_ppppp_fast);
RTS_FUN(stg_ap_pppppp_fast);
+RTS_FUN(stg_PAP_apply);
/* standard GC & stack check entry points, all defined in HeapStackCheck.hc */
diff --git a/ghc/rts/Apply.cmm b/ghc/rts/Apply.cmm
index 58ca18b059..6678a63471 100644
--- a/ghc/rts/Apply.cmm
+++ b/ghc/rts/Apply.cmm
@@ -58,6 +58,9 @@ stg_ap_0_fast
-------------------------------------------------------------------------- */
INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP")
+{ foreign "C" barf("PAP object entered!"); }
+
+stg_PAP_apply
{
W_ Words;
W_ pap;
diff --git a/ghc/utils/genapply/GenApply.hs b/ghc/utils/genapply/GenApply.hs
index a91226632c..cdde66fa78 100644
--- a/ghc/utils/genapply/GenApply.hs
+++ b/ghc/utils/genapply/GenApply.hs
@@ -457,7 +457,7 @@ genApply regstatus args =
nest 4 (vcat [
text "arity = TO_W_(StgPAP_arity(R1));",
text "ASSERT(arity > 0);",
- genMkPAP regstatus "NEW_PAP" "ENTRY_LBL(stg_PAP)" "PAP" "PAP"
+ genMkPAP regstatus "NEW_PAP" "stg_PAP_apply" "PAP" "PAP"
True{-stack apply-} False{-args on stack-} True{-is a PAP-}
args all_args_size fun_info_label
]),