X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fcmm%2FCLabel.hs;h=f50d406fa4df616e60e9cc03f84c3b09e791fd8d;hb=ca23a0493febcc04f6f2fda5a221ad7350ad8bec;hp=ae470caa8494d4599478e1ed8bc5844a72f7ff39;hpb=423d477bfecd490de1449c59325c8776f91d7aac;p=ghc-hetmet.git diff --git a/ghc/compiler/cmm/CLabel.hs b/ghc/compiler/cmm/CLabel.hs index ae470ca..f50d406 100644 --- a/ghc/compiler/cmm/CLabel.hs +++ b/ghc/compiler/cmm/CLabel.hs @@ -28,6 +28,7 @@ module CLabel ( mkAltLabel, mkDefaultLabel, mkBitmapLabel, + mkStringLitLabel, mkClosureTblLabel, @@ -36,7 +37,6 @@ module CLabel ( mkModuleInitLabel, mkPlainModuleInitLabel, - mkErrorStdEntryLabel, mkSplitMarkerLabel, mkUpdInfoLabel, mkSeqInfoLabel, @@ -74,9 +74,15 @@ module CLabel ( mkCCLabel, mkCCSLabel, + DynamicLinkerLabelInfo(..), + mkDynamicLinkerLabel, + dynamicLinkerLabelInfo, + + mkPicBaseLabel, + infoLblToEntryLbl, entryLblToInfoLbl, needsCDecl, isAsmTemp, externallyVisibleCLabel, - CLabelType(..), labelType, labelDynamic, labelCouldBeDynamic, + CLabelType(..), labelType, labelDynamic, pprCLabel ) where @@ -97,7 +103,6 @@ import CostCentre ( CostCentre, CostCentreStack ) import Outputable import FastString - -- ----------------------------------------------------------------------------- -- The CLabel type @@ -136,6 +141,9 @@ data CLabel | AsmTempLabel {-# UNPACK #-} !Unique + | StringLitLabel + {-# UNPACK #-} !Unique + | ModuleInitLabel Module -- the module name String -- its "way" @@ -160,9 +168,21 @@ data CLabel | 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 @@ -195,9 +215,7 @@ data CaseLabelInfo 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 @@ -225,6 +243,14 @@ data RtsLabelInfo -- 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 @@ -249,6 +275,7 @@ mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag) mkDefaultLabel uniq = CaseLabel uniq CaseDefault +mkStringLitLabel = StringLitLabel mkAsmTempLabel = AsmTempLabel mkModuleInitLabel = ModuleInitLabel @@ -256,7 +283,6 @@ mkPlainModuleInitLabel = PlainModuleInitLabel -- 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")) @@ -308,6 +334,20 @@ mkRtsDataLabelFS str = RtsLabel (RtsDataFS str) 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. @@ -344,13 +384,13 @@ needsCDecl (IdLabel _ SRT) = False 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 @@ -372,6 +412,7 @@ isAsmTemp _ = False externallyVisibleCLabel :: CLabel -> Bool -- not C "static" externallyVisibleCLabel (CaseLabel _ _) = False +externallyVisibleCLabel (StringLitLabel _) = False externallyVisibleCLabel (AsmTempLabel _) = False externallyVisibleCLabel (ModuleInitLabel _ _)= True externallyVisibleCLabel (PlainModuleInitLabel _)= True @@ -381,7 +422,7 @@ externallyVisibleCLabel (ForeignLabel _ _ _) = True externallyVisibleCLabel (IdLabel id _) = isExternalName id externallyVisibleCLabel (CC_Label _) = True externallyVisibleCLabel (CCS_Label _) = True - +externallyVisibleCLabel (DynamicLinkerLabel _ _) = False -- ----------------------------------------------------------------------------- -- Finding the "type" of a CLabel @@ -408,7 +449,7 @@ labelType (RtsLabel (RtsEntryFS _)) = CodeLabel 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 @@ -436,28 +477,21 @@ labelType _ = DataLabel 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 @@ -514,6 +548,12 @@ pprCLabel (AsmTempLabel u) ptext asmTempLabelPrefix <> pprUnique u else char '_' <> pprUnique u + +pprCLabel (DynamicLinkerLabel info lbl) + = pprDynamicLinkerAsmLabel info lbl + +pprCLabel PicBaseLabel + = ptext SLIT("1b") #endif pprCLabel lbl = @@ -529,13 +569,18 @@ maybe_underscore doc | 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 (StringLitLabel u) + = pprUnique u <> ptext SLIT("_str") + pprCLbl (CaseLabel u CaseReturnPt) = hcat [pprUnique u, ptext SLIT("_ret")] pprCLbl (CaseLabel u CaseReturnInfo) @@ -545,10 +590,6 @@ pprCLbl (CaseLabel u (CaseAlt tag)) 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 @@ -669,3 +710,29 @@ asmTempLabelPrefix = #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"