X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCLabel.hs;h=9ba55ac7b2baabf834009ee5a04da0a7e64fb307;hp=cb07d067dd132b3549ece3125e1b0c31d8365834;hb=cbbee4e8727c583daf32d9bf17f00afaa839ef10;hpb=78bbce57e04a29541b7343f0b188a20cef956187 diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index cb07d06..9ba55ac 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -51,6 +51,7 @@ module CLabel ( mkModuleInitLabel, mkPlainModuleInitLabel, + mkModuleInitTableLabel, mkSplitMarkerLabel, mkDirty_MUT_VAR_Label, @@ -63,11 +64,11 @@ module CLabel ( mkTopTickyCtrLabel, mkCAFBlackHoleInfoTableLabel, - mkSECAFBlackHoleInfoTableLabel, mkRtsPrimOpLabel, mkRtsSlowTickyCtrLabel, moduleRegdLabel, + moduleRegTableLabel, mkSelectorInfoLabel, mkSelectorEntryLabel, @@ -78,6 +79,7 @@ module CLabel ( mkRtsRetLabel, mkRtsCodeLabel, mkRtsDataLabel, + mkRtsGcPtrLabel, mkRtsInfoLabelFS, mkRtsEntryLabelFS, @@ -88,8 +90,11 @@ module CLabel ( mkRtsApFastLabel, + mkPrimCallLabel, + mkForeignLabel, addLabelSize, + foreignLabelStdcallInfo, mkCCLabel, mkCCSLabel, @@ -103,17 +108,21 @@ module CLabel ( mkHpcTicksLabel, mkHpcModuleNameLabel, - infoLblToEntryLbl, entryLblToInfoLbl, + hasCAF, + infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl, needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel, isMathFun, - CLabelType(..), labelType, labelDynamic, + isCFunctionLabel, isGcPtrLabel, labelDynamic, pprCLabel ) where #include "HsVersions.h" +import IdInfo import StaticFlags +import BasicTypes +import Literal import Packages import DataCon import PackageConfig @@ -126,6 +135,7 @@ import CostCentre import Outputable import FastString import DynFlags +import UniqSet -- ----------------------------------------------------------------------------- -- The CLabel type @@ -155,6 +165,7 @@ CLabel is an abstract type that supports the following operations: data CLabel = IdLabel -- A family of labels related to the Name -- definition of a particular Id or Con + CafInfo IdLabelInfo | CaseLabel -- A family of labels related to a particular @@ -177,18 +188,22 @@ data CLabel -- because we don't always recompile modules which depend on a module -- whose version has changed. - | PlainModuleInitLabel -- without the vesrion & way info + | PlainModuleInitLabel -- without the version & way info + Module + + | ModuleInitTableLabel -- table of imported modules to init Module | ModuleRegdLabel | RtsLabel RtsLabelInfo - | ForeignLabel FastString -- a 'C' (or otherwise foreign) 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 + | ForeignLabel FastString -- a 'C' (or otherwise foreign) 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 + FunctionOrData | CC_Label CostCentre | CCS_Label CostCentreStack @@ -262,7 +277,8 @@ data RtsLabelInfo | RtsEntry LitString -- misc rts entry points | RtsRetInfo LitString -- misc rts ret info tables | RtsRet LitString -- misc rts return points - | RtsData LitString -- misc rts data bits, eg CHARLIKE_closure + | RtsData LitString -- misc rts data bits + | RtsGcPtr LitString -- GcPtrs eg CHARLIKE_closure | RtsCode LitString -- misc rts code | RtsInfoFS FastString -- misc rts info tables @@ -292,29 +308,29 @@ data DynamicLinkerLabelInfo -- Constructing CLabels -- These are always local: -mkSRTLabel name = IdLabel name SRT -mkSlowEntryLabel name = IdLabel name Slow -mkRednCountsLabel name = IdLabel name RednCounts +mkSRTLabel name c = IdLabel name c SRT +mkSlowEntryLabel name c = IdLabel name c Slow +mkRednCountsLabel name c = IdLabel name c 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 name = IdLabel name Closure -mkInfoTableLabel name = IdLabel name InfoTable -mkEntryLabel name = IdLabel name Entry -mkClosureTableLabel name = 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 = IdLabel name ConInfoTable -mkStaticInfoTableLabel name = IdLabel name StaticInfoTable - -mkConEntryLabel name = IdLabel name ConEntry -mkStaticConEntryLabel name = IdLabel name StaticConEntry +mkLocalClosureLabel name c = IdLabel name c Closure +mkLocalInfoTableLabel name c = IdLabel name c InfoTable +mkLocalEntryLabel name c = IdLabel name c Entry +mkLocalClosureTableLabel name c = IdLabel name c ClosureTable + +mkClosureLabel name c = IdLabel name c Closure +mkInfoTableLabel name c = IdLabel name c InfoTable +mkEntryLabel name c = IdLabel name c Entry +mkClosureTableLabel name c = IdLabel name c ClosureTable +mkLocalConInfoTableLabel c con = IdLabel con c ConInfoTable +mkLocalConEntryLabel c con = IdLabel con c ConEntry +mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable +mkLocalStaticConEntryLabel c con = IdLabel con c StaticConEntry +mkConInfoTableLabel name c = IdLabel name c ConInfoTable +mkStaticInfoTableLabel name c = IdLabel name c StaticInfoTable + +mkConEntryLabel name c = IdLabel name c ConEntry +mkStaticConEntryLabel name c = IdLabel name c StaticConEntry mkLargeSRTLabel uniq = LargeSRTLabel uniq mkBitmapLabel uniq = LargeBitmapLabel uniq @@ -334,6 +350,9 @@ 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 (sLit "__stg_split_marker")) @@ -347,13 +366,10 @@ mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo (sLit "stg_EMPTY_MVAR")) mkTopTickyCtrLabel = RtsLabel (RtsData (sLit "top_ct")) mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE")) -mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then - RtsLabel (RtsInfo (sLit "stg_SE_CAF_BLACKHOLE")) - else -- RTS won't have info table unless -ticky is on - panic "mkSECAFBlackHoleInfoTableLabel requires -ticky" mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop) moduleRegdLabel = ModuleRegdLabel +moduleRegTableLabel = ModuleInitTableLabel mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off) mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off) @@ -361,17 +377,27 @@ mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off) mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off) mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off) + -- Primitive / cmm call labels + +mkPrimCallLabel :: PrimCall -> CLabel +mkPrimCallLabel (PrimCall str) = ForeignLabel str Nothing False IsFunction + -- Foreign labels -mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel -mkForeignLabel str mb_sz is_dynamic = ForeignLabel str mb_sz is_dynamic +mkForeignLabel :: FastString -> Maybe Int -> Bool -> FunctionOrData -> CLabel +mkForeignLabel str mb_sz is_dynamic fod + = ForeignLabel str mb_sz is_dynamic fod addLabelSize :: CLabel -> Int -> CLabel -addLabelSize (ForeignLabel str _ is_dynamic) sz - = ForeignLabel str (Just sz) is_dynamic +addLabelSize (ForeignLabel str _ is_dynamic fod) sz + = ForeignLabel str (Just sz) is_dynamic fod addLabelSize label _ = label +foreignLabelStdcallInfo :: CLabel -> Maybe Int +foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info +foreignLabelStdcallInfo _lbl = Nothing + -- Cost centres etc. mkCCLabel cc = CC_Label cc @@ -383,6 +409,7 @@ 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) mkRtsInfoLabelFS str = RtsLabel (RtsInfoFS str) mkRtsEntryLabelFS str = RtsLabel (RtsEntryFS str) @@ -422,9 +449,9 @@ mkDeadStripPreventer lbl = DeadStripPreventer lbl -- Converting between info labels and entry/ret labels. infoLblToEntryLbl :: CLabel -> CLabel -infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry -infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry -infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry +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) @@ -433,9 +460,9 @@ infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s) infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl" entryLblToInfoLbl :: CLabel -> CLabel -entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable -entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable -entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable +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) @@ -443,6 +470,24 @@ entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s) entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS 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) + +-- ----------------------------------------------------------------------------- +-- Does a CLabel refer to a CAF? +hasCAF :: CLabel -> Bool +hasCAF (IdLabel _ MayHaveCafRefs _) = True +hasCAF _ = False + -- ----------------------------------------------------------------------------- -- Does a CLabel need declaring before use or not? -- @@ -452,19 +497,20 @@ needsCDecl :: CLabel -> Bool -- False <=> it's pre-declared; don't bother -- don't bother declaring SRT & Bitmap labels, we always make sure -- they are defined before use. -needsCDecl (IdLabel _ SRT) = False +needsCDecl (IdLabel _ _ SRT) = False needsCDecl (LargeSRTLabel _) = False needsCDecl (LargeBitmapLabel _) = False -needsCDecl (IdLabel _ _) = True +needsCDecl (IdLabel _ _ _) = True needsCDecl (CaseLabel _ _) = True needsCDecl (ModuleInitLabel _ _) = True needsCDecl (PlainModuleInitLabel _) = True +needsCDecl (ModuleInitTableLabel _) = True needsCDecl ModuleRegdLabel = False needsCDecl (StringLitLabel _) = False needsCDecl (AsmTempLabel _) = False needsCDecl (RtsLabel _) = False -needsCDecl l@(ForeignLabel _ _ _) = not (isMathFun l) +needsCDecl l@(ForeignLabel _ _ _ _) = not (isMathFun l) needsCDecl (CC_Label _) = True needsCDecl (CCS_Label _) = True needsCDecl (HpcTicksLabel _) = True @@ -484,21 +530,89 @@ maybeAsmTemp _ = Nothing -- they are builtin to the C compiler. For these labels we avoid -- generating our own C prototypes. isMathFun :: CLabel -> Bool -isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs - where - math_funs = [ - (fsLit "pow"), (fsLit "sin"), (fsLit "cos"), - (fsLit "tan"), (fsLit "sinh"), (fsLit "cosh"), - (fsLit "tanh"), (fsLit "asin"), (fsLit "acos"), - (fsLit "atan"), (fsLit "log"), (fsLit "exp"), - (fsLit "sqrt"), (fsLit "powf"), (fsLit "sinf"), - (fsLit "cosf"), (fsLit "tanf"), (fsLit "sinhf"), - (fsLit "coshf"), (fsLit "tanhf"), (fsLit "asinf"), - (fsLit "acosf"), (fsLit "atanf"), (fsLit "logf"), - (fsLit "expf"), (fsLit "sqrtf") - ] +isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs isMathFun _ = False +math_funs = mkUniqSet [ + -- _ISOC99_SOURCE + (fsLit "acos"), (fsLit "acosf"), (fsLit "acosh"), + (fsLit "acoshf"), (fsLit "acoshl"), (fsLit "acosl"), + (fsLit "asin"), (fsLit "asinf"), (fsLit "asinl"), + (fsLit "asinh"), (fsLit "asinhf"), (fsLit "asinhl"), + (fsLit "atan"), (fsLit "atanf"), (fsLit "atanl"), + (fsLit "atan2"), (fsLit "atan2f"), (fsLit "atan2l"), + (fsLit "atanh"), (fsLit "atanhf"), (fsLit "atanhl"), + (fsLit "cbrt"), (fsLit "cbrtf"), (fsLit "cbrtl"), + (fsLit "ceil"), (fsLit "ceilf"), (fsLit "ceill"), + (fsLit "copysign"), (fsLit "copysignf"), (fsLit "copysignl"), + (fsLit "cos"), (fsLit "cosf"), (fsLit "cosl"), + (fsLit "cosh"), (fsLit "coshf"), (fsLit "coshl"), + (fsLit "erf"), (fsLit "erff"), (fsLit "erfl"), + (fsLit "erfc"), (fsLit "erfcf"), (fsLit "erfcl"), + (fsLit "exp"), (fsLit "expf"), (fsLit "expl"), + (fsLit "exp2"), (fsLit "exp2f"), (fsLit "exp2l"), + (fsLit "expm1"), (fsLit "expm1f"), (fsLit "expm1l"), + (fsLit "fabs"), (fsLit "fabsf"), (fsLit "fabsl"), + (fsLit "fdim"), (fsLit "fdimf"), (fsLit "fdiml"), + (fsLit "floor"), (fsLit "floorf"), (fsLit "floorl"), + (fsLit "fma"), (fsLit "fmaf"), (fsLit "fmal"), + (fsLit "fmax"), (fsLit "fmaxf"), (fsLit "fmaxl"), + (fsLit "fmin"), (fsLit "fminf"), (fsLit "fminl"), + (fsLit "fmod"), (fsLit "fmodf"), (fsLit "fmodl"), + (fsLit "frexp"), (fsLit "frexpf"), (fsLit "frexpl"), + (fsLit "hypot"), (fsLit "hypotf"), (fsLit "hypotl"), + (fsLit "ilogb"), (fsLit "ilogbf"), (fsLit "ilogbl"), + (fsLit "ldexp"), (fsLit "ldexpf"), (fsLit "ldexpl"), + (fsLit "lgamma"), (fsLit "lgammaf"), (fsLit "lgammal"), + (fsLit "llrint"), (fsLit "llrintf"), (fsLit "llrintl"), + (fsLit "llround"), (fsLit "llroundf"), (fsLit "llroundl"), + (fsLit "log"), (fsLit "logf"), (fsLit "logl"), + (fsLit "log10l"), (fsLit "log10"), (fsLit "log10f"), + (fsLit "log1pl"), (fsLit "log1p"), (fsLit "log1pf"), + (fsLit "log2"), (fsLit "log2f"), (fsLit "log2l"), + (fsLit "logb"), (fsLit "logbf"), (fsLit "logbl"), + (fsLit "lrint"), (fsLit "lrintf"), (fsLit "lrintl"), + (fsLit "lround"), (fsLit "lroundf"), (fsLit "lroundl"), + (fsLit "modf"), (fsLit "modff"), (fsLit "modfl"), + (fsLit "nan"), (fsLit "nanf"), (fsLit "nanl"), + (fsLit "nearbyint"), (fsLit "nearbyintf"), (fsLit "nearbyintl"), + (fsLit "nextafter"), (fsLit "nextafterf"), (fsLit "nextafterl"), + (fsLit "nexttoward"), (fsLit "nexttowardf"), (fsLit "nexttowardl"), + (fsLit "pow"), (fsLit "powf"), (fsLit "powl"), + (fsLit "remainder"), (fsLit "remainderf"), (fsLit "remainderl"), + (fsLit "remquo"), (fsLit "remquof"), (fsLit "remquol"), + (fsLit "rint"), (fsLit "rintf"), (fsLit "rintl"), + (fsLit "round"), (fsLit "roundf"), (fsLit "roundl"), + (fsLit "scalbln"), (fsLit "scalblnf"), (fsLit "scalblnl"), + (fsLit "scalbn"), (fsLit "scalbnf"), (fsLit "scalbnl"), + (fsLit "sin"), (fsLit "sinf"), (fsLit "sinl"), + (fsLit "sinh"), (fsLit "sinhf"), (fsLit "sinhl"), + (fsLit "sqrt"), (fsLit "sqrtf"), (fsLit "sqrtl"), + (fsLit "tan"), (fsLit "tanf"), (fsLit "tanl"), + (fsLit "tanh"), (fsLit "tanhf"), (fsLit "tanhl"), + (fsLit "tgamma"), (fsLit "tgammaf"), (fsLit "tgammal"), + (fsLit "trunc"), (fsLit "truncf"), (fsLit "truncl"), + -- ISO C 99 also defines these function-like macros in math.h: + -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater, + -- isgreaterequal, isless, islessequal, islessgreater, isunordered + + -- additional symbols from _BSD_SOURCE + (fsLit "drem"), (fsLit "dremf"), (fsLit "dreml"), + (fsLit "finite"), (fsLit "finitef"), (fsLit "finitel"), + (fsLit "gamma"), (fsLit "gammaf"), (fsLit "gammal"), + (fsLit "isinf"), (fsLit "isinff"), (fsLit "isinfl"), + (fsLit "isnan"), (fsLit "isnanf"), (fsLit "isnanl"), + (fsLit "j0"), (fsLit "j0f"), (fsLit "j0l"), + (fsLit "j1"), (fsLit "j1f"), (fsLit "j1l"), + (fsLit "jn"), (fsLit "jnf"), (fsLit "jnl"), + (fsLit "lgamma_r"), (fsLit "lgammaf_r"), (fsLit "lgammal_r"), + (fsLit "scalb"), (fsLit "scalbf"), (fsLit "scalbl"), + (fsLit "significand"), (fsLit "significandf"), (fsLit "significandl"), + (fsLit "y0"), (fsLit "y0f"), (fsLit "y0l"), + (fsLit "y1"), (fsLit "y1f"), (fsLit "y1l"), + (fsLit "yn"), (fsLit "ynf"), (fsLit "ynl") + ] + -- ----------------------------------------------------------------------------- -- Is a CLabel visible outside this object file or not? @@ -512,10 +626,11 @@ 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 (ForeignLabel _ _ _ _) = True +externallyVisibleCLabel (IdLabel name _ _) = isExternalName name externallyVisibleCLabel (CC_Label _) = True externallyVisibleCLabel (CCS_Label _) = True externallyVisibleCLabel (DynamicLinkerLabel _ _) = False @@ -530,13 +645,25 @@ externallyVisibleCLabel (LargeSRTLabel _) = False -- For generating correct types in label declarations: data CLabelType - = CodeLabel - | DataLabel + = CodeLabel -- Address of some executable instructions + | DataLabel -- Address of data, not a GC ptr + | GcPtrLabel -- Address of a (presumably static) GC object + +isCFunctionLabel :: CLabel -> Bool +isCFunctionLabel lbl = case labelType lbl of + CodeLabel -> True + _other -> False + +isGcPtrLabel :: CLabel -> Bool +isGcPtrLabel lbl = case labelType lbl of + GcPtrLabel -> True + _other -> False labelType :: CLabel -> CLabelType 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 @@ -553,20 +680,20 @@ labelType (CaseLabel _ CaseReturnInfo) = DataLabel labelType (CaseLabel _ _) = CodeLabel labelType (ModuleInitLabel _ _) = CodeLabel labelType (PlainModuleInitLabel _) = CodeLabel +labelType (ModuleInitTableLabel _) = DataLabel labelType (LargeSRTLabel _) = DataLabel labelType (LargeBitmapLabel _) = DataLabel - -labelType (IdLabel _ info) = idInfoLabelType info -labelType _ = DataLabel +labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel +labelType (IdLabel _ _ info) = idInfoLabelType info +labelType _ = DataLabel idInfoLabelType info = case info of InfoTable -> DataLabel - Closure -> DataLabel + Closure -> GcPtrLabel ConInfoTable -> DataLabel StaticInfoTable -> DataLabel ClosureTable -> DataLabel --- krc: aie! a ticky counter label is data RednCounts -> DataLabel _ -> CodeLabel @@ -583,16 +710,17 @@ 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 + IdLabel n _ k -> isDllName this_pkg n #if mingw32_TARGET_OS - ForeignLabel _ _ d -> d + 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 + ForeignLabel _ _ _ _ -> True #endif ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m) PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m) + ModuleInitTableLabel m -> not opt_Static && this_pkg /= (modulePackageId m) -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves. _ -> False @@ -683,7 +811,7 @@ maybe_underscore 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) _) +pprAsmCLbl (ForeignLabel fs (Just sz) _ _) = ftext fs <> char '@' <> int sz #endif pprAsmCLbl lbl @@ -710,6 +838,7 @@ pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLi pprCLbl (RtsLabel (RtsCode str)) = ptext str pprCLbl (RtsLabel (RtsData str)) = ptext str +pprCLbl (RtsLabel (RtsGcPtr str)) = ptext str pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str pprCLbl (RtsLabel (RtsDataFS str)) = ftext str @@ -776,10 +905,10 @@ pprCLbl (RtsLabel (RtsSlowTickyCtr pat)) pprCLbl ModuleRegdLabel = ptext (sLit "_module_registered") -pprCLbl (ForeignLabel str _ _) +pprCLbl (ForeignLabel str _ _ _) = ftext str -pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor +pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor pprCLbl (CC_Label cc) = ppr cc pprCLbl (CCS_Label ccs) = ppr ccs @@ -789,6 +918,8 @@ pprCLbl (ModuleInitLabel mod way) <> char '_' <> text way pprCLbl (PlainModuleInitLabel mod) = ptext (sLit "__stginit_") <> ppr mod +pprCLbl (ModuleInitTableLabel mod) + = ptext (sLit "__stginittable_") <> ppr mod pprCLbl (HpcTicksLabel mod) = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc") @@ -838,6 +969,10 @@ asmTempLabelPrefix = pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc #if x86_64_TARGET_ARCH && darwin_TARGET_OS +pprDynamicLinkerAsmLabel CodeStub lbl + = char 'L' <> pprCLabel lbl <> text "$stub" +pprDynamicLinkerAsmLabel SymbolPtr lbl + = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr" pprDynamicLinkerAsmLabel GotSymbolPtr lbl = pprCLabel lbl <> text "@GOTPCREL" pprDynamicLinkerAsmLabel GotSymbolOffset lbl