Commit 2636794d authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot
Browse files

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).
parent 7750bd45
......@@ -12,6 +12,7 @@
module GHC.Cmm.CLabel (
CLabel, -- abstract type
NeedExternDecl (..),
ForeignLabelSource(..),
pprDebugCLabel,
......@@ -71,6 +72,7 @@ module GHC.Cmm.CLabel (
mkCmmRetLabel,
mkCmmCodeLabel,
mkCmmDataLabel,
mkRtsCmmDataLabel,
mkCmmClosureLabel,
mkRtsApFastLabel,
......@@ -182,13 +184,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
......@@ -208,13 +211,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
......@@ -227,7 +230,7 @@ data CLabel
-- Must not occur outside of the NCG or LLVM code generators.
| AsmTempDerivedLabel
CLabel
FastString -- suffix
FastString -- ^ suffix
| StringLitLabel
{-# UNPACK #-} !Unique
......@@ -275,6 +278,24 @@ isTickyLabel :: CLabel -> Bool
isTickyLabel (IdLabel _ _ RednCounts) = True
isTickyLabel _ = False
-- | 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]
......@@ -285,10 +306,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) =
......@@ -380,7 +402,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")
......@@ -510,24 +532,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
......@@ -551,16 +573,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
......@@ -593,7 +622,7 @@ mkApEntryLabel dflags upd arity =
-- A call to some primitive hand written Cmm code
mkPrimCallLabel :: PrimCall -> CLabel
mkPrimCallLabel (PrimCall str pkg)
= CmmLabel (toUnitId pkg) str CmmPrimCall
= CmmLabel (toUnitId pkg) (NeedExternDecl True) str CmmPrimCall
-- Constructing ForeignLabels
......@@ -631,7 +660,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
......@@ -643,7 +672,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
......@@ -725,7 +754,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
......@@ -740,16 +769,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
......@@ -801,10 +830,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
......@@ -929,7 +961,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
......@@ -972,14 +1004,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
......@@ -1049,7 +1081,7 @@ labelDynamic config 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 && (toUnitId this_pkg /= pkg)
| otherwise -> externalDynamicRefs
......@@ -1248,9 +1280,9 @@ pprCLbl platform = \case
-- until that gets resolved we'll just force them to start
-- with a letter so the label will be legal assembly code.
(CmmLabel _ str CmmCode) -> ftext str
(CmmLabel _ str CmmData) -> ftext str
(CmmLabel _ str CmmPrimCall) -> ftext str
(CmmLabel _ _ str CmmCode) -> ftext str
(CmmLabel _ _ str CmmData) -> ftext str
(CmmLabel _ _ str CmmPrimCall) -> ftext str
(LocalBlockLabel u) -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u
......@@ -1284,11 +1316,11 @@ pprCLbl platform = \case
else (sLit "_noupd_entry"))
]
(CmmLabel _ fs CmmInfo) -> ftext fs <> text "_info"
(CmmLabel _ fs CmmEntry) -> ftext fs <> text "_entry"
(CmmLabel _ fs CmmRetInfo) -> ftext fs <> text "_info"
(CmmLabel _ fs CmmRet) -> ftext fs <> text "_ret"
(CmmLabel _ fs CmmClosure) -> ftext fs <> text "_closure"
(CmmLabel _ _ fs CmmInfo) -> ftext fs <> text "_info"
(CmmLabel _ _ fs CmmEntry) -> ftext fs <> text "_entry"
(CmmLabel _ _ fs CmmRetInfo) -> ftext fs <> text "_info"
(CmmLabel _ _ fs CmmRet) -> ftext fs <> text "_ret"
(CmmLabel _ _ fs CmmClosure) -> ftext fs <> text "_closure"
(RtsLabel (RtsPrimOp primop)) -> text "stg_" <> ppr primop
(RtsLabel (RtsSlowFastTickyCtr pat)) ->
......
......@@ -399,7 +399,7 @@ cmmdata :: { CmmParse () }
data_label :: { CmmParse CLabel }
: NAME ':'
{% liftP . withHomeUnitId $ \pkg ->
return (mkCmmDataLabel pkg $1) }
return (mkCmmDataLabel pkg (NeedExternDecl False) $1) }
statics :: { [CmmParse [CmmStatic]] }
: {- empty -} { [] }
......@@ -1176,7 +1176,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
......
......@@ -364,7 +364,7 @@ ldvEnter cl_ptr = do
loadEra :: DynFlags -> CmmExpr
loadEra dflags = CmmMachOp (MO_UU_Conv (cIntWidth dflags) (wordWidth platform))
[CmmLoad (mkLblExpr (mkCmmDataLabel rtsUnitId (fsLit "era")))
[CmmLoad (mkLblExpr (mkRtsCmmDataLabel (fsLit "era")))
(cInt dflags)]
where platform = targetPlatform dflags
......
......@@ -115,7 +115,6 @@ import GHC.Cmm.Utils
import GHC.Cmm.CLabel
import GHC.Runtime.Heap.Layout
import GHC.Unit
import GHC.Types.Name
import GHC.Types.Id
import GHC.Types.Basic
......@@ -356,7 +355,7 @@ registerTickyCtr ctr_lbl = do
, mkStore (CmmLit (cmmLabelOffB ctr_lbl
(oFFSET_StgEntCounter_registeredp dflags)))
(mkIntExpr platform 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 ()
......@@ -498,12 +497,12 @@ tickyAllocHeap genuine hp
bytes,
-- Bump the global allocation total ALLOC_HEAP_tot
addToMemLbl (bWord platform)
(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 platform)
(mkCmmDataLabel rtsUnitId (fsLit "ALLOC_HEAP_ctr"))
(mkRtsCmmDataLabel (fsLit "ALLOC_HEAP_ctr"))
1
]}
......@@ -567,13 +566,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
......@@ -615,7 +614,7 @@ bumpHistogram lbl n = do
emit (addToMem (bWord platform)
(cmmIndexExpr platform
(wordWidth platform)
(CmmLit (CmmLabel (mkCmmDataLabel rtsUnitId lbl)))
(CmmLit (CmmLabel (mkRtsCmmDataLabel lbl)))
(CmmLit (CmmInt (fromIntegral offset) (wordWidth platform))))
1)
......
......@@ -75,8 +75,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, [''])
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment