[commit: ghc] master: CLabel: Catch #11155 during C-- pretty-printing (f091218)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/f091218ae14a24f9dbd991794c2da6377364578b/ghc

>---------------------------------------------------------------

commit f091218ae14a24f9dbd991794c2da6377364578b
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Tue May 17 19:16:30 2016 +0200

    CLabel: Catch #11155 during C-- pretty-printing
    
    In #11555 we ended up generating references to the non-existence
    stg_ap_0_upd. Here we add asserts to verify that we don't generate
    references to non-existent selector or application symbols.
    
    It would likely also make sense to add further asserts during code
    generation, so we can catch the issue even closer to its source.
    
    Test Plan: Validate
    
    Reviewers: simonmar, austin, ezyang
    
    Reviewed By: simonmar, austin
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2230
    
    GHC Trac Issues: #11155


>---------------------------------------------------------------

f091218ae14a24f9dbd991794c2da6377364578b
 compiler/cmm/CLabel.hs | 21 +++++++++++++++++----
 1 file changed, 17 insertions(+), 4 deletions(-)

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index bb5be5d..df00203 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -6,6 +6,8 @@
 --
 -----------------------------------------------------------------------------
 
+{-# LANGUAGE CPP #-}
+
 module CLabel (
         CLabel, -- abstract type
         ForeignLabelSource(..),
@@ -113,6 +115,8 @@ module CLabel (
         pprCLabel
     ) where
 
+#include "HsVersions.h"
+
 import IdInfo
 import BasicTypes
 import Packages
@@ -127,6 +131,7 @@ import FastString
 import DynFlags
 import Platform
 import UniqSet
+import Util
 import PprCore ( {- instances -} )
 
 -- -----------------------------------------------------------------------------
@@ -1062,28 +1067,36 @@ pprCLbl (CmmLabel _ str CmmPrimCall)    = ftext str
 pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> text "_fast"
 
 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
-  = hcat [text "stg_sel_", text (show offset),
+  = sdocWithDynFlags $ \dflags ->
+    ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
+    hcat [text "stg_sel_", text (show offset),
           ptext (if upd_reqd
                  then (sLit "_upd_info")
                  else (sLit "_noupd_info"))
         ]
 
 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
-  = hcat [text "stg_sel_", text (show offset),
+  = sdocWithDynFlags $ \dflags ->
+    ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
+    hcat [text "stg_sel_", text (show offset),
                 ptext (if upd_reqd
                         then (sLit "_upd_entry")
                         else (sLit "_noupd_entry"))
         ]
 
 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
-  = hcat [text "stg_ap_", text (show arity),
+  = sdocWithDynFlags $ \dflags ->
+    ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
+    hcat [text "stg_ap_", text (show arity),
                 ptext (if upd_reqd
                         then (sLit "_upd_info")
                         else (sLit "_noupd_info"))
         ]
 
 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
-  = hcat [text "stg_ap_", text (show arity),
+  = sdocWithDynFlags $ \dflags ->
+    ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
+    hcat [text "stg_ap_", text (show arity),
                 ptext (if upd_reqd
                         then (sLit "_upd_entry")
                         else (sLit "_noupd_entry"))