mkStaticInfoTableLabel,
mkApEntryLabel,
mkApInfoTableLabel,
+ mkClosureTableLabel,
+
+ mkLocalClosureLabel,
+ mkLocalInfoTableLabel,
+ mkLocalEntryLabel,
+ mkLocalConEntryLabel,
+ mkLocalStaticConEntryLabel,
+ mkLocalConInfoTableLabel,
+ mkLocalStaticInfoTableLabel,
+ mkLocalClosureTableLabel,
mkReturnPtLabel,
mkReturnInfoLabel,
mkBitmapLabel,
mkStringLitLabel,
- mkClosureTblLabel,
-
mkAsmTempLabel,
mkModuleInitLabel,
mkPlainModuleInitLabel,
mkSplitMarkerLabel,
+ mkDirty_MUT_VAR_Label,
mkUpdInfoLabel,
mkSeqInfoLabel,
mkIndStaticInfoLabel,
mkMainCapabilityLabel,
mkMAP_FROZEN_infoLabel,
+ mkMAP_DIRTY_infoLabel,
mkEMPTY_MVAR_infoLabel,
mkTopTickyCtrLabel,
mkRtsCodeLabelFS,
mkRtsDataLabelFS,
+ mkRtsApFastLabel,
+
mkForeignLabel,
mkCCLabel, mkCCSLabel,
dynamicLinkerLabelInfo,
mkPicBaseLabel,
+ mkDeadStripPreventer,
infoLblToEntryLbl, entryLblToInfoLbl,
needsCDecl, isAsmTemp, externallyVisibleCLabel,
#include "HsVersions.h"
-#include "../includes/ghcconfig.h"
-import CmdLineOpts ( opt_Static, opt_DoTickyProfiling )
+import Packages ( HomeModules )
+import StaticFlags ( opt_Static, opt_DoTickyProfiling )
+import Packages ( isHomeModule, isDllName )
import DataCon ( ConTag )
-import Module ( moduleName, moduleNameFS,
- Module, isHomeModule )
-import Name ( Name, isDllName, isExternalName )
+import Module ( moduleFS, Module )
+import Name ( Name, isExternalName )
import Unique ( pprUnique, Unique )
import PrimOp ( PrimOp )
import Config ( cLeadingUnderscore )
Name -- definition of a particular Id or Con
IdLabelInfo
+ | DynIdLabel -- like IdLabel, but in a separate package,
+ Name -- and might therefore need a dynamic
+ IdLabelInfo -- reference.
+
| CaseLabel -- A family of labels related to a particular
-- case expression.
{-# UNPACK #-} !Unique -- Unique says which case expression
| ModuleInitLabel
Module -- the module name
String -- its "way"
+ Bool -- True <=> is in a different package
-- 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 Module -- without the vesrion & way info
+ | PlainModuleInitLabel -- without the vesrion & way info
+ Module
+ Bool -- True <=> is in a different package
| ModuleRegdLabel
-- assembler label '1'; it is pretty-printed
-- as 1b, referring to the previous definition
-- of 1: in the assembler source file.
+
+ | DeadStripPreventer CLabel
+ -- label before an info table to prevent excessive dead-stripping on darwin
+
deriving (Eq, Ord)
data IdLabelInfo
= Closure -- Label for closure
| SRT -- Static reference table
| SRTDesc -- Static reference table descriptor
- | InfoTbl -- Info tables for closures; always read-only
+ | InfoTable -- Info tables for closures; always read-only
| Entry -- entry point
| Slow -- slow entry point
| Bitmap -- A bitmap (function or case return)
| ConEntry -- constructor entry point
- | ConInfoTbl -- corresponding info table
+ | ConInfoTable -- corresponding info table
| StaticConEntry -- static constructor entry point
- | StaticInfoTbl -- corresponding info table
+ | StaticInfoTable -- corresponding info table
| ClosureTable -- table of closures for Enum tycons
data RtsLabelInfo
- = RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-} -- Selector thunks
+ = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- Selector thunks
| RtsSelectorEntry Bool{-updatable-} Int{-offset-}
- | RtsApInfoTbl Bool{-updatable-} Int{-arity-} -- AP thunks
+ | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- AP thunks
| RtsApEntry Bool{-updatable-} Int{-arity-}
| RtsPrimOp PrimOp
| RtsDataFS FastString -- misc rts data bits, eg CHARLIKE_closure
| RtsCodeFS FastString -- misc rts code
+ | RtsApFast LitString -- _fast versions of generic apply
+
| RtsSlowTickyCtr String
deriving (Eq, Ord)
-- -----------------------------------------------------------------------------
-- Constructing CLabels
-mkClosureLabel id = IdLabel id Closure
-mkSRTLabel id = IdLabel id SRT
-mkSRTDescLabel id = IdLabel id SRTDesc
-mkInfoTableLabel id = IdLabel id InfoTbl
-mkEntryLabel id = IdLabel id Entry
-mkSlowEntryLabel id = IdLabel id Slow
-mkBitmapLabel id = IdLabel id Bitmap
-mkRednCountsLabel id = IdLabel id RednCounts
+-- These are always local:
+mkSRTLabel name = IdLabel name SRT
+mkSRTDescLabel name = IdLabel name SRTDesc
+mkSlowEntryLabel name = IdLabel name Slow
+mkBitmapLabel name = IdLabel name Bitmap
+mkRednCountsLabel name = IdLabel name RednCounts
+
+-- These have local & (possibly) external variants:
+mkLocalClosureLabel name = IdLabel name Closure
+mkLocalInfoTableLabel name = IdLabel name InfoTable
+mkLocalEntryLabel name = IdLabel name Entry
+mkLocalClosureTableLabel name = IdLabel name ClosureTable
+
+mkClosureLabel hmods name
+ | isDllName hmods name = DynIdLabel name Closure
+ | otherwise = IdLabel name Closure
+
+mkInfoTableLabel hmods name
+ | isDllName hmods name = DynIdLabel name InfoTable
+ | otherwise = IdLabel name InfoTable
+
+mkEntryLabel hmods name
+ | isDllName hmods name = DynIdLabel name Entry
+ | otherwise = IdLabel name Entry
+
+mkClosureTableLabel hmods name
+ | isDllName hmods name = DynIdLabel name ClosureTable
+ | otherwise = IdLabel name ClosureTable
+
+mkLocalConInfoTableLabel con = IdLabel con ConInfoTable
+mkLocalConEntryLabel con = IdLabel con ConEntry
+mkLocalStaticInfoTableLabel con = IdLabel con StaticInfoTable
+mkLocalStaticConEntryLabel con = IdLabel con StaticConEntry
+
+mkConInfoTableLabel name False = IdLabel name ConInfoTable
+mkConInfoTableLabel name True = DynIdLabel name ConInfoTable
+
+mkStaticInfoTableLabel name False = IdLabel name StaticInfoTable
+mkStaticInfoTableLabel name True = DynIdLabel name StaticInfoTable
+
+mkConEntryLabel hmods name
+ | isDllName hmods name = DynIdLabel name ConEntry
+ | otherwise = IdLabel name ConEntry
-mkConInfoTableLabel con = IdLabel con ConInfoTbl
-mkConEntryLabel con = IdLabel con ConEntry
-mkStaticInfoTableLabel con = IdLabel con StaticInfoTbl
-mkStaticConEntryLabel con = IdLabel con StaticConEntry
+mkStaticConEntryLabel hmods name
+ | isDllName hmods name = DynIdLabel name StaticConEntry
+ | otherwise = IdLabel name StaticConEntry
-mkClosureTblLabel id = IdLabel id ClosureTable
mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
mkStringLitLabel = StringLitLabel
mkAsmTempLabel = AsmTempLabel
-mkModuleInitLabel = ModuleInitLabel
-mkPlainModuleInitLabel = PlainModuleInitLabel
+mkModuleInitLabel :: HomeModules -> Module -> String -> CLabel
+mkModuleInitLabel hmods mod way
+ = ModuleInitLabel mod way $! (not (isHomeModule hmods mod))
+
+mkPlainModuleInitLabel :: HomeModules -> Module -> CLabel
+mkPlainModuleInitLabel hmods mod
+ = PlainModuleInitLabel mod $! (not (isHomeModule hmods mod))
-- Some fixed runtime system labels
mkSplitMarkerLabel = RtsLabel (RtsCode SLIT("__stg_split_marker"))
+mkDirty_MUT_VAR_Label = RtsLabel (RtsCode SLIT("dirty_MUT_VAR"))
mkUpdInfoLabel = RtsLabel (RtsInfo SLIT("stg_upd_frame"))
mkSeqInfoLabel = RtsLabel (RtsInfo SLIT("stg_seq_frame"))
mkIndStaticInfoLabel = RtsLabel (RtsInfo SLIT("stg_IND_STATIC"))
mkMainCapabilityLabel = RtsLabel (RtsData SLIT("MainCapability"))
-mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN"))
+mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN0"))
+mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_DIRTY"))
mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo SLIT("stg_EMPTY_MVAR"))
mkTopTickyCtrLabel = RtsLabel (RtsData SLIT("top_ct"))
moduleRegdLabel = ModuleRegdLabel
-mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTbl upd off)
+mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
-mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTbl upd off)
+mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
-- Foreign labels
mkRtsCodeLabelFS str = RtsLabel (RtsCodeFS str)
mkRtsDataLabelFS str = RtsLabel (RtsDataFS str)
+mkRtsApFastLabel str = RtsLabel (RtsApFast str)
+
mkRtsSlowTickyCtrLabel :: String -> CLabel
mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
mkPicBaseLabel :: CLabel
mkPicBaseLabel = PicBaseLabel
+mkDeadStripPreventer :: CLabel -> CLabel
+mkDeadStripPreventer lbl = DeadStripPreventer lbl
+
-- -----------------------------------------------------------------------------
-- Converting info labels to entry labels.
infoLblToEntryLbl :: CLabel -> CLabel
-infoLblToEntryLbl (IdLabel n InfoTbl) = IdLabel n Entry
-infoLblToEntryLbl (IdLabel n ConInfoTbl) = IdLabel n ConEntry
-infoLblToEntryLbl (IdLabel n StaticInfoTbl) = IdLabel n StaticConEntry
+infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
+infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
+infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
+infoLblToEntryLbl (DynIdLabel n InfoTable) = DynIdLabel n Entry
+infoLblToEntryLbl (DynIdLabel n ConInfoTable) = DynIdLabel n ConEntry
+infoLblToEntryLbl (DynIdLabel n StaticInfoTable) = DynIdLabel n 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"
entryLblToInfoLbl :: CLabel -> CLabel
-entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTbl
-entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTbl
-entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTbl
+entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
+entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
+entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
+entryLblToInfoLbl (DynIdLabel n Entry) = DynIdLabel n InfoTable
+entryLblToInfoLbl (DynIdLabel n ConEntry) = DynIdLabel n ConInfoTable
+entryLblToInfoLbl (DynIdLabel n StaticConEntry) = DynIdLabel n StaticInfoTable
entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
needsCDecl (IdLabel _ SRTDesc) = False
needsCDecl (IdLabel _ Bitmap) = False
needsCDecl (IdLabel _ _) = True
+needsCDecl (DynIdLabel _ _) = True
needsCDecl (CaseLabel _ _) = True
-needsCDecl (ModuleInitLabel _ _) = True
-needsCDecl (PlainModuleInitLabel _) = True
+needsCDecl (ModuleInitLabel _ _ _) = True
+needsCDecl (PlainModuleInitLabel _ _) = True
needsCDecl ModuleRegdLabel = False
-needsCDecl (CaseLabel _ _) = False
needsCDecl (StringLitLabel _) = False
needsCDecl (AsmTempLabel _) = False
needsCDecl (RtsLabel _) = False
externallyVisibleCLabel (CaseLabel _ _) = False
externallyVisibleCLabel (StringLitLabel _) = False
externallyVisibleCLabel (AsmTempLabel _) = False
-externallyVisibleCLabel (ModuleInitLabel _ _)= True
-externallyVisibleCLabel (PlainModuleInitLabel _)= True
+externallyVisibleCLabel (ModuleInitLabel _ _ _)= True
+externallyVisibleCLabel (PlainModuleInitLabel _ _)= True
externallyVisibleCLabel ModuleRegdLabel = False
externallyVisibleCLabel (RtsLabel _) = True
externallyVisibleCLabel (ForeignLabel _ _ _) = True
-externallyVisibleCLabel (IdLabel id _) = isExternalName id
+externallyVisibleCLabel (IdLabel name _) = isExternalName name
+externallyVisibleCLabel (DynIdLabel name _) = isExternalName name
externallyVisibleCLabel (CC_Label _) = True
externallyVisibleCLabel (CCS_Label _) = True
externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
| DataLabel
labelType :: CLabel -> CLabelType
-labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = DataLabel
-labelType (RtsLabel (RtsApInfoTbl _ _)) = DataLabel
+labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
+labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsData _)) = DataLabel
labelType (RtsLabel (RtsCode _)) = CodeLabel
labelType (RtsLabel (RtsInfo _)) = DataLabel
labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
labelType (RtsLabel (RtsRetFS _)) = CodeLabel
+labelType (RtsLabel (RtsApFast _)) = CodeLabel
labelType (CaseLabel _ CaseReturnInfo) = DataLabel
labelType (CaseLabel _ _) = CodeLabel
-labelType (ModuleInitLabel _ _) = CodeLabel
-labelType (PlainModuleInitLabel _) = CodeLabel
+labelType (ModuleInitLabel _ _ _) = CodeLabel
+labelType (PlainModuleInitLabel _ _) = CodeLabel
+
+labelType (IdLabel _ info) = idInfoLabelType info
+labelType (DynIdLabel _ info) = idInfoLabelType info
+labelType _ = DataLabel
-labelType (IdLabel _ info) =
+idInfoLabelType info =
case info of
- InfoTbl -> DataLabel
+ InfoTable -> DataLabel
Closure -> DataLabel
Bitmap -> DataLabel
- ConInfoTbl -> DataLabel
- StaticInfoTbl -> DataLabel
+ ConInfoTable -> DataLabel
+ StaticInfoTable -> DataLabel
ClosureTable -> DataLabel
_ -> CodeLabel
-labelType _ = DataLabel
-
-- -----------------------------------------------------------------------------
-- Does a CLabel need dynamic linkage?
labelDynamic lbl =
case lbl of
RtsLabel _ -> not opt_Static -- i.e., is the RTS in a DLL or not?
- IdLabel n k -> isDllName n
+ IdLabel n k -> False
+ DynIdLabel n k -> True
#if mingw32_TARGET_OS
ForeignLabel _ _ d -> d
#else
-- so we claim that all foreign imports come from dynamic libraries
ForeignLabel _ _ _ -> True
#endif
- ModuleInitLabel m _ -> (not opt_Static) && (not (isHomeModule m))
- PlainModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m))
+ ModuleInitLabel m _ dyn -> not opt_Static && dyn
+ PlainModuleInitLabel m dyn -> not opt_Static && dyn
-- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
_ -> False
entry.
-}
+instance Outputable CLabel where
+ ppr = pprCLabel
+
pprCLabel :: CLabel -> SDoc
#if ! OMIT_NATIVE_CODEGEN
pprCLabel PicBaseLabel
= ptext SLIT("1b")
+
+pprCLabel (DeadStripPreventer lbl)
+ = pprCLabel lbl <> ptext SLIT("_dsp")
#endif
pprCLabel lbl =
-- (The C compiler does this itself).
pprAsmCLbl (ForeignLabel fs (Just sz) _)
= ftext fs <> char '@' <> int sz
-#else
+#endif
pprAsmCLbl lbl
= pprCLbl lbl
-#endif
pprCLbl (StringLitLabel u)
= pprUnique u <> ptext SLIT("_str")
pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
-pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
+pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext SLIT("_fast")
+
+pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
= hcat [ptext SLIT("stg_sel_"), text (show offset),
ptext (if upd_reqd
then SLIT("_upd_info")
else SLIT("_noupd_entry"))
]
-pprCLbl (RtsLabel (RtsApInfoTbl upd_reqd arity))
+pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
= hcat [ptext SLIT("stg_ap_"), text (show arity),
ptext (if upd_reqd
then SLIT("_upd_info")
pprCLbl (ForeignLabel str _ _)
= ftext str
-pprCLbl (IdLabel id flavor) = ppr id <> ppIdFlavor flavor
+pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor
+pprCLbl (DynIdLabel name flavor) = ppr name <> ppIdFlavor flavor
pprCLbl (CC_Label cc) = ppr cc
pprCLbl (CCS_Label ccs) = ppr ccs
-pprCLbl (ModuleInitLabel mod way)
- = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
+pprCLbl (ModuleInitLabel mod way _)
+ = ptext SLIT("__stginit_") <> ppr mod
<> char '_' <> text way
-pprCLbl (PlainModuleInitLabel mod)
- = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
+pprCLbl (PlainModuleInitLabel mod _)
+ = ptext SLIT("__stginit_") <> ppr mod
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <>
Closure -> ptext SLIT("closure")
SRT -> ptext SLIT("srt")
SRTDesc -> ptext SLIT("srtd")
- InfoTbl -> ptext SLIT("info")
+ InfoTable -> ptext SLIT("info")
Entry -> ptext SLIT("entry")
Slow -> ptext SLIT("slow")
RednCounts -> ptext SLIT("ct")
Bitmap -> ptext SLIT("btm")
ConEntry -> ptext SLIT("con_entry")
- ConInfoTbl -> ptext SLIT("con_info")
+ ConInfoTable -> ptext SLIT("con_info")
StaticConEntry -> ptext SLIT("static_entry")
- StaticInfoTbl -> ptext SLIT("static_info")
+ StaticInfoTable -> ptext SLIT("static_info")
ClosureTable -> ptext SLIT("closure_tbl")
)
= pprCLabel lbl <> text "@got"
pprDynamicLinkerAsmLabel GotSymbolOffset lbl
= pprCLabel lbl <> text "@gotoff"
+pprDynamicLinkerAsmLabel SymbolPtr lbl
+ = text ".LC_" <> pprCLabel lbl
#elif mingw32_TARGET_OS
pprDynamicLinkerAsmLabel SymbolPtr lbl
= text "__imp_" <> pprCLabel lbl
projects / ghc-hetmet.git / blobdiff