mkAltLabel,
mkDefaultLabel,
mkBitmapLabel,
+ mkStringLitLabel,
mkClosureTblLabel,
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
import Outputable
import FastString
-
-- -----------------------------------------------------------------------------
-- The CLabel type
| AsmTempLabel
{-# UNPACK #-} !Unique
+ | StringLitLabel
+ {-# UNPACK #-} !Unique
+
| ModuleInitLabel
Module -- the module name
String -- its "way"
| CC_Label CostCentre
| CCS_Label CostCentreStack
+ -- 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
data RtsLabelInfo
- = RtsShouldNeverHappenCode
-
- | RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-} -- Selector thunks
+ = RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-} -- Selector thunks
| RtsSelectorEntry Bool{-updatable-} Int{-offset-}
| RtsApInfoTbl Bool{-updatable-} Int{-arity-} -- AP thunks
-- 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
mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
mkDefaultLabel uniq = CaseLabel uniq CaseDefault
+mkStringLitLabel = StringLitLabel
mkAsmTempLabel = AsmTempLabel
mkModuleInitLabel = ModuleInitLabel
-- Some fixed runtime system labels
-mkErrorStdEntryLabel = RtsLabel RtsShouldNeverHappenCode
mkSplitMarkerLabel = RtsLabel (RtsCode SLIT("__stg_split_marker"))
mkUpdInfoLabel = RtsLabel (RtsInfo SLIT("stg_upd_frame"))
mkSeqInfoLabel = RtsLabel (RtsInfo SLIT("stg_seq_frame"))
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.
needsCDecl (IdLabel _ SRTDesc) = False
needsCDecl (IdLabel _ Bitmap) = False
needsCDecl (IdLabel _ _) = True
-needsCDecl (CaseLabel _ CaseReturnPt) = True
-needsCDecl (CaseLabel _ CaseReturnInfo) = True
+needsCDecl (CaseLabel _ _) = True
needsCDecl (ModuleInitLabel _ _) = True
needsCDecl (PlainModuleInitLabel _) = True
needsCDecl ModuleRegdLabel = False
needsCDecl (CaseLabel _ _) = False
+needsCDecl (StringLitLabel _) = False
needsCDecl (AsmTempLabel _) = False
needsCDecl (RtsLabel _) = False
needsCDecl (ForeignLabel _ _ _) = False
externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
externallyVisibleCLabel (CaseLabel _ _) = False
+externallyVisibleCLabel (StringLitLabel _) = False
externallyVisibleCLabel (AsmTempLabel _) = False
externallyVisibleCLabel (ModuleInitLabel _ _)= True
externallyVisibleCLabel (PlainModuleInitLabel _)= True
externallyVisibleCLabel (IdLabel id _) = isExternalName id
externallyVisibleCLabel (CC_Label _) = True
externallyVisibleCLabel (CCS_Label _) = True
-
+externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
-- -----------------------------------------------------------------------------
-- Finding the "type" of a CLabel
labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
labelType (RtsLabel (RtsRetFS _)) = CodeLabel
labelType (CaseLabel _ CaseReturnInfo) = DataLabel
-labelType (CaseLabel _ CaseReturnPt) = CodeLabel
+labelType (CaseLabel _ _) = CodeLabel
labelType (ModuleInitLabel _ _) = CodeLabel
labelType (PlainModuleInitLabel _) = CodeLabel
labelDynamic :: CLabel -> Bool
labelDynamic lbl =
case lbl of
- -- The special case for RtsShouldNeverHappenCode is because the associated address is
- -- NULL, i.e. not a DLL entry point
- RtsLabel RtsShouldNeverHappenCode -> False
RtsLabel _ -> not opt_Static -- i.e., is the RTS in a DLL or not?
IdLabel n k -> isDllName n
+#if mingw32_TARGET_OS
ForeignLabel _ _ d -> d
+#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 _ -> (not opt_Static) && (not (isHomeModule m))
PlainModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m))
+
+ -- 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
+#else
pprAsmCLbl lbl
= pprCLbl lbl
+#endif
+
+pprCLbl (StringLitLabel u)
+ = pprUnique u <> ptext SLIT("_str")
pprCLbl (CaseLabel u CaseReturnPt)
= hcat [pprUnique u, ptext SLIT("_ret")]
pprCLbl (CaseLabel u CaseDefault)
= hcat [pprUnique u, ptext SLIT("_dflt")]
-pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("0")
--- used to be stg_error_entry but Windows can't have DLL entry points as static
--- initialisers, and besides, this ShouldNeverHappen, right?
-
pprCLbl (RtsLabel (RtsCode str)) = ptext str
pprCLbl (RtsLabel (RtsData str)) = ptext str
pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
#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"
projects / ghc-hetmet.git / blobdiff