module CLabel (
CLabel,
ForeignLabelSource(..),
pprDebugCLabel,
mkClosureLabel,
mkSRTLabel,
mkInfoTableLabel,
mkEntryLabel,
mkRednCountsLabel,
mkConInfoTableLabel,
mkApEntryLabel,
mkApInfoTableLabel,
mkClosureTableLabel,
mkBytesLabel,
mkLocalBlockLabel,
mkLocalClosureLabel,
mkLocalInfoTableLabel,
mkLocalClosureTableLabel,
mkBlockInfoTableLabel,
mkBitmapLabel,
mkStringLitLabel,
mkAsmTempLabel,
mkAsmTempDerivedLabel,
mkAsmTempEndLabel,
mkAsmTempDieLabel,
mkSplitMarkerLabel,
mkDirty_MUT_VAR_Label,
mkUpdInfoLabel,
mkBHUpdInfoLabel,
mkIndStaticInfoLabel,
mkMainCapabilityLabel,
mkMAP_FROZEN_CLEAN_infoLabel,
mkMAP_FROZEN_DIRTY_infoLabel,
mkMAP_DIRTY_infoLabel,
mkSMAP_FROZEN_CLEAN_infoLabel,
mkSMAP_FROZEN_DIRTY_infoLabel,
mkSMAP_DIRTY_infoLabel,
mkBadAlignmentLabel,
mkArrWords_infoLabel,
mkSRTInfoLabel,
mkTopTickyCtrLabel,
mkCAFBlackHoleInfoTableLabel,
mkRtsPrimOpLabel,
mkRtsSlowFastTickyCtrLabel,
mkSelectorInfoLabel,
mkSelectorEntryLabel,
mkCmmInfoLabel,
mkCmmEntryLabel,
mkCmmRetInfoLabel,
mkCmmRetLabel,
mkCmmCodeLabel,
mkCmmDataLabel,
mkCmmClosureLabel,
mkRtsApFastLabel,
mkPrimCallLabel,
mkForeignLabel,
addLabelSize,
foreignLabelStdcallInfo,
isBytesLabel,
isForeignLabel,
isSomeRODataLabel,
isStaticClosureLabel,
mkCCLabel, mkCCSLabel,
DynamicLinkerLabelInfo(..),
mkDynamicLinkerLabel,
dynamicLinkerLabelInfo,
mkPicBaseLabel,
mkDeadStripPreventer,
mkHpcTicksLabel,
hasCAF,
needsCDecl, maybeLocalBlockLabel, externallyVisibleCLabel,
isMathFun,
isCFunctionLabel, isGcPtrLabel, labelDynamic,
isLocalCLabel,
toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName,
pprCLabel
) where
#include "HsVersions.h"
import GhcPrelude
import IdInfo
import BasicTypes
import BlockId (BlockId, mkBlockId)
import Packages
import Module
import Name
import Unique
import PrimOp
import Config
import CostCentre
import Outputable
import FastString
import DynFlags
import Platform
import UniqSet
import Util
import PprCore ( )
data CLabel
=
IdLabel
Name
CafInfo
IdLabelInfo
| CmmLabel
UnitId
FastString
CmmLabelInfo
| RtsLabel
RtsLabelInfo
| LocalBlockLabel
!Unique
| ForeignLabel
FastString
(Maybe Int)
ForeignLabelSource
FunctionOrData
| AsmTempLabel
!Unique
| AsmTempDerivedLabel
CLabel
FastString
| StringLitLabel
!Unique
| CC_Label CostCentre
| CCS_Label CostCentreStack
| DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
| PicBaseLabel
| DeadStripPreventer CLabel
| HpcTicksLabel Module
| SRTLabel
!Unique
| LargeBitmapLabel
!Unique
deriving Eq
instance Ord CLabel where
compare (IdLabel a1 b1 c1) (IdLabel a2 b2 c2) =
compare a1 a2 `thenCmp`
compare b1 b2 `thenCmp`
compare c1 c2
compare (CmmLabel a1 b1 c1) (CmmLabel a2 b2 c2) =
compare a1 a2 `thenCmp`
compare b1 b2 `thenCmp`
compare c1 c2
compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2
compare (LocalBlockLabel u1) (LocalBlockLabel u2) = nonDetCmpUnique u1 u2
compare (ForeignLabel a1 b1 c1 d1) (ForeignLabel a2 b2 c2 d2) =
compare a1 a2 `thenCmp`
compare b1 b2 `thenCmp`
compare c1 c2 `thenCmp`
compare d1 d2
compare (AsmTempLabel u1) (AsmTempLabel u2) = nonDetCmpUnique u1 u2
compare (AsmTempDerivedLabel a1 b1) (AsmTempDerivedLabel a2 b2) =
compare a1 a2 `thenCmp`
compare b1 b2
compare (StringLitLabel u1) (StringLitLabel u2) =
nonDetCmpUnique u1 u2
compare (CC_Label a1) (CC_Label a2) =
compare a1 a2
compare (CCS_Label a1) (CCS_Label a2) =
compare a1 a2
compare (DynamicLinkerLabel a1 b1) (DynamicLinkerLabel a2 b2) =
compare a1 a2 `thenCmp`
compare b1 b2
compare PicBaseLabel PicBaseLabel = EQ
compare (DeadStripPreventer a1) (DeadStripPreventer a2) =
compare a1 a2
compare (HpcTicksLabel a1) (HpcTicksLabel a2) =
compare a1 a2
compare (SRTLabel u1) (SRTLabel u2) =
nonDetCmpUnique u1 u2
compare (LargeBitmapLabel u1) (LargeBitmapLabel u2) =
nonDetCmpUnique u1 u2
compare IdLabel{} _ = LT
compare _ IdLabel{} = GT
compare CmmLabel{} _ = LT
compare _ CmmLabel{} = GT
compare RtsLabel{} _ = LT
compare _ RtsLabel{} = GT
compare LocalBlockLabel{} _ = LT
compare _ LocalBlockLabel{} = GT
compare ForeignLabel{} _ = LT
compare _ ForeignLabel{} = GT
compare AsmTempLabel{} _ = LT
compare _ AsmTempLabel{} = GT
compare AsmTempDerivedLabel{} _ = LT
compare _ AsmTempDerivedLabel{} = GT
compare StringLitLabel{} _ = LT
compare _ StringLitLabel{} = GT
compare CC_Label{} _ = LT
compare _ CC_Label{} = GT
compare CCS_Label{} _ = LT
compare _ CCS_Label{} = GT
compare DynamicLinkerLabel{} _ = LT
compare _ DynamicLinkerLabel{} = GT
compare PicBaseLabel{} _ = LT
compare _ PicBaseLabel{} = GT
compare DeadStripPreventer{} _ = LT
compare _ DeadStripPreventer{} = GT
compare HpcTicksLabel{} _ = LT
compare _ HpcTicksLabel{} = GT
compare SRTLabel{} _ = LT
compare _ SRTLabel{} = GT
data ForeignLabelSource
= ForeignLabelInPackage UnitId
| ForeignLabelInExternalPackage
| ForeignLabelInThisPackage
deriving (Eq, Ord)
pprDebugCLabel :: CLabel -> SDoc
pprDebugCLabel lbl
= case lbl of
IdLabel _ _ info-> ppr lbl <> (parens $ text "IdLabel"
<> whenPprDebug (text ":" <> text (show info)))
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
| InfoTable
| Entry
| Slow
| LocalInfoTable
| LocalEntry
| RednCounts
| ConEntry
| ConInfoTable
| ClosureTable
| Bytes
| BlockInfoTable
deriving (Eq, Ord, Show)
data RtsLabelInfo
= RtsSelectorInfoTable Bool Int
| RtsSelectorEntry Bool Int
| RtsApInfoTable Bool Int
| RtsApEntry Bool Int
| RtsPrimOp PrimOp
| RtsApFast FastString
| RtsSlowFastTickyCtr String
deriving (Eq, Ord)
data CmmLabelInfo
= CmmInfo
| CmmEntry
| CmmRetInfo
| CmmRet
| CmmData
| CmmCode
| CmmClosure
| CmmPrimCall
deriving (Eq, Ord)
data DynamicLinkerLabelInfo
= CodeStub
| SymbolPtr
| GotSymbolPtr
| GotSymbolOffset
deriving (Eq, Ord)
mkSRTLabel :: Unique -> CLabel
mkSRTLabel u = SRTLabel u
mkRednCountsLabel :: Name -> CLabel
mkRednCountsLabel name =
IdLabel name NoCafRefs RednCounts
mkLocalClosureLabel :: Name -> CafInfo -> CLabel
mkLocalInfoTableLabel :: Name -> CafInfo -> CLabel
mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
mkLocalClosureLabel name c = IdLabel name c Closure
mkLocalInfoTableLabel name c = IdLabel name c LocalInfoTable
mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
mkClosureLabel :: Name -> CafInfo -> CLabel
mkInfoTableLabel :: Name -> CafInfo -> CLabel
mkEntryLabel :: Name -> CafInfo -> CLabel
mkClosureTableLabel :: Name -> CafInfo -> CLabel
mkConInfoTableLabel :: Name -> CafInfo -> CLabel
mkBytesLabel :: Name -> CLabel
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
mkConInfoTableLabel name c = IdLabel name c ConInfoTable
mkBytesLabel name = IdLabel name NoCafRefs Bytes
mkBlockInfoTableLabel :: Name -> CafInfo -> CLabel
mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable
mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel,
mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel,
mkMAP_DIRTY_infoLabel,
mkArrWords_infoLabel,
mkTopTickyCtrLabel,
mkCAFBlackHoleInfoTableLabel,
mkSMAP_FROZEN_CLEAN_infoLabel, mkSMAP_FROZEN_DIRTY_infoLabel,
mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel
mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
mkSplitMarkerLabel = CmmLabel rtsUnitId (fsLit "__stg_split_marker") CmmCode
mkUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_upd_frame") CmmInfo
mkBHUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_bh_upd_frame" ) CmmInfo
mkIndStaticInfoLabel = CmmLabel rtsUnitId (fsLit "stg_IND_STATIC") CmmInfo
mkMainCapabilityLabel = CmmLabel rtsUnitId (fsLit "MainCapability") CmmData
mkMAP_FROZEN_CLEAN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
mkMAP_FROZEN_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
mkMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
mkTopTickyCtrLabel = CmmLabel rtsUnitId (fsLit "top_ct") CmmData
mkCAFBlackHoleInfoTableLabel = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE") CmmInfo
mkArrWords_infoLabel = CmmLabel rtsUnitId (fsLit "stg_ARR_WORDS") CmmInfo
mkSMAP_FROZEN_CLEAN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
mkSMAP_FROZEN_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
mkBadAlignmentLabel = CmmLabel rtsUnitId (fsLit "stg_badAlignment") CmmEntry
mkSRTInfoLabel :: Int -> CLabel
mkSRTInfoLabel n = CmmLabel rtsUnitId lbl CmmInfo
where
lbl =
case n of
1 -> fsLit "stg_SRT_1"
2 -> fsLit "stg_SRT_2"
3 -> fsLit "stg_SRT_3"
4 -> fsLit "stg_SRT_4"
5 -> fsLit "stg_SRT_5"
6 -> fsLit "stg_SRT_6"
7 -> fsLit "stg_SRT_7"
8 -> fsLit "stg_SRT_8"
9 -> fsLit "stg_SRT_9"
10 -> fsLit "stg_SRT_10"
11 -> fsLit "stg_SRT_11"
12 -> fsLit "stg_SRT_12"
13 -> fsLit "stg_SRT_13"
14 -> fsLit "stg_SRT_14"
15 -> fsLit "stg_SRT_15"
16 -> fsLit "stg_SRT_16"
_ -> panic "mkSRTInfoLabel"
mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
mkCmmCodeLabel, mkCmmDataLabel, mkCmmClosureLabel
:: UnitId -> 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
mkCmmClosureLabel pkg str = CmmLabel pkg str CmmClosure
mkLocalBlockLabel :: Unique -> CLabel
mkLocalBlockLabel u = LocalBlockLabel u
mkRtsPrimOpLabel :: PrimOp -> CLabel
mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
mkSelectorInfoLabel :: Bool -> Int -> CLabel
mkSelectorEntryLabel :: Bool -> Int -> CLabel
mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
mkApInfoTableLabel :: Bool -> Int -> CLabel
mkApEntryLabel :: Bool -> Int -> CLabel
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
isBytesLabel :: CLabel -> Bool
isBytesLabel (IdLabel _ _ Bytes) = True
isBytesLabel _lbl = False
isForeignLabel :: CLabel -> Bool
isForeignLabel (ForeignLabel _ _ _ _) = True
isForeignLabel _lbl = False
isStaticClosureLabel :: CLabel -> Bool
isStaticClosureLabel (IdLabel _ _ Closure) = True
isStaticClosureLabel (CmmLabel _ _ CmmClosure) = True
isStaticClosureLabel _lbl = False
isSomeRODataLabel :: CLabel -> Bool
isSomeRODataLabel (IdLabel _ _ ClosureTable) = True
isSomeRODataLabel (IdLabel _ _ ConInfoTable) = True
isSomeRODataLabel (IdLabel _ _ InfoTable) = True
isSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True
isSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True
isSomeRODataLabel (CmmLabel _ _ CmmInfo) = True
isSomeRODataLabel _lbl = False
foreignLabelStdcallInfo :: CLabel -> Maybe Int
foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
foreignLabelStdcallInfo _lbl = Nothing
mkBitmapLabel :: Unique -> CLabel
mkBitmapLabel uniq = LargeBitmapLabel uniq
mkCCLabel :: CostCentre -> CLabel
mkCCSLabel :: CostCentreStack -> CLabel
mkCCLabel cc = CC_Label cc
mkCCSLabel ccs = CCS_Label ccs
mkRtsApFastLabel :: FastString -> CLabel
mkRtsApFastLabel str = RtsLabel (RtsApFast str)
mkRtsSlowFastTickyCtrLabel :: String -> CLabel
mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
mkHpcTicksLabel :: Module -> CLabel
mkHpcTicksLabel = HpcTicksLabel
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)
mkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel = AsmTempDerivedLabel
mkAsmTempEndLabel :: CLabel -> CLabel
mkAsmTempEndLabel l = mkAsmTempDerivedLabel l (fsLit "_end")
mkAsmTempDieLabel :: CLabel -> CLabel
mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die")
toClosureLbl :: CLabel -> CLabel
toClosureLbl (IdLabel n c _) = IdLabel n c Closure
toClosureLbl (CmmLabel m str _) = CmmLabel m str CmmClosure
toClosureLbl l = pprPanic "toClosureLbl" (ppr l)
toSlowEntryLbl :: CLabel -> CLabel
toSlowEntryLbl (IdLabel n _ BlockInfoTable)
= pprPanic "toSlowEntryLbl" (ppr n)
toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l)
toEntryLbl :: CLabel -> CLabel
toEntryLbl (IdLabel n c LocalInfoTable) = IdLabel n c LocalEntry
toEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
toEntryLbl (IdLabel n _ BlockInfoTable) = mkLocalBlockLabel (nameUnique n)
toEntryLbl (IdLabel n c _) = IdLabel n c Entry
toEntryLbl (CmmLabel m str CmmInfo) = CmmLabel m str CmmEntry
toEntryLbl (CmmLabel m str CmmRetInfo) = CmmLabel m str CmmRet
toEntryLbl l = pprPanic "toEntryLbl" (ppr l)
toInfoLbl :: CLabel -> CLabel
toInfoLbl (IdLabel n c LocalEntry) = IdLabel n c LocalInfoTable
toInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
toInfoLbl (IdLabel n c _) = IdLabel n c InfoTable
toInfoLbl (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo
toInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo
toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
hasHaskellName :: CLabel -> Maybe Name
hasHaskellName (IdLabel n _ _) = Just n
hasHaskellName _ = Nothing
hasCAF :: CLabel -> Bool
hasCAF (IdLabel _ _ RednCounts) = False
hasCAF (IdLabel _ MayHaveCafRefs _) = True
hasCAF _ = False
needsCDecl :: CLabel -> Bool
needsCDecl (SRTLabel _) = True
needsCDecl (LargeBitmapLabel _) = False
needsCDecl (IdLabel _ _ _) = True
needsCDecl (LocalBlockLabel _) = True
needsCDecl (StringLitLabel _) = False
needsCDecl (AsmTempLabel _) = False
needsCDecl (AsmTempDerivedLabel _ _) = False
needsCDecl (RtsLabel _) = False
needsCDecl (CmmLabel pkgId _ _)
| pkgId == rtsUnitId = False
| otherwise = True
needsCDecl l@(ForeignLabel{}) = not (isMathFun l)
needsCDecl (CC_Label _) = True
needsCDecl (CCS_Label _) = True
needsCDecl (HpcTicksLabel _) = True
needsCDecl (DynamicLinkerLabel {}) = panic "needsCDecl DynamicLinkerLabel"
needsCDecl PicBaseLabel = panic "needsCDecl PicBaseLabel"
needsCDecl (DeadStripPreventer {}) = panic "needsCDecl DeadStripPreventer"
maybeLocalBlockLabel :: CLabel -> Maybe BlockId
maybeLocalBlockLabel (LocalBlockLabel uq) = Just $ mkBlockId uq
maybeLocalBlockLabel _ = Nothing
isMathFun :: CLabel -> Bool
isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
isMathFun _ = False
math_funs :: UniqSet FastString
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"),
(fsLit "nextup"), (fsLit "nextupf"), (fsLit "nextupl"),
(fsLit "nextdown"), (fsLit "nextdownf"), (fsLit "nextdownl")
]
externallyVisibleCLabel :: CLabel -> Bool
externallyVisibleCLabel (StringLitLabel _) = False
externallyVisibleCLabel (AsmTempLabel _) = False
externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False
externallyVisibleCLabel (RtsLabel _) = True
externallyVisibleCLabel (LocalBlockLabel _) = False
externallyVisibleCLabel (CmmLabel _ _ _) = True
externallyVisibleCLabel (ForeignLabel{}) = True
externallyVisibleCLabel (IdLabel name _ info) = isExternalName name && externallyVisibleIdLabel info
externallyVisibleCLabel (CC_Label _) = True
externallyVisibleCLabel (CCS_Label _) = True
externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
externallyVisibleCLabel (HpcTicksLabel _) = True
externallyVisibleCLabel (LargeBitmapLabel _) = False
externallyVisibleCLabel (SRTLabel _) = False
externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
externallyVisibleIdLabel :: IdLabelInfo -> Bool
externallyVisibleIdLabel LocalInfoTable = False
externallyVisibleIdLabel LocalEntry = False
externallyVisibleIdLabel BlockInfoTable = False
externallyVisibleIdLabel _ = True
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 (IdLabel _ _ info) = idInfoLabelType info
labelType (CmmLabel _ _ CmmData) = DataLabel
labelType (CmmLabel _ _ CmmClosure) = GcPtrLabel
labelType (CmmLabel _ _ CmmCode) = CodeLabel
labelType (CmmLabel _ _ CmmInfo) = DataLabel
labelType (CmmLabel _ _ CmmEntry) = CodeLabel
labelType (CmmLabel _ _ CmmPrimCall) = CodeLabel
labelType (CmmLabel _ _ CmmRetInfo) = DataLabel
labelType (CmmLabel _ _ CmmRet) = CodeLabel
labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApFast _)) = CodeLabel
labelType (RtsLabel _) = DataLabel
labelType (LocalBlockLabel _) = CodeLabel
labelType (SRTLabel _) = DataLabel
labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
labelType (ForeignLabel _ _ _ IsData) = DataLabel
labelType (AsmTempLabel _) = panic "labelType(AsmTempLabel)"
labelType (AsmTempDerivedLabel _ _) = panic "labelType(AsmTempDerivedLabel)"
labelType (StringLitLabel _) = DataLabel
labelType (CC_Label _) = DataLabel
labelType (CCS_Label _) = DataLabel
labelType (DynamicLinkerLabel _ _) = DataLabel
labelType PicBaseLabel = DataLabel
labelType (DeadStripPreventer _) = DataLabel
labelType (HpcTicksLabel _) = DataLabel
labelType (LargeBitmapLabel _) = DataLabel
idInfoLabelType :: IdLabelInfo -> CLabelType
idInfoLabelType info =
case info of
InfoTable -> DataLabel
LocalInfoTable -> DataLabel
BlockInfoTable -> DataLabel
Closure -> GcPtrLabel
ConInfoTable -> DataLabel
ClosureTable -> DataLabel
RednCounts -> DataLabel
Bytes -> DataLabel
_ -> CodeLabel
isLocalCLabel :: Module -> CLabel -> Bool
isLocalCLabel this_mod lbl =
case lbl of
IdLabel name _ _
| isInternalName name -> True
| otherwise -> nameModule name == this_mod
LocalBlockLabel _ -> True
_ -> False
labelDynamic :: DynFlags -> Module -> CLabel -> Bool
labelDynamic dflags this_mod lbl =
case lbl of
RtsLabel _ ->
(gopt Opt_ExternalDynamicRefs dflags) && (this_pkg /= rtsUnitId)
IdLabel n _ _ ->
isDllName dflags this_mod n
CmmLabel pkg _ _
| os == OSMinGW32 ->
(gopt Opt_ExternalDynamicRefs dflags) && (this_pkg /= pkg)
| otherwise ->
gopt Opt_ExternalDynamicRefs dflags
LocalBlockLabel _ -> False
ForeignLabel _ _ source _ ->
if os == OSMinGW32
then case source of
ForeignLabelInExternalPackage -> True
ForeignLabelInThisPackage -> False
ForeignLabelInPackage pkgId ->
(gopt Opt_ExternalDynamicRefs dflags) && (this_pkg /= pkgId)
else
True
HpcTicksLabel m ->
(gopt Opt_ExternalDynamicRefs dflags) && this_mod /= m
_ -> False
where
os = platformOS (targetPlatform dflags)
this_pkg = moduleUnitId this_mod
instance Outputable CLabel where
ppr c = sdocWithPlatform $ \platform -> pprCLabel platform c
pprCLabel :: Platform -> CLabel -> SDoc
pprCLabel platform (LocalBlockLabel u)
= getPprStyle $ \ sty ->
if asmStyle sty then
ptext (asmTempLabelPrefix platform) <> pprUniqueAlways u
else
char '_' <> pprUniqueAlways u
pprCLabel platform (AsmTempLabel u)
| not (platformUnregisterised platform)
= getPprStyle $ \ sty ->
if asmStyle sty then
ptext (asmTempLabelPrefix platform) <> pprUniqueAlways u
else
char '_' <> pprUniqueAlways u
pprCLabel platform (AsmTempDerivedLabel l suf)
| cGhcWithNativeCodeGen == "YES"
= ptext (asmTempLabelPrefix platform)
<> case l of AsmTempLabel u -> pprUniqueAlways u
LocalBlockLabel u -> pprUniqueAlways u
_other -> pprCLabel platform l
<> ftext suf
pprCLabel platform (DynamicLinkerLabel info lbl)
| cGhcWithNativeCodeGen == "YES"
= pprDynamicLinkerAsmLabel platform info lbl
pprCLabel _ PicBaseLabel
| cGhcWithNativeCodeGen == "YES"
= text "1b"
pprCLabel platform (DeadStripPreventer lbl)
| cGhcWithNativeCodeGen == "YES"
= pprCLabel platform lbl <> text "_dsp"
pprCLabel _ (StringLitLabel u)
| cGhcWithNativeCodeGen == "YES"
= pprUniqueAlways u <> ptext (sLit "_str")
pprCLabel platform lbl
= getPprStyle $ \ sty ->
if cGhcWithNativeCodeGen == "YES" && asmStyle sty
then maybe_underscore (pprAsmCLbl platform lbl)
else pprCLbl lbl
maybe_underscore :: SDoc -> SDoc
maybe_underscore doc
| underscorePrefix = pp_cSEP <> doc
| otherwise = doc
pprAsmCLbl :: Platform -> CLabel -> SDoc
pprAsmCLbl platform (ForeignLabel fs (Just sz) _ _)
| platformOS platform == OSMinGW32
= ftext fs <> char '@' <> int sz
pprAsmCLbl _ lbl
= pprCLbl lbl
pprCLbl :: CLabel -> SDoc
pprCLbl (StringLitLabel u)
= pprUniqueAlways u <> text "_str"
pprCLbl (SRTLabel u)
= pprUniqueAlways u <> pp_cSEP <> text "srt"
pprCLbl (LargeBitmapLabel u) = text "b" <> pprUniqueAlways u <> pp_cSEP <> text "btm"
pprCLbl (CmmLabel _ str CmmCode) = ftext str
pprCLbl (CmmLabel _ str CmmData) = ftext str
pprCLbl (CmmLabel _ str CmmPrimCall) = ftext str
pprCLbl (LocalBlockLabel u) = text "blk_" <> pprUniqueAlways u
pprCLbl (RtsLabel (RtsApFast str)) = ftext str <> text "_fast"
pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
= sdocWithDynFlags $ \dflags ->
ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
hcat [text "stg_sel_", text (show offset),
ptext (if upd_reqd
then (sLit "_upd_info")
else (sLit "_noupd_info"))
]
pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
= sdocWithDynFlags $ \dflags ->
ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
hcat [text "stg_sel_", text (show offset),
ptext (if upd_reqd
then (sLit "_upd_entry")
else (sLit "_noupd_entry"))
]
pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
= sdocWithDynFlags $ \dflags ->
ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
hcat [text "stg_ap_", text (show arity),
ptext (if upd_reqd
then (sLit "_upd_info")
else (sLit "_noupd_info"))
]
pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
= sdocWithDynFlags $ \dflags ->
ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
hcat [text "stg_ap_", text (show arity),
ptext (if upd_reqd
then (sLit "_upd_entry")
else (sLit "_noupd_entry"))
]
pprCLbl (CmmLabel _ fs CmmInfo)
= ftext fs <> text "_info"
pprCLbl (CmmLabel _ fs CmmEntry)
= ftext fs <> text "_entry"
pprCLbl (CmmLabel _ fs CmmRetInfo)
= ftext fs <> text "_info"
pprCLbl (CmmLabel _ fs CmmRet)
= ftext fs <> text "_ret"
pprCLbl (CmmLabel _ fs CmmClosure)
= ftext fs <> text "_closure"
pprCLbl (RtsLabel (RtsPrimOp primop))
= text "stg_" <> ppr primop
pprCLbl (RtsLabel (RtsSlowFastTickyCtr pat))
= text "SLOW_CALL_fast_" <> text pat <> ptext (sLit "_ctr")
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 (HpcTicksLabel mod)
= text "_hpc_tickboxes_" <> ppr mod <> ptext (sLit "_hpc")
pprCLbl (AsmTempLabel {}) = panic "pprCLbl AsmTempLabel"
pprCLbl (AsmTempDerivedLabel {})= panic "pprCLbl AsmTempDerivedLabel"
pprCLbl (DynamicLinkerLabel {}) = panic "pprCLbl DynamicLinkerLabel"
pprCLbl (PicBaseLabel {}) = panic "pprCLbl PicBaseLabel"
pprCLbl (DeadStripPreventer {}) = panic "pprCLbl DeadStripPreventer"
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <>
(case x of
Closure -> text "closure"
InfoTable -> text "info"
LocalInfoTable -> text "info"
Entry -> text "entry"
LocalEntry -> text "entry"
Slow -> text "slow"
RednCounts -> text "ct"
ConEntry -> text "con_entry"
ConInfoTable -> text "con_info"
ClosureTable -> text "closure_tbl"
Bytes -> text "bytes"
BlockInfoTable -> text "info"
)
pp_cSEP :: SDoc
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 :: Platform -> LitString
asmTempLabelPrefix platform = case platformOS platform of
OSDarwin -> sLit "L"
OSAIX -> sLit "__L"
_ -> sLit ".L"
pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc
pprDynamicLinkerAsmLabel platform dllInfo lbl =
case platformOS platform of
OSDarwin
| platformArch platform == ArchX86_64 ->
case dllInfo of
CodeStub -> char 'L' <> ppr lbl <> text "$stub"
SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
GotSymbolPtr -> ppr lbl <> text "@GOTPCREL"
GotSymbolOffset -> ppr lbl
| otherwise ->
case dllInfo of
CodeStub -> char 'L' <> ppr lbl <> text "$stub"
SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
_ -> panic "pprDynamicLinkerAsmLabel"
OSAIX ->
case dllInfo of
SymbolPtr -> text "LC.." <> ppr lbl
_ -> panic "pprDynamicLinkerAsmLabel"
_ | osElfTarget (platformOS platform) -> elfLabel
OSMinGW32 ->
case dllInfo of
SymbolPtr -> text "__imp_" <> ppr lbl
_ -> panic "pprDynamicLinkerAsmLabel"
_ -> panic "pprDynamicLinkerAsmLabel"
where
elfLabel
| platformArch platform == ArchPPC
= case dllInfo of
CodeStub ->
ppr lbl <> text "+32768@plt"
SymbolPtr -> text ".LC_" <> ppr lbl
_ -> panic "pprDynamicLinkerAsmLabel"
| platformArch platform == ArchX86_64
= case dllInfo of
CodeStub -> ppr lbl <> text "@plt"
GotSymbolPtr -> ppr lbl <> text "@gotpcrel"
GotSymbolOffset -> ppr lbl
SymbolPtr -> text ".LC_" <> ppr lbl
| platformArch platform == ArchPPC_64 ELF_V1
|| platformArch platform == ArchPPC_64 ELF_V2
= case dllInfo of
GotSymbolPtr -> text ".LC_" <> ppr lbl
<> text "@toc"
GotSymbolOffset -> ppr lbl
SymbolPtr -> text ".LC_" <> ppr lbl
_ -> panic "pprDynamicLinkerAsmLabel"
| otherwise
= case dllInfo of
CodeStub -> ppr lbl <> text "@plt"
SymbolPtr -> text ".LC_" <> ppr lbl
GotSymbolPtr -> ppr lbl <> text "@got"
GotSymbolOffset -> ppr lbl <> text "@gotoff"