module CLabel (
CLabel,
ForeignLabelSource(..),
pprDebugCLabel,
mkClosureLabel,
mkSRTLabel,
mkInfoTableLabel,
mkEntryLabel,
mkSlowEntryLabel,
mkConEntryLabel,
mkStaticConEntryLabel,
mkRednCountsLabel,
mkConInfoTableLabel,
mkStaticInfoTableLabel,
mkLargeSRTLabel,
mkApEntryLabel,
mkApInfoTableLabel,
mkClosureTableLabel,
mkLocalClosureLabel,
mkLocalInfoTableLabel,
mkLocalEntryLabel,
mkLocalConEntryLabel,
mkLocalStaticConEntryLabel,
mkLocalConInfoTableLabel,
mkLocalStaticInfoTableLabel,
mkLocalClosureTableLabel,
mkReturnPtLabel,
mkReturnInfoLabel,
mkAltLabel,
mkDefaultLabel,
mkBitmapLabel,
mkStringLitLabel,
mkAsmTempLabel,
mkModuleInitLabel,
mkPlainModuleInitLabel,
mkModuleInitTableLabel,
mkSplitMarkerLabel,
mkDirty_MUT_VAR_Label,
mkUpdInfoLabel,
mkBHUpdInfoLabel,
mkIndStaticInfoLabel,
mkMainCapabilityLabel,
mkMAP_FROZEN_infoLabel,
mkMAP_DIRTY_infoLabel,
mkEMPTY_MVAR_infoLabel,
mkTopTickyCtrLabel,
mkCAFBlackHoleInfoTableLabel,
mkRtsPrimOpLabel,
mkRtsSlowTickyCtrLabel,
moduleRegdLabel,
moduleRegTableLabel,
mkSelectorInfoLabel,
mkSelectorEntryLabel,
mkCmmInfoLabel,
mkCmmEntryLabel,
mkCmmRetInfoLabel,
mkCmmRetLabel,
mkCmmCodeLabel,
mkCmmDataLabel,
mkCmmGcPtrLabel,
mkRtsApFastLabel,
mkPrimCallLabel,
mkForeignLabel,
addLabelSize,
foreignLabelStdcallInfo,
mkCCLabel, mkCCSLabel,
DynamicLinkerLabelInfo(..),
mkDynamicLinkerLabel,
dynamicLinkerLabelInfo,
mkPicBaseLabel,
mkDeadStripPreventer,
mkHpcTicksLabel,
mkHpcModuleNameLabel,
hasCAF,
infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
isMathFun,
isCFunctionLabel, isGcPtrLabel, labelDynamic,
pprCLabel
) where
#include "HsVersions.h"
import IdInfo
import StaticFlags
import BasicTypes
import Literal
import Packages
import DataCon
import PackageConfig
import Module
import Name
import Unique
import PrimOp
import Config
import CostCentre
import Outputable
import FastString
import DynFlags
import UniqSet
data CLabel
=
IdLabel
Name
CafInfo
IdLabelInfo
| CmmLabel
PackageId
FastString
CmmLabelInfo
| RtsLabel
RtsLabelInfo
| ForeignLabel
FastString
(Maybe Int)
ForeignLabelSource
FunctionOrData
| CaseLabel
!Unique
CaseLabelInfo
| AsmTempLabel
!Unique
| StringLitLabel
!Unique
| ModuleInitLabel
Module
String
| PlainModuleInitLabel
Module
| ModuleInitTableLabel
Module
| ModuleRegdLabel
| CC_Label CostCentre
| CCS_Label CostCentreStack
| DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
| PicBaseLabel
| DeadStripPreventer CLabel
| HpcTicksLabel Module
| HpcModuleNameLabel
| LargeSRTLabel
!Unique
| LargeBitmapLabel
!Unique
deriving (Eq, Ord)
data ForeignLabelSource
= ForeignLabelInPackage PackageId
| ForeignLabelInExternalPackage
| ForeignLabelInThisPackage
deriving (Eq, Ord)
pprDebugCLabel :: CLabel -> SDoc
pprDebugCLabel lbl
= case lbl of
IdLabel{} -> ppr lbl <> (parens $ text "IdLabel")
CmmLabel pkg name _info
-> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
RtsLabel{} -> ppr lbl <> (parens $ text "RtsLabel")
ForeignLabel name mSuffix src funOrData
-> ppr lbl <> (parens
$ text "ForeignLabel"
<+> ppr mSuffix
<+> ppr src
<+> ppr funOrData)
_ -> ppr lbl <> (parens $ text "other CLabel)")
data IdLabelInfo
= Closure
| SRT
| InfoTable
| Entry
| Slow
| RednCounts
| ConEntry
| ConInfoTable
| StaticConEntry
| StaticInfoTable
| ClosureTable
deriving (Eq, Ord)
data CaseLabelInfo
= CaseReturnPt
| CaseReturnInfo
| CaseAlt ConTag
| CaseDefault
deriving (Eq, Ord)
data RtsLabelInfo
= RtsSelectorInfoTable Bool Int
| RtsSelectorEntry Bool Int
| RtsApInfoTable Bool Int
| RtsApEntry Bool Int
| RtsPrimOp PrimOp
| RtsApFast FastString
| RtsSlowTickyCtr String
deriving (Eq, Ord)
data CmmLabelInfo
= CmmInfo
| CmmEntry
| CmmRetInfo
| CmmRet
| CmmData
| CmmCode
| CmmGcPtr
| CmmPrimCall
deriving (Eq, Ord)
data DynamicLinkerLabelInfo
= CodeStub
| SymbolPtr
| GotSymbolPtr
| GotSymbolOffset
deriving (Eq, Ord)
mkSRTLabel name c = IdLabel name c SRT
mkSlowEntryLabel name c = IdLabel name c Slow
mkRednCountsLabel name c = IdLabel name c RednCounts
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
mkSplitMarkerLabel = CmmLabel rtsPackageId (fsLit "__stg_split_marker") CmmCode
mkDirty_MUT_VAR_Label = CmmLabel rtsPackageId (fsLit "dirty_MUT_VAR") CmmCode
mkUpdInfoLabel = CmmLabel rtsPackageId (fsLit "stg_upd_frame") CmmInfo
mkBHUpdInfoLabel = CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" ) CmmInfo
mkIndStaticInfoLabel = CmmLabel rtsPackageId (fsLit "stg_IND_STATIC") CmmInfo
mkMainCapabilityLabel = CmmLabel rtsPackageId (fsLit "MainCapability") CmmData
mkMAP_FROZEN_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkMAP_DIRTY_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
mkEMPTY_MVAR_infoLabel = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR") CmmInfo
mkTopTickyCtrLabel = CmmLabel rtsPackageId (fsLit "top_ct") CmmData
mkCAFBlackHoleInfoTableLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmInfo
mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
mkCmmCodeLabel, mkCmmDataLabel, mkCmmGcPtrLabel
:: PackageId -> FastString -> CLabel
mkCmmInfoLabel pkg str = CmmLabel pkg str CmmInfo
mkCmmEntryLabel pkg str = CmmLabel pkg str CmmEntry
mkCmmRetInfoLabel pkg str = CmmLabel pkg str CmmRetInfo
mkCmmRetLabel pkg str = CmmLabel pkg str CmmRet
mkCmmCodeLabel pkg str = CmmLabel pkg str CmmCode
mkCmmDataLabel pkg str = CmmLabel pkg str CmmData
mkCmmGcPtrLabel pkg str = CmmLabel pkg str CmmGcPtr
mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
mkPrimCallLabel :: PrimCall -> CLabel
mkPrimCallLabel (PrimCall str pkg)
= CmmLabel pkg str CmmPrimCall
mkForeignLabel
:: FastString
-> Maybe Int
-> ForeignLabelSource
-> FunctionOrData
-> CLabel
mkForeignLabel str mb_sz src fod
= ForeignLabel str mb_sz src fod
addLabelSize :: CLabel -> Int -> CLabel
addLabelSize (ForeignLabel str _ src fod) sz
= ForeignLabel str (Just sz) src fod
addLabelSize label _
= label
foreignLabelStdcallInfo :: CLabel -> Maybe Int
foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
foreignLabelStdcallInfo _lbl = Nothing
mkLargeSRTLabel uniq = LargeSRTLabel uniq
mkBitmapLabel uniq = LargeBitmapLabel uniq
mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
mkDefaultLabel uniq = CaseLabel uniq CaseDefault
mkCCLabel cc = CC_Label cc
mkCCSLabel ccs = CCS_Label ccs
mkRtsApFastLabel str = RtsLabel (RtsApFast str)
mkRtsSlowTickyCtrLabel :: String -> CLabel
mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
mkHpcTicksLabel = HpcTicksLabel
mkHpcModuleNameLabel = HpcModuleNameLabel
mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel = DynamicLinkerLabel
dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
dynamicLinkerLabelInfo _ = Nothing
mkPicBaseLabel :: CLabel
mkPicBaseLabel = PicBaseLabel
mkDeadStripPreventer :: CLabel -> CLabel
mkDeadStripPreventer lbl = DeadStripPreventer lbl
mkStringLitLabel :: Unique -> CLabel
mkStringLitLabel = StringLitLabel
mkAsmTempLabel :: Uniquable a => a -> CLabel
mkAsmTempLabel a = AsmTempLabel (getUnique a)
mkModuleInitLabel :: Module -> String -> CLabel
mkModuleInitLabel mod way = ModuleInitLabel mod way
mkPlainModuleInitLabel :: Module -> CLabel
mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
mkModuleInitTableLabel :: Module -> CLabel
mkModuleInitTableLabel mod = ModuleInitTableLabel mod
moduleRegdLabel = ModuleRegdLabel
moduleRegTableLabel = ModuleInitTableLabel
infoLblToEntryLbl :: CLabel -> CLabel
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 (CmmLabel m str CmmInfo) = CmmLabel m str CmmEntry
infoLblToEntryLbl (CmmLabel m str CmmRetInfo) = CmmLabel m str CmmRet
infoLblToEntryLbl _
= panic "CLabel.infoLblToEntryLbl"
entryLblToInfoLbl :: CLabel -> CLabel
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 (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo
entryLblToInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo
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)
hasCAF :: CLabel -> Bool
hasCAF (IdLabel _ MayHaveCafRefs _) = True
hasCAF _ = False
needsCDecl :: CLabel -> Bool
needsCDecl (IdLabel _ _ SRT) = False
needsCDecl (LargeSRTLabel _) = False
needsCDecl (LargeBitmapLabel _) = False
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 (CmmLabel pkgId _ _)
| pkgId == rtsPackageId = False
| otherwise = True
needsCDecl l@(ForeignLabel{}) = not (isMathFun l)
needsCDecl (CC_Label _) = True
needsCDecl (CCS_Label _) = True
needsCDecl (HpcTicksLabel _) = True
needsCDecl HpcModuleNameLabel = False
isAsmTemp :: CLabel -> Bool
isAsmTemp (AsmTempLabel _) = True
isAsmTemp _ = False
maybeAsmTemp :: CLabel -> Maybe Unique
maybeAsmTemp (AsmTempLabel uq) = Just uq
maybeAsmTemp _ = Nothing
isMathFun :: CLabel -> Bool
isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
isMathFun _ = False
math_funs = mkUniqSet [
(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"),
(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")
]
externallyVisibleCLabel :: CLabel -> Bool
externallyVisibleCLabel (CaseLabel _ _) = False
externallyVisibleCLabel (StringLitLabel _) = False
externallyVisibleCLabel (AsmTempLabel _) = False
externallyVisibleCLabel (ModuleInitLabel _ _) = True
externallyVisibleCLabel (PlainModuleInitLabel _)= True
externallyVisibleCLabel (ModuleInitTableLabel _)= False
externallyVisibleCLabel ModuleRegdLabel = False
externallyVisibleCLabel (RtsLabel _) = True
externallyVisibleCLabel (CmmLabel _ _ _) = True
externallyVisibleCLabel (ForeignLabel{}) = True
externallyVisibleCLabel (IdLabel name _ _) = isExternalName name
externallyVisibleCLabel (CC_Label _) = True
externallyVisibleCLabel (CCS_Label _) = True
externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
externallyVisibleCLabel (HpcTicksLabel _) = True
externallyVisibleCLabel HpcModuleNameLabel = False
externallyVisibleCLabel (LargeBitmapLabel _) = False
externallyVisibleCLabel (LargeSRTLabel _) = False
data CLabelType
= CodeLabel
| DataLabel
| GcPtrLabel
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 (CmmLabel _ _ CmmData) = DataLabel
labelType (CmmLabel _ _ CmmGcPtr) = GcPtrLabel
labelType (CmmLabel _ _ CmmCode) = CodeLabel
labelType (CmmLabel _ _ CmmInfo) = DataLabel
labelType (CmmLabel _ _ CmmEntry) = CodeLabel
labelType (CmmLabel _ _ CmmRetInfo) = DataLabel
labelType (CmmLabel _ _ CmmRet) = CodeLabel
labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApFast _)) = CodeLabel
labelType (CaseLabel _ CaseReturnInfo) = DataLabel
labelType (CaseLabel _ _) = CodeLabel
labelType (ModuleInitLabel _ _) = CodeLabel
labelType (PlainModuleInitLabel _) = CodeLabel
labelType (ModuleInitTableLabel _) = DataLabel
labelType (LargeSRTLabel _) = DataLabel
labelType (LargeBitmapLabel _) = DataLabel
labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
labelType (IdLabel _ _ info) = idInfoLabelType info
labelType _ = DataLabel
idInfoLabelType info =
case info of
InfoTable -> DataLabel
Closure -> GcPtrLabel
ConInfoTable -> DataLabel
StaticInfoTable -> DataLabel
ClosureTable -> DataLabel
RednCounts -> DataLabel
_ -> CodeLabel
labelDynamic :: PackageId -> CLabel -> Bool
labelDynamic this_pkg lbl =
case lbl of
RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId)
IdLabel n _ k -> isDllName this_pkg n
#if mingw32_TARGET_OS
CmmLabel pkg _ _
-> not opt_Static && (this_pkg /= pkg)
ForeignLabel _ _ ForeignLabelInExternalPackage _ -> True
ForeignLabel _ _ ForeignLabelInThisPackage _ -> False
ForeignLabel _ _ (ForeignLabelInPackage pkgId) _
-> (not opt_Static) && (this_pkg /= pkgId)
#else
ForeignLabel _ _ _ _ -> True
CmmLabel pkg _ _ -> 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)
_ -> False
instance Outputable CLabel where
ppr = pprCLabel
pprCLabel :: CLabel -> SDoc
#if ! OMIT_NATIVE_CODEGEN
pprCLabel (AsmTempLabel u)
= getPprStyle $ \ sty ->
if asmStyle sty then
ptext asmTempLabelPrefix <> pprUnique u
else
char '_' <> pprUnique u
pprCLabel (DynamicLinkerLabel info lbl)
= pprDynamicLinkerAsmLabel info lbl
pprCLabel PicBaseLabel
= ptext (sLit "1b")
pprCLabel (DeadStripPreventer lbl)
= pprCLabel lbl <> ptext (sLit "_dsp")
#endif
pprCLabel lbl =
#if ! OMIT_NATIVE_CODEGEN
getPprStyle $ \ sty ->
if asmStyle sty then
maybe_underscore (pprAsmCLbl lbl)
else
#endif
pprCLbl lbl
maybe_underscore doc
| underscorePrefix = pp_cSEP <> doc
| otherwise = doc
#ifdef mingw32_TARGET_OS
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)
= hcat [pprUnique u, ptext (sLit "_info")]
pprCLbl (CaseLabel u (CaseAlt tag))
= hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
pprCLbl (CaseLabel u CaseDefault)
= hcat [pprUnique u, ptext (sLit "_dflt")]
pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
pprCLbl (CmmLabel _ str CmmCode) = ftext str
pprCLbl (CmmLabel _ str CmmData) = ftext str
pprCLbl (CmmLabel _ str CmmGcPtr) = ftext str
pprCLbl (CmmLabel _ str CmmPrimCall) = ftext str
pprCLbl (RtsLabel (RtsApFast str)) = ftext 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_info"))
]
pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
= hcat [ptext (sLit "stg_sel_"), text (show offset),
ptext (if upd_reqd
then (sLit "_upd_entry")
else (sLit "_noupd_entry"))
]
pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
= hcat [ptext (sLit "stg_ap_"), text (show arity),
ptext (if upd_reqd
then (sLit "_upd_info")
else (sLit "_noupd_info"))
]
pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
= hcat [ptext (sLit "stg_ap_"), text (show arity),
ptext (if upd_reqd
then (sLit "_upd_entry")
else (sLit "_noupd_entry"))
]
pprCLbl (CmmLabel _ fs CmmInfo)
= ftext fs <> ptext (sLit "_info")
pprCLbl (CmmLabel _ fs CmmEntry)
= ftext fs <> ptext (sLit "_entry")
pprCLbl (CmmLabel _ fs CmmRetInfo)
= ftext fs <> ptext (sLit "_info")
pprCLbl (CmmLabel _ fs CmmRet)
= ftext fs <> ptext (sLit "_ret")
pprCLbl (RtsLabel (RtsPrimOp primop))
= ptext (sLit "stg_") <> ppr primop
pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
= ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
pprCLbl ModuleRegdLabel
= ptext (sLit "_module_registered")
pprCLbl (ForeignLabel str _ _ _)
= ftext str
pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
pprCLbl (CC_Label cc) = ppr cc
pprCLbl (CCS_Label ccs) = ppr ccs
pprCLbl (ModuleInitLabel mod way)
= ptext (sLit "__stginit_") <> ppr mod
<> 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")
pprCLbl HpcModuleNameLabel
= ptext (sLit "_hpc_module_name_str")
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <>
(case x of
Closure -> ptext (sLit "closure")
SRT -> ptext (sLit "srt")
InfoTable -> ptext (sLit "info")
Entry -> ptext (sLit "entry")
Slow -> ptext (sLit "slow")
RednCounts -> ptext (sLit "ct")
ConEntry -> ptext (sLit "con_entry")
ConInfoTable -> ptext (sLit "con_info")
StaticConEntry -> ptext (sLit "static_entry")
StaticInfoTable -> ptext (sLit "static_info")
ClosureTable -> ptext (sLit "closure_tbl")
)
pp_cSEP = char '_'
instance Outputable ForeignLabelSource where
ppr fs
= case fs of
ForeignLabelInPackage pkgId -> parens $ text "package: " <> ppr pkgId
ForeignLabelInThisPackage -> parens $ text "this package"
ForeignLabelInExternalPackage -> parens $ text "external package"
underscorePrefix :: Bool
underscorePrefix = (cLeadingUnderscore == "YES")
asmTempLabelPrefix :: LitString
asmTempLabelPrefix =
#if alpha_TARGET_OS
(sLit "$")
#elif darwin_TARGET_OS
(sLit "L")
#else
(sLit ".L")
#endif
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
= pprCLabel lbl
pprDynamicLinkerAsmLabel _ _
= panic "pprDynamicLinkerAsmLabel"
#elif darwin_TARGET_OS
pprDynamicLinkerAsmLabel CodeStub lbl
= char 'L' <> pprCLabel lbl <> text "$stub"
pprDynamicLinkerAsmLabel SymbolPtr lbl
= char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
pprDynamicLinkerAsmLabel _ _
= panic "pprDynamicLinkerAsmLabel"
#elif powerpc_TARGET_ARCH && elf_OBJ_FORMAT
pprDynamicLinkerAsmLabel CodeStub lbl
= pprCLabel lbl <> text "@plt"
pprDynamicLinkerAsmLabel SymbolPtr lbl
= text ".LC_" <> pprCLabel lbl
pprDynamicLinkerAsmLabel _ _
= panic "pprDynamicLinkerAsmLabel"
#elif x86_64_TARGET_ARCH && elf_OBJ_FORMAT
pprDynamicLinkerAsmLabel CodeStub lbl
= pprCLabel lbl <> text "@plt"
pprDynamicLinkerAsmLabel GotSymbolPtr lbl
= pprCLabel lbl <> text "@gotpcrel"
pprDynamicLinkerAsmLabel GotSymbolOffset lbl
= pprCLabel lbl
pprDynamicLinkerAsmLabel SymbolPtr lbl
= text ".LC_" <> pprCLabel lbl
#elif elf_OBJ_FORMAT
pprDynamicLinkerAsmLabel CodeStub lbl
= pprCLabel lbl <> text "@plt"
pprDynamicLinkerAsmLabel SymbolPtr lbl
= text ".LC_" <> pprCLabel lbl
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
pprDynamicLinkerAsmLabel _ _
= panic "pprDynamicLinkerAsmLabel"
#else
pprDynamicLinkerAsmLabel _ _
= panic "pprDynamicLinkerAsmLabel"
#endif