{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module GHC.Cmm.CLabel (
CLabel,
NeedExternDecl (..),
ForeignLabelSource(..),
DynamicLinkerLabelInfo(..),
ConInfoTableLocation(..),
getConInfoTableLocation,
mkClosureLabel,
mkSRTLabel,
mkInfoTableLabel,
mkEntryLabel,
mkRednCountsLabel,
mkTagHitLabel,
mkConInfoTableLabel,
mkApEntryLabel,
mkApInfoTableLabel,
mkClosureTableLabel,
mkBytesLabel,
mkLocalBlockLabel,
mkBlockInfoTableLabel,
mkBitmapLabel,
mkStringLitLabel,
mkInitializerStubLabel,
mkInitializerArrayLabel,
mkFinalizerStubLabel,
mkFinalizerArrayLabel,
mkAsmTempLabel,
mkAsmTempDerivedLabel,
mkAsmTempEndLabel,
mkAsmTempProcEndLabel,
mkAsmTempDieLabel,
mkDirty_MUT_VAR_Label,
mkMUT_VAR_CLEAN_infoLabel,
mkNonmovingWriteBarrierEnabledLabel,
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,
mkOutOfBoundsAccessLabel,
mkMemcpyRangeOverlapLabel,
mkArrWords_infoLabel,
mkSRTInfoLabel,
mkTopTickyCtrLabel,
mkCAFBlackHoleInfoTableLabel,
mkRtsPrimOpLabel,
mkRtsSlowFastTickyCtrLabel,
mkRtsUnpackCStringLabel,
mkRtsUnpackCStringUtf8Label,
mkSelectorInfoLabel,
mkSelectorEntryLabel,
mkCmmInfoLabel,
mkCmmEntryLabel,
mkCmmRetInfoLabel,
mkCmmRetLabel,
mkCmmCodeLabel,
mkCmmDataLabel,
mkRtsCmmDataLabel,
mkCmmClosureLabel,
mkRtsApFastLabel,
mkPrimCallLabel,
mkForeignLabel,
mkCCLabel,
mkCCSLabel,
mkIPELabel,
InfoProvEnt(..),
mkDynamicLinkerLabel,
mkPicBaseLabel,
mkDeadStripPreventer,
mkHpcTicksLabel,
hasCAF,
needsCDecl,
maybeLocalBlockLabel,
externallyVisibleCLabel,
isMathFun,
isCFunctionLabel,
isGcPtrLabel,
labelDynamic,
isLocalCLabel,
mayRedirectTo,
isInfoTableLabel,
isCmmInfoTableLabel,
isConInfoTableLabel,
isIdLabel,
isTickyLabel,
hasHaskellName,
hasIdLabelInfo,
isBytesLabel,
isForeignLabel,
isSomeRODataLabel,
isStaticClosureLabel,
toClosureLbl,
toSlowEntryLbl,
toEntryLbl,
toInfoLbl,
LabelStyle (..),
pprDebugCLabel,
pprCLabel,
pprAsmLabel,
ppInternalProcLabel,
dynamicLinkerLabelInfo,
addLabelSize,
foreignLabelStdcallInfo
) where
import GHC.Prelude
import GHC.Types.Id.Info
import GHC.Types.Basic
import {-# SOURCE #-} GHC.Cmm.BlockId (BlockId, mkBlockId)
import GHC.Unit.Types
import GHC.Types.Name
import GHC.Types.Unique
import GHC.Builtin.PrimOps
import GHC.Types.CostCentre
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Data.FastString
import GHC.Platform
import GHC.Types.Unique.Set
import GHC.Core.Ppr ( )
import GHC.Types.SrcLoc
import qualified Data.Semigroup as S
data CLabel
=
IdLabel
Name
CafInfo
IdLabelInfo
| CmmLabel
UnitId
NeedExternDecl
FastString
CmmLabelInfo
| RtsLabel
RtsLabelInfo
| LocalBlockLabel
{-# UNPACK #-} !Unique
| ForeignLabel
FastString
(Maybe Int)
ForeignLabelSource
FunctionOrData
| AsmTempLabel
{-# UNPACK #-} !Unique
| AsmTempDerivedLabel
CLabel
FastString
| StringLitLabel
{-# UNPACK #-} !Unique
| CC_Label CostCentre
| CCS_Label CostCentreStack
| IPE_Label InfoProvEnt
| ModuleLabel !Module ModuleLabelKind
| DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
| PicBaseLabel
| DeadStripPreventer CLabel
| HpcTicksLabel Module
| SRTLabel
{-# UNPACK #-} !Unique
| LargeBitmapLabel
{-# UNPACK #-} !Unique
deriving CLabel -> CLabel -> Bool
(CLabel -> CLabel -> Bool)
-> (CLabel -> CLabel -> Bool) -> Eq CLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CLabel -> CLabel -> Bool
== :: CLabel -> CLabel -> Bool
$c/= :: CLabel -> CLabel -> Bool
/= :: CLabel -> CLabel -> Bool
Eq
instance Show CLabel where
show :: CLabel -> String
show = SDoc -> String
forall a. Outputable a => a -> String
showPprUnsafe (SDoc -> String) -> (CLabel -> SDoc) -> CLabel -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> CLabel -> SDoc
pprDebugCLabel Platform
genericPlatform
data ModuleLabelKind
= MLK_Initializer LexicalFastString
| MLK_InitializerArray
| MLK_Finalizer LexicalFastString
| MLK_FinalizerArray
| MLK_IPEBuffer
deriving (ModuleLabelKind -> ModuleLabelKind -> Bool
(ModuleLabelKind -> ModuleLabelKind -> Bool)
-> (ModuleLabelKind -> ModuleLabelKind -> Bool)
-> Eq ModuleLabelKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleLabelKind -> ModuleLabelKind -> Bool
== :: ModuleLabelKind -> ModuleLabelKind -> Bool
$c/= :: ModuleLabelKind -> ModuleLabelKind -> Bool
/= :: ModuleLabelKind -> ModuleLabelKind -> Bool
Eq, Eq ModuleLabelKind
Eq ModuleLabelKind =>
(ModuleLabelKind -> ModuleLabelKind -> Ordering)
-> (ModuleLabelKind -> ModuleLabelKind -> Bool)
-> (ModuleLabelKind -> ModuleLabelKind -> Bool)
-> (ModuleLabelKind -> ModuleLabelKind -> Bool)
-> (ModuleLabelKind -> ModuleLabelKind -> Bool)
-> (ModuleLabelKind -> ModuleLabelKind -> ModuleLabelKind)
-> (ModuleLabelKind -> ModuleLabelKind -> ModuleLabelKind)
-> Ord ModuleLabelKind
ModuleLabelKind -> ModuleLabelKind -> Bool
ModuleLabelKind -> ModuleLabelKind -> Ordering
ModuleLabelKind -> ModuleLabelKind -> ModuleLabelKind
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ModuleLabelKind -> ModuleLabelKind -> Ordering
compare :: ModuleLabelKind -> ModuleLabelKind -> Ordering
$c< :: ModuleLabelKind -> ModuleLabelKind -> Bool
< :: ModuleLabelKind -> ModuleLabelKind -> Bool
$c<= :: ModuleLabelKind -> ModuleLabelKind -> Bool
<= :: ModuleLabelKind -> ModuleLabelKind -> Bool
$c> :: ModuleLabelKind -> ModuleLabelKind -> Bool
> :: ModuleLabelKind -> ModuleLabelKind -> Bool
$c>= :: ModuleLabelKind -> ModuleLabelKind -> Bool
>= :: ModuleLabelKind -> ModuleLabelKind -> Bool
$cmax :: ModuleLabelKind -> ModuleLabelKind -> ModuleLabelKind
max :: ModuleLabelKind -> ModuleLabelKind -> ModuleLabelKind
$cmin :: ModuleLabelKind -> ModuleLabelKind -> ModuleLabelKind
min :: ModuleLabelKind -> ModuleLabelKind -> ModuleLabelKind
Ord)
pprModuleLabelKind :: IsLine doc => ModuleLabelKind -> doc
pprModuleLabelKind :: forall doc. IsLine doc => ModuleLabelKind -> doc
pprModuleLabelKind ModuleLabelKind
MLK_InitializerArray = String -> doc
forall doc. IsLine doc => String -> doc
text String
"init_arr"
pprModuleLabelKind (MLK_Initializer (LexicalFastString FastString
s)) = String -> doc
forall doc. IsLine doc => String -> doc
text String
"init__" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
s
pprModuleLabelKind ModuleLabelKind
MLK_FinalizerArray = String -> doc
forall doc. IsLine doc => String -> doc
text String
"fini_arr"
pprModuleLabelKind (MLK_Finalizer (LexicalFastString FastString
s)) = String -> doc
forall doc. IsLine doc => String -> doc
text String
"fini__" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
s
pprModuleLabelKind ModuleLabelKind
MLK_IPEBuffer = String -> doc
forall doc. IsLine doc => String -> doc
text String
"ipe_buf"
{-# SPECIALIZE pprModuleLabelKind :: ModuleLabelKind -> SDoc #-}
{-# SPECIALIZE pprModuleLabelKind :: ModuleLabelKind -> HLine #-}
isIdLabel :: CLabel -> Bool
isIdLabel :: CLabel -> Bool
isIdLabel IdLabel{} = Bool
True
isIdLabel CLabel
_ = Bool
False
isTickyLabel :: CLabel -> Bool
isTickyLabel :: CLabel -> Bool
isTickyLabel (IdLabel Name
_ CafInfo
_ IdTickyInfo{}) = Bool
True
isTickyLabel CLabel
_ = Bool
False
newtype NeedExternDecl
= NeedExternDecl Bool
deriving (Eq NeedExternDecl
Eq NeedExternDecl =>
(NeedExternDecl -> NeedExternDecl -> Ordering)
-> (NeedExternDecl -> NeedExternDecl -> Bool)
-> (NeedExternDecl -> NeedExternDecl -> Bool)
-> (NeedExternDecl -> NeedExternDecl -> Bool)
-> (NeedExternDecl -> NeedExternDecl -> Bool)
-> (NeedExternDecl -> NeedExternDecl -> NeedExternDecl)
-> (NeedExternDecl -> NeedExternDecl -> NeedExternDecl)
-> Ord NeedExternDecl
NeedExternDecl -> NeedExternDecl -> Bool
NeedExternDecl -> NeedExternDecl -> Ordering
NeedExternDecl -> NeedExternDecl -> NeedExternDecl
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NeedExternDecl -> NeedExternDecl -> Ordering
compare :: NeedExternDecl -> NeedExternDecl -> Ordering
$c< :: NeedExternDecl -> NeedExternDecl -> Bool
< :: NeedExternDecl -> NeedExternDecl -> Bool
$c<= :: NeedExternDecl -> NeedExternDecl -> Bool
<= :: NeedExternDecl -> NeedExternDecl -> Bool
$c> :: NeedExternDecl -> NeedExternDecl -> Bool
> :: NeedExternDecl -> NeedExternDecl -> Bool
$c>= :: NeedExternDecl -> NeedExternDecl -> Bool
>= :: NeedExternDecl -> NeedExternDecl -> Bool
$cmax :: NeedExternDecl -> NeedExternDecl -> NeedExternDecl
max :: NeedExternDecl -> NeedExternDecl -> NeedExternDecl
$cmin :: NeedExternDecl -> NeedExternDecl -> NeedExternDecl
min :: NeedExternDecl -> NeedExternDecl -> NeedExternDecl
Ord,NeedExternDecl -> NeedExternDecl -> Bool
(NeedExternDecl -> NeedExternDecl -> Bool)
-> (NeedExternDecl -> NeedExternDecl -> Bool) -> Eq NeedExternDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NeedExternDecl -> NeedExternDecl -> Bool
== :: NeedExternDecl -> NeedExternDecl -> Bool
$c/= :: NeedExternDecl -> NeedExternDecl -> Bool
/= :: NeedExternDecl -> NeedExternDecl -> Bool
Eq)
instance Ord CLabel where
compare :: CLabel -> CLabel -> Ordering
compare (IdLabel Name
a1 CafInfo
b1 IdLabelInfo
c1) (IdLabel Name
a2 CafInfo
b2 IdLabelInfo
c2) =
Name -> Name -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Name
a1 Name
a2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<>
CafInfo -> CafInfo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CafInfo
b1 CafInfo
b2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<>
IdLabelInfo -> IdLabelInfo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare IdLabelInfo
c1 IdLabelInfo
c2
compare (CmmLabel UnitId
a1 NeedExternDecl
b1 FastString
c1 CmmLabelInfo
d1) (CmmLabel UnitId
a2 NeedExternDecl
b2 FastString
c2 CmmLabelInfo
d2) =
UnitId -> UnitId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare UnitId
a1 UnitId
a2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<>
NeedExternDecl -> NeedExternDecl -> Ordering
forall a. Ord a => a -> a -> Ordering
compare NeedExternDecl
b1 NeedExternDecl
b2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<>
FastString -> FastString -> Ordering
uniqCompareFS FastString
c1 FastString
c2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<>
CmmLabelInfo -> CmmLabelInfo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CmmLabelInfo
d1 CmmLabelInfo
d2
compare (RtsLabel RtsLabelInfo
a1) (RtsLabel RtsLabelInfo
a2) = RtsLabelInfo -> RtsLabelInfo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare RtsLabelInfo
a1 RtsLabelInfo
a2
compare (LocalBlockLabel Unique
u1) (LocalBlockLabel Unique
u2) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
u1 Unique
u2
compare (ForeignLabel FastString
a1 Maybe Int
b1 ForeignLabelSource
c1 FunctionOrData
d1) (ForeignLabel FastString
a2 Maybe Int
b2 ForeignLabelSource
c2 FunctionOrData
d2) =
FastString -> FastString -> Ordering
uniqCompareFS FastString
a1 FastString
a2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<>
Maybe Int -> Maybe Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Maybe Int
b1 Maybe Int
b2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<>
ForeignLabelSource -> ForeignLabelSource -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ForeignLabelSource
c1 ForeignLabelSource
c2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<>
FunctionOrData -> FunctionOrData -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FunctionOrData
d1 FunctionOrData
d2
compare (AsmTempLabel Unique
u1) (AsmTempLabel Unique
u2) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
u1 Unique
u2
compare (AsmTempDerivedLabel CLabel
a1 FastString
b1) (AsmTempDerivedLabel CLabel
a2 FastString
b2) =
CLabel -> CLabel -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CLabel
a1 CLabel
a2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<>
FastString -> FastString -> Ordering
lexicalCompareFS FastString
b1 FastString
b2
compare (StringLitLabel Unique
u1) (StringLitLabel Unique
u2) =
Unique -> Unique -> Ordering
nonDetCmpUnique Unique
u1 Unique
u2
compare (CC_Label CostCentre
a1) (CC_Label CostCentre
a2) =
CostCentre -> CostCentre -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CostCentre
a1 CostCentre
a2
compare (CCS_Label CostCentreStack
a1) (CCS_Label CostCentreStack
a2) =
CostCentreStack -> CostCentreStack -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CostCentreStack
a1 CostCentreStack
a2
compare (IPE_Label InfoProvEnt
a1) (IPE_Label InfoProvEnt
a2) =
InfoProvEnt -> InfoProvEnt -> Ordering
forall a. Ord a => a -> a -> Ordering
compare InfoProvEnt
a1 InfoProvEnt
a2
compare (ModuleLabel Module
m1 ModuleLabelKind
k1) (ModuleLabel Module
m2 ModuleLabelKind
k2) =
Module -> Module -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Module
m1 Module
m2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<>
ModuleLabelKind -> ModuleLabelKind -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ModuleLabelKind
k1 ModuleLabelKind
k2
compare (DynamicLinkerLabel DynamicLinkerLabelInfo
a1 CLabel
b1) (DynamicLinkerLabel DynamicLinkerLabelInfo
a2 CLabel
b2) =
DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare DynamicLinkerLabelInfo
a1 DynamicLinkerLabelInfo
a2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<>
CLabel -> CLabel -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CLabel
b1 CLabel
b2
compare CLabel
PicBaseLabel CLabel
PicBaseLabel = Ordering
EQ
compare (DeadStripPreventer CLabel
a1) (DeadStripPreventer CLabel
a2) =
CLabel -> CLabel -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CLabel
a1 CLabel
a2
compare (HpcTicksLabel Module
a1) (HpcTicksLabel Module
a2) =
Module -> Module -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Module
a1 Module
a2
compare (SRTLabel Unique
u1) (SRTLabel Unique
u2) =
Unique -> Unique -> Ordering
nonDetCmpUnique Unique
u1 Unique
u2
compare (LargeBitmapLabel Unique
u1) (LargeBitmapLabel Unique
u2) =
Unique -> Unique -> Ordering
nonDetCmpUnique Unique
u1 Unique
u2
compare IdLabel{} CLabel
_ = Ordering
LT
compare CLabel
_ IdLabel{} = Ordering
GT
compare CmmLabel{} CLabel
_ = Ordering
LT
compare CLabel
_ CmmLabel{} = Ordering
GT
compare RtsLabel{} CLabel
_ = Ordering
LT
compare CLabel
_ RtsLabel{} = Ordering
GT
compare LocalBlockLabel{} CLabel
_ = Ordering
LT
compare CLabel
_ LocalBlockLabel{} = Ordering
GT
compare ForeignLabel{} CLabel
_ = Ordering
LT
compare CLabel
_ ForeignLabel{} = Ordering
GT
compare AsmTempLabel{} CLabel
_ = Ordering
LT
compare CLabel
_ AsmTempLabel{} = Ordering
GT
compare AsmTempDerivedLabel{} CLabel
_ = Ordering
LT
compare CLabel
_ AsmTempDerivedLabel{} = Ordering
GT
compare StringLitLabel{} CLabel
_ = Ordering
LT
compare CLabel
_ StringLitLabel{} = Ordering
GT
compare CC_Label{} CLabel
_ = Ordering
LT
compare CLabel
_ CC_Label{} = Ordering
GT
compare CCS_Label{} CLabel
_ = Ordering
LT
compare CLabel
_ CCS_Label{} = Ordering
GT
compare DynamicLinkerLabel{} CLabel
_ = Ordering
LT
compare CLabel
_ DynamicLinkerLabel{} = Ordering
GT
compare PicBaseLabel{} CLabel
_ = Ordering
LT
compare CLabel
_ PicBaseLabel{} = Ordering
GT
compare DeadStripPreventer{} CLabel
_ = Ordering
LT
compare CLabel
_ DeadStripPreventer{} = Ordering
GT
compare HpcTicksLabel{} CLabel
_ = Ordering
LT
compare CLabel
_ HpcTicksLabel{} = Ordering
GT
compare SRTLabel{} CLabel
_ = Ordering
LT
compare CLabel
_ SRTLabel{} = Ordering
GT
compare (IPE_Label {}) CLabel
_ = Ordering
LT
compare CLabel
_ (IPE_Label{}) = Ordering
GT
compare (ModuleLabel {}) CLabel
_ = Ordering
LT
compare CLabel
_ (ModuleLabel{}) = Ordering
GT
data ForeignLabelSource
= ForeignLabelInPackage UnitId
| ForeignLabelInExternalPackage
| ForeignLabelInThisPackage
deriving (ForeignLabelSource -> ForeignLabelSource -> Bool
(ForeignLabelSource -> ForeignLabelSource -> Bool)
-> (ForeignLabelSource -> ForeignLabelSource -> Bool)
-> Eq ForeignLabelSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForeignLabelSource -> ForeignLabelSource -> Bool
== :: ForeignLabelSource -> ForeignLabelSource -> Bool
$c/= :: ForeignLabelSource -> ForeignLabelSource -> Bool
/= :: ForeignLabelSource -> ForeignLabelSource -> Bool
Eq, Eq ForeignLabelSource
Eq ForeignLabelSource =>
(ForeignLabelSource -> ForeignLabelSource -> Ordering)
-> (ForeignLabelSource -> ForeignLabelSource -> Bool)
-> (ForeignLabelSource -> ForeignLabelSource -> Bool)
-> (ForeignLabelSource -> ForeignLabelSource -> Bool)
-> (ForeignLabelSource -> ForeignLabelSource -> Bool)
-> (ForeignLabelSource -> ForeignLabelSource -> ForeignLabelSource)
-> (ForeignLabelSource -> ForeignLabelSource -> ForeignLabelSource)
-> Ord ForeignLabelSource
ForeignLabelSource -> ForeignLabelSource -> Bool
ForeignLabelSource -> ForeignLabelSource -> Ordering
ForeignLabelSource -> ForeignLabelSource -> ForeignLabelSource
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ForeignLabelSource -> ForeignLabelSource -> Ordering
compare :: ForeignLabelSource -> ForeignLabelSource -> Ordering
$c< :: ForeignLabelSource -> ForeignLabelSource -> Bool
< :: ForeignLabelSource -> ForeignLabelSource -> Bool
$c<= :: ForeignLabelSource -> ForeignLabelSource -> Bool
<= :: ForeignLabelSource -> ForeignLabelSource -> Bool
$c> :: ForeignLabelSource -> ForeignLabelSource -> Bool
> :: ForeignLabelSource -> ForeignLabelSource -> Bool
$c>= :: ForeignLabelSource -> ForeignLabelSource -> Bool
>= :: ForeignLabelSource -> ForeignLabelSource -> Bool
$cmax :: ForeignLabelSource -> ForeignLabelSource -> ForeignLabelSource
max :: ForeignLabelSource -> ForeignLabelSource -> ForeignLabelSource
$cmin :: ForeignLabelSource -> ForeignLabelSource -> ForeignLabelSource
min :: ForeignLabelSource -> ForeignLabelSource -> ForeignLabelSource
Ord)
pprDebugCLabel :: Platform -> CLabel -> SDoc
pprDebugCLabel :: Platform -> CLabel -> SDoc
pprDebugCLabel Platform
platform CLabel
lbl = Platform -> CLabel -> SDoc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
extra
where
extra :: SDoc
extra = case CLabel
lbl of
IdLabel Name
_ CafInfo
_ IdLabelInfo
info
-> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"IdLabel" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
":" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> IdLabelInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdLabelInfo
info)
CmmLabel UnitId
pkg NeedExternDecl
_ext FastString
_name CmmLabelInfo
_info
-> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CmmLabel" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pkg
RtsLabel{}
-> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RtsLabel"
ForeignLabel FastString
_name Maybe Int
mSuffix ForeignLabelSource
src FunctionOrData
funOrData
-> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ForeignLabel" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Int
mSuffix SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ForeignLabelSource -> SDoc
forall a. Outputable a => a -> SDoc
ppr ForeignLabelSource
src SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FunctionOrData -> SDoc
forall a. Outputable a => a -> SDoc
ppr FunctionOrData
funOrData
CLabel
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"other CLabel"
data TickyIdInfo
= TickyRednCounts
| TickyInferedTag !Unique
deriving (TickyIdInfo -> TickyIdInfo -> Bool
(TickyIdInfo -> TickyIdInfo -> Bool)
-> (TickyIdInfo -> TickyIdInfo -> Bool) -> Eq TickyIdInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TickyIdInfo -> TickyIdInfo -> Bool
== :: TickyIdInfo -> TickyIdInfo -> Bool
$c/= :: TickyIdInfo -> TickyIdInfo -> Bool
/= :: TickyIdInfo -> TickyIdInfo -> Bool
Eq,Int -> TickyIdInfo -> ShowS
[TickyIdInfo] -> ShowS
TickyIdInfo -> String
(Int -> TickyIdInfo -> ShowS)
-> (TickyIdInfo -> String)
-> ([TickyIdInfo] -> ShowS)
-> Show TickyIdInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TickyIdInfo -> ShowS
showsPrec :: Int -> TickyIdInfo -> ShowS
$cshow :: TickyIdInfo -> String
show :: TickyIdInfo -> String
$cshowList :: [TickyIdInfo] -> ShowS
showList :: [TickyIdInfo] -> ShowS
Show)
instance Outputable TickyIdInfo where
ppr :: TickyIdInfo -> SDoc
ppr TickyIdInfo
TickyRednCounts = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ct_rdn"
ppr (TickyInferedTag Unique
unique) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ct_tag[" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unique
unique SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
']'
instance Ord TickyIdInfo where
compare :: TickyIdInfo -> TickyIdInfo -> Ordering
compare TickyIdInfo
TickyRednCounts TickyIdInfo
TickyRednCounts = Ordering
EQ
compare TickyIdInfo
TickyRednCounts TickyIdInfo
_ = Ordering
LT
compare TickyIdInfo
_ TickyIdInfo
TickyRednCounts = Ordering
GT
compare (TickyInferedTag Unique
unique1) (TickyInferedTag Unique
unique2) =
Unique -> Unique -> Ordering
nonDetCmpUnique Unique
unique1 Unique
unique2
data IdLabelInfo
= Closure
| InfoTable
| Entry
| Slow
| LocalInfoTable
| LocalEntry
| IdTickyInfo !TickyIdInfo
| ConEntry ConInfoTableLocation
| ConInfoTable ConInfoTableLocation
| ClosureTable
| Bytes
| BlockInfoTable
deriving (IdLabelInfo -> IdLabelInfo -> Bool
(IdLabelInfo -> IdLabelInfo -> Bool)
-> (IdLabelInfo -> IdLabelInfo -> Bool) -> Eq IdLabelInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdLabelInfo -> IdLabelInfo -> Bool
== :: IdLabelInfo -> IdLabelInfo -> Bool
$c/= :: IdLabelInfo -> IdLabelInfo -> Bool
/= :: IdLabelInfo -> IdLabelInfo -> Bool
Eq, Eq IdLabelInfo
Eq IdLabelInfo =>
(IdLabelInfo -> IdLabelInfo -> Ordering)
-> (IdLabelInfo -> IdLabelInfo -> Bool)
-> (IdLabelInfo -> IdLabelInfo -> Bool)
-> (IdLabelInfo -> IdLabelInfo -> Bool)
-> (IdLabelInfo -> IdLabelInfo -> Bool)
-> (IdLabelInfo -> IdLabelInfo -> IdLabelInfo)
-> (IdLabelInfo -> IdLabelInfo -> IdLabelInfo)
-> Ord IdLabelInfo
IdLabelInfo -> IdLabelInfo -> Bool
IdLabelInfo -> IdLabelInfo -> Ordering
IdLabelInfo -> IdLabelInfo -> IdLabelInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IdLabelInfo -> IdLabelInfo -> Ordering
compare :: IdLabelInfo -> IdLabelInfo -> Ordering
$c< :: IdLabelInfo -> IdLabelInfo -> Bool
< :: IdLabelInfo -> IdLabelInfo -> Bool
$c<= :: IdLabelInfo -> IdLabelInfo -> Bool
<= :: IdLabelInfo -> IdLabelInfo -> Bool
$c> :: IdLabelInfo -> IdLabelInfo -> Bool
> :: IdLabelInfo -> IdLabelInfo -> Bool
$c>= :: IdLabelInfo -> IdLabelInfo -> Bool
>= :: IdLabelInfo -> IdLabelInfo -> Bool
$cmax :: IdLabelInfo -> IdLabelInfo -> IdLabelInfo
max :: IdLabelInfo -> IdLabelInfo -> IdLabelInfo
$cmin :: IdLabelInfo -> IdLabelInfo -> IdLabelInfo
min :: IdLabelInfo -> IdLabelInfo -> IdLabelInfo
Ord)
data ConInfoTableLocation = UsageSite Module Int
| DefinitionSite
deriving (ConInfoTableLocation -> ConInfoTableLocation -> Bool
(ConInfoTableLocation -> ConInfoTableLocation -> Bool)
-> (ConInfoTableLocation -> ConInfoTableLocation -> Bool)
-> Eq ConInfoTableLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConInfoTableLocation -> ConInfoTableLocation -> Bool
== :: ConInfoTableLocation -> ConInfoTableLocation -> Bool
$c/= :: ConInfoTableLocation -> ConInfoTableLocation -> Bool
/= :: ConInfoTableLocation -> ConInfoTableLocation -> Bool
Eq, Eq ConInfoTableLocation
Eq ConInfoTableLocation =>
(ConInfoTableLocation -> ConInfoTableLocation -> Ordering)
-> (ConInfoTableLocation -> ConInfoTableLocation -> Bool)
-> (ConInfoTableLocation -> ConInfoTableLocation -> Bool)
-> (ConInfoTableLocation -> ConInfoTableLocation -> Bool)
-> (ConInfoTableLocation -> ConInfoTableLocation -> Bool)
-> (ConInfoTableLocation
-> ConInfoTableLocation -> ConInfoTableLocation)
-> (ConInfoTableLocation
-> ConInfoTableLocation -> ConInfoTableLocation)
-> Ord ConInfoTableLocation
ConInfoTableLocation -> ConInfoTableLocation -> Bool
ConInfoTableLocation -> ConInfoTableLocation -> Ordering
ConInfoTableLocation
-> ConInfoTableLocation -> ConInfoTableLocation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConInfoTableLocation -> ConInfoTableLocation -> Ordering
compare :: ConInfoTableLocation -> ConInfoTableLocation -> Ordering
$c< :: ConInfoTableLocation -> ConInfoTableLocation -> Bool
< :: ConInfoTableLocation -> ConInfoTableLocation -> Bool
$c<= :: ConInfoTableLocation -> ConInfoTableLocation -> Bool
<= :: ConInfoTableLocation -> ConInfoTableLocation -> Bool
$c> :: ConInfoTableLocation -> ConInfoTableLocation -> Bool
> :: ConInfoTableLocation -> ConInfoTableLocation -> Bool
$c>= :: ConInfoTableLocation -> ConInfoTableLocation -> Bool
>= :: ConInfoTableLocation -> ConInfoTableLocation -> Bool
$cmax :: ConInfoTableLocation
-> ConInfoTableLocation -> ConInfoTableLocation
max :: ConInfoTableLocation
-> ConInfoTableLocation -> ConInfoTableLocation
$cmin :: ConInfoTableLocation
-> ConInfoTableLocation -> ConInfoTableLocation
min :: ConInfoTableLocation
-> ConInfoTableLocation -> ConInfoTableLocation
Ord)
instance Outputable ConInfoTableLocation where
ppr :: ConInfoTableLocation -> SDoc
ppr (UsageSite Module
m Int
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Loc(" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"):" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m
ppr ConInfoTableLocation
DefinitionSite = SDoc
forall doc. IsOutput doc => doc
empty
getConInfoTableLocation :: IdLabelInfo -> Maybe ConInfoTableLocation
getConInfoTableLocation :: IdLabelInfo -> Maybe ConInfoTableLocation
getConInfoTableLocation (ConInfoTable ConInfoTableLocation
ci) = ConInfoTableLocation -> Maybe ConInfoTableLocation
forall a. a -> Maybe a
Just ConInfoTableLocation
ci
getConInfoTableLocation IdLabelInfo
_ = Maybe ConInfoTableLocation
forall a. Maybe a
Nothing
instance Outputable IdLabelInfo where
ppr :: IdLabelInfo -> SDoc
ppr IdLabelInfo
Closure = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Closure"
ppr IdLabelInfo
InfoTable = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"InfoTable"
ppr IdLabelInfo
Entry = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Entry"
ppr IdLabelInfo
Slow = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Slow"
ppr IdLabelInfo
LocalInfoTable = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LocalInfoTable"
ppr IdLabelInfo
LocalEntry = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LocalEntry"
ppr (ConEntry ConInfoTableLocation
mn) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ConEntry" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ConInfoTableLocation -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConInfoTableLocation
mn
ppr (ConInfoTable ConInfoTableLocation
mn) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ConInfoTable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ConInfoTableLocation -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConInfoTableLocation
mn
ppr IdLabelInfo
ClosureTable = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ClosureTable"
ppr IdLabelInfo
Bytes = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Bytes"
ppr IdLabelInfo
BlockInfoTable = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"BlockInfoTable"
ppr (IdTickyInfo TickyIdInfo
info) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"IdTickyInfo" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TickyIdInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr TickyIdInfo
info
data RtsLabelInfo
= RtsSelectorInfoTable Bool Int
| RtsSelectorEntry Bool Int
| RtsApInfoTable Bool Int
| RtsApEntry Bool Int
| RtsUnpackCStringInfoTable
| RtsUnpackCStringUtf8InfoTable
| RtsPrimOp PrimOp
| RtsApFast NonDetFastString
| RtsSlowFastTickyCtr String
deriving (RtsLabelInfo -> RtsLabelInfo -> Bool
(RtsLabelInfo -> RtsLabelInfo -> Bool)
-> (RtsLabelInfo -> RtsLabelInfo -> Bool) -> Eq RtsLabelInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RtsLabelInfo -> RtsLabelInfo -> Bool
== :: RtsLabelInfo -> RtsLabelInfo -> Bool
$c/= :: RtsLabelInfo -> RtsLabelInfo -> Bool
/= :: RtsLabelInfo -> RtsLabelInfo -> Bool
Eq,Eq RtsLabelInfo
Eq RtsLabelInfo =>
(RtsLabelInfo -> RtsLabelInfo -> Ordering)
-> (RtsLabelInfo -> RtsLabelInfo -> Bool)
-> (RtsLabelInfo -> RtsLabelInfo -> Bool)
-> (RtsLabelInfo -> RtsLabelInfo -> Bool)
-> (RtsLabelInfo -> RtsLabelInfo -> Bool)
-> (RtsLabelInfo -> RtsLabelInfo -> RtsLabelInfo)
-> (RtsLabelInfo -> RtsLabelInfo -> RtsLabelInfo)
-> Ord RtsLabelInfo
RtsLabelInfo -> RtsLabelInfo -> Bool
RtsLabelInfo -> RtsLabelInfo -> Ordering
RtsLabelInfo -> RtsLabelInfo -> RtsLabelInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RtsLabelInfo -> RtsLabelInfo -> Ordering
compare :: RtsLabelInfo -> RtsLabelInfo -> Ordering
$c< :: RtsLabelInfo -> RtsLabelInfo -> Bool
< :: RtsLabelInfo -> RtsLabelInfo -> Bool
$c<= :: RtsLabelInfo -> RtsLabelInfo -> Bool
<= :: RtsLabelInfo -> RtsLabelInfo -> Bool
$c> :: RtsLabelInfo -> RtsLabelInfo -> Bool
> :: RtsLabelInfo -> RtsLabelInfo -> Bool
$c>= :: RtsLabelInfo -> RtsLabelInfo -> Bool
>= :: RtsLabelInfo -> RtsLabelInfo -> Bool
$cmax :: RtsLabelInfo -> RtsLabelInfo -> RtsLabelInfo
max :: RtsLabelInfo -> RtsLabelInfo -> RtsLabelInfo
$cmin :: RtsLabelInfo -> RtsLabelInfo -> RtsLabelInfo
min :: RtsLabelInfo -> RtsLabelInfo -> RtsLabelInfo
Ord)
data CmmLabelInfo
= CmmInfo
| CmmEntry
| CmmRetInfo
| CmmRet
| CmmData
| CmmCode
| CmmClosure
| CmmPrimCall
deriving (CmmLabelInfo -> CmmLabelInfo -> Bool
(CmmLabelInfo -> CmmLabelInfo -> Bool)
-> (CmmLabelInfo -> CmmLabelInfo -> Bool) -> Eq CmmLabelInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmmLabelInfo -> CmmLabelInfo -> Bool
== :: CmmLabelInfo -> CmmLabelInfo -> Bool
$c/= :: CmmLabelInfo -> CmmLabelInfo -> Bool
/= :: CmmLabelInfo -> CmmLabelInfo -> Bool
Eq, Eq CmmLabelInfo
Eq CmmLabelInfo =>
(CmmLabelInfo -> CmmLabelInfo -> Ordering)
-> (CmmLabelInfo -> CmmLabelInfo -> Bool)
-> (CmmLabelInfo -> CmmLabelInfo -> Bool)
-> (CmmLabelInfo -> CmmLabelInfo -> Bool)
-> (CmmLabelInfo -> CmmLabelInfo -> Bool)
-> (CmmLabelInfo -> CmmLabelInfo -> CmmLabelInfo)
-> (CmmLabelInfo -> CmmLabelInfo -> CmmLabelInfo)
-> Ord CmmLabelInfo
CmmLabelInfo -> CmmLabelInfo -> Bool
CmmLabelInfo -> CmmLabelInfo -> Ordering
CmmLabelInfo -> CmmLabelInfo -> CmmLabelInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CmmLabelInfo -> CmmLabelInfo -> Ordering
compare :: CmmLabelInfo -> CmmLabelInfo -> Ordering
$c< :: CmmLabelInfo -> CmmLabelInfo -> Bool
< :: CmmLabelInfo -> CmmLabelInfo -> Bool
$c<= :: CmmLabelInfo -> CmmLabelInfo -> Bool
<= :: CmmLabelInfo -> CmmLabelInfo -> Bool
$c> :: CmmLabelInfo -> CmmLabelInfo -> Bool
> :: CmmLabelInfo -> CmmLabelInfo -> Bool
$c>= :: CmmLabelInfo -> CmmLabelInfo -> Bool
>= :: CmmLabelInfo -> CmmLabelInfo -> Bool
$cmax :: CmmLabelInfo -> CmmLabelInfo -> CmmLabelInfo
max :: CmmLabelInfo -> CmmLabelInfo -> CmmLabelInfo
$cmin :: CmmLabelInfo -> CmmLabelInfo -> CmmLabelInfo
min :: CmmLabelInfo -> CmmLabelInfo -> CmmLabelInfo
Ord)
data DynamicLinkerLabelInfo
= CodeStub
| SymbolPtr
| GotSymbolPtr
| GotSymbolOffset
deriving (DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
(DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool)
-> (DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool)
-> Eq DynamicLinkerLabelInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
== :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
$c/= :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
/= :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
Eq, Eq DynamicLinkerLabelInfo
Eq DynamicLinkerLabelInfo =>
(DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Ordering)
-> (DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool)
-> (DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool)
-> (DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool)
-> (DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool)
-> (DynamicLinkerLabelInfo
-> DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo)
-> (DynamicLinkerLabelInfo
-> DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo)
-> Ord DynamicLinkerLabelInfo
DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Ordering
DynamicLinkerLabelInfo
-> DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Ordering
compare :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Ordering
$c< :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
< :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
$c<= :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
<= :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
$c> :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
> :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
$c>= :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
>= :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
$cmax :: DynamicLinkerLabelInfo
-> DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo
max :: DynamicLinkerLabelInfo
-> DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo
$cmin :: DynamicLinkerLabelInfo
-> DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo
min :: DynamicLinkerLabelInfo
-> DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo
Ord)
mkSRTLabel :: Unique -> CLabel
mkSRTLabel :: Unique -> CLabel
mkSRTLabel Unique
u = Unique -> CLabel
SRTLabel Unique
u
mkRednCountsLabel :: Name -> CLabel
mkRednCountsLabel :: Name -> CLabel
mkRednCountsLabel Name
name = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
NoCafRefs (TickyIdInfo -> IdLabelInfo
IdTickyInfo TickyIdInfo
TickyRednCounts)
mkTagHitLabel :: Name -> Unique -> CLabel
mkTagHitLabel :: Name -> Unique -> CLabel
mkTagHitLabel Name
name !Unique
uniq = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
NoCafRefs (TickyIdInfo -> IdLabelInfo
IdTickyInfo (Unique -> TickyIdInfo
TickyInferedTag Unique
uniq))
mkClosureLabel :: Name -> CafInfo -> CLabel
mkInfoTableLabel :: Name -> CafInfo -> CLabel
mkEntryLabel :: Name -> CafInfo -> CLabel
mkClosureTableLabel :: Name -> CafInfo -> CLabel
mkConInfoTableLabel :: Name -> ConInfoTableLocation -> CLabel
mkBytesLabel :: Name -> CLabel
mkClosureLabel :: Name -> CafInfo -> CLabel
mkClosureLabel Name
name CafInfo
c = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
c IdLabelInfo
Closure
mkInfoTableLabel :: Name -> CafInfo -> CLabel
mkInfoTableLabel Name
name CafInfo
c
| Name -> Bool
isExternalName Name
name = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
c IdLabelInfo
InfoTable
| Bool
otherwise = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
c IdLabelInfo
LocalInfoTable
mkEntryLabel :: Name -> CafInfo -> CLabel
mkEntryLabel Name
name CafInfo
c = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
c IdLabelInfo
Entry
mkClosureTableLabel :: Name -> CafInfo -> CLabel
mkClosureTableLabel Name
name CafInfo
c = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
c IdLabelInfo
ClosureTable
mkConInfoTableLabel :: Name -> ConInfoTableLocation -> CLabel
mkConInfoTableLabel Name
name ConInfoTableLocation
DefinitionSite = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
NoCafRefs (ConInfoTableLocation -> IdLabelInfo
ConInfoTable ConInfoTableLocation
DefinitionSite)
mkConInfoTableLabel Name
name ConInfoTableLocation
k = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
NoCafRefs (ConInfoTableLocation -> IdLabelInfo
ConInfoTable ConInfoTableLocation
k)
mkBytesLabel :: Name -> CLabel
mkBytesLabel Name
name = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
NoCafRefs IdLabelInfo
Bytes
mkBlockInfoTableLabel :: Name -> CafInfo -> CLabel
mkBlockInfoTableLabel :: Name -> CafInfo -> CLabel
mkBlockInfoTableLabel Name
name CafInfo
c = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
c IdLabelInfo
BlockInfoTable
mkDirty_MUT_VAR_Label,
mkNonmovingWriteBarrierEnabledLabel,
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,
mkOutOfBoundsAccessLabel, mkMemcpyRangeOverlapLabel,
mkMUT_VAR_CLEAN_infoLabel :: CLabel
mkDirty_MUT_VAR_Label :: CLabel
mkDirty_MUT_VAR_Label = FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel (String -> FastString
fsLit String
"dirty_MUT_VAR") Maybe Int
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInExternalPackage FunctionOrData
IsFunction
mkNonmovingWriteBarrierEnabledLabel :: CLabel
mkNonmovingWriteBarrierEnabledLabel
= UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"nonmoving_write_barrier_enabled") CmmLabelInfo
CmmData
mkUpdInfoLabel :: CLabel
mkUpdInfoLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_upd_frame") CmmLabelInfo
CmmInfo
mkBHUpdInfoLabel :: CLabel
mkBHUpdInfoLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_bh_upd_frame" ) CmmLabelInfo
CmmInfo
mkIndStaticInfoLabel :: CLabel
mkIndStaticInfoLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_IND_STATIC") CmmLabelInfo
CmmInfo
mkMainCapabilityLabel :: CLabel
mkMainCapabilityLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"MainCapability") CmmLabelInfo
CmmData
mkMAP_FROZEN_CLEAN_infoLabel :: CLabel
mkMAP_FROZEN_CLEAN_infoLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_MUT_ARR_PTRS_FROZEN_CLEAN") CmmLabelInfo
CmmInfo
mkMAP_FROZEN_DIRTY_infoLabel :: CLabel
mkMAP_FROZEN_DIRTY_infoLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_MUT_ARR_PTRS_FROZEN_DIRTY") CmmLabelInfo
CmmInfo
mkMAP_DIRTY_infoLabel :: CLabel
mkMAP_DIRTY_infoLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_MUT_ARR_PTRS_DIRTY") CmmLabelInfo
CmmInfo
mkTopTickyCtrLabel :: CLabel
mkTopTickyCtrLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"top_ct") CmmLabelInfo
CmmData
mkCAFBlackHoleInfoTableLabel :: CLabel
mkCAFBlackHoleInfoTableLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_CAF_BLACKHOLE") CmmLabelInfo
CmmInfo
mkArrWords_infoLabel :: CLabel
mkArrWords_infoLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_ARR_WORDS") CmmLabelInfo
CmmInfo
mkSMAP_FROZEN_CLEAN_infoLabel :: CLabel
mkSMAP_FROZEN_CLEAN_infoLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") CmmLabelInfo
CmmInfo
mkSMAP_FROZEN_DIRTY_infoLabel :: CLabel
mkSMAP_FROZEN_DIRTY_infoLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmLabelInfo
CmmInfo
mkSMAP_DIRTY_infoLabel :: CLabel
mkSMAP_DIRTY_infoLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmLabelInfo
CmmInfo
mkBadAlignmentLabel :: CLabel
mkBadAlignmentLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_badAlignment") CmmLabelInfo
CmmEntry
mkOutOfBoundsAccessLabel :: CLabel
mkOutOfBoundsAccessLabel = FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel (String -> FastString
fsLit String
"rtsOutOfBoundsAccess") Maybe Int
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInExternalPackage FunctionOrData
IsFunction
mkMemcpyRangeOverlapLabel :: CLabel
mkMemcpyRangeOverlapLabel = FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel (String -> FastString
fsLit String
"rtsMemcpyRangeOverlap") Maybe Int
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInExternalPackage FunctionOrData
IsFunction
mkMUT_VAR_CLEAN_infoLabel :: CLabel
mkMUT_VAR_CLEAN_infoLabel = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) (String -> FastString
fsLit String
"stg_MUT_VAR_CLEAN") CmmLabelInfo
CmmInfo
mkSRTInfoLabel :: Int -> CLabel
mkSRTInfoLabel :: Int -> CLabel
mkSRTInfoLabel Int
n = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) FastString
lbl CmmLabelInfo
CmmInfo
where
lbl :: FastString
lbl =
case Int
n of
Int
1 -> String -> FastString
fsLit String
"stg_SRT_1"
Int
2 -> String -> FastString
fsLit String
"stg_SRT_2"
Int
3 -> String -> FastString
fsLit String
"stg_SRT_3"
Int
4 -> String -> FastString
fsLit String
"stg_SRT_4"
Int
5 -> String -> FastString
fsLit String
"stg_SRT_5"
Int
6 -> String -> FastString
fsLit String
"stg_SRT_6"
Int
7 -> String -> FastString
fsLit String
"stg_SRT_7"
Int
8 -> String -> FastString
fsLit String
"stg_SRT_8"
Int
9 -> String -> FastString
fsLit String
"stg_SRT_9"
Int
10 -> String -> FastString
fsLit String
"stg_SRT_10"
Int
11 -> String -> FastString
fsLit String
"stg_SRT_11"
Int
12 -> String -> FastString
fsLit String
"stg_SRT_12"
Int
13 -> String -> FastString
fsLit String
"stg_SRT_13"
Int
14 -> String -> FastString
fsLit String
"stg_SRT_14"
Int
15 -> String -> FastString
fsLit String
"stg_SRT_15"
Int
16 -> String -> FastString
fsLit String
"stg_SRT_16"
Int
_ -> String -> FastString
forall a. HasCallStack => String -> a
panic String
"mkSRTInfoLabel"
mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
mkCmmCodeLabel, mkCmmClosureLabel
:: UnitId -> FastString -> CLabel
mkCmmDataLabel :: UnitId -> NeedExternDecl -> FastString -> CLabel
mkRtsCmmDataLabel :: FastString -> CLabel
mkCmmInfoLabel :: UnitId -> FastString -> CLabel
mkCmmInfoLabel UnitId
pkg FastString
str = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
pkg (Bool -> NeedExternDecl
NeedExternDecl Bool
True) FastString
str CmmLabelInfo
CmmInfo
mkCmmEntryLabel :: UnitId -> FastString -> CLabel
mkCmmEntryLabel UnitId
pkg FastString
str = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
pkg (Bool -> NeedExternDecl
NeedExternDecl Bool
True) FastString
str CmmLabelInfo
CmmEntry
mkCmmRetInfoLabel :: UnitId -> FastString -> CLabel
mkCmmRetInfoLabel UnitId
pkg FastString
str = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
pkg (Bool -> NeedExternDecl
NeedExternDecl Bool
True) FastString
str CmmLabelInfo
CmmRetInfo
mkCmmRetLabel :: UnitId -> FastString -> CLabel
mkCmmRetLabel UnitId
pkg FastString
str = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
pkg (Bool -> NeedExternDecl
NeedExternDecl Bool
True) FastString
str CmmLabelInfo
CmmRet
mkCmmCodeLabel :: UnitId -> FastString -> CLabel
mkCmmCodeLabel UnitId
pkg FastString
str = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
pkg (Bool -> NeedExternDecl
NeedExternDecl Bool
True) FastString
str CmmLabelInfo
CmmCode
mkCmmClosureLabel :: UnitId -> FastString -> CLabel
mkCmmClosureLabel UnitId
pkg FastString
str = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
pkg (Bool -> NeedExternDecl
NeedExternDecl Bool
True) FastString
str CmmLabelInfo
CmmClosure
mkCmmDataLabel :: UnitId -> NeedExternDecl -> FastString -> CLabel
mkCmmDataLabel UnitId
pkg NeedExternDecl
ext FastString
str = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
pkg NeedExternDecl
ext FastString
str CmmLabelInfo
CmmData
mkRtsCmmDataLabel :: FastString -> CLabel
mkRtsCmmDataLabel FastString
str = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
rtsUnitId (Bool -> NeedExternDecl
NeedExternDecl Bool
False) FastString
str CmmLabelInfo
CmmData
mkLocalBlockLabel :: Unique -> CLabel
mkLocalBlockLabel :: Unique -> CLabel
mkLocalBlockLabel Unique
u = Unique -> CLabel
LocalBlockLabel Unique
u
mkRtsPrimOpLabel :: PrimOp -> CLabel
mkRtsPrimOpLabel :: PrimOp -> CLabel
mkRtsPrimOpLabel PrimOp
primop = RtsLabelInfo -> CLabel
RtsLabel (PrimOp -> RtsLabelInfo
RtsPrimOp PrimOp
primop)
mkSelectorInfoLabel :: Platform -> Bool -> Int -> CLabel
mkSelectorInfoLabel :: Platform -> Bool -> Int -> CLabel
mkSelectorInfoLabel Platform
platform Bool
upd Int
offset =
Bool -> CLabel -> CLabel
forall a. HasCallStack => Bool -> a -> a
assert (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= PlatformConstants -> Int
pc_MAX_SPEC_SELECTEE_SIZE (Platform -> PlatformConstants
platformConstants Platform
platform)) (CLabel -> CLabel) -> CLabel -> CLabel
forall a b. (a -> b) -> a -> b
$
RtsLabelInfo -> CLabel
RtsLabel (Bool -> Int -> RtsLabelInfo
RtsSelectorInfoTable Bool
upd Int
offset)
mkSelectorEntryLabel :: Platform -> Bool -> Int -> CLabel
mkSelectorEntryLabel :: Platform -> Bool -> Int -> CLabel
mkSelectorEntryLabel Platform
platform Bool
upd Int
offset =
Bool -> CLabel -> CLabel
forall a. HasCallStack => Bool -> a -> a
assert (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= PlatformConstants -> Int
pc_MAX_SPEC_SELECTEE_SIZE (Platform -> PlatformConstants
platformConstants Platform
platform)) (CLabel -> CLabel) -> CLabel -> CLabel
forall a b. (a -> b) -> a -> b
$
RtsLabelInfo -> CLabel
RtsLabel (Bool -> Int -> RtsLabelInfo
RtsSelectorEntry Bool
upd Int
offset)
mkApInfoTableLabel :: Platform -> Bool -> Int -> CLabel
mkApInfoTableLabel :: Platform -> Bool -> Int -> CLabel
mkApInfoTableLabel Platform
platform Bool
upd Int
arity =
Bool -> CLabel -> CLabel
forall a. HasCallStack => Bool -> a -> a
assert (Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= PlatformConstants -> Int
pc_MAX_SPEC_AP_SIZE (Platform -> PlatformConstants
platformConstants Platform
platform)) (CLabel -> CLabel) -> CLabel -> CLabel
forall a b. (a -> b) -> a -> b
$
RtsLabelInfo -> CLabel
RtsLabel (Bool -> Int -> RtsLabelInfo
RtsApInfoTable Bool
upd Int
arity)
mkApEntryLabel :: Platform -> Bool -> Int -> CLabel
mkApEntryLabel :: Platform -> Bool -> Int -> CLabel
mkApEntryLabel Platform
platform Bool
upd Int
arity =
Bool -> CLabel -> CLabel
forall a. HasCallStack => Bool -> a -> a
assert (Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= PlatformConstants -> Int
pc_MAX_SPEC_AP_SIZE (Platform -> PlatformConstants
platformConstants Platform
platform)) (CLabel -> CLabel) -> CLabel -> CLabel
forall a b. (a -> b) -> a -> b
$
RtsLabelInfo -> CLabel
RtsLabel (Bool -> Int -> RtsLabelInfo
RtsApEntry Bool
upd Int
arity)
mkPrimCallLabel :: PrimCall -> CLabel
mkPrimCallLabel :: PrimCall -> CLabel
mkPrimCallLabel (PrimCall FastString
str GenUnit UnitId
pkg)
= UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel (GenUnit UnitId -> UnitId
toUnitId GenUnit UnitId
pkg) (Bool -> NeedExternDecl
NeedExternDecl Bool
True) FastString
str CmmLabelInfo
CmmPrimCall
mkForeignLabel
:: FastString
-> Maybe Int
-> ForeignLabelSource
-> FunctionOrData
-> CLabel
mkForeignLabel :: FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel = FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
ForeignLabel
addLabelSize :: CLabel -> Int -> CLabel
addLabelSize :: CLabel -> Int -> CLabel
addLabelSize (ForeignLabel FastString
str Maybe Int
_ ForeignLabelSource
src FunctionOrData
fod) Int
sz
= FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
ForeignLabel FastString
str (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
sz) ForeignLabelSource
src FunctionOrData
fod
addLabelSize CLabel
label Int
_
= CLabel
label
isBytesLabel :: CLabel -> Bool
isBytesLabel :: CLabel -> Bool
isBytesLabel (IdLabel Name
_ CafInfo
_ IdLabelInfo
Bytes) = Bool
True
isBytesLabel CLabel
_lbl = Bool
False
isForeignLabel :: CLabel -> Bool
isForeignLabel :: CLabel -> Bool
isForeignLabel (ForeignLabel FastString
_ Maybe Int
_ ForeignLabelSource
_ FunctionOrData
_) = Bool
True
isForeignLabel CLabel
_lbl = Bool
False
isStaticClosureLabel :: CLabel -> Bool
isStaticClosureLabel :: CLabel -> Bool
isStaticClosureLabel (IdLabel Name
_ CafInfo
_ IdLabelInfo
Closure) = Bool
True
isStaticClosureLabel (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmClosure) = Bool
True
isStaticClosureLabel CLabel
_lbl = Bool
False
isSomeRODataLabel :: CLabel -> Bool
isSomeRODataLabel :: CLabel -> Bool
isSomeRODataLabel (IdLabel Name
_ CafInfo
_ IdLabelInfo
ClosureTable) = Bool
True
isSomeRODataLabel (IdLabel Name
_ CafInfo
_ ConInfoTable {}) = Bool
True
isSomeRODataLabel (IdLabel Name
_ CafInfo
_ IdLabelInfo
InfoTable) = Bool
True
isSomeRODataLabel (IdLabel Name
_ CafInfo
_ IdLabelInfo
LocalInfoTable) = Bool
True
isSomeRODataLabel (IdLabel Name
_ CafInfo
_ IdLabelInfo
BlockInfoTable) = Bool
True
isSomeRODataLabel (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmInfo) = Bool
True
isSomeRODataLabel CLabel
_lbl = Bool
False
isInfoTableLabel :: CLabel -> Bool
isInfoTableLabel :: CLabel -> Bool
isInfoTableLabel (IdLabel Name
_ CafInfo
_ IdLabelInfo
InfoTable) = Bool
True
isInfoTableLabel (IdLabel Name
_ CafInfo
_ IdLabelInfo
LocalInfoTable) = Bool
True
isInfoTableLabel (IdLabel Name
_ CafInfo
_ ConInfoTable {}) = Bool
True
isInfoTableLabel (IdLabel Name
_ CafInfo
_ IdLabelInfo
BlockInfoTable) = Bool
True
isInfoTableLabel (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmInfo) = Bool
True
isInfoTableLabel CLabel
_ = Bool
False
isCmmInfoTableLabel :: CLabel -> Bool
isCmmInfoTableLabel :: CLabel -> Bool
isCmmInfoTableLabel (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmInfo) = Bool
True
isCmmInfoTableLabel CLabel
_ = Bool
False
isConInfoTableLabel :: CLabel -> Bool
isConInfoTableLabel :: CLabel -> Bool
isConInfoTableLabel (IdLabel Name
_ CafInfo
_ ConInfoTable {}) = Bool
True
isConInfoTableLabel CLabel
_ = Bool
False
foreignLabelStdcallInfo :: CLabel -> Maybe Int
foreignLabelStdcallInfo :: CLabel -> Maybe Int
foreignLabelStdcallInfo (ForeignLabel FastString
_ Maybe Int
info ForeignLabelSource
_ FunctionOrData
_) = Maybe Int
info
foreignLabelStdcallInfo CLabel
_lbl = Maybe Int
forall a. Maybe a
Nothing
mkBitmapLabel :: Unique -> CLabel
mkBitmapLabel :: Unique -> CLabel
mkBitmapLabel Unique
uniq = Unique -> CLabel
LargeBitmapLabel Unique
uniq
data InfoProvEnt = InfoProvEnt
{ InfoProvEnt -> CLabel
infoTablePtr :: !CLabel
, InfoProvEnt -> Int
infoProvEntClosureType :: !Int
, InfoProvEnt -> String
infoTableType :: !String
, InfoProvEnt -> Module
infoProvModule :: !Module
, InfoProvEnt -> Maybe (RealSrcSpan, String)
infoTableProv :: !(Maybe (RealSrcSpan, String)) }
deriving (InfoProvEnt -> InfoProvEnt -> Bool
(InfoProvEnt -> InfoProvEnt -> Bool)
-> (InfoProvEnt -> InfoProvEnt -> Bool) -> Eq InfoProvEnt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InfoProvEnt -> InfoProvEnt -> Bool
== :: InfoProvEnt -> InfoProvEnt -> Bool
$c/= :: InfoProvEnt -> InfoProvEnt -> Bool
/= :: InfoProvEnt -> InfoProvEnt -> Bool
Eq, Eq InfoProvEnt
Eq InfoProvEnt =>
(InfoProvEnt -> InfoProvEnt -> Ordering)
-> (InfoProvEnt -> InfoProvEnt -> Bool)
-> (InfoProvEnt -> InfoProvEnt -> Bool)
-> (InfoProvEnt -> InfoProvEnt -> Bool)
-> (InfoProvEnt -> InfoProvEnt -> Bool)
-> (InfoProvEnt -> InfoProvEnt -> InfoProvEnt)
-> (InfoProvEnt -> InfoProvEnt -> InfoProvEnt)
-> Ord InfoProvEnt
InfoProvEnt -> InfoProvEnt -> Bool
InfoProvEnt -> InfoProvEnt -> Ordering
InfoProvEnt -> InfoProvEnt -> InfoProvEnt
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InfoProvEnt -> InfoProvEnt -> Ordering
compare :: InfoProvEnt -> InfoProvEnt -> Ordering
$c< :: InfoProvEnt -> InfoProvEnt -> Bool
< :: InfoProvEnt -> InfoProvEnt -> Bool
$c<= :: InfoProvEnt -> InfoProvEnt -> Bool
<= :: InfoProvEnt -> InfoProvEnt -> Bool
$c> :: InfoProvEnt -> InfoProvEnt -> Bool
> :: InfoProvEnt -> InfoProvEnt -> Bool
$c>= :: InfoProvEnt -> InfoProvEnt -> Bool
>= :: InfoProvEnt -> InfoProvEnt -> Bool
$cmax :: InfoProvEnt -> InfoProvEnt -> InfoProvEnt
max :: InfoProvEnt -> InfoProvEnt -> InfoProvEnt
$cmin :: InfoProvEnt -> InfoProvEnt -> InfoProvEnt
min :: InfoProvEnt -> InfoProvEnt -> InfoProvEnt
Ord)
instance OutputableP Platform InfoProvEnt where
pdoc :: Platform -> InfoProvEnt -> SDoc
pdoc Platform
platform (InfoProvEnt CLabel
clabel Int
_ String
_ Module
_ Maybe (RealSrcSpan, String)
_) = Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
clabel
mkCCLabel :: CostCentre -> CLabel
mkCCSLabel :: CostCentreStack -> CLabel
mkIPELabel :: Module -> CLabel
mkCCLabel :: CostCentre -> CLabel
mkCCLabel CostCentre
cc = CostCentre -> CLabel
CC_Label CostCentre
cc
mkCCSLabel :: CostCentreStack -> CLabel
mkCCSLabel CostCentreStack
ccs = CostCentreStack -> CLabel
CCS_Label CostCentreStack
ccs
mkIPELabel :: Module -> CLabel
mkIPELabel Module
mod = Module -> ModuleLabelKind -> CLabel
ModuleLabel Module
mod ModuleLabelKind
MLK_IPEBuffer
mkRtsApFastLabel :: FastString -> CLabel
mkRtsApFastLabel :: FastString -> CLabel
mkRtsApFastLabel FastString
str = RtsLabelInfo -> CLabel
RtsLabel (NonDetFastString -> RtsLabelInfo
RtsApFast (FastString -> NonDetFastString
NonDetFastString FastString
str))
mkRtsSlowFastTickyCtrLabel :: String -> CLabel
mkRtsSlowFastTickyCtrLabel :: String -> CLabel
mkRtsSlowFastTickyCtrLabel String
pat = RtsLabelInfo -> CLabel
RtsLabel (String -> RtsLabelInfo
RtsSlowFastTickyCtr String
pat)
mkRtsUnpackCStringLabel, mkRtsUnpackCStringUtf8Label :: CLabel
mkRtsUnpackCStringLabel :: CLabel
mkRtsUnpackCStringLabel = RtsLabelInfo -> CLabel
RtsLabel RtsLabelInfo
RtsUnpackCStringInfoTable
mkRtsUnpackCStringUtf8Label :: CLabel
mkRtsUnpackCStringUtf8Label = RtsLabelInfo -> CLabel
RtsLabel RtsLabelInfo
RtsUnpackCStringUtf8InfoTable
mkHpcTicksLabel :: Module -> CLabel
mkHpcTicksLabel :: Module -> CLabel
mkHpcTicksLabel = Module -> CLabel
HpcTicksLabel
mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel = DynamicLinkerLabelInfo -> CLabel -> CLabel
DynamicLinkerLabel
dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo (DynamicLinkerLabel DynamicLinkerLabelInfo
info CLabel
lbl) = (DynamicLinkerLabelInfo, CLabel)
-> Maybe (DynamicLinkerLabelInfo, CLabel)
forall a. a -> Maybe a
Just (DynamicLinkerLabelInfo
info, CLabel
lbl)
dynamicLinkerLabelInfo CLabel
_ = Maybe (DynamicLinkerLabelInfo, CLabel)
forall a. Maybe a
Nothing
mkPicBaseLabel :: CLabel
mkPicBaseLabel :: CLabel
mkPicBaseLabel = CLabel
PicBaseLabel
mkDeadStripPreventer :: CLabel -> CLabel
mkDeadStripPreventer :: CLabel -> CLabel
mkDeadStripPreventer CLabel
lbl = CLabel -> CLabel
DeadStripPreventer CLabel
lbl
mkStringLitLabel :: Unique -> CLabel
mkStringLitLabel :: Unique -> CLabel
mkStringLitLabel = Unique -> CLabel
StringLitLabel
mkInitializerStubLabel :: Module -> FastString -> CLabel
mkInitializerStubLabel :: Module -> FastString -> CLabel
mkInitializerStubLabel Module
mod FastString
s = Module -> ModuleLabelKind -> CLabel
ModuleLabel Module
mod (LexicalFastString -> ModuleLabelKind
MLK_Initializer (FastString -> LexicalFastString
LexicalFastString FastString
s))
mkInitializerArrayLabel :: Module -> CLabel
mkInitializerArrayLabel :: Module -> CLabel
mkInitializerArrayLabel Module
mod = Module -> ModuleLabelKind -> CLabel
ModuleLabel Module
mod ModuleLabelKind
MLK_InitializerArray
mkFinalizerStubLabel :: Module -> FastString -> CLabel
mkFinalizerStubLabel :: Module -> FastString -> CLabel
mkFinalizerStubLabel Module
mod FastString
s = Module -> ModuleLabelKind -> CLabel
ModuleLabel Module
mod (LexicalFastString -> ModuleLabelKind
MLK_Finalizer (FastString -> LexicalFastString
LexicalFastString FastString
s))
mkFinalizerArrayLabel :: Module -> CLabel
mkFinalizerArrayLabel :: Module -> CLabel
mkFinalizerArrayLabel Module
mod = Module -> ModuleLabelKind -> CLabel
ModuleLabel Module
mod ModuleLabelKind
MLK_FinalizerArray
mkAsmTempLabel :: Uniquable a => a -> CLabel
mkAsmTempLabel :: forall a. Uniquable a => a -> CLabel
mkAsmTempLabel a
a = Unique -> CLabel
AsmTempLabel (a -> Unique
forall a. Uniquable a => a -> Unique
getUnique a
a)
mkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel = CLabel -> FastString -> CLabel
AsmTempDerivedLabel
mkAsmTempEndLabel :: CLabel -> CLabel
mkAsmTempEndLabel :: CLabel -> CLabel
mkAsmTempEndLabel CLabel
l = CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel CLabel
l (String -> FastString
fsLit String
"_end")
mkAsmTempProcEndLabel :: CLabel -> CLabel
mkAsmTempProcEndLabel :: CLabel -> CLabel
mkAsmTempProcEndLabel CLabel
l = CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel CLabel
l (String -> FastString
fsLit String
"_proc_end")
mkAsmTempDieLabel :: CLabel -> CLabel
mkAsmTempDieLabel :: CLabel -> CLabel
mkAsmTempDieLabel CLabel
l = CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel CLabel
l (String -> FastString
fsLit String
"_die")
toClosureLbl :: Platform -> CLabel -> CLabel
toClosureLbl :: Platform -> CLabel -> CLabel
toClosureLbl Platform
platform CLabel
lbl = case CLabel
lbl of
IdLabel Name
n CafInfo
c IdLabelInfo
_ -> Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
Closure
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
_ -> UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmClosure
CLabel
_ -> String -> SDoc -> CLabel
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"toClosureLbl" (Platform -> CLabel -> SDoc
pprDebugCLabel Platform
platform CLabel
lbl)
toSlowEntryLbl :: Platform -> CLabel -> CLabel
toSlowEntryLbl :: Platform -> CLabel -> CLabel
toSlowEntryLbl Platform
platform CLabel
lbl = case CLabel
lbl of
IdLabel Name
n CafInfo
_ IdLabelInfo
BlockInfoTable -> String -> SDoc -> CLabel
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"toSlowEntryLbl" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
IdLabel Name
n CafInfo
c IdLabelInfo
_ -> Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
Slow
CLabel
_ -> String -> SDoc -> CLabel
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"toSlowEntryLbl" (Platform -> CLabel -> SDoc
pprDebugCLabel Platform
platform CLabel
lbl)
toEntryLbl :: Platform -> CLabel -> CLabel
toEntryLbl :: Platform -> CLabel -> CLabel
toEntryLbl Platform
platform CLabel
lbl = case CLabel
lbl of
IdLabel Name
n CafInfo
c IdLabelInfo
LocalInfoTable -> Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
LocalEntry
IdLabel Name
n CafInfo
c (ConInfoTable ConInfoTableLocation
k) -> Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c (ConInfoTableLocation -> IdLabelInfo
ConEntry ConInfoTableLocation
k)
IdLabel Name
n CafInfo
_ IdLabelInfo
BlockInfoTable -> Unique -> CLabel
mkLocalBlockLabel (Name -> Unique
nameUnique Name
n)
IdLabel Name
n CafInfo
c IdLabelInfo
_ -> Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
Entry
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmInfo -> UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmEntry
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmRetInfo -> UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmRet
CLabel
_ -> String -> SDoc -> CLabel
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"toEntryLbl" (Platform -> CLabel -> SDoc
pprDebugCLabel Platform
platform CLabel
lbl)
toInfoLbl :: Platform -> CLabel -> CLabel
toInfoLbl :: Platform -> CLabel -> CLabel
toInfoLbl Platform
platform CLabel
lbl = case CLabel
lbl of
IdLabel Name
n CafInfo
c IdLabelInfo
LocalEntry -> Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
LocalInfoTable
IdLabel Name
n CafInfo
c (ConEntry ConInfoTableLocation
k) -> Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c (ConInfoTableLocation -> IdLabelInfo
ConInfoTable ConInfoTableLocation
k)
IdLabel Name
n CafInfo
c IdLabelInfo
_ -> Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
InfoTable
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmEntry -> UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmInfo
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmRet -> UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmRetInfo
CLabel
_ -> String -> SDoc -> CLabel
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"CLabel.toInfoLbl" (Platform -> CLabel -> SDoc
pprDebugCLabel Platform
platform CLabel
lbl)
hasHaskellName :: CLabel -> Maybe Name
hasHaskellName :: CLabel -> Maybe Name
hasHaskellName (IdLabel Name
n CafInfo
_ IdLabelInfo
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
hasHaskellName CLabel
_ = Maybe Name
forall a. Maybe a
Nothing
hasIdLabelInfo :: CLabel -> Maybe IdLabelInfo
hasIdLabelInfo :: CLabel -> Maybe IdLabelInfo
hasIdLabelInfo (IdLabel Name
_ CafInfo
_ IdLabelInfo
l) = IdLabelInfo -> Maybe IdLabelInfo
forall a. a -> Maybe a
Just IdLabelInfo
l
hasIdLabelInfo CLabel
_ = Maybe IdLabelInfo
forall a. Maybe a
Nothing
hasCAF :: CLabel -> Bool
hasCAF :: CLabel -> Bool
hasCAF (IdLabel Name
_ CafInfo
_ (IdTickyInfo TickyIdInfo
TickyRednCounts)) = Bool
False
hasCAF (IdLabel Name
_ CafInfo
MayHaveCafRefs IdLabelInfo
_) = Bool
True
hasCAF (RtsLabel RtsLabelInfo
RtsUnpackCStringInfoTable) = Bool
True
hasCAF (RtsLabel RtsLabelInfo
RtsUnpackCStringUtf8InfoTable) = Bool
True
hasCAF CLabel
_ = Bool
False
needsCDecl :: CLabel -> Bool
needsCDecl :: CLabel -> Bool
needsCDecl (SRTLabel Unique
_) = Bool
True
needsCDecl (LargeBitmapLabel Unique
_) = Bool
False
needsCDecl (IdLabel Name
_ CafInfo
_ IdLabelInfo
_) = Bool
True
needsCDecl (LocalBlockLabel Unique
_) = Bool
True
needsCDecl (StringLitLabel Unique
_) = Bool
False
needsCDecl (AsmTempLabel Unique
_) = Bool
False
needsCDecl (AsmTempDerivedLabel CLabel
_ FastString
_) = Bool
False
needsCDecl (RtsLabel RtsLabelInfo
_) = Bool
False
needsCDecl (CmmLabel UnitId
pkgId (NeedExternDecl Bool
external) FastString
_ CmmLabelInfo
_)
| Bool -> Bool
not Bool
external = Bool
False
| UnitId
pkgId UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
rtsUnitId = Bool
False
| Bool
otherwise = Bool
True
needsCDecl l :: CLabel
l@(ForeignLabel{}) = Bool -> Bool
not (CLabel -> Bool
isMathFun CLabel
l)
needsCDecl (CC_Label CostCentre
_) = Bool
True
needsCDecl (CCS_Label CostCentreStack
_) = Bool
True
needsCDecl (IPE_Label {}) = Bool
True
needsCDecl (ModuleLabel Module
_ ModuleLabelKind
kind) = ModuleLabelKind -> Bool
modLabelNeedsCDecl ModuleLabelKind
kind
needsCDecl (HpcTicksLabel Module
_) = Bool
True
needsCDecl (DynamicLinkerLabel {}) = String -> Bool
forall a. HasCallStack => String -> a
panic String
"needsCDecl DynamicLinkerLabel"
needsCDecl CLabel
PicBaseLabel = String -> Bool
forall a. HasCallStack => String -> a
panic String
"needsCDecl PicBaseLabel"
needsCDecl (DeadStripPreventer {}) = String -> Bool
forall a. HasCallStack => String -> a
panic String
"needsCDecl DeadStripPreventer"
modLabelNeedsCDecl :: ModuleLabelKind -> Bool
modLabelNeedsCDecl :: ModuleLabelKind -> Bool
modLabelNeedsCDecl (MLK_Initializer LexicalFastString
_) = Bool
True
modLabelNeedsCDecl (MLK_Finalizer LexicalFastString
_) = Bool
True
modLabelNeedsCDecl ModuleLabelKind
MLK_IPEBuffer = Bool
True
modLabelNeedsCDecl ModuleLabelKind
MLK_InitializerArray = Bool
False
modLabelNeedsCDecl ModuleLabelKind
MLK_FinalizerArray = Bool
False
maybeLocalBlockLabel :: CLabel -> Maybe BlockId
maybeLocalBlockLabel :: CLabel -> Maybe BlockId
maybeLocalBlockLabel (LocalBlockLabel Unique
uq) = BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just (BlockId -> Maybe BlockId) -> BlockId -> Maybe BlockId
forall a b. (a -> b) -> a -> b
$ Unique -> BlockId
mkBlockId Unique
uq
maybeLocalBlockLabel CLabel
_ = Maybe BlockId
forall a. Maybe a
Nothing
isMathFun :: CLabel -> Bool
isMathFun :: CLabel -> Bool
isMathFun (ForeignLabel FastString
fs Maybe Int
_ ForeignLabelSource
_ FunctionOrData
_) = FastString
fs FastString -> UniqSet FastString -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet` UniqSet FastString
math_funs
isMathFun CLabel
_ = Bool
False
math_funs :: UniqSet FastString
math_funs :: UniqSet FastString
math_funs = [FastString] -> UniqSet FastString
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet [
(String -> FastString
fsLit String
"acos"), (String -> FastString
fsLit String
"acosf"), (String -> FastString
fsLit String
"acosh"),
(String -> FastString
fsLit String
"acoshf"), (String -> FastString
fsLit String
"acoshl"), (String -> FastString
fsLit String
"acosl"),
(String -> FastString
fsLit String
"asin"), (String -> FastString
fsLit String
"asinf"), (String -> FastString
fsLit String
"asinl"),
(String -> FastString
fsLit String
"asinh"), (String -> FastString
fsLit String
"asinhf"), (String -> FastString
fsLit String
"asinhl"),
(String -> FastString
fsLit String
"atan"), (String -> FastString
fsLit String
"atanf"), (String -> FastString
fsLit String
"atanl"),
(String -> FastString
fsLit String
"atan2"), (String -> FastString
fsLit String
"atan2f"), (String -> FastString
fsLit String
"atan2l"),
(String -> FastString
fsLit String
"atanh"), (String -> FastString
fsLit String
"atanhf"), (String -> FastString
fsLit String
"atanhl"),
(String -> FastString
fsLit String
"cbrt"), (String -> FastString
fsLit String
"cbrtf"), (String -> FastString
fsLit String
"cbrtl"),
(String -> FastString
fsLit String
"ceil"), (String -> FastString
fsLit String
"ceilf"), (String -> FastString
fsLit String
"ceill"),
(String -> FastString
fsLit String
"copysign"), (String -> FastString
fsLit String
"copysignf"), (String -> FastString
fsLit String
"copysignl"),
(String -> FastString
fsLit String
"cos"), (String -> FastString
fsLit String
"cosf"), (String -> FastString
fsLit String
"cosl"),
(String -> FastString
fsLit String
"cosh"), (String -> FastString
fsLit String
"coshf"), (String -> FastString
fsLit String
"coshl"),
(String -> FastString
fsLit String
"erf"), (String -> FastString
fsLit String
"erff"), (String -> FastString
fsLit String
"erfl"),
(String -> FastString
fsLit String
"erfc"), (String -> FastString
fsLit String
"erfcf"), (String -> FastString
fsLit String
"erfcl"),
(String -> FastString
fsLit String
"exp"), (String -> FastString
fsLit String
"expf"), (String -> FastString
fsLit String
"expl"),
(String -> FastString
fsLit String
"exp2"), (String -> FastString
fsLit String
"exp2f"), (String -> FastString
fsLit String
"exp2l"),
(String -> FastString
fsLit String
"expm1"), (String -> FastString
fsLit String
"expm1f"), (String -> FastString
fsLit String
"expm1l"),
(String -> FastString
fsLit String
"fabs"), (String -> FastString
fsLit String
"fabsf"), (String -> FastString
fsLit String
"fabsl"),
(String -> FastString
fsLit String
"fdim"), (String -> FastString
fsLit String
"fdimf"), (String -> FastString
fsLit String
"fdiml"),
(String -> FastString
fsLit String
"floor"), (String -> FastString
fsLit String
"floorf"), (String -> FastString
fsLit String
"floorl"),
(String -> FastString
fsLit String
"fma"), (String -> FastString
fsLit String
"fmaf"), (String -> FastString
fsLit String
"fmal"),
(String -> FastString
fsLit String
"fmax"), (String -> FastString
fsLit String
"fmaxf"), (String -> FastString
fsLit String
"fmaxl"),
(String -> FastString
fsLit String
"fmin"), (String -> FastString
fsLit String
"fminf"), (String -> FastString
fsLit String
"fminl"),
(String -> FastString
fsLit String
"fmod"), (String -> FastString
fsLit String
"fmodf"), (String -> FastString
fsLit String
"fmodl"),
(String -> FastString
fsLit String
"frexp"), (String -> FastString
fsLit String
"frexpf"), (String -> FastString
fsLit String
"frexpl"),
(String -> FastString
fsLit String
"hypot"), (String -> FastString
fsLit String
"hypotf"), (String -> FastString
fsLit String
"hypotl"),
(String -> FastString
fsLit String
"ilogb"), (String -> FastString
fsLit String
"ilogbf"), (String -> FastString
fsLit String
"ilogbl"),
(String -> FastString
fsLit String
"ldexp"), (String -> FastString
fsLit String
"ldexpf"), (String -> FastString
fsLit String
"ldexpl"),
(String -> FastString
fsLit String
"lgamma"), (String -> FastString
fsLit String
"lgammaf"), (String -> FastString
fsLit String
"lgammal"),
(String -> FastString
fsLit String
"llrint"), (String -> FastString
fsLit String
"llrintf"), (String -> FastString
fsLit String
"llrintl"),
(String -> FastString
fsLit String
"llround"), (String -> FastString
fsLit String
"llroundf"), (String -> FastString
fsLit String
"llroundl"),
(String -> FastString
fsLit String
"log"), (String -> FastString
fsLit String
"logf"), (String -> FastString
fsLit String
"logl"),
(String -> FastString
fsLit String
"log10l"), (String -> FastString
fsLit String
"log10"), (String -> FastString
fsLit String
"log10f"),
(String -> FastString
fsLit String
"log1pl"), (String -> FastString
fsLit String
"log1p"), (String -> FastString
fsLit String
"log1pf"),
(String -> FastString
fsLit String
"log2"), (String -> FastString
fsLit String
"log2f"), (String -> FastString
fsLit String
"log2l"),
(String -> FastString
fsLit String
"logb"), (String -> FastString
fsLit String
"logbf"), (String -> FastString
fsLit String
"logbl"),
(String -> FastString
fsLit String
"lrint"), (String -> FastString
fsLit String
"lrintf"), (String -> FastString
fsLit String
"lrintl"),
(String -> FastString
fsLit String
"lround"), (String -> FastString
fsLit String
"lroundf"), (String -> FastString
fsLit String
"lroundl"),
(String -> FastString
fsLit String
"modf"), (String -> FastString
fsLit String
"modff"), (String -> FastString
fsLit String
"modfl"),
(String -> FastString
fsLit String
"nan"), (String -> FastString
fsLit String
"nanf"), (String -> FastString
fsLit String
"nanl"),
(String -> FastString
fsLit String
"nearbyint"), (String -> FastString
fsLit String
"nearbyintf"), (String -> FastString
fsLit String
"nearbyintl"),
(String -> FastString
fsLit String
"nextafter"), (String -> FastString
fsLit String
"nextafterf"), (String -> FastString
fsLit String
"nextafterl"),
(String -> FastString
fsLit String
"nexttoward"), (String -> FastString
fsLit String
"nexttowardf"), (String -> FastString
fsLit String
"nexttowardl"),
(String -> FastString
fsLit String
"pow"), (String -> FastString
fsLit String
"powf"), (String -> FastString
fsLit String
"powl"),
(String -> FastString
fsLit String
"remainder"), (String -> FastString
fsLit String
"remainderf"), (String -> FastString
fsLit String
"remainderl"),
(String -> FastString
fsLit String
"remquo"), (String -> FastString
fsLit String
"remquof"), (String -> FastString
fsLit String
"remquol"),
(String -> FastString
fsLit String
"rint"), (String -> FastString
fsLit String
"rintf"), (String -> FastString
fsLit String
"rintl"),
(String -> FastString
fsLit String
"round"), (String -> FastString
fsLit String
"roundf"), (String -> FastString
fsLit String
"roundl"),
(String -> FastString
fsLit String
"scalbln"), (String -> FastString
fsLit String
"scalblnf"), (String -> FastString
fsLit String
"scalblnl"),
(String -> FastString
fsLit String
"scalbn"), (String -> FastString
fsLit String
"scalbnf"), (String -> FastString
fsLit String
"scalbnl"),
(String -> FastString
fsLit String
"sin"), (String -> FastString
fsLit String
"sinf"), (String -> FastString
fsLit String
"sinl"),
(String -> FastString
fsLit String
"sinh"), (String -> FastString
fsLit String
"sinhf"), (String -> FastString
fsLit String
"sinhl"),
(String -> FastString
fsLit String
"sqrt"), (String -> FastString
fsLit String
"sqrtf"), (String -> FastString
fsLit String
"sqrtl"),
(String -> FastString
fsLit String
"tan"), (String -> FastString
fsLit String
"tanf"), (String -> FastString
fsLit String
"tanl"),
(String -> FastString
fsLit String
"tanh"), (String -> FastString
fsLit String
"tanhf"), (String -> FastString
fsLit String
"tanhl"),
(String -> FastString
fsLit String
"tgamma"), (String -> FastString
fsLit String
"tgammaf"), (String -> FastString
fsLit String
"tgammal"),
(String -> FastString
fsLit String
"trunc"), (String -> FastString
fsLit String
"truncf"), (String -> FastString
fsLit String
"truncl"),
(String -> FastString
fsLit String
"drem"), (String -> FastString
fsLit String
"dremf"), (String -> FastString
fsLit String
"dreml"),
(String -> FastString
fsLit String
"finite"), (String -> FastString
fsLit String
"finitef"), (String -> FastString
fsLit String
"finitel"),
(String -> FastString
fsLit String
"gamma"), (String -> FastString
fsLit String
"gammaf"), (String -> FastString
fsLit String
"gammal"),
(String -> FastString
fsLit String
"isinf"), (String -> FastString
fsLit String
"isinff"), (String -> FastString
fsLit String
"isinfl"),
(String -> FastString
fsLit String
"isnan"), (String -> FastString
fsLit String
"isnanf"), (String -> FastString
fsLit String
"isnanl"),
(String -> FastString
fsLit String
"j0"), (String -> FastString
fsLit String
"j0f"), (String -> FastString
fsLit String
"j0l"),
(String -> FastString
fsLit String
"j1"), (String -> FastString
fsLit String
"j1f"), (String -> FastString
fsLit String
"j1l"),
(String -> FastString
fsLit String
"jn"), (String -> FastString
fsLit String
"jnf"), (String -> FastString
fsLit String
"jnl"),
(String -> FastString
fsLit String
"lgamma_r"), (String -> FastString
fsLit String
"lgammaf_r"), (String -> FastString
fsLit String
"lgammal_r"),
(String -> FastString
fsLit String
"scalb"), (String -> FastString
fsLit String
"scalbf"), (String -> FastString
fsLit String
"scalbl"),
(String -> FastString
fsLit String
"significand"), (String -> FastString
fsLit String
"significandf"), (String -> FastString
fsLit String
"significandl"),
(String -> FastString
fsLit String
"y0"), (String -> FastString
fsLit String
"y0f"), (String -> FastString
fsLit String
"y0l"),
(String -> FastString
fsLit String
"y1"), (String -> FastString
fsLit String
"y1f"), (String -> FastString
fsLit String
"y1l"),
(String -> FastString
fsLit String
"yn"), (String -> FastString
fsLit String
"ynf"), (String -> FastString
fsLit String
"ynl"),
(String -> FastString
fsLit String
"nextup"), (String -> FastString
fsLit String
"nextupf"), (String -> FastString
fsLit String
"nextupl"),
(String -> FastString
fsLit String
"nextdown"), (String -> FastString
fsLit String
"nextdownf"), (String -> FastString
fsLit String
"nextdownl")
]
externallyVisibleCLabel :: CLabel -> Bool
externallyVisibleCLabel :: CLabel -> Bool
externallyVisibleCLabel (StringLitLabel Unique
_) = Bool
False
externallyVisibleCLabel (AsmTempLabel Unique
_) = Bool
False
externallyVisibleCLabel (AsmTempDerivedLabel CLabel
_ FastString
_)= Bool
False
externallyVisibleCLabel (RtsLabel RtsLabelInfo
_) = Bool
True
externallyVisibleCLabel (LocalBlockLabel Unique
_) = Bool
False
externallyVisibleCLabel (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
_) = Bool
True
externallyVisibleCLabel (ForeignLabel{}) = Bool
True
externallyVisibleCLabel (IdLabel Name
name CafInfo
_ IdLabelInfo
info) = Name -> Bool
isExternalName Name
name Bool -> Bool -> Bool
&& IdLabelInfo -> Bool
externallyVisibleIdLabel IdLabelInfo
info
externallyVisibleCLabel (CC_Label CostCentre
_) = Bool
True
externallyVisibleCLabel (CCS_Label CostCentreStack
_) = Bool
True
externallyVisibleCLabel (IPE_Label {}) = Bool
True
externallyVisibleCLabel (ModuleLabel {}) = Bool
True
externallyVisibleCLabel (DynamicLinkerLabel DynamicLinkerLabelInfo
_ CLabel
_) = Bool
False
externallyVisibleCLabel (HpcTicksLabel Module
_) = Bool
True
externallyVisibleCLabel (LargeBitmapLabel Unique
_) = Bool
False
externallyVisibleCLabel (SRTLabel Unique
_) = Bool
False
externallyVisibleCLabel (PicBaseLabel {}) = String -> Bool
forall a. HasCallStack => String -> a
panic String
"externallyVisibleCLabel PicBaseLabel"
externallyVisibleCLabel (DeadStripPreventer {}) = String -> Bool
forall a. HasCallStack => String -> a
panic String
"externallyVisibleCLabel DeadStripPreventer"
externallyVisibleIdLabel :: IdLabelInfo -> Bool
externallyVisibleIdLabel :: IdLabelInfo -> Bool
externallyVisibleIdLabel IdLabelInfo
LocalInfoTable = Bool
False
externallyVisibleIdLabel IdLabelInfo
LocalEntry = Bool
False
externallyVisibleIdLabel IdLabelInfo
BlockInfoTable = Bool
False
externallyVisibleIdLabel IdLabelInfo
_ = Bool
True
data CLabelType
= CodeLabel
| DataLabel
| GcPtrLabel
isCFunctionLabel :: CLabel -> Bool
isCFunctionLabel :: CLabel -> Bool
isCFunctionLabel CLabel
lbl = case CLabel -> CLabelType
labelType CLabel
lbl of
CLabelType
CodeLabel -> Bool
True
CLabelType
_other -> Bool
False
isGcPtrLabel :: CLabel -> Bool
isGcPtrLabel :: CLabel -> Bool
isGcPtrLabel CLabel
lbl = case CLabel -> CLabelType
labelType CLabel
lbl of
CLabelType
GcPtrLabel -> Bool
True
CLabelType
_other -> Bool
False
labelType :: CLabel -> CLabelType
labelType :: CLabel -> CLabelType
labelType (IdLabel Name
_ CafInfo
_ IdLabelInfo
info) = IdLabelInfo -> CLabelType
idInfoLabelType IdLabelInfo
info
labelType (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmData) = CLabelType
DataLabel
labelType (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmClosure) = CLabelType
GcPtrLabel
labelType (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmCode) = CLabelType
CodeLabel
labelType (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmInfo) = CLabelType
DataLabel
labelType (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmEntry) = CLabelType
CodeLabel
labelType (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmPrimCall) = CLabelType
CodeLabel
labelType (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmRetInfo) = CLabelType
DataLabel
labelType (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmRet) = CLabelType
CodeLabel
labelType (RtsLabel (RtsSelectorInfoTable Bool
_ Int
_)) = CLabelType
DataLabel
labelType (RtsLabel (RtsSelectorEntry Bool
_ Int
_)) = CLabelType
CodeLabel
labelType (RtsLabel (RtsApInfoTable Bool
_ Int
_)) = CLabelType
DataLabel
labelType (RtsLabel (RtsApEntry Bool
_ Int
_)) = CLabelType
CodeLabel
labelType (RtsLabel (RtsApFast NonDetFastString
_)) = CLabelType
CodeLabel
labelType (RtsLabel RtsLabelInfo
RtsUnpackCStringInfoTable) = CLabelType
DataLabel
labelType (RtsLabel RtsLabelInfo
RtsUnpackCStringUtf8InfoTable)
= CLabelType
DataLabel
labelType (RtsLabel (RtsPrimOp PrimOp
_)) = CLabelType
CodeLabel
labelType (RtsLabel (RtsSlowFastTickyCtr String
_)) = CLabelType
DataLabel
labelType (LocalBlockLabel Unique
_) = CLabelType
CodeLabel
labelType (SRTLabel Unique
_) = CLabelType
DataLabel
labelType (ForeignLabel FastString
_ Maybe Int
_ ForeignLabelSource
_ FunctionOrData
IsFunction) = CLabelType
CodeLabel
labelType (ForeignLabel FastString
_ Maybe Int
_ ForeignLabelSource
_ FunctionOrData
IsData) = CLabelType
DataLabel
labelType (AsmTempLabel Unique
_) = String -> CLabelType
forall a. HasCallStack => String -> a
panic String
"labelType(AsmTempLabel)"
labelType (AsmTempDerivedLabel CLabel
_ FastString
_) = String -> CLabelType
forall a. HasCallStack => String -> a
panic String
"labelType(AsmTempDerivedLabel)"
labelType (StringLitLabel Unique
_) = CLabelType
DataLabel
labelType (CC_Label CostCentre
_) = CLabelType
DataLabel
labelType (CCS_Label CostCentreStack
_) = CLabelType
DataLabel
labelType (IPE_Label {}) = CLabelType
DataLabel
labelType (ModuleLabel Module
_ ModuleLabelKind
kind) = ModuleLabelKind -> CLabelType
moduleLabelKindType ModuleLabelKind
kind
labelType (DynamicLinkerLabel DynamicLinkerLabelInfo
_ CLabel
_) = CLabelType
DataLabel
labelType CLabel
PicBaseLabel = CLabelType
DataLabel
labelType (DeadStripPreventer CLabel
_) = CLabelType
DataLabel
labelType (HpcTicksLabel Module
_) = CLabelType
DataLabel
labelType (LargeBitmapLabel Unique
_) = CLabelType
DataLabel
moduleLabelKindType :: ModuleLabelKind -> CLabelType
moduleLabelKindType :: ModuleLabelKind -> CLabelType
moduleLabelKindType ModuleLabelKind
kind =
case ModuleLabelKind
kind of
MLK_Initializer LexicalFastString
_ -> CLabelType
CodeLabel
ModuleLabelKind
MLK_InitializerArray -> CLabelType
DataLabel
MLK_Finalizer LexicalFastString
_ -> CLabelType
CodeLabel
ModuleLabelKind
MLK_FinalizerArray -> CLabelType
DataLabel
ModuleLabelKind
MLK_IPEBuffer -> CLabelType
DataLabel
idInfoLabelType :: IdLabelInfo -> CLabelType
idInfoLabelType :: IdLabelInfo -> CLabelType
idInfoLabelType IdLabelInfo
info =
case IdLabelInfo
info of
IdLabelInfo
InfoTable -> CLabelType
DataLabel
IdLabelInfo
LocalInfoTable -> CLabelType
DataLabel
IdLabelInfo
BlockInfoTable -> CLabelType
DataLabel
IdLabelInfo
Closure -> CLabelType
GcPtrLabel
ConInfoTable {} -> CLabelType
DataLabel
IdLabelInfo
ClosureTable -> CLabelType
DataLabel
IdTickyInfo{} -> CLabelType
DataLabel
IdLabelInfo
Bytes -> CLabelType
DataLabel
IdLabelInfo
_ -> CLabelType
CodeLabel
isLocalCLabel :: Module -> CLabel -> Bool
isLocalCLabel :: Module -> CLabel -> Bool
isLocalCLabel Module
this_mod CLabel
lbl =
case CLabel
lbl of
IdLabel Name
name CafInfo
_ IdLabelInfo
_
| Name -> Bool
isInternalName Name
name -> Bool
True
| Bool
otherwise -> (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
this_mod
LocalBlockLabel Unique
_ -> Bool
True
CLabel
_ -> Bool
False
labelDynamic :: Module -> Platform -> Bool -> CLabel -> Bool
labelDynamic :: Module -> Platform -> Bool -> CLabel -> Bool
labelDynamic Module
this_mod Platform
platform Bool
external_dynamic_refs CLabel
lbl =
case CLabel
lbl of
RtsLabel RtsLabelInfo
_ ->
Bool
external_dynamic_refs Bool -> Bool -> Bool
&& (UnitId
this_unit UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= UnitId
rtsUnitId)
IdLabel Name
n CafInfo
_ IdLabelInfo
_ ->
Bool
external_dynamic_refs Bool -> Bool -> Bool
&& Platform -> Module -> Name -> Bool
isDynLinkName Platform
platform Module
this_mod Name
n
CmmLabel UnitId
lbl_unit NeedExternDecl
_ FastString
_ CmmLabelInfo
_
| OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32 -> Bool
external_dynamic_refs Bool -> Bool -> Bool
&& (UnitId
this_unit UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= UnitId
lbl_unit)
| Bool
otherwise -> Bool
external_dynamic_refs
LocalBlockLabel Unique
_ -> Bool
False
ForeignLabel FastString
_ Maybe Int
_ ForeignLabelSource
source FunctionOrData
_ ->
if OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
then case ForeignLabelSource
source of
ForeignLabelSource
ForeignLabelInExternalPackage -> Bool
True
ForeignLabelSource
ForeignLabelInThisPackage -> Bool
False
ForeignLabelInPackage UnitId
pkgId ->
Bool
external_dynamic_refs Bool -> Bool -> Bool
&& (UnitId
this_unit UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= UnitId
pkgId)
else
Bool
True
CC_Label CostCentre
cc ->
Bool
external_dynamic_refs Bool -> Bool -> Bool
&& Bool -> Bool
not (CostCentre -> Module -> Bool
ccFromThisModule CostCentre
cc Module
this_mod)
CCS_Label CostCentreStack
_ -> Bool
False
IPE_Label {} -> Bool
True
HpcTicksLabel Module
m ->
Bool
external_dynamic_refs Bool -> Bool -> Bool
&& Module
this_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= Module
m
CLabel
_ -> Bool
False
where
os :: OS
os = Platform -> OS
platformOS Platform
platform
this_unit :: UnitId
this_unit = GenUnit UnitId -> UnitId
toUnitId (Module -> GenUnit UnitId
forall unit. GenModule unit -> unit
moduleUnit Module
this_mod)
data LabelStyle
= CStyle
| AsmStyle
pprAsmLabel :: IsLine doc => Platform -> CLabel -> doc
pprAsmLabel :: forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl = Platform -> LabelStyle -> CLabel -> doc
forall doc. IsLine doc => Platform -> LabelStyle -> CLabel -> doc
pprCLabelStyle Platform
platform LabelStyle
AsmStyle CLabel
lbl
{-# SPECIALIZE pprAsmLabel :: Platform -> CLabel -> SDoc #-}
{-# SPECIALIZE pprAsmLabel :: Platform -> CLabel -> HLine #-}
pprCLabel :: IsLine doc => Platform -> CLabel -> doc
pprCLabel :: forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl = Platform -> LabelStyle -> CLabel -> doc
forall doc. IsLine doc => Platform -> LabelStyle -> CLabel -> doc
pprCLabelStyle Platform
platform LabelStyle
CStyle CLabel
lbl
{-# SPECIALIZE pprCLabel :: Platform -> CLabel -> SDoc #-}
{-# SPECIALIZE pprCLabel :: Platform -> CLabel -> HLine #-}
instance OutputableP Platform CLabel where
{-# INLINE pdoc #-}
pdoc :: Platform -> CLabel -> SDoc
pdoc !Platform
platform CLabel
lbl = (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
pp_sty ->
case PprStyle
pp_sty of
PprDump{} -> Platform -> CLabel -> SDoc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl
PprStyle
_ -> let lbl_doc :: SDoc
lbl_doc = (Platform -> CLabel -> SDoc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
lbl)
in SDoc -> SDoc -> SDoc
forall a. HasCallStack => SDoc -> a -> a
pprTraceUserWarning (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Labels in code should be printed with pprCLabel or pprAsmLabel" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
lbl_doc) SDoc
lbl_doc
pprCLabelStyle :: forall doc. IsLine doc => Platform -> LabelStyle -> CLabel -> doc
pprCLabelStyle :: forall doc. IsLine doc => Platform -> LabelStyle -> CLabel -> doc
pprCLabelStyle !Platform
platform !LabelStyle
sty CLabel
lbl =
let
!use_leading_underscores :: Bool
use_leading_underscores = Platform -> Bool
platformLeadingUnderscore Platform
platform
maybe_underscore :: doc -> doc
maybe_underscore :: doc -> doc
maybe_underscore doc
doc = case LabelStyle
sty of
LabelStyle
AsmStyle | Bool
use_leading_underscores -> doc
forall doc. IsLine doc => doc
pp_cSEP doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
doc
LabelStyle
_ -> doc
doc
tempLabelPrefixOrUnderscore :: doc
tempLabelPrefixOrUnderscore :: doc
tempLabelPrefixOrUnderscore = case LabelStyle
sty of
LabelStyle
AsmStyle -> Platform -> doc
forall doc. IsLine doc => Platform -> doc
asmTempLabelPrefix Platform
platform
LabelStyle
CStyle -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'_'
in case CLabel
lbl of
LocalBlockLabel Unique
u -> case LabelStyle
sty of
LabelStyle
AsmStyle -> doc
tempLabelPrefixOrUnderscore doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
LabelStyle
CStyle -> doc
tempLabelPrefixOrUnderscore doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"blk_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
AsmTempLabel Unique
u
-> doc
tempLabelPrefixOrUnderscore doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
AsmTempDerivedLabel CLabel
l FastString
suf
-> Platform -> doc
forall doc. IsLine doc => Platform -> doc
asmTempLabelPrefix Platform
platform
doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> case CLabel
l of AsmTempLabel Unique
u -> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
LocalBlockLabel Unique
u -> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
CLabel
_other -> Platform -> LabelStyle -> CLabel -> doc
forall doc. IsLine doc => Platform -> LabelStyle -> CLabel -> doc
pprCLabelStyle Platform
platform LabelStyle
sty CLabel
l
doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
suf
DynamicLinkerLabel DynamicLinkerLabelInfo
info CLabel
lbl
-> Platform -> DynamicLinkerLabelInfo -> doc -> doc
forall doc.
IsLine doc =>
Platform -> DynamicLinkerLabelInfo -> doc -> doc
pprDynamicLinkerAsmLabel Platform
platform DynamicLinkerLabelInfo
info (Platform -> CLabel -> doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl)
CLabel
PicBaseLabel
-> String -> doc
forall doc. IsLine doc => String -> doc
text String
"1b"
DeadStripPreventer CLabel
lbl
->
doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> doc
forall doc. IsLine doc => String -> doc
text String
"dsp_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> LabelStyle -> CLabel -> doc
forall doc. IsLine doc => Platform -> LabelStyle -> CLabel -> doc
pprCLabelStyle Platform
platform LabelStyle
sty CLabel
lbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_dsp"
StringLitLabel Unique
u
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_str"
ForeignLabel FastString
fs (Just Int
sz) ForeignLabelSource
_ FunctionOrData
_
| LabelStyle
AsmStyle <- LabelStyle
sty
, OS
OSMinGW32 <- Platform -> OS
platformOS Platform
platform
->
doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fs doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'@' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
sz
ForeignLabel FastString
fs Maybe Int
_ ForeignLabelSource
_ FunctionOrData
_
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fs
IdLabel Name
name CafInfo
_cafs IdLabelInfo
flavor -> case LabelStyle
sty of
LabelStyle
AsmStyle -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ doc
internalNamePrefix doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Name -> doc
forall doc. IsLine doc => Name -> doc
pprName Name
name doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> IdLabelInfo -> doc
forall doc. IsLine doc => IdLabelInfo -> doc
ppIdFlavor IdLabelInfo
flavor
where
isRandomGenerated :: Bool
isRandomGenerated = Bool -> Bool
not (Name -> Bool
isExternalName Name
name)
internalNamePrefix :: doc
internalNamePrefix =
if Bool
isRandomGenerated
then Platform -> doc
forall doc. IsLine doc => Platform -> doc
asmTempLabelPrefix Platform
platform
else doc
forall doc. IsOutput doc => doc
empty
LabelStyle
CStyle -> Name -> doc
forall doc. IsLine doc => Name -> doc
pprName Name
name doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> IdLabelInfo -> doc
forall doc. IsLine doc => IdLabelInfo -> doc
ppIdFlavor IdLabelInfo
flavor
SRTLabel Unique
u
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ doc
tempLabelPrefixOrUnderscore doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
pp_cSEP doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"srt"
RtsLabel (RtsApFast (NonDetFastString FastString
str))
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
str doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_fast"
RtsLabel (RtsSelectorInfoTable Bool
upd_reqd Int
offset)
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ [doc] -> doc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_sel_", Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
offset
, if Bool
upd_reqd
then String -> doc
forall doc. IsLine doc => String -> doc
text String
"_upd_info"
else String -> doc
forall doc. IsLine doc => String -> doc
text String
"_noupd_info"
]
RtsLabel (RtsSelectorEntry Bool
upd_reqd Int
offset)
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ [doc] -> doc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_sel_", Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
offset
, if Bool
upd_reqd
then String -> doc
forall doc. IsLine doc => String -> doc
text String
"_upd_entry"
else String -> doc
forall doc. IsLine doc => String -> doc
text String
"_noupd_entry"
]
RtsLabel (RtsApInfoTable Bool
upd_reqd Int
arity)
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ [doc] -> doc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_ap_", Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
arity
, if Bool
upd_reqd
then String -> doc
forall doc. IsLine doc => String -> doc
text String
"_upd_info"
else String -> doc
forall doc. IsLine doc => String -> doc
text String
"_noupd_info"
]
RtsLabel (RtsApEntry Bool
upd_reqd Int
arity)
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ [doc] -> doc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_ap_", Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
arity
, if Bool
upd_reqd
then String -> doc
forall doc. IsLine doc => String -> doc
text String
"_upd_entry"
else String -> doc
forall doc. IsLine doc => String -> doc
text String
"_noupd_entry"
]
RtsLabel (RtsPrimOp PrimOp
primop)
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> PrimOp -> doc
forall doc. IsLine doc => PrimOp -> doc
pprPrimOp PrimOp
primop
RtsLabel (RtsSlowFastTickyCtr String
pat)
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> doc
forall doc. IsLine doc => String -> doc
text String
"SLOW_CALL_fast_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
pat doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_ctr"
RtsLabel RtsLabelInfo
RtsUnpackCStringInfoTable
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_unpack_cstring_info"
RtsLabel RtsLabelInfo
RtsUnpackCStringUtf8InfoTable
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_unpack_cstring_utf8_info"
LargeBitmapLabel Unique
u
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ doc
tempLabelPrefixOrUnderscore
doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'b' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
pp_cSEP doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"btm"
HpcTicksLabel Module
mod
-> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> doc
forall doc. IsLine doc => String -> doc
text String
"_hpc_tickboxes_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Module -> doc
forall doc. IsLine doc => Module -> doc
pprModule Module
mod doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_hpc"
CC_Label CostCentre
cc -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ CostCentre -> doc
forall doc. IsLine doc => CostCentre -> doc
pprCostCentre CostCentre
cc
CCS_Label CostCentreStack
ccs -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ CostCentreStack -> doc
forall doc. IsLine doc => CostCentreStack -> doc
pprCostCentreStack CostCentreStack
ccs
IPE_Label (InfoProvEnt CLabel
l Int
_ String
_ Module
m Maybe (RealSrcSpan, String)
_) -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ (Platform -> CLabel -> doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
l doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Module -> doc
forall doc. IsLine doc => Module -> doc
pprModule Module
m doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_ipe")
ModuleLabel Module
mod ModuleLabelKind
kind -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ Module -> doc
forall doc. IsLine doc => Module -> doc
pprModule Module
mod doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> ModuleLabelKind -> doc
forall doc. IsLine doc => ModuleLabelKind -> doc
pprModuleLabelKind ModuleLabelKind
kind
CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmCode -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fs
CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmData -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fs
CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmPrimCall -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fs
CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmInfo -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fs doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_info"
CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmEntry -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fs doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_entry"
CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmRetInfo -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fs doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_info"
CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmRet -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fs doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_ret"
CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmClosure -> doc -> doc
maybe_underscore (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
fs doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"_closure"
{-# SPECIALIZE pprCLabelStyle :: Platform -> LabelStyle -> CLabel -> SDoc #-}
{-# SPECIALIZE pprCLabelStyle :: Platform -> LabelStyle -> CLabel -> HLine #-}
ppInternalProcLabel :: IsLine doc
=> Module
-> CLabel
-> Maybe doc
ppInternalProcLabel :: forall doc. IsLine doc => Module -> CLabel -> Maybe doc
ppInternalProcLabel Module
this_mod (IdLabel Name
nm CafInfo
_ IdLabelInfo
flavour)
| Name -> Bool
isInternalName Name
nm
= doc -> Maybe doc
forall a. a -> Maybe a
Just
(doc -> Maybe doc) -> doc -> Maybe doc
forall a b. (a -> b) -> a -> b
$ String -> doc
forall doc. IsLine doc => String -> doc
text String
"_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Module -> doc
forall doc. IsLine doc => Module -> doc
pprModule Module
this_mod
doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'_'
doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> FastZString -> doc
forall doc. IsLine doc => FastZString -> doc
ztext (FastString -> FastZString
zEncodeFS (OccName -> FastString
occNameFS (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
nm)))
doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'_'
doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways (Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique Name
nm)
doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> IdLabelInfo -> doc
forall doc. IsLine doc => IdLabelInfo -> doc
ppIdFlavor IdLabelInfo
flavour
ppInternalProcLabel Module
_ CLabel
_ = Maybe doc
forall a. Maybe a
Nothing
{-# SPECIALIZE ppInternalProcLabel :: Module -> CLabel -> Maybe SDoc #-}
{-# SPECIALIZE ppInternalProcLabel :: Module -> CLabel -> Maybe HLine #-}
ppIdFlavor :: IsLine doc => IdLabelInfo -> doc
ppIdFlavor :: forall doc. IsLine doc => IdLabelInfo -> doc
ppIdFlavor IdLabelInfo
x = doc
forall doc. IsLine doc => doc
pp_cSEP doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> case IdLabelInfo
x of
IdLabelInfo
Closure -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"closure"
IdLabelInfo
InfoTable -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"info"
IdLabelInfo
LocalInfoTable -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"info"
IdLabelInfo
Entry -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"entry"
IdLabelInfo
LocalEntry -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"entry"
IdLabelInfo
Slow -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"slow"
IdTickyInfo TickyIdInfo
TickyRednCounts
-> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ct"
IdTickyInfo (TickyInferedTag Unique
unique)
-> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ct_inf_tag" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'_' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
unique
ConEntry ConInfoTableLocation
loc ->
case ConInfoTableLocation
loc of
ConInfoTableLocation
DefinitionSite -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"con_entry"
UsageSite Module
m Int
n ->
Module -> doc
forall doc. IsLine doc => Module -> doc
pprModule Module
m doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
pp_cSEP doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
pp_cSEP doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"con_entry"
ConInfoTable ConInfoTableLocation
k ->
case ConInfoTableLocation
k of
ConInfoTableLocation
DefinitionSite -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"con_info"
UsageSite Module
m Int
n ->
Module -> doc
forall doc. IsLine doc => Module -> doc
pprModule Module
m doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
pp_cSEP doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
pp_cSEP doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"con_info"
IdLabelInfo
ClosureTable -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"closure_tbl"
IdLabelInfo
Bytes -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"bytes"
IdLabelInfo
BlockInfoTable -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"info"
pp_cSEP :: IsLine doc => doc
pp_cSEP :: forall doc. IsLine doc => doc
pp_cSEP = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'_'
instance Outputable ForeignLabelSource where
ppr :: ForeignLabelSource -> SDoc
ppr ForeignLabelSource
fs
= case ForeignLabelSource
fs of
ForeignLabelInPackage UnitId
pkgId -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"package: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pkgId
ForeignLabelSource
ForeignLabelInThisPackage -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"this package"
ForeignLabelSource
ForeignLabelInExternalPackage -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"external package"
asmTempLabelPrefix :: IsLine doc => Platform -> doc
asmTempLabelPrefix :: forall doc. IsLine doc => Platform -> doc
asmTempLabelPrefix !Platform
platform = case Platform -> OS
platformOS Platform
platform of
OS
OSDarwin -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"L"
OS
OSAIX -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"__L"
OS
_ -> String -> doc
forall doc. IsLine doc => String -> doc
text String
".L"
pprDynamicLinkerAsmLabel :: IsLine doc => Platform -> DynamicLinkerLabelInfo -> doc -> doc
pprDynamicLinkerAsmLabel :: forall doc.
IsLine doc =>
Platform -> DynamicLinkerLabelInfo -> doc -> doc
pprDynamicLinkerAsmLabel !Platform
platform DynamicLinkerLabelInfo
dllInfo doc
ppLbl =
case Platform -> OS
platformOS Platform
platform of
OS
OSDarwin
| Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchX86_64 ->
case DynamicLinkerLabelInfo
dllInfo of
DynamicLinkerLabelInfo
CodeStub -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'L' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
ppLbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"$stub"
DynamicLinkerLabelInfo
SymbolPtr -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'L' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
ppLbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"$non_lazy_ptr"
DynamicLinkerLabelInfo
GotSymbolPtr -> doc
ppLbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"@GOTPCREL"
DynamicLinkerLabelInfo
GotSymbolOffset -> doc
ppLbl
| Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchAArch64 -> doc
ppLbl
| Bool
otherwise ->
case DynamicLinkerLabelInfo
dllInfo of
DynamicLinkerLabelInfo
CodeStub -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'L' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
ppLbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"$stub"
DynamicLinkerLabelInfo
SymbolPtr -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'L' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
ppLbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"$non_lazy_ptr"
DynamicLinkerLabelInfo
_ -> String -> doc
forall a. HasCallStack => String -> a
panic String
"pprDynamicLinkerAsmLabel"
OS
OSAIX ->
case DynamicLinkerLabelInfo
dllInfo of
DynamicLinkerLabelInfo
SymbolPtr -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"LC.." doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
ppLbl
DynamicLinkerLabelInfo
_ -> String -> doc
forall a. HasCallStack => String -> a
panic String
"pprDynamicLinkerAsmLabel"
OS
_ | OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform) -> doc
elfLabel
OS
OSMinGW32 ->
case DynamicLinkerLabelInfo
dllInfo of
DynamicLinkerLabelInfo
SymbolPtr -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"__imp_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
ppLbl
DynamicLinkerLabelInfo
_ -> String -> doc
forall a. HasCallStack => String -> a
panic String
"pprDynamicLinkerAsmLabel"
OS
_ -> String -> doc
forall a. HasCallStack => String -> a
panic String
"pprDynamicLinkerAsmLabel"
where
elfLabel :: doc
elfLabel
| Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchPPC
= case DynamicLinkerLabelInfo
dllInfo of
DynamicLinkerLabelInfo
CodeStub ->
doc
ppLbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"+32768@plt"
DynamicLinkerLabelInfo
SymbolPtr -> String -> doc
forall doc. IsLine doc => String -> doc
text String
".LC_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
ppLbl
DynamicLinkerLabelInfo
_ -> String -> doc
forall a. HasCallStack => String -> a
panic String
"pprDynamicLinkerAsmLabel"
| Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchAArch64
= doc
ppLbl
| Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchX86_64
= case DynamicLinkerLabelInfo
dllInfo of
DynamicLinkerLabelInfo
CodeStub -> doc
ppLbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"@plt"
DynamicLinkerLabelInfo
GotSymbolPtr -> doc
ppLbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"@gotpcrel"
DynamicLinkerLabelInfo
GotSymbolOffset -> doc
ppLbl
DynamicLinkerLabelInfo
SymbolPtr -> String -> doc
forall doc. IsLine doc => String -> doc
text String
".LC_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
ppLbl
| Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1
Bool -> Bool -> Bool
|| Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2
= case DynamicLinkerLabelInfo
dllInfo of
DynamicLinkerLabelInfo
GotSymbolPtr -> String -> doc
forall doc. IsLine doc => String -> doc
text String
".LC_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
ppLbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"@toc"
DynamicLinkerLabelInfo
GotSymbolOffset -> doc
ppLbl
DynamicLinkerLabelInfo
SymbolPtr -> String -> doc
forall doc. IsLine doc => String -> doc
text String
".LC_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
ppLbl
DynamicLinkerLabelInfo
_ -> String -> doc
forall a. HasCallStack => String -> a
panic String
"pprDynamicLinkerAsmLabel"
| Bool
otherwise
= case DynamicLinkerLabelInfo
dllInfo of
DynamicLinkerLabelInfo
CodeStub -> doc
ppLbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"@plt"
DynamicLinkerLabelInfo
SymbolPtr -> String -> doc
forall doc. IsLine doc => String -> doc
text String
".LC_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
ppLbl
DynamicLinkerLabelInfo
GotSymbolPtr -> doc
ppLbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"@got"
DynamicLinkerLabelInfo
GotSymbolOffset -> doc
ppLbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"@gotoff"
mayRedirectTo :: CLabel -> CLabel -> Bool
mayRedirectTo :: CLabel -> CLabel -> Bool
mayRedirectTo CLabel
symbol CLabel
target
| Just Name
nam <- Maybe Name
haskellName
, Bool
staticClosureLabel
, Name -> Bool
isExternalName Name
nam
, Just Module
mod <- Name -> Maybe Module
nameModule_maybe Name
nam
, Just Name
anam <- CLabel -> Maybe Name
hasHaskellName CLabel
symbol
, Just Module
amod <- Name -> Maybe Module
nameModule_maybe Name
anam
= Module
amod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
mod
| Just Name
nam <- Maybe Name
haskellName
, Bool
staticClosureLabel
, Name -> Bool
isInternalName Name
nam
= Bool
True
| Bool
otherwise = Bool
False
where staticClosureLabel :: Bool
staticClosureLabel = CLabel -> Bool
isStaticClosureLabel CLabel
target
haskellName :: Maybe Name
haskellName = CLabel -> Maybe Name
hasHaskellName CLabel
target