diff options
author | Ben Gamari <bgamari.foss@gmail.com> | 2016-05-17 19:16:30 +0200 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2016-05-18 22:02:22 +0200 |
commit | f091218ae14a24f9dbd991794c2da6377364578b (patch) | |
tree | 63a9d1cd2fcc708b5bc2efc58616d741ae63e910 /compiler | |
parent | 310371ff2d5b73cdcb2439b67170ca5e613541c0 (diff) | |
download | haskell-f091218ae14a24f9dbd991794c2da6377364578b.tar.gz |
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
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/cmm/CLabel.hs | 21 |
1 files changed, 17 insertions, 4 deletions
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index bb5be5d04b..df0020301f 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")) |