module CLabel (
CLabel, -- abstract type
+ ForeignLabelSource(..),
+ pprDebugCLabel,
mkClosureLabel,
mkSRTLabel,
mkAsmTempLabel,
- mkModuleInitLabel,
- mkPlainModuleInitLabel,
- mkModuleInitTableLabel,
+ mkPlainModuleInitLabel,
mkSplitMarkerLabel,
mkDirty_MUT_VAR_Label,
mkUpdInfoLabel,
+ mkBHUpdInfoLabel,
mkIndStaticInfoLabel,
mkMainCapabilityLabel,
mkMAP_FROZEN_infoLabel,
mkRtsPrimOpLabel,
mkRtsSlowTickyCtrLabel,
- moduleRegdLabel,
- moduleRegTableLabel,
-
- mkSelectorInfoLabel,
+ mkSelectorInfoLabel,
mkSelectorEntryLabel,
mkCmmInfoLabel,
mkDeadStripPreventer,
mkHpcTicksLabel,
- mkHpcModuleNameLabel,
hasCAF,
infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
- isMathFun,
+ isMathFun, isCas,
isCFunctionLabel, isGcPtrLabel, labelDynamic,
pprCLabel
-- | 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
-- If it doesn't have an algorithmically generated name then use a CmmLabel
- -- instead and give it an appropriate Module argument.
+ -- instead and give it an appropriate PackageId argument.
| RtsLabel
RtsLabelInfo
- -- | A 'C' (or otherwise foreign) label
- | ForeignLabel FastString
+ -- | A 'C' (or otherwise foreign) label.
+ --
+ | ForeignLabel
+ FastString -- name of the imported label.
+
(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.
- Bool -- True <=> is dynamic
+
+ ForeignLabelSource -- what package the foreign label is in.
+
FunctionOrData
-- | A family of labels related to a particular case expression.
| StringLitLabel
{-# UNPACK #-} !Unique
- | ModuleInitLabel
- Module -- the module name
- String -- its "way"
- -- at some point we might want some kind of version number in
- -- the module init label, to guard against compiling modules in
- -- the wrong order. We can't use the interface file version however,
- -- because we don't always recompile modules which depend on a module
- -- whose version has changed.
-
- | PlainModuleInitLabel -- without the version & way info
+ | PlainModuleInitLabel -- without the version & way info
Module
- | ModuleInitTableLabel -- table of imported modules to init
- Module
-
- | ModuleRegdLabel
-
| CC_Label CostCentre
| CCS_Label CostCentreStack
-- | Per-module table of tick locations
| HpcTicksLabel Module
- -- | Per-module name of the module for Hpc
- | HpcModuleNameLabel
-
-- | Label of an StgLargeSRT
| LargeSRTLabel
{-# UNPACK #-} !Unique
deriving (Eq, Ord)
+
+-- | Record where a foreign label is stored.
+data ForeignLabelSource
+
+ -- | Label is in a named package
+ = ForeignLabelInPackage PackageId
+
+ -- | Label is in some external, system package that doesn't also
+ -- contain compiled Haskell code, and is not associated with any .hi files.
+ -- We don't have to worry about Haskell code being inlined from
+ -- external packages. It is safe to treat the RTS package as "external".
+ | ForeignLabelInExternalPackage
+
+ -- | Label is in the package currenly being compiled.
+ -- This is only used for creating hacky tmp labels during code generation.
+ -- Don't use it in any code that might be inlined across a package boundary
+ -- (ie, core code) else the information will be wrong relative to the
+ -- destination module.
+ | ForeignLabelInThisPackage
+
+ deriving (Eq, Ord)
+
+
+-- | For debugging problems with the CLabel representation.
+-- We can't make a Show instance for CLabel because lots of its components don't have instances.
+-- The regular Outputable instance only shows the label name, and not its other info.
+--
+pprDebugCLabel :: CLabel -> SDoc
+pprDebugCLabel lbl
+ = case lbl of
+ IdLabel{} -> ppr lbl <> (parens $ text "IdLabel")
+ CmmLabel pkg name _info
+ -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
+
+ RtsLabel{} -> ppr lbl <> (parens $ text "RtsLabel")
+
+ ForeignLabel name mSuffix src funOrData
+ -> ppr lbl <> (parens
+ $ text "ForeignLabel"
+ <+> ppr mSuffix
+ <+> ppr src
+ <+> ppr funOrData)
+
+ _ -> ppr lbl <> (parens $ text "other CLabel)")
+
+
data IdLabelInfo
= Closure -- ^ Label for closure
| SRT -- ^ Static reference table
| CmmData -- ^ misc rts data bits, eg CHARLIKE_closure
| CmmCode -- ^ misc rts code
| CmmGcPtr -- ^ GcPtrs eg CHARLIKE_closure
+ | CmmPrimCall -- ^ a prim call to some hand written Cmm code
deriving (Eq, Ord)
data DynamicLinkerLabelInfo
mkSplitMarkerLabel = CmmLabel rtsPackageId (fsLit "__stg_split_marker") CmmCode
mkDirty_MUT_VAR_Label = CmmLabel rtsPackageId (fsLit "dirty_MUT_VAR") CmmCode
mkUpdInfoLabel = CmmLabel rtsPackageId (fsLit "stg_upd_frame") CmmInfo
+mkBHUpdInfoLabel = CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" ) CmmInfo
mkIndStaticInfoLabel = CmmLabel rtsPackageId (fsLit "stg_IND_STATIC") CmmInfo
mkMainCapabilityLabel = CmmLabel rtsPackageId (fsLit "MainCapability") CmmData
mkMAP_FROZEN_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
--- Constructing ForeignLabels
--- Primitive / cmm call labels
+-- A call to some primitive hand written Cmm code
mkPrimCallLabel :: PrimCall -> CLabel
-mkPrimCallLabel (PrimCall str) = ForeignLabel str Nothing False IsFunction
+mkPrimCallLabel (PrimCall str pkg)
+ = CmmLabel pkg str CmmPrimCall
+
--- Foreign labels
-mkForeignLabel :: FastString -> Maybe Int -> Bool -> FunctionOrData -> CLabel
-mkForeignLabel str mb_sz is_dynamic fod
- = ForeignLabel str mb_sz is_dynamic fod
+-- Constructing ForeignLabels
+
+-- | Make a foreign label
+mkForeignLabel
+ :: FastString -- name
+ -> Maybe Int -- size prefix
+ -> ForeignLabelSource -- what package it's in
+ -> FunctionOrData
+ -> CLabel
+
+mkForeignLabel str mb_sz src fod
+ = ForeignLabel str mb_sz src fod
+
+-- | Update the label size field in a ForeignLabel
addLabelSize :: CLabel -> Int -> CLabel
-addLabelSize (ForeignLabel str _ is_dynamic fod) sz
- = ForeignLabel str (Just sz) is_dynamic fod
+addLabelSize (ForeignLabel str _ src fod) sz
+ = ForeignLabel str (Just sz) src fod
addLabelSize label _
= label
+-- | Get the label size field from a ForeignLabel
foreignLabelStdcallInfo :: CLabel -> Maybe Int
foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
foreignLabelStdcallInfo _lbl = Nothing
-- Constructing Code Coverage Labels
mkHpcTicksLabel = HpcTicksLabel
-mkHpcModuleNameLabel = HpcModuleNameLabel
-- Constructing labels used for dynamic linking
mkAsmTempLabel :: Uniquable a => a -> CLabel
mkAsmTempLabel a = AsmTempLabel (getUnique a)
-mkModuleInitLabel :: Module -> String -> CLabel
-mkModuleInitLabel mod way = ModuleInitLabel mod way
-
mkPlainModuleInitLabel :: Module -> CLabel
mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
-mkModuleInitTableLabel :: Module -> CLabel
-mkModuleInitTableLabel mod = ModuleInitTableLabel mod
-
-moduleRegdLabel = ModuleRegdLabel
-moduleRegTableLabel = ModuleInitTableLabel
-
-
-- -----------------------------------------------------------------------------
-- Converting between info labels and entry/ret labels.
cvtToClosureLbl (IdLabel n c InfoTable) = IdLabel n c Closure
cvtToClosureLbl (IdLabel n c Entry) = IdLabel n c Closure
cvtToClosureLbl (IdLabel n c ConEntry) = IdLabel n c Closure
+cvtToClosureLbl (IdLabel n c RednCounts) = IdLabel n c Closure
cvtToClosureLbl l@(IdLabel n c Closure) = l
cvtToClosureLbl l
= pprPanic "cvtToClosureLbl" (pprCLabel l)
needsCDecl (LargeBitmapLabel _) = False
needsCDecl (IdLabel _ _ _) = True
needsCDecl (CaseLabel _ _) = True
-needsCDecl (ModuleInitLabel _ _) = True
-needsCDecl (PlainModuleInitLabel _) = True
-needsCDecl (ModuleInitTableLabel _) = True
-needsCDecl ModuleRegdLabel = False
+needsCDecl (PlainModuleInitLabel _) = True
needsCDecl (StringLitLabel _) = False
needsCDecl (AsmTempLabel _) = False
needsCDecl (RtsLabel _) = False
-needsCDecl l@(ForeignLabel _ _ _ _) = not (isMathFun l)
+
+needsCDecl (CmmLabel pkgId _ _)
+ -- Prototypes for labels defined in the runtime system are imported
+ -- into HC files via includes/Stg.h.
+ | pkgId == rtsPackageId = False
+
+ -- For other labels we inline one into the HC file directly.
+ | otherwise = True
+
+needsCDecl l@(ForeignLabel{}) = not (isMathFun l)
needsCDecl (CC_Label _) = True
needsCDecl (CCS_Label _) = True
needsCDecl (HpcTicksLabel _) = True
-needsCDecl HpcModuleNameLabel = False
-- | Check whether a label is a local temporary for native code generation
maybeAsmTemp _ = Nothing
--- Check whether a label corresponds to a C function that has
+-- | Check whether a label corresponds to our cas function.
+-- We #include the prototype for this, so we need to avoid
+-- generating out own C prototypes.
+isCas :: CLabel -> Bool
+isCas (CmmLabel pkgId fn _) = pkgId == rtsPackageId && fn == fsLit "cas"
+isCas _ = False
+
+
+-- | Check whether a label corresponds to a C function that has
-- a prototype in a system header somehere, or is built-in
--- to the C compiler. For these labels we abovoid generating our
+-- to the C compiler. For these labels we avoid generating our
-- own C prototypes.
isMathFun :: CLabel -> Bool
-isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
+isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
isMathFun _ = False
math_funs = mkUniqSet [
]
-- -----------------------------------------------------------------------------
--- Is a CLabel visible outside this object file or not?
-
--- From the point of view of the code generator, a name is
--- externally visible if it has to be declared as exported
--- in the .o file's symbol table; that is, made non-static.
-
+-- | Is a CLabel visible outside this object file or not?
+-- From the point of view of the code generator, a name is
+-- externally visible if it has to be declared as exported
+-- in the .o file's symbol table; that is, made non-static.
externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
externallyVisibleCLabel (CaseLabel _ _) = False
externallyVisibleCLabel (StringLitLabel _) = False
externallyVisibleCLabel (AsmTempLabel _) = False
-externallyVisibleCLabel (ModuleInitLabel _ _) = True
externallyVisibleCLabel (PlainModuleInitLabel _)= True
-externallyVisibleCLabel (ModuleInitTableLabel _)= False
-externallyVisibleCLabel ModuleRegdLabel = False
-externallyVisibleCLabel (RtsLabel _) = True
+externallyVisibleCLabel (RtsLabel _) = True
externallyVisibleCLabel (CmmLabel _ _ _) = True
-externallyVisibleCLabel (ForeignLabel _ _ _ _) = True
+externallyVisibleCLabel (ForeignLabel{}) = True
externallyVisibleCLabel (IdLabel name _ _) = isExternalName name
externallyVisibleCLabel (CC_Label _) = True
externallyVisibleCLabel (CCS_Label _) = True
externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
externallyVisibleCLabel (HpcTicksLabel _) = True
-externallyVisibleCLabel HpcModuleNameLabel = False
-externallyVisibleCLabel (LargeBitmapLabel _) = False
+externallyVisibleCLabel (LargeBitmapLabel _) = False
externallyVisibleCLabel (LargeSRTLabel _) = False
-- -----------------------------------------------------------------------------
labelType (RtsLabel (RtsApFast _)) = CodeLabel
labelType (CaseLabel _ CaseReturnInfo) = DataLabel
labelType (CaseLabel _ _) = CodeLabel
-labelType (ModuleInitLabel _ _) = CodeLabel
labelType (PlainModuleInitLabel _) = CodeLabel
-labelType (ModuleInitTableLabel _) = DataLabel
labelType (LargeSRTLabel _) = DataLabel
labelType (LargeBitmapLabel _) = DataLabel
-labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
+labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
labelType (IdLabel _ _ info) = idInfoLabelType info
labelType _ = DataLabel
labelDynamic :: PackageId -> CLabel -> Bool
labelDynamic this_pkg lbl =
case lbl of
- RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
- CmmLabel pkg _ _ -> not opt_Static && (this_pkg /= pkg)
+ -- is the RTS in a DLL or not?
+ RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId)
+
IdLabel n _ k -> isDllName this_pkg n
+
#if mingw32_TARGET_OS
- ForeignLabel _ _ d _ -> d
+ -- When compiling in the "dyn" way, eack package is to be linked into its own shared library.
+ CmmLabel pkg _ _
+ -> not opt_Static && (this_pkg /= pkg)
+
+ -- Foreign label is in some un-named foreign package (or DLL)
+ ForeignLabel _ _ ForeignLabelInExternalPackage _ -> True
+
+ -- Foreign label is linked into the same package as the source file currently being compiled.
+ ForeignLabel _ _ ForeignLabelInThisPackage _ -> False
+
+ -- Foreign label is in some named package.
+ -- When compiling in the "dyn" way, each package is to be linked into its own DLL.
+ ForeignLabel _ _ (ForeignLabelInPackage pkgId) _
+ -> (not opt_Static) && (this_pkg /= pkgId)
+
#else
-- On Mac OS X and on ELF platforms, false positives are OK,
-- so we claim that all foreign imports come from dynamic libraries
ForeignLabel _ _ _ _ -> True
+
+ CmmLabel pkg _ _ -> True
+
#endif
- ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
- ModuleInitTableLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
-
+
-- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
_ -> False
pprCLbl (CmmLabel _ str CmmCode) = ftext str
pprCLbl (CmmLabel _ str CmmData) = ftext str
pprCLbl (CmmLabel _ str CmmGcPtr) = ftext str
+pprCLbl (CmmLabel _ str CmmPrimCall) = ftext str
pprCLbl (RtsLabel (RtsApFast str)) = ftext str <> ptext (sLit "_fast")
pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
= ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
-pprCLbl ModuleRegdLabel
- = ptext (sLit "_module_registered")
-
pprCLbl (ForeignLabel str _ _ _)
= ftext str
pprCLbl (CC_Label cc) = ppr cc
pprCLbl (CCS_Label ccs) = ppr ccs
-pprCLbl (ModuleInitLabel mod way)
- = ptext (sLit "__stginit_") <> ppr mod
- <> char '_' <> text way
-
pprCLbl (PlainModuleInitLabel mod)
= ptext (sLit "__stginit_") <> ppr mod
-pprCLbl (ModuleInitTableLabel mod)
- = ptext (sLit "__stginittable_") <> ppr mod
-
pprCLbl (HpcTicksLabel mod)
= ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
-pprCLbl HpcModuleNameLabel
- = ptext (sLit "_hpc_module_name_str")
-
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <>
(case x of
pp_cSEP = char '_'
+
+instance Outputable ForeignLabelSource where
+ ppr fs
+ = case fs of
+ ForeignLabelInPackage pkgId -> parens $ text "package: " <> ppr pkgId
+ ForeignLabelInThisPackage -> parens $ text "this package"
+ ForeignLabelInExternalPackage -> parens $ text "external package"
+
-- -----------------------------------------------------------------------------
-- Machine-dependent knowledge about labels.
pprDynamicLinkerAsmLabel _ _
= panic "pprDynamicLinkerAsmLabel"
-#elif powerpc_TARGET_ARCH && linux_TARGET_OS
+#elif powerpc_TARGET_ARCH && elf_OBJ_FORMAT
pprDynamicLinkerAsmLabel CodeStub lbl
= pprCLabel lbl <> text "@plt"
pprDynamicLinkerAsmLabel SymbolPtr lbl
pprDynamicLinkerAsmLabel _ _
= panic "pprDynamicLinkerAsmLabel"
-#elif x86_64_TARGET_ARCH && linux_TARGET_OS
+#elif x86_64_TARGET_ARCH && elf_OBJ_FORMAT
pprDynamicLinkerAsmLabel CodeStub lbl
= pprCLabel lbl <> text "@plt"
pprDynamicLinkerAsmLabel GotSymbolPtr lbl
pprDynamicLinkerAsmLabel SymbolPtr lbl
= text ".LC_" <> pprCLabel lbl
-#elif linux_TARGET_OS
+#elif elf_OBJ_FORMAT
pprDynamicLinkerAsmLabel CodeStub lbl
= pprCLabel lbl <> text "@plt"
pprDynamicLinkerAsmLabel SymbolPtr lbl