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,
IdLabel
Name
CafInfo
- IdLabelInfo
-
- -- | A label with a baked-in name that definitely comes from the RTS.
- -- The code for it must compile into libHSrts.a \/ libHSrts.so \/ libHSrts.dll
+ IdLabelInfo -- encodes the suffix of the label
+
+ -- | A label from a .cmm file that is not associated with a .hs level Id.
+ | CmmLabel
+ 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 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)
+
+closureSuffix' :: Name -> SDoc
+closureSuffix' hs_fn =
+ if depth==0 then ptext (sLit "") else ptext (sLit $ (show depth))
+ where depth = getNameDepth hs_fn
+
+-- | 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
| RtsApEntry Bool{-updatable-} Int{-arity-}
| RtsPrimOp PrimOp
-
- | RtsInfo FastString -- ^ misc rts info tables
- | RtsEntry FastString -- ^ misc rts entry points
- | RtsRetInfo FastString -- ^ misc rts ret info tables
- | RtsRet FastString -- ^ misc rts return points
- | RtsData FastString -- ^ misc rts data bits, eg CHARLIKE_closure
- | RtsCode FastString -- ^ misc rts code
- | RtsGcPtr FastString -- ^ GcPtrs eg CHARLIKE_closure
-
| RtsApFast FastString -- ^ _fast versions of generic apply
-
| RtsSlowTickyCtr String
deriving (Eq, Ord)
-- NOTE: Eq on LitString compares the pointer only, so this isn't
-- a real equality.
+
+-- | What type of Cmm label we're dealing with.
+-- Determines the suffix appended to the name when a CLabel.CmmLabel
+-- is pretty printed.
+data CmmLabelInfo
+ = CmmInfo -- ^ misc rts info tabless, suffix _info
+ | CmmEntry -- ^ misc rts entry points, suffix _entry
+ | CmmRetInfo -- ^ misc rts ret info tables, suffix _info
+ | CmmRet -- ^ misc rts return points, suffix _ret
+ | 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
= CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
| SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
| GotSymbolOffset -- ELF: foo@gotoff
deriving (Eq, Ord)
-
+
+
-- -----------------------------------------------------------------------------
-- Constructing CLabels
+-- -----------------------------------------------------------------------------
+-- Constructing IdLabels
-- These are always local:
-mkSRTLabel name c = IdLabel name c SRT
+mkSRTLabel name c = IdLabel name c SRT
mkSlowEntryLabel name c = IdLabel name c Slow
mkRednCountsLabel name c = IdLabel name c RednCounts
mkConEntryLabel name c = IdLabel name c ConEntry
mkStaticConEntryLabel name c = IdLabel name c StaticConEntry
-mkLargeSRTLabel uniq = LargeSRTLabel uniq
-mkBitmapLabel uniq = LargeBitmapLabel uniq
-
-mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
-mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
-mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
-mkDefaultLabel uniq = CaseLabel uniq CaseDefault
-
-mkStringLitLabel = StringLitLabel
-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
-
- -- Some fixed runtime system labels
-
-mkSplitMarkerLabel = RtsLabel (RtsCode (fsLit "__stg_split_marker"))
-mkDirty_MUT_VAR_Label = RtsLabel (RtsCode (fsLit "dirty_MUT_VAR"))
-mkUpdInfoLabel = RtsLabel (RtsInfo (fsLit "stg_upd_frame"))
-mkIndStaticInfoLabel = RtsLabel (RtsInfo (fsLit "stg_IND_STATIC"))
-mkMainCapabilityLabel = RtsLabel (RtsData (fsLit "MainCapability"))
-mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo (fsLit "stg_MUT_ARR_PTRS_FROZEN0"))
-mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo (fsLit "stg_MUT_ARR_PTRS_DIRTY"))
-mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo (fsLit "stg_EMPTY_MVAR"))
-
-mkTopTickyCtrLabel = RtsLabel (RtsData (fsLit "top_ct"))
-mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (fsLit "stg_CAF_BLACKHOLE"))
+-- Constructing Cmm Labels
+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
+
+-----
+mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
+ mkCmmCodeLabel, mkCmmDataLabel, mkCmmGcPtrLabel
+ :: PackageId -> 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
+mkCmmGcPtrLabel pkg str = CmmLabel pkg str CmmGcPtr
+
+
+-- Constructing RtsLabels
mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
-moduleRegdLabel = ModuleRegdLabel
-moduleRegTableLabel = ModuleInitTableLabel
-
mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
-mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
+mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
-mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
-mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
+mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
+mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
- -- 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 str mb_sz src fod
+ = ForeignLabel str mb_sz src fod
-mkForeignLabel :: FastString -> Maybe Int -> Bool -> FunctionOrData -> CLabel
-mkForeignLabel str mb_sz is_dynamic fod
- = ForeignLabel str mb_sz is_dynamic 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
+ = label
+-- | Get the label size field from a ForeignLabel
foreignLabelStdcallInfo :: CLabel -> Maybe Int
foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
foreignLabelStdcallInfo _lbl = Nothing
- -- Cost centres etc.
-mkCCLabel cc = CC_Label cc
-mkCCSLabel ccs = CCS_Label ccs
+-- Constructing Large*Labels
+mkLargeSRTLabel uniq = LargeSRTLabel uniq
+mkBitmapLabel uniq = LargeBitmapLabel uniq
+
+
+-- Constructin CaseLabels
+mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
+mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
+mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
+mkDefaultLabel uniq = CaseLabel uniq CaseDefault
-mkRtsInfoLabel str = RtsLabel (RtsInfo str)
-mkRtsEntryLabel str = RtsLabel (RtsEntry str)
-mkRtsRetInfoLabel str = RtsLabel (RtsRetInfo str)
-mkRtsRetLabel str = RtsLabel (RtsRet str)
-mkRtsCodeLabel str = RtsLabel (RtsCode str)
-mkRtsDataLabel str = RtsLabel (RtsData str)
-mkRtsGcPtrLabel str = RtsLabel (RtsGcPtr str)
+-- Constructing Cost Center Labels
+mkCCLabel cc = CC_Label cc
+mkCCSLabel ccs = CCS_Label ccs
mkRtsApFastLabel str = RtsLabel (RtsApFast str)
mkRtsSlowTickyCtrLabel :: String -> CLabel
mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
- -- Coverage
+-- Constructing Code Coverage Labels
mkHpcTicksLabel = HpcTicksLabel
mkHpcModuleNameLabel = HpcModuleNameLabel
- -- Dynamic linking
-
+
+-- Constructing labels used for dynamic linking
mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
-mkDynamicLinkerLabel = DynamicLinkerLabel
+mkDynamicLinkerLabel = DynamicLinkerLabel
dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
-dynamicLinkerLabelInfo _ = Nothing
-
- -- Position independent code
-
+dynamicLinkerLabelInfo _ = Nothing
+
mkPicBaseLabel :: CLabel
-mkPicBaseLabel = PicBaseLabel
+mkPicBaseLabel = PicBaseLabel
+
+-- Constructing miscellaneous other labels
mkDeadStripPreventer :: CLabel -> CLabel
-mkDeadStripPreventer lbl = DeadStripPreventer lbl
+mkDeadStripPreventer lbl = DeadStripPreventer lbl
+
+mkStringLitLabel :: Unique -> CLabel
+mkStringLitLabel = StringLitLabel
+
+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.
infoLblToEntryLbl :: CLabel -> CLabel
-infoLblToEntryLbl (IdLabel n c InfoTable) = IdLabel n c Entry
-infoLblToEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
-infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
-infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
-infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
-infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
-infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
+infoLblToEntryLbl (IdLabel n c InfoTable) = IdLabel n c Entry
+infoLblToEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
+infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
+infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
+infoLblToEntryLbl (CmmLabel m str CmmInfo) = CmmLabel m str CmmEntry
+infoLblToEntryLbl (CmmLabel m str CmmRetInfo) = CmmLabel m str CmmRet
+infoLblToEntryLbl _
+ = panic "CLabel.infoLblToEntryLbl"
+
entryLblToInfoLbl :: CLabel -> CLabel
-entryLblToInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable
-entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
-entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
-entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
-entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
-entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
-entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
-
-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 l@(IdLabel n c Closure) = l
-cvtToClosureLbl l = pprPanic "cvtToClosureLbl" (pprCLabel l)
-
-cvtToSRTLbl (IdLabel n c InfoTable) = mkSRTLabel n c
-cvtToSRTLbl (IdLabel n c Entry) = mkSRTLabel n c
-cvtToSRTLbl (IdLabel n c ConEntry) = mkSRTLabel n c
-cvtToSRTLbl l@(IdLabel n c Closure) = mkSRTLabel n c
-cvtToSRTLbl l = pprPanic "cvtToSRTLbl" (pprCLabel l)
+entryLblToInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable
+entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
+entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
+entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
+entryLblToInfoLbl (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo
+entryLblToInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo
+entryLblToInfoLbl l
+ = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
+
+
+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 l@(IdLabel n c Closure) = l
+cvtToClosureLbl l
+ = pprPanic "cvtToClosureLbl" (pprCLabel l)
+
+
+cvtToSRTLbl (IdLabel n c InfoTable) = mkSRTLabel n c
+cvtToSRTLbl (IdLabel n c Entry) = mkSRTLabel n c
+cvtToSRTLbl (IdLabel n c ConEntry) = mkSRTLabel n c
+cvtToSRTLbl l@(IdLabel n c Closure) = mkSRTLabel n c
+cvtToSRTLbl l
+ = pprPanic "cvtToSRTLbl" (pprCLabel l)
+
-- -----------------------------------------------------------------------------
-- Does a CLabel refer to a CAF?
hasCAF (IdLabel _ MayHaveCafRefs _) = True
hasCAF _ = False
+
-- -----------------------------------------------------------------------------
-- Does a CLabel need declaring before use or not?
--
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
--- Whether the label is an assembler temporary:
-isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
-isAsmTemp (AsmTempLabel _) = True
-isAsmTemp _ = False
+-- | Check whether a label is a local temporary for native code generation
+isAsmTemp :: CLabel -> Bool
+isAsmTemp (AsmTempLabel _) = True
+isAsmTemp _ = False
+
+-- | If a label is a local temporary used for native code generation
+-- then return just its unique, otherwise nothing.
maybeAsmTemp :: CLabel -> Maybe Unique
-maybeAsmTemp (AsmTempLabel uq) = Just uq
-maybeAsmTemp _ = Nothing
+maybeAsmTemp (AsmTempLabel uq) = Just uq
+maybeAsmTemp _ = Nothing
--- some labels have C prototypes in scope when compiling via C, because
--- they are builtin to the C compiler. For these labels we avoid
--- generating our own C prototypes.
+
+-- | 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 (AsmTempLabel _) = False
-externallyVisibleCLabel (ModuleInitLabel _ _) = True
+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 (ForeignLabel _ _ _ _) = True
-externallyVisibleCLabel (IdLabel name _ _) = isExternalName name
-externallyVisibleCLabel (CC_Label _) = True
-externallyVisibleCLabel (CCS_Label _) = True
+externallyVisibleCLabel ModuleRegdLabel = False
+externallyVisibleCLabel (RtsLabel _) = True
+externallyVisibleCLabel (CmmLabel _ _ _) = 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 (LargeSRTLabel _) = False
+externallyVisibleCLabel (HpcTicksLabel _) = True
+externallyVisibleCLabel HpcModuleNameLabel = False
+externallyVisibleCLabel (LargeBitmapLabel _) = False
+externallyVisibleCLabel (LargeSRTLabel _) = False
-- -----------------------------------------------------------------------------
-- Finding the "type" of a CLabel
GcPtrLabel -> True
_other -> False
+
+-- | Work out the general type of data at the address of this label
+-- whether it be code, data, or static GC object.
labelType :: CLabel -> CLabelType
+labelType (CmmLabel _ _ CmmData) = DataLabel
+labelType (CmmLabel _ _ CmmGcPtr) = GcPtrLabel
+labelType (CmmLabel _ _ CmmCode) = CodeLabel
+labelType (CmmLabel _ _ CmmInfo) = DataLabel
+labelType (CmmLabel _ _ CmmEntry) = CodeLabel
+labelType (CmmLabel _ _ CmmRetInfo) = DataLabel
+labelType (CmmLabel _ _ CmmRet) = CodeLabel
labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
-labelType (RtsLabel (RtsData _)) = DataLabel
-labelType (RtsLabel (RtsGcPtr _)) = GcPtrLabel
-labelType (RtsLabel (RtsCode _)) = CodeLabel
-labelType (RtsLabel (RtsInfo _)) = DataLabel
-labelType (RtsLabel (RtsEntry _)) = CodeLabel
-labelType (RtsLabel (RtsRetInfo _)) = DataLabel
-labelType (RtsLabel (RtsRet _)) = CodeLabel
labelType (RtsLabel (RtsApFast _)) = CodeLabel
labelType (CaseLabel _ CaseReturnInfo) = DataLabel
labelType (CaseLabel _ _) = 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?
- 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)
-- with a letter so the label will be legal assmbly code.
-pprCLbl (RtsLabel (RtsCode str)) = ftext str
-pprCLbl (RtsLabel (RtsData str)) = ftext str
-pprCLbl (RtsLabel (RtsGcPtr str)) = ftext str
+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")
else (sLit "_noupd_entry"))
]
-pprCLbl (RtsLabel (RtsInfo fs))
+pprCLbl (CmmLabel _ fs CmmInfo)
= ftext fs <> ptext (sLit "_info")
-pprCLbl (RtsLabel (RtsEntry fs))
+pprCLbl (CmmLabel _ fs CmmEntry)
= ftext fs <> ptext (sLit "_entry")
-pprCLbl (RtsLabel (RtsRetInfo fs))
+pprCLbl (CmmLabel _ fs CmmRetInfo)
= ftext fs <> ptext (sLit "_info")
-pprCLbl (RtsLabel (RtsRet fs))
+pprCLbl (CmmLabel _ fs CmmRet)
= ftext fs <> ptext (sLit "_ret")
pprCLbl (RtsLabel (RtsPrimOp primop))
pprCLbl (ForeignLabel str _ _ _)
= ftext str
-pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
+pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor name flavor
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 HpcModuleNameLabel
= ptext (sLit "_hpc_module_name_str")
-ppIdFlavor :: IdLabelInfo -> SDoc
-ppIdFlavor x = pp_cSEP <>
+ppIdFlavor :: Name -> IdLabelInfo -> SDoc
+ppIdFlavor n x = pp_cSEP <> closureSuffix' n <>
(case x of
Closure -> ptext (sLit "closure")
SRT -> ptext (sLit "srt")
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.
= pprCLabel lbl
pprDynamicLinkerAsmLabel _ _
= panic "pprDynamicLinkerAsmLabel"
+
#elif darwin_TARGET_OS
pprDynamicLinkerAsmLabel CodeStub lbl
= char 'L' <> pprCLabel lbl <> text "$stub"
= char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
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
= text ".LC_" <> pprCLabel 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
= pprCLabel 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
= pprCLabel lbl <> text "@got"
pprDynamicLinkerAsmLabel GotSymbolOffset lbl
= pprCLabel lbl <> text "@gotoff"
+
#elif mingw32_TARGET_OS
pprDynamicLinkerAsmLabel SymbolPtr lbl
= text "__imp_" <> pprCLabel lbl
pprDynamicLinkerAsmLabel _ _
= panic "pprDynamicLinkerAsmLabel"
+
#else
pprDynamicLinkerAsmLabel _ _
= panic "pprDynamicLinkerAsmLabel"