module CLabel (
CLabel, -- abstract type
+ ForeignLabelSource(..),
+ pprDebugCLabel,
mkClosureLabel,
mkSRTLabel,
mkSplitMarkerLabel,
mkDirty_MUT_VAR_Label,
mkUpdInfoLabel,
+ mkBHUpdInfoLabel,
mkIndStaticInfoLabel,
mkMainCapabilityLabel,
mkMAP_FROZEN_infoLabel,
mkSelectorInfoLabel,
mkSelectorEntryLabel,
- mkRtsInfoLabel,
- mkRtsEntryLabel,
- mkRtsRetInfoLabel,
- mkRtsRetLabel,
- mkRtsCodeLabel,
- mkRtsDataLabel,
- mkRtsGcPtrLabel,
+ mkCmmInfoLabel,
+ mkCmmEntryLabel,
+ mkCmmRetInfoLabel,
+ mkCmmRetLabel,
+ mkCmmCodeLabel,
+ mkCmmDataLabel,
+ mkCmmGcPtrLabel,
mkRtsApFastLabel,
-- | A label from a .cmm file that is not associated with a .hs level Id.
| CmmLabel
- Module -- what Cmm source module the label belongs to
+ PackageId -- what package the label belongs to.
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
-- 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.
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
mkConEntryLabel name c = IdLabel name c ConEntry
mkStaticConEntryLabel name c = IdLabel name c StaticConEntry
-
-- Constructing Cmm Labels
-
--- | Pretend that wired-in names from the RTS are in a top-level module called RTS,
--- located in the RTS package. It doesn't matter what module they're actually in
--- as long as that module is in the correct package.
-topRtsModule :: Module
-topRtsModule = mkModule rtsPackageId (mkModuleNameFS (fsLit "RTS"))
-
-mkSplitMarkerLabel = CmmLabel topRtsModule (fsLit "__stg_split_marker") CmmCode
-mkDirty_MUT_VAR_Label = CmmLabel topRtsModule (fsLit "dirty_MUT_VAR") CmmCode
-mkUpdInfoLabel = CmmLabel topRtsModule (fsLit "stg_upd_frame") CmmInfo
-mkIndStaticInfoLabel = CmmLabel topRtsModule (fsLit "stg_IND_STATIC") CmmInfo
-mkMainCapabilityLabel = CmmLabel topRtsModule (fsLit "MainCapability") CmmData
-mkMAP_FROZEN_infoLabel = CmmLabel topRtsModule (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
-mkMAP_DIRTY_infoLabel = CmmLabel topRtsModule (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
-mkEMPTY_MVAR_infoLabel = CmmLabel topRtsModule (fsLit "stg_EMPTY_MVAR") CmmInfo
-mkTopTickyCtrLabel = CmmLabel topRtsModule (fsLit "top_ct") CmmData
-mkCAFBlackHoleInfoTableLabel = CmmLabel topRtsModule (fsLit "stg_CAF_BLACKHOLE") CmmInfo
+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
+mkMAP_DIRTY_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
+mkEMPTY_MVAR_infoLabel = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR") CmmInfo
+mkTopTickyCtrLabel = CmmLabel rtsPackageId (fsLit "top_ct") CmmData
+mkCAFBlackHoleInfoTableLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmInfo
-----
-mkRtsInfoLabel, mkRtsEntryLabel, mkRtsRetInfoLabel, mkRtsRetLabel,
- mkRtsCodeLabel, mkRtsDataLabel, mkRtsGcPtrLabel
- :: FastString -> CLabel
+mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
+ mkCmmCodeLabel, mkCmmDataLabel, mkCmmGcPtrLabel
+ :: PackageId -> FastString -> CLabel
-mkRtsInfoLabel str = CmmLabel topRtsModule str CmmInfo
-mkRtsEntryLabel str = CmmLabel topRtsModule str CmmEntry
-mkRtsRetInfoLabel str = CmmLabel topRtsModule str CmmRetInfo
-mkRtsRetLabel str = CmmLabel topRtsModule str CmmRet
-mkRtsCodeLabel str = CmmLabel topRtsModule str CmmCode
-mkRtsDataLabel str = CmmLabel topRtsModule str CmmData
-mkRtsGcPtrLabel str = CmmLabel topRtsModule str CmmGcPtr
+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
+mkCmmGcPtrLabel pkg str = CmmLabel pkg str CmmGcPtr
-- Constructing RtsLabels
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
+
+
+-- Constructing ForeignLabels
+
+-- | Make a foreign label
+mkForeignLabel
+ :: FastString -- name
+ -> Maybe Int -- size prefix
+ -> ForeignLabelSource -- what package it's in
+ -> FunctionOrData
+ -> CLabel
--- Foreign labels
-mkForeignLabel :: FastString -> Maybe Int -> Bool -> FunctionOrData -> CLabel
-mkForeignLabel str mb_sz is_dynamic fod
- = ForeignLabel str mb_sz is_dynamic fod
+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
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
maybeAsmTemp _ = Nothing
--- Check whether a label corresponds to a C function that has
+-- | 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
-- 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 (ModuleInitTableLabel _)= False
externallyVisibleCLabel ModuleRegdLabel = False
externallyVisibleCLabel (RtsLabel _) = True
-externallyVisibleCLabel (ForeignLabel _ _ _ _) = True
+externallyVisibleCLabel (CmmLabel _ _ _) = True
+externallyVisibleCLabel (ForeignLabel{}) = True
externallyVisibleCLabel (IdLabel name _ _) = isExternalName name
externallyVisibleCLabel (CC_Label _) = True
externallyVisibleCLabel (CCS_Label _) = True
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?
- IdLabel n _ k -> isDllName this_pkg n
+ -- 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)
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")
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