mkStaticInfoTableLabel,
mkApEntryLabel,
mkApInfoTableLabel,
+ mkClosureTableLabel,
+
+ mkLocalClosureLabel,
+ mkLocalInfoTableLabel,
+ mkLocalEntryLabel,
+ mkLocalConEntryLabel,
+ mkLocalStaticConEntryLabel,
+ mkLocalConInfoTableLabel,
+ mkLocalStaticInfoTableLabel,
+ mkLocalClosureTableLabel,
mkReturnPtLabel,
mkReturnInfoLabel,
mkBitmapLabel,
mkStringLitLabel,
- mkClosureTblLabel,
-
mkAsmTempLabel,
mkModuleInitLabel,
mkPlainModuleInitLabel,
- mkErrorStdEntryLabel,
mkSplitMarkerLabel,
mkUpdInfoLabel,
mkSeqInfoLabel,
mkCCLabel, mkCCSLabel,
+ DynamicLinkerLabelInfo(..),
+ mkDynamicLinkerLabel,
+ dynamicLinkerLabelInfo,
+
+ mkPicBaseLabel,
+
infoLblToEntryLbl, entryLblToInfoLbl,
needsCDecl, isAsmTemp, externallyVisibleCLabel,
- CLabelType(..), labelType, labelDynamic, labelCouldBeDynamic,
+ CLabelType(..), labelType, labelDynamic,
pprCLabel
) where
#include "HsVersions.h"
#include "../includes/ghcconfig.h"
-import CmdLineOpts ( opt_Static, opt_DoTickyProfiling )
+import CmdLineOpts ( DynFlags, 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 )
import Outputable
import FastString
-
-- -----------------------------------------------------------------------------
-- The CLabel type
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
| CC_Label CostCentre
| CCS_Label CostCentreStack
- deriving (Eq, Ord)
+ -- Dynamic Linking in the NCG:
+ -- generated and used inside the NCG only,
+ -- see module PositionIndependentCode for details.
+
+ | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
+ -- special variants of a label used for dynamic linking
+
+ | PicBaseLabel -- a label used as a base for PIC calculations
+ -- on some platforms.
+ -- It takes the form of a local numeric
+ -- assembler label '1'; it is pretty-printed
+ -- as 1b, referring to the previous definition
+ -- of 1: in the assembler source file.
+ 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
-- NOTE: Eq on LitString compares the pointer only, so this isn't
-- a real equality.
+data DynamicLinkerLabelInfo
+ = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
+ | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
+ | GotSymbolPtr -- ELF: foo@got
+ | GotSymbolOffset -- ELF: foo@gotoff
+
+ 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 dflags name
+ | isDllName dflags name = DynIdLabel name Closure
+ | otherwise = IdLabel name Closure
+
+mkInfoTableLabel dflags name
+ | isDllName dflags name = DynIdLabel name InfoTable
+ | otherwise = IdLabel name InfoTable
+
+mkEntryLabel dflags name
+ | isDllName dflags name = DynIdLabel name Entry
+ | otherwise = IdLabel name Entry
+
+mkClosureTableLabel dflags name
+ | isDllName dflags 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 dflags name
+ | isDllName dflags 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 dflags name
+ | isDllName dflags 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 :: DynFlags -> Module -> String -> CLabel
+mkModuleInitLabel dflags mod way
+ = ModuleInitLabel mod way $! (not (isHomeModule dflags mod))
+
+mkPlainModuleInitLabel :: DynFlags -> Module -> CLabel
+mkPlainModuleInitLabel dflags mod
+ = PlainModuleInitLabel mod $! (not (isHomeModule dflags mod))
-- Some fixed runtime system labels
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
mkRtsSlowTickyCtrLabel :: String -> CLabel
mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
+ -- Dynamic linking
+
+mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
+mkDynamicLinkerLabel = DynamicLinkerLabel
+
+dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
+dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
+dynamicLinkerLabelInfo _ = Nothing
+
+ -- Position independent code
+
+mkPicBaseLabel :: CLabel
+mkPicBaseLabel = PicBaseLabel
+
-- -----------------------------------------------------------------------------
-- 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 (CaseLabel _ CaseReturnPt) = True
-needsCDecl (CaseLabel _ CaseReturnInfo) = True
-needsCDecl (ModuleInitLabel _ _) = True
-needsCDecl (PlainModuleInitLabel _) = True
+needsCDecl (DynIdLabel _ _) = True
+needsCDecl (CaseLabel _ _) = True
+needsCDecl (ModuleInitLabel _ _ _) = True
+needsCDecl (PlainModuleInitLabel _ _) = True
needsCDecl ModuleRegdLabel = False
needsCDecl (CaseLabel _ _) = 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
-- -----------------------------------------------------------------------------
-- Finding the "type" of a CLabel
| 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 (RtsRetInfoFS _)) = DataLabel
labelType (RtsLabel (RtsRetFS _)) = CodeLabel
labelType (CaseLabel _ CaseReturnInfo) = DataLabel
-labelType (CaseLabel _ CaseReturnPt) = CodeLabel
-labelType (ModuleInitLabel _ _) = CodeLabel
-labelType (PlainModuleInitLabel _) = CodeLabel
+labelType (CaseLabel _ _) = CodeLabel
+labelType (ModuleInitLabel _ _ _) = CodeLabel
+labelType (PlainModuleInitLabel _ _) = CodeLabel
-labelType (IdLabel _ info) =
+labelType (IdLabel _ info) = idInfoLabelType info
+labelType (DynIdLabel _ info) = idInfoLabelType info
+labelType _ = DataLabel
+
+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
- ModuleInitLabel m _ -> (not opt_Static) && (not (isHomeModule m))
- PlainModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m))
+#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
+#endif
+ ModuleInitLabel m _ dyn -> not opt_Static && dyn
+ PlainModuleInitLabel m dyn -> not opt_Static && dyn
+
+ -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
_ -> False
--- Basically the same as above, but this time for Darwin only.
--- The things that GHC does when labelDynamic returns true are not quite right
--- for Darwin. Also, every ForeignLabel might possibly be from a dynamic library,
--- and a 'false positive' doesn't really hurt on Darwin, so this just returns
--- True for every ForeignLabel.
---
--- ToDo: Clean up DLL-related code so we can do away with the distinction
--- between this and labelDynamic above.
-
-labelCouldBeDynamic (ForeignLabel _ _ _) = True
-labelCouldBeDynamic lbl = labelDynamic lbl
-
{-
OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
right places. It is used to detect when the abstractC statement of an
ptext asmTempLabelPrefix <> pprUnique u
else
char '_' <> pprUnique u
+
+pprCLabel (DynamicLinkerLabel info lbl)
+ = pprDynamicLinkerAsmLabel info lbl
+
+pprCLabel PicBaseLabel
+ = ptext SLIT("1b")
#endif
pprCLabel lbl =
| underscorePrefix = pp_cSEP <> doc
| otherwise = doc
+#ifdef mingw32_TARGET_OS
-- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
-- (The C compiler does this itself).
pprAsmCLbl (ForeignLabel fs (Just sz) _)
= ftext fs <> char '@' <> int sz
+#endif
pprAsmCLbl lbl
= pprCLbl lbl
pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
-pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
+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_") <> ftext (moduleFS mod)
<> char '_' <> text way
-pprCLbl (PlainModuleInitLabel mod)
- = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
+pprCLbl (PlainModuleInitLabel mod _)
+ = ptext SLIT("__stginit_") <> ftext (moduleFS 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")
)
#else
SLIT(".L")
#endif
+
+pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
+
+#if darwin_TARGET_OS
+pprDynamicLinkerAsmLabel SymbolPtr lbl
+ = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
+pprDynamicLinkerAsmLabel CodeStub lbl
+ = char 'L' <> pprCLabel lbl <> text "$stub"
+#elif powerpc_TARGET_ARCH && linux_TARGET_OS
+pprDynamicLinkerAsmLabel CodeStub lbl
+ = pprCLabel lbl <> text "@plt"
+pprDynamicLinkerAsmLabel SymbolPtr lbl
+ = text ".LC_" <> pprCLabel lbl
+#elif linux_TARGET_OS
+pprDynamicLinkerAsmLabel CodeStub lbl
+ = pprCLabel lbl <> text "@plt"
+pprDynamicLinkerAsmLabel GotSymbolPtr lbl
+ = pprCLabel lbl <> text "@got"
+pprDynamicLinkerAsmLabel GotSymbolOffset lbl
+ = pprCLabel lbl <> text "@gotoff"
+#elif mingw32_TARGET_OS
+pprDynamicLinkerAsmLabel SymbolPtr lbl
+ = text "__imp_" <> pprCLabel lbl
+#endif
+pprDynamicLinkerAsmLabel _ _
+ = panic "pprDynamicLinkerAsmLabel"