diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-06-08 18:33:41 +0200 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2020-07-22 22:57:09 -0400 |
commit | e447bd2caf5f7e949d67ab8408209b76a659c478 (patch) | |
tree | f36d5a9d254e54c52d72220bed4ae577c4ed45e3 | |
parent | 9ab76ca5576aede70d37dc29105e3831e7b1d1e5 (diff) | |
download | haskell-e447bd2caf5f7e949d67ab8408209b76a659c478.tar.gz |
CmmToC: don't add extern decl to parsed Cmm data
Previously, if a .cmm file *not in the RTS* contained something like:
```cmm
section "rodata" { msg : bits8[] "Test\n"; }
```
It would get compiled by CmmToC into:
```c
ERW_(msg);
const char msg[] = "Test\012";
```
and fail with:
```
/tmp/ghc32129_0/ghc_4.hc:5:12: error:
error: conflicting types for \u2018msg\u2019
const char msg[] = "Test\012";
^~~
In file included from /tmp/ghc32129_0/ghc_4.hc:3:0: error:
/tmp/ghc32129_0/ghc_4.hc:4:6: error:
note: previous declaration of \u2018msg\u2019 was here
ERW_(msg);
^
/builds/hsyl20/ghc/_build/install/lib/ghc-8.11.0.20200605/lib/../lib/x86_64-linux-ghc-8.11.0.20200605/rts-1.0/include/Stg.h:253:46: error:
note: in definition of macro \u2018ERW_\u2019
#define ERW_(X) extern StgWordArray (X)
^
```
See the rationale for this on https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes
Now we don't generate these extern declarations (ERW_, etc.) for
top-level data. It shouldn't change anything for the RTS (the only place
we use .cmm files) as it is already special cased in
`GHC.Cmm.CLabel.needsCDecl`. And hand-written Cmm can use explicit
extern declarations when needed.
Note that it allows `cgrun069` test to pass with CmmToC (cf #15467).
(cherry picked from commit 499f3a2829d7c5a047c2ee87377d71ab2ea8c6d9)
-rw-r--r-- | compiler/GHC/StgToCmm/Prof.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/StgToCmm/Ticky.hs | 15 | ||||
-rw-r--r-- | compiler/cmm/CLabel.hs | 158 | ||||
-rw-r--r-- | compiler/cmm/CmmParse.y | 4 | ||||
-rw-r--r-- | testsuite/tests/codeGen/should_run/all.T | 3 |
5 files changed, 106 insertions, 76 deletions
diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs index ce8ef61f17..984c371360 100644 --- a/compiler/GHC/StgToCmm/Prof.hs +++ b/compiler/GHC/StgToCmm/Prof.hs @@ -350,7 +350,7 @@ ldvEnter cl_ptr = do loadEra :: DynFlags -> CmmExpr loadEra dflags = CmmMachOp (MO_UU_Conv (cIntWidth dflags) (wordWidth dflags)) - [CmmLoad (mkLblExpr (mkCmmDataLabel rtsUnitId (fsLit "era"))) + [CmmLoad (mkLblExpr (mkRtsCmmDataLabel (fsLit "era"))) (cInt dflags)] ldvWord :: DynFlags -> CmmExpr -> CmmExpr diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs index 7548f3de13..6287eb1313 100644 --- a/compiler/GHC/StgToCmm/Ticky.hs +++ b/compiler/GHC/StgToCmm/Ticky.hs @@ -118,7 +118,6 @@ import CmmUtils import CLabel import SMRep -import Module import Name import Id import BasicTypes @@ -366,7 +365,7 @@ registerTickyCtr ctr_lbl = do , mkStore (CmmLit (cmmLabelOffB ctr_lbl (oFFSET_StgEntCounter_registeredp dflags))) (mkIntExpr dflags 1) ] - ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsUnitId (fsLit "ticky_entry_ctrs")) + ticky_entry_ctrs = mkLblExpr (mkRtsCmmDataLabel (fsLit "ticky_entry_ctrs")) emit =<< mkCmmIfThen test (catAGraphs register_stmts) tickyReturnOldCon, tickyReturnNewCon :: RepArity -> FCode () @@ -506,12 +505,12 @@ tickyAllocHeap genuine hp bytes, -- Bump the global allocation total ALLOC_HEAP_tot addToMemLbl (bWord dflags) - (mkCmmDataLabel rtsUnitId (fsLit "ALLOC_HEAP_tot")) + (mkRtsCmmDataLabel (fsLit "ALLOC_HEAP_tot")) bytes, -- Bump the global allocation counter ALLOC_HEAP_ctr if not genuine then mkNop else addToMemLbl (bWord dflags) - (mkCmmDataLabel rtsUnitId (fsLit "ALLOC_HEAP_ctr")) + (mkRtsCmmDataLabel (fsLit "ALLOC_HEAP_ctr")) 1 ]} @@ -575,13 +574,13 @@ ifTickyDynThunk :: FCode () -> FCode () ifTickyDynThunk code = tickyDynThunkIsOn >>= \b -> when b code bumpTickyCounter :: FastString -> FCode () -bumpTickyCounter lbl = bumpTickyLbl (mkCmmDataLabel rtsUnitId lbl) +bumpTickyCounter lbl = bumpTickyLbl (mkRtsCmmDataLabel lbl) bumpTickyCounterBy :: FastString -> Int -> FCode () -bumpTickyCounterBy lbl = bumpTickyLblBy (mkCmmDataLabel rtsUnitId lbl) +bumpTickyCounterBy lbl = bumpTickyLblBy (mkRtsCmmDataLabel lbl) bumpTickyCounterByE :: FastString -> CmmExpr -> FCode () -bumpTickyCounterByE lbl = bumpTickyLblByE (mkCmmDataLabel rtsUnitId lbl) +bumpTickyCounterByE lbl = bumpTickyLblByE (mkRtsCmmDataLabel lbl) bumpTickyEntryCount :: CLabel -> FCode () bumpTickyEntryCount lbl = do @@ -622,7 +621,7 @@ bumpHistogram lbl n = do emit (addToMem (bWord dflags) (cmmIndexExpr dflags (wordWidth dflags) - (CmmLit (CmmLabel (mkCmmDataLabel rtsUnitId lbl))) + (CmmLit (CmmLabel (mkRtsCmmDataLabel lbl))) (CmmLit (CmmInt (fromIntegral offset) (wordWidth dflags)))) 1) diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 66e39f0d69..bcfef86606 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -10,6 +10,7 @@ module CLabel ( CLabel, -- abstract type + NeedExternDecl (..), ForeignLabelSource(..), pprDebugCLabel, @@ -69,6 +70,7 @@ module CLabel ( mkCmmRetLabel, mkCmmCodeLabel, mkCmmDataLabel, + mkRtsCmmDataLabel, mkCmmClosureLabel, mkRtsApFastLabel, @@ -179,13 +181,14 @@ data CLabel IdLabel Name CafInfo - IdLabelInfo -- encodes the suffix of the label + IdLabelInfo -- ^ encodes the suffix of the label -- | A label from a .cmm file that is not associated with a .hs level Id. | CmmLabel - UnitId -- what package the label belongs to. - FastString -- identifier giving the prefix of the label - CmmLabelInfo -- encodes the suffix of the label + UnitId -- ^ what package the label belongs to. + NeedExternDecl -- ^ does the label need an "extern .." declaration + FastString -- ^ identifier giving the prefix of the label + CmmLabelInfo -- ^ encodes the suffix of the label -- | A label with a baked-in \/ algorithmically generated name that definitely -- comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so @@ -205,13 +208,13 @@ data CLabel -- | A 'C' (or otherwise foreign) label. -- | ForeignLabel - FastString -- name of the imported label. + FastString -- ^ name of the imported label. - (Maybe Int) -- possible '@n' suffix for stdcall functions + (Maybe Int) -- ^ possible '@n' suffix for stdcall functions -- When generating C, the '@n' suffix is omitted, but when -- generating assembler we must add it to the label. - ForeignLabelSource -- what package the foreign label is in. + ForeignLabelSource -- ^ what package the foreign label is in. FunctionOrData @@ -224,7 +227,7 @@ data CLabel -- Must not occur outside of the NCG or LLVM code generators. | AsmTempDerivedLabel CLabel - FastString -- suffix + FastString -- ^ suffix | StringLitLabel {-# UNPACK #-} !Unique @@ -262,6 +265,24 @@ data CLabel deriving Eq +-- | Indicate if "GHC.CmmToC" has to generate an extern declaration for the +-- label (e.g. "extern StgWordArray(foo)"). The type is fixed to StgWordArray. +-- +-- Symbols from the RTS don't need "extern" declarations because they are +-- exposed via "includes/Stg.h" with the appropriate type. See 'needsCDecl'. +-- +-- The fixed StgWordArray type led to "conflicting types" issues with user +-- provided Cmm files (not in the RTS) that declare data of another type (#15467 +-- and test for #17920). Hence the Cmm parser considers that labels in data +-- sections don't need the "extern" declaration (just add one explicitly if you +-- need it). +-- +-- See https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes +-- for why extern declaration are needed at all. +newtype NeedExternDecl + = NeedExternDecl Bool + deriving (Ord,Eq) + -- This is laborious, but necessary. We can't derive Ord because -- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the -- implementation. See Note [No Ord for Unique] @@ -272,10 +293,11 @@ instance Ord CLabel where compare a1 a2 `thenCmp` compare b1 b2 `thenCmp` compare c1 c2 - compare (CmmLabel a1 b1 c1) (CmmLabel a2 b2 c2) = + compare (CmmLabel a1 b1 c1 d1) (CmmLabel a2 b2 c2 d2) = compare a1 a2 `thenCmp` compare b1 b2 `thenCmp` - compare c1 c2 + compare c1 c2 `thenCmp` + compare d1 d2 compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2 compare (LocalBlockLabel u1) (LocalBlockLabel u2) = nonDetCmpUnique u1 u2 compare (ForeignLabel a1 b1 c1 d1) (ForeignLabel a2 b2 c2 d2) = @@ -367,7 +389,7 @@ pprDebugCLabel lbl = case lbl of IdLabel _ _ info-> ppr lbl <> (parens $ text "IdLabel" <> whenPprDebug (text ":" <> text (show info))) - CmmLabel pkg _name _info + CmmLabel pkg _ext _name _info -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg) RtsLabel{} -> ppr lbl <> (parens $ text "RtsLabel") @@ -498,24 +520,24 @@ mkDirty_MUT_VAR_Label, mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel - = CmmLabel rtsUnitId (fsLit "nonmoving_write_barrier_enabled") CmmData -mkUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_upd_frame") CmmInfo -mkBHUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_bh_upd_frame" ) CmmInfo -mkIndStaticInfoLabel = CmmLabel rtsUnitId (fsLit "stg_IND_STATIC") CmmInfo -mkMainCapabilityLabel = CmmLabel rtsUnitId (fsLit "MainCapability") CmmData -mkMAP_FROZEN_CLEAN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo -mkMAP_FROZEN_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo -mkMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo -mkTopTickyCtrLabel = CmmLabel rtsUnitId (fsLit "top_ct") CmmData -mkCAFBlackHoleInfoTableLabel = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE") CmmInfo -mkArrWords_infoLabel = CmmLabel rtsUnitId (fsLit "stg_ARR_WORDS") CmmInfo -mkSMAP_FROZEN_CLEAN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo -mkSMAP_FROZEN_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo -mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo -mkBadAlignmentLabel = CmmLabel rtsUnitId (fsLit "stg_badAlignment") CmmEntry + = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData +mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo +mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo +mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo +mkMainCapabilityLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "MainCapability") CmmData +mkMAP_FROZEN_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo +mkMAP_FROZEN_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo +mkMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo +mkTopTickyCtrLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "top_ct") CmmData +mkCAFBlackHoleInfoTableLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_CAF_BLACKHOLE") CmmInfo +mkArrWords_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_ARR_WORDS") CmmInfo +mkSMAP_FROZEN_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo +mkSMAP_FROZEN_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo +mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo +mkBadAlignmentLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment") CmmEntry mkSRTInfoLabel :: Int -> CLabel -mkSRTInfoLabel n = CmmLabel rtsUnitId lbl CmmInfo +mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo where lbl = case n of @@ -539,16 +561,23 @@ mkSRTInfoLabel n = CmmLabel rtsUnitId lbl CmmInfo ----- mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel, - mkCmmCodeLabel, mkCmmDataLabel, mkCmmClosureLabel + mkCmmCodeLabel, mkCmmClosureLabel :: UnitId -> FastString -> CLabel -mkCmmInfoLabel pkg str = CmmLabel pkg str CmmInfo -mkCmmEntryLabel pkg str = CmmLabel pkg str CmmEntry -mkCmmRetInfoLabel pkg str = CmmLabel pkg str CmmRetInfo -mkCmmRetLabel pkg str = CmmLabel pkg str CmmRet -mkCmmCodeLabel pkg str = CmmLabel pkg str CmmCode -mkCmmDataLabel pkg str = CmmLabel pkg str CmmData -mkCmmClosureLabel pkg str = CmmLabel pkg str CmmClosure +mkCmmDataLabel :: UnitId -> NeedExternDecl -> FastString -> CLabel +mkRtsCmmDataLabel :: FastString -> CLabel + +mkCmmInfoLabel pkg str = CmmLabel pkg (NeedExternDecl True) str CmmInfo +mkCmmEntryLabel pkg str = CmmLabel pkg (NeedExternDecl True) str CmmEntry +mkCmmRetInfoLabel pkg str = CmmLabel pkg (NeedExternDecl True) str CmmRetInfo +mkCmmRetLabel pkg str = CmmLabel pkg (NeedExternDecl True) str CmmRet +mkCmmCodeLabel pkg str = CmmLabel pkg (NeedExternDecl True) str CmmCode +mkCmmClosureLabel pkg str = CmmLabel pkg (NeedExternDecl True) str CmmClosure +mkCmmDataLabel pkg ext str = CmmLabel pkg ext str CmmData +mkRtsCmmDataLabel str = CmmLabel rtsUnitId (NeedExternDecl False) str CmmData + -- RTS symbols don't need "GHC.CmmToC" to + -- generate \"extern\" declaration (they are + -- exposed via includes/Stg.h) mkLocalBlockLabel :: Unique -> CLabel mkLocalBlockLabel u = LocalBlockLabel u @@ -571,7 +600,7 @@ mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off) -- A call to some primitive hand written Cmm code mkPrimCallLabel :: PrimCall -> CLabel mkPrimCallLabel (PrimCall str pkg) - = CmmLabel pkg str CmmPrimCall + = CmmLabel pkg (NeedExternDecl True) str CmmPrimCall -- Constructing ForeignLabels @@ -609,7 +638,7 @@ isStaticClosureLabel :: CLabel -> Bool -- Closure defined in haskell (.hs) isStaticClosureLabel (IdLabel _ _ Closure) = True -- Closure defined in cmm -isStaticClosureLabel (CmmLabel _ _ CmmClosure) = True +isStaticClosureLabel (CmmLabel _ _ _ CmmClosure) = True isStaticClosureLabel _lbl = False -- | Whether label is a .rodata label @@ -621,7 +650,7 @@ isSomeRODataLabel (IdLabel _ _ InfoTable) = True isSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True isSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True -- info table defined in cmm (.cmm) -isSomeRODataLabel (CmmLabel _ _ CmmInfo) = True +isSomeRODataLabel (CmmLabel _ _ _ CmmInfo) = True isSomeRODataLabel _lbl = False -- | Whether label is points to some kind of info table @@ -703,7 +732,7 @@ mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die") toClosureLbl :: CLabel -> CLabel toClosureLbl (IdLabel n c _) = IdLabel n c Closure -toClosureLbl (CmmLabel m str _) = CmmLabel m str CmmClosure +toClosureLbl (CmmLabel m ext str _) = CmmLabel m ext str CmmClosure toClosureLbl l = pprPanic "toClosureLbl" (ppr l) toSlowEntryLbl :: CLabel -> CLabel @@ -718,16 +747,16 @@ toEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry toEntryLbl (IdLabel n _ BlockInfoTable) = mkLocalBlockLabel (nameUnique n) -- See Note [Proc-point local block entry-point]. toEntryLbl (IdLabel n c _) = IdLabel n c Entry -toEntryLbl (CmmLabel m str CmmInfo) = CmmLabel m str CmmEntry -toEntryLbl (CmmLabel m str CmmRetInfo) = CmmLabel m str CmmRet +toEntryLbl (CmmLabel m ext str CmmInfo) = CmmLabel m ext str CmmEntry +toEntryLbl (CmmLabel m ext str CmmRetInfo) = CmmLabel m ext str CmmRet toEntryLbl l = pprPanic "toEntryLbl" (ppr l) toInfoLbl :: CLabel -> CLabel toInfoLbl (IdLabel n c LocalEntry) = IdLabel n c LocalInfoTable toInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable toInfoLbl (IdLabel n c _) = IdLabel n c InfoTable -toInfoLbl (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo -toInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo +toInfoLbl (CmmLabel m ext str CmmEntry)= CmmLabel m ext str CmmInfo +toInfoLbl (CmmLabel m ext str CmmRet) = CmmLabel m ext str CmmRetInfo toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l) hasHaskellName :: CLabel -> Maybe Name @@ -779,10 +808,13 @@ needsCDecl (AsmTempLabel _) = False needsCDecl (AsmTempDerivedLabel _ _) = False needsCDecl (RtsLabel _) = False -needsCDecl (CmmLabel pkgId _ _) +needsCDecl (CmmLabel pkgId (NeedExternDecl external) _ _) + -- local labels mustn't have it + | not external = False + -- Prototypes for labels defined in the runtime system are imported -- into HC files via includes/Stg.h. - | pkgId == rtsUnitId = False + | pkgId == rtsUnitId = False -- For other labels we inline one into the HC file directly. | otherwise = True @@ -907,7 +939,7 @@ externallyVisibleCLabel (AsmTempLabel _) = False externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False externallyVisibleCLabel (RtsLabel _) = True externallyVisibleCLabel (LocalBlockLabel _) = False -externallyVisibleCLabel (CmmLabel _ _ _) = True +externallyVisibleCLabel (CmmLabel _ _ _ _) = True externallyVisibleCLabel (ForeignLabel{}) = True externallyVisibleCLabel (IdLabel name _ info) = isExternalName name && externallyVisibleIdLabel info externallyVisibleCLabel (CC_Label _) = True @@ -950,14 +982,14 @@ isGcPtrLabel lbl = case labelType lbl of -- whether it be code, data, or static GC object. labelType :: CLabel -> CLabelType labelType (IdLabel _ _ info) = idInfoLabelType info -labelType (CmmLabel _ _ CmmData) = DataLabel -labelType (CmmLabel _ _ CmmClosure) = GcPtrLabel -labelType (CmmLabel _ _ CmmCode) = CodeLabel -labelType (CmmLabel _ _ CmmInfo) = DataLabel -labelType (CmmLabel _ _ CmmEntry) = CodeLabel -labelType (CmmLabel _ _ CmmPrimCall) = CodeLabel -labelType (CmmLabel _ _ CmmRetInfo) = DataLabel -labelType (CmmLabel _ _ CmmRet) = CodeLabel +labelType (CmmLabel _ _ _ CmmData) = DataLabel +labelType (CmmLabel _ _ _ CmmClosure) = GcPtrLabel +labelType (CmmLabel _ _ _ CmmCode) = CodeLabel +labelType (CmmLabel _ _ _ CmmInfo) = DataLabel +labelType (CmmLabel _ _ _ CmmEntry) = CodeLabel +labelType (CmmLabel _ _ _ CmmPrimCall) = CodeLabel +labelType (CmmLabel _ _ _ CmmRetInfo) = DataLabel +labelType (CmmLabel _ _ _ CmmRet) = CodeLabel labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel labelType (RtsLabel (RtsApFast _)) = CodeLabel @@ -1027,7 +1059,7 @@ labelDynamic dflags this_mod lbl = -- When compiling in the "dyn" way, each package is to be linked into -- its own shared library. - CmmLabel pkg _ _ + CmmLabel pkg _ _ _ | os == OSMinGW32 -> externalDynamicRefs && (this_pkg /= pkg) | otherwise -> @@ -1233,9 +1265,9 @@ pprCLbl (LargeBitmapLabel u) = -- with a letter so the label will be legal assembly code. -pprCLbl (CmmLabel _ str CmmCode) = ftext str -pprCLbl (CmmLabel _ str CmmData) = ftext str -pprCLbl (CmmLabel _ str CmmPrimCall) = ftext str +pprCLbl (CmmLabel _ _ str CmmCode) = ftext str +pprCLbl (CmmLabel _ _ str CmmData) = ftext str +pprCLbl (CmmLabel _ _ str CmmPrimCall) = ftext str pprCLbl (LocalBlockLabel u) = tempLabelPrefixOrUnderscore <> text "blk_" <> pprUniqueAlways u @@ -1278,19 +1310,19 @@ pprCLbl (RtsLabel (RtsApEntry upd_reqd arity)) else (sLit "_noupd_entry")) ] -pprCLbl (CmmLabel _ fs CmmInfo) +pprCLbl (CmmLabel _ _ fs CmmInfo) = ftext fs <> text "_info" -pprCLbl (CmmLabel _ fs CmmEntry) +pprCLbl (CmmLabel _ _ fs CmmEntry) = ftext fs <> text "_entry" -pprCLbl (CmmLabel _ fs CmmRetInfo) +pprCLbl (CmmLabel _ _ fs CmmRetInfo) = ftext fs <> text "_info" -pprCLbl (CmmLabel _ fs CmmRet) +pprCLbl (CmmLabel _ _ fs CmmRet) = ftext fs <> text "_ret" -pprCLbl (CmmLabel _ fs CmmClosure) +pprCLbl (CmmLabel _ _ fs CmmClosure) = ftext fs <> text "_closure" pprCLbl (RtsLabel (RtsPrimOp primop)) diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 9458b9d621..e007355b91 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -399,7 +399,7 @@ cmmdata :: { CmmParse () } data_label :: { CmmParse CLabel } : NAME ':' {% liftP . withThisPackage $ \pkg -> - return (mkCmmDataLabel pkg $1) } + return (mkCmmDataLabel pkg (NeedExternDecl False) $1) } statics :: { [CmmParse [CmmStatic]] } : {- empty -} { [] } @@ -1178,7 +1178,7 @@ staticClosure :: UnitId -> FastString -> FastString -> [CmmLit] -> CmmParse () staticClosure pkg cl_label info payload = do dflags <- getDynFlags let lits = mkStaticClosure dflags (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] [] - code $ emitDataLits (mkCmmDataLabel pkg cl_label) lits + code $ emitDataLits (mkCmmDataLabel pkg (NeedExternDecl True) cl_label) lits foreignCall :: String diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index f96820de81..3d114d9f55 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -74,8 +74,7 @@ test('cgrun066', normal, compile_and_run, ['']) test('cgrun067', [extra_files(['Cgrun067A.hs'])], compile_and_run, ['']) test('cgrun068', reqlib('random'), compile_and_run, ['']) test('cgrun069', - [when(unregisterised(), expect_broken(15467)), - omit_ways(['ghci'])], + [ omit_ways(['ghci'])], multi_compile_and_run, ['cgrun069', [('cgrun069_cmm.cmm', '')], '']) test('cgrun070', normal, compile_and_run, ['']) |