-----------------------------------------------------------------------------
--
-- Object-file symbols (called CLabel for histerical raisins).
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}


module GHC.Cmm.CLabel (
        CLabel, -- abstract type
        NeedExternDecl (..),
        ForeignLabelSource(..),
        DynamicLinkerLabelInfo(..),
        ConInfoTableLocation(..),
        getConInfoTableLocation,

        -- * Constructors
        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,
        mkArrWords_infoLabel,
        mkSRTInfoLabel,

        mkTopTickyCtrLabel,
        mkCAFBlackHoleInfoTableLabel,
        mkRtsPrimOpLabel,
        mkRtsSlowFastTickyCtrLabel,

        mkSelectorInfoLabel,
        mkSelectorEntryLabel,
        mkCmmInfoLabel,
        mkCmmEntryLabel,
        mkCmmRetInfoLabel,
        mkCmmRetLabel,
        mkCmmCodeLabel,
        mkCmmDataLabel,
        mkRtsCmmDataLabel,
        mkCmmClosureLabel,
        mkRtsApFastLabel,
        mkPrimCallLabel,
        mkForeignLabel,
        mkCCLabel,
        mkCCSLabel,
        mkIPELabel,
        InfoProvEnt(..),

        mkDynamicLinkerLabel,
        mkPicBaseLabel,
        mkDeadStripPreventer,
        mkHpcTicksLabel,

        -- * Predicates
        hasCAF,
        needsCDecl,
        maybeLocalBlockLabel,
        externallyVisibleCLabel,
        isMathFun,
        isCFunctionLabel,
        isGcPtrLabel,
        labelDynamic,
        isLocalCLabel,
        mayRedirectTo,
        isInfoTableLabel,
        isConInfoTableLabel,
        isIdLabel,
        isTickyLabel,
        hasHaskellName,
        hasIdLabelInfo,
        isBytesLabel,
        isForeignLabel,
        isSomeRODataLabel,
        isStaticClosureLabel,

        -- * Conversions
        toClosureLbl,
        toSlowEntryLbl,
        toEntryLbl,
        toInfoLbl,

        -- * Pretty-printing
        LabelStyle (..),
        pprDebugCLabel,
        pprCLabel,
        ppInternalProcLabel,

        -- * Others
        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.Utils.Misc
import GHC.Core.Ppr ( {- instances -} )
import GHC.Types.SrcLoc

-- -----------------------------------------------------------------------------
-- The CLabel type

{- |
  'CLabel' is an abstract type that supports the following operations:

  - Pretty printing

  - In a C file, does it need to be declared before use?  (i.e. is it
    guaranteed to be already in scope in the places we need to refer to it?)

  - If it needs to be declared, what type (code or data) should it be
    declared to have?

  - Is it visible outside this object file or not?

  - Is it "dynamic" (see details below)

  - Eq and Ord, so that we can make sets of CLabels (currently only
    used in outputting C as far as I can tell, to avoid generating
    more than one declaration for any given label).

  - Converting an info table label into an entry label.

  CLabel usage is a bit messy in GHC as they are used in a number of different
  contexts:

  - By the C-- AST to identify labels

  - By the unregisterised C code generator (\"PprC\") for naming functions (hence
    the name 'CLabel')

  - By the native and LLVM code generators to identify labels

  For extra fun, each of these uses a slightly different subset of constructors
  (e.g. 'AsmTempLabel' and 'AsmTempDerivedLabel' are used only in the NCG and
  LLVM backends).

  In general, we use 'IdLabel' to represent Haskell things early in the
  pipeline. However, later optimization passes will often represent blocks they
  create with 'LocalBlockLabel' where there is no obvious 'Name' to hang off the
  label.
-}

data CLabel
  = -- | A label related to the definition of a particular Id or Con in a .hs file.
    IdLabel
        Name
        CafInfo
        IdLabelInfo             -- ^ encodes the suffix of the label

  -- | A label from a .cmm file that is not associated with a .hs level Id.
  | CmmLabel
        UnitId                  -- ^ what package the label belongs to.
        NeedExternDecl          -- ^ does the label need an "extern .." declaration
        FastString              -- ^ identifier giving the prefix of the label
        CmmLabelInfo            -- ^ encodes the suffix of the label

  -- | A label with a baked-in \/ algorithmically generated name that definitely
  --    comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
  --    If it doesn't have an algorithmically generated name then use a CmmLabel
  --    instead and give it an appropriate UnitId argument.
  | RtsLabel
        RtsLabelInfo

  -- | A label associated with a block. These aren't visible outside of the
  -- compilation unit in which they are defined. These are generally used to
  -- name blocks produced by Cmm-to-Cmm passes and the native code generator,
  -- where we don't have a 'Name' to associate the label to and therefore can't
  -- use 'IdLabel'.
  | LocalBlockLabel
        {-# UNPACK #-} !Unique

  -- | A 'C' (or otherwise foreign) label.
  --
  | ForeignLabel
        FastString              -- ^ name of the imported label.

        (Maybe Int)             -- ^ possible '@n' suffix for stdcall functions
                                -- When generating C, the '@n' suffix is omitted, but when
                                -- generating assembler we must add it to the label.

        ForeignLabelSource      -- ^ what package the foreign label is in.

        FunctionOrData

  -- | Local temporary label used for native (or LLVM) code generation; must not
  -- appear outside of these contexts. Use primarily for debug information
  | AsmTempLabel
        {-# UNPACK #-} !Unique

  -- | A label \"derived\" from another 'CLabel' by the addition of a suffix.
  -- Must not occur outside of the NCG or LLVM code generators.
  | AsmTempDerivedLabel
        CLabel
        FastString              -- ^ suffix

  | StringLitLabel
        {-# UNPACK #-} !Unique

  | CC_Label  CostCentre
  | CCS_Label CostCentreStack
  | IPE_Label InfoProvEnt

    -- | A per-module metadata label.
  | ModuleLabel !Module ModuleLabelKind

  -- | These labels are generated and used inside the NCG only.
  --    They are special variants of a label used for dynamic linking
  --    see module "GHC.CmmToAsm.PIC" for details.
  | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel

  -- | This label is generated and used inside the NCG only.
  --    It is used as a base for PIC calculations on some platforms.
  --    It takes the form of a local numeric assembler label '1'; and
  --    is pretty-printed as 1b, referring to the previous definition
  --    of 1: in the assembler source file.
  | PicBaseLabel

  -- | A label before an info table to prevent excessive dead-stripping on darwin
  | DeadStripPreventer CLabel

  -- | Per-module table of tick locations
  | HpcTicksLabel Module

  -- | Static reference table
  | SRTLabel
        {-# UNPACK #-} !Unique

  -- | A bitmap (function or case return)
  | 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

instance Outputable CLabel where
  ppr :: CLabel -> SDoc
ppr = String -> SDoc
text (String -> SDoc) -> (CLabel -> String) -> CLabel -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLabel -> String
forall a. Show a => a -> String
show

data ModuleLabelKind
    = MLK_Initializer String
    | MLK_InitializerArray
    | MLK_Finalizer String
    | MLK_FinalizerArray
    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)

instance Outputable ModuleLabelKind where
    ppr :: ModuleLabelKind -> SDoc
ppr ModuleLabelKind
MLK_InitializerArray = String -> SDoc
text String
"init_arr"
    ppr (MLK_Initializer String
s)  = String -> SDoc
text (String
"init__" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
    ppr ModuleLabelKind
MLK_FinalizerArray   = String -> SDoc
text String
"fini_arr"
    ppr (MLK_Finalizer String
s)    = String -> SDoc
text (String
"fini__" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)

isIdLabel :: CLabel -> Bool
isIdLabel :: CLabel -> Bool
isIdLabel IdLabel{} = Bool
True
isIdLabel CLabel
_ = Bool
False

-- Used in SRT analysis. See Note [Ticky labels in SRT analysis] in
-- GHC.Cmm.Info.Build.
isTickyLabel :: CLabel -> Bool
isTickyLabel :: CLabel -> Bool
isTickyLabel (IdLabel Name
_ CafInfo
_ IdTickyInfo{}) = Bool
True
isTickyLabel CLabel
_ = Bool
False

-- | Indicate if "GHC.CmmToC" has to generate an extern declaration for the
-- label (e.g. "extern StgWordArray(foo)").  The type is fixed to StgWordArray.
--
-- Symbols from the RTS don't need "extern" declarations because they are
-- exposed via "rts/include/Stg.h" with the appropriate type. See 'needsCDecl'.
--
-- The fixed StgWordArray type led to "conflicting types" issues with user
-- provided Cmm files (not in the RTS) that declare data of another type (#15467
-- and test for #17920).  Hence the Cmm parser considers that labels in data
-- sections don't need the "extern" declaration (just add one explicitly if you
-- need it).
--
-- See https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes
-- for why extern declaration are needed at all.
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)

-- This is laborious, but necessary. We can't derive Ord because
-- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the
-- implementation. See Note [No Ord for Unique]
-- This is non-deterministic but we do not currently support deterministic
-- code-generation. See Note [Unique Determinism and code generation]
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
`thenCmp`
    CafInfo -> CafInfo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CafInfo
b1 CafInfo
b2 Ordering -> Ordering -> Ordering
`thenCmp`
    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
`thenCmp`
    NeedExternDecl -> NeedExternDecl -> Ordering
forall a. Ord a => a -> a -> Ordering
compare NeedExternDecl
b1 NeedExternDecl
b2 Ordering -> Ordering -> Ordering
`thenCmp`
    -- This non-determinism is "safe" in the sense that it only affects object code,
    -- which is currently not covered by GHC's determinism guarantees. See #12935.
    FastString -> FastString -> Ordering
uniqCompareFS FastString
c1 FastString
c2 Ordering -> Ordering -> Ordering
`thenCmp`
    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
`thenCmp`
    Maybe Int -> Maybe Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Maybe Int
b1 Maybe Int
b2 Ordering -> Ordering -> Ordering
`thenCmp`
    ForeignLabelSource -> ForeignLabelSource -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ForeignLabelSource
c1 ForeignLabelSource
c2 Ordering -> Ordering -> Ordering
`thenCmp`
    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
`thenCmp`
    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
`thenCmp`
    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
`thenCmp`
    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

-- | Record where a foreign label is stored.
data ForeignLabelSource

   -- | Label is in a named package
   = ForeignLabelInPackage UnitId

   -- | Label is in some external, system package that doesn't also
   --   contain compiled Haskell code, and is not associated with any .hi files.
   --   We don't have to worry about Haskell code being inlined from
   --   external packages. It is safe to treat the RTS package as "external".
   | ForeignLabelInExternalPackage

   -- | Label is in the package currently being compiled.
   --   This is only used for creating hacky tmp labels during code generation.
   --   Don't use it in any code that might be inlined across a package boundary
   --   (ie, core code) else the information will be wrong relative to the
   --   destination module.
   | 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)


-- | For debugging problems with the CLabel representation.
--      We can't make a Show instance for CLabel because lots of its components don't have instances.
--      The regular Outputable instance only shows the label name, and not its other info.
--
pprDebugCLabel :: Platform -> CLabel -> SDoc
pprDebugCLabel :: Platform -> CLabel -> SDoc
pprDebugCLabel Platform
platform CLabel
lbl = Platform -> LabelStyle -> CLabel -> SDoc
pprCLabel Platform
platform LabelStyle
AsmStyle CLabel
lbl SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens SDoc
extra
   where
      extra :: SDoc
extra = case CLabel
lbl of
         IdLabel Name
_ CafInfo
_ IdLabelInfo
info
            -> String -> SDoc
text String
"IdLabel" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
whenPprDebug (String -> SDoc
text String
":" SDoc -> SDoc -> SDoc
<> IdLabelInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdLabelInfo
info)

         CmmLabel UnitId
pkg NeedExternDecl
_ext FastString
_name CmmLabelInfo
_info
            -> String -> SDoc
text String
"CmmLabel" SDoc -> SDoc -> SDoc
<+> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pkg

         RtsLabel{}
            -> String -> SDoc
text String
"RtsLabel"

         ForeignLabel FastString
_name Maybe Int
mSuffix ForeignLabelSource
src FunctionOrData
funOrData
             -> String -> SDoc
text String
"ForeignLabel" SDoc -> SDoc -> SDoc
<+> Maybe Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Int
mSuffix SDoc -> SDoc -> SDoc
<+> ForeignLabelSource -> SDoc
forall a. Outputable a => a -> SDoc
ppr ForeignLabelSource
src SDoc -> SDoc -> SDoc
<+> FunctionOrData -> SDoc
forall a. Outputable a => a -> SDoc
ppr FunctionOrData
funOrData

         CLabel
_  -> String -> SDoc
text String
"other CLabel"

-- Dynamic ticky info for the id.
data TickyIdInfo
  = TickyRednCounts           -- ^ Used for dynamic allocations
  | TickyInferedTag !Unique    -- ^ Used to track dynamic hits of tag inference.
  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
text String
"ct_rdn"
    ppr (TickyInferedTag Unique
unique) = String -> SDoc
text String
"ct_tag[" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unique
unique SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
']'

-- | Don't depend on this if you need determinism.
-- No determinism in the ncg backend, so we use the unique for Ord.
-- Even if it pains me slightly.
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             -- ^ Label for closure
  | InfoTable           -- ^ Info tables for closures; always read-only
  | Entry               -- ^ Entry point
  | Slow                -- ^ Slow entry point

  | LocalInfoTable      -- ^ Like InfoTable but not externally visible
  | LocalEntry          -- ^ Like Entry but not externally visible

  | IdTickyInfo !TickyIdInfo -- ^ Label of place to keep Ticky-ticky hit info for this Id

  | ConEntry ConInfoTableLocation
  -- ^ Constructor entry point, when `-fdistinct-info-tables` is enabled then
  -- each usage of a constructor will be given a unique number and a fresh info
  -- table will be created in the module where the constructor is used. The
  -- argument is used to keep track of which info table a usage of a constructor
  -- should use. When the argument is 'Nothing' then it uses the info table which
  -- is defined in the module where the datatype is declared, this is the usual case.
  -- When it is (Just (m, k)) it will use the kth info table defined in module m. The
  -- point of this inefficiency is so that you can work out where allocations of data
  -- constructors are coming from when you are debugging.

  | ConInfoTable ConInfoTableLocation        -- ^ Corresponding info table

  | ClosureTable        -- ^ Table of closures for Enum tycons

  | Bytes               -- ^ Content of a string literal. See
                        -- Note [Bytes label].
  | BlockInfoTable      -- ^ Like LocalInfoTable but for a proc-point block
                        -- instead of a closure entry-point.
                        -- See Note [Proc-point local block entry-points].

  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)

-- | Which module is the info table from, and which number was it.
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
text String
"Loc(" SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"):" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m
  ppr ConInfoTableLocation
DefinitionSite = SDoc
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
text String
"Closure"
  ppr IdLabelInfo
InfoTable  = String -> SDoc
text String
"InfoTable"
  ppr IdLabelInfo
Entry      = String -> SDoc
text String
"Entry"
  ppr IdLabelInfo
Slow       = String -> SDoc
text String
"Slow"

  ppr IdLabelInfo
LocalInfoTable  = String -> SDoc
text String
"LocalInfoTable"
  ppr IdLabelInfo
LocalEntry      = String -> SDoc
text String
"LocalEntry"

  ppr (ConEntry ConInfoTableLocation
mn) = String -> SDoc
text String
"ConEntry" SDoc -> SDoc -> SDoc
<+> ConInfoTableLocation -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConInfoTableLocation
mn
  ppr (ConInfoTable ConInfoTableLocation
mn) = String -> SDoc
text String
"ConInfoTable" SDoc -> SDoc -> SDoc
<+> ConInfoTableLocation -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConInfoTableLocation
mn
  ppr IdLabelInfo
ClosureTable = String -> SDoc
text String
"ClosureTable"
  ppr IdLabelInfo
Bytes        = String -> SDoc
text String
"Bytes"
  ppr IdLabelInfo
BlockInfoTable  = String -> SDoc
text String
"BlockInfoTable"
  ppr (IdTickyInfo TickyIdInfo
info) = String -> SDoc
text String
"IdTickyInfo" SDoc -> SDoc -> SDoc
<+> TickyIdInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr TickyIdInfo
info


data RtsLabelInfo
  = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}  -- ^ Selector thunks
  | RtsSelectorEntry     Bool{-updatable-} Int{-offset-}

  | RtsApInfoTable       Bool{-updatable-} Int{-arity-}    -- ^ AP thunks
  | RtsApEntry           Bool{-updatable-} Int{-arity-}

  | RtsPrimOp            PrimOp
  | RtsApFast            NonDetFastString    -- ^ _fast versions of generic apply
  | 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)


-- | What type of Cmm label we're dealing with.
--      Determines the suffix appended to the name when a CLabel.CmmLabel
--      is pretty printed.
data CmmLabelInfo
  = CmmInfo                     -- ^ misc rts info tables,      suffix _info
  | CmmEntry                    -- ^ misc rts entry points,     suffix _entry
  | CmmRetInfo                  -- ^ misc rts ret info tables,  suffix _info
  | CmmRet                      -- ^ misc rts return points,    suffix _ret
  | CmmData                     -- ^ misc rts data bits, eg CHARLIKE_closure
  | CmmCode                     -- ^ misc rts code
  | CmmClosure                  -- ^ closures eg CHARLIKE_closure
  | CmmPrimCall                 -- ^ a prim call to some hand written Cmm code
  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                    -- MachO: Lfoo$stub, ELF: foo@plt
  | SymbolPtr                   -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
  | GotSymbolPtr                -- ELF: foo@got
  | GotSymbolOffset             -- ELF: foo@gotoff

  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)


-- -----------------------------------------------------------------------------
-- Constructing CLabels
-- -----------------------------------------------------------------------------

-- Constructing IdLabels
-- These are always local:

mkSRTLabel     :: Unique -> CLabel
mkSRTLabel :: Unique -> CLabel
mkSRTLabel Unique
u = Unique -> CLabel
SRTLabel Unique
u

-- See Note [ticky for LNE]
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
-- | Decicdes between external and local labels based on the names externality.
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
-- Special case for the normal 'DefinitionSite' case so that the 'ConInfoTable' application can be floated to a CAF.
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
                               -- See Note [Proc-point local block entry-points].

-- Constructing Cmm Labels
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, 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
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. 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
                                    -- RTS symbols don't need "GHC.CmmToC" to
                                    -- generate \"extern\" declaration (they are
                                    -- exposed via rts/include/Stg.h)

mkLocalBlockLabel :: Unique -> CLabel
mkLocalBlockLabel :: Unique -> CLabel
mkLocalBlockLabel Unique
u = Unique -> CLabel
LocalBlockLabel Unique
u

-- Constructing RtsLabels
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)


-- A call to some primitive hand written Cmm code
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


-- Constructing ForeignLabels

-- | Make a foreign label
mkForeignLabel
        :: FastString           -- name
        -> Maybe Int            -- size prefix
        -> ForeignLabelSource   -- what package it's in
        -> FunctionOrData
        -> CLabel

mkForeignLabel :: FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel = FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
ForeignLabel


-- | Update the label size field in a 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

-- | Whether label is a top-level string literal
isBytesLabel :: CLabel -> Bool
isBytesLabel :: CLabel -> Bool
isBytesLabel (IdLabel Name
_ CafInfo
_ IdLabelInfo
Bytes) = Bool
True
isBytesLabel CLabel
_lbl = Bool
False

-- | Whether label is a non-haskell label (defined in C code)
isForeignLabel :: CLabel -> Bool
isForeignLabel :: CLabel -> Bool
isForeignLabel (ForeignLabel FastString
_ Maybe Int
_ ForeignLabelSource
_ FunctionOrData
_) = Bool
True
isForeignLabel CLabel
_lbl = Bool
False

-- | Whether label is a static closure label (can come from haskell or cmm)
isStaticClosureLabel :: CLabel -> Bool
-- Closure defined in haskell (.hs)
isStaticClosureLabel :: CLabel -> Bool
isStaticClosureLabel (IdLabel Name
_ CafInfo
_ IdLabelInfo
Closure) = Bool
True
-- Closure defined in cmm
isStaticClosureLabel (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmClosure) = Bool
True
isStaticClosureLabel CLabel
_lbl = Bool
False

-- | Whether label is a .rodata label
isSomeRODataLabel :: CLabel -> Bool
-- info table defined in haskell (.hs)
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
-- info table defined in cmm (.cmm)
isSomeRODataLabel (CmmLabel UnitId
_ NeedExternDecl
_ FastString
_ CmmLabelInfo
CmmInfo) = Bool
True
isSomeRODataLabel CLabel
_lbl = Bool
False

-- | Whether label is points to some kind of info table
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 CLabel
_                            = Bool
False

-- | Whether label is points to constructor info table
isConInfoTableLabel :: CLabel -> Bool
isConInfoTableLabel :: CLabel -> Bool
isConInfoTableLabel (IdLabel Name
_ CafInfo
_ ConInfoTable {})   = Bool
True
isConInfoTableLabel CLabel
_                            = Bool
False

-- | Get the label size field from a ForeignLabel
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


-- Constructing Large*Labels
mkBitmapLabel   :: Unique -> CLabel
mkBitmapLabel :: Unique -> CLabel
mkBitmapLabel   Unique
uniq            = Unique -> CLabel
LargeBitmapLabel Unique
uniq

-- | Info Table Provenance Entry
-- See Note [Mapping Info Tables to Source Positions]
data InfoProvEnt = InfoProvEnt
                               { InfoProvEnt -> CLabel
infoTablePtr :: !CLabel
                               -- Address of the info table
                               , InfoProvEnt -> Int
infoProvEntClosureType :: !Int
                               -- The closure type of the info table (from ClosureMacros.h)
                               , InfoProvEnt -> String
infoTableType :: !String
                               -- The rendered Haskell type of the closure the table represents
                               , InfoProvEnt -> Module
infoProvModule :: !Module
                               -- Origin module
                               , InfoProvEnt -> Maybe (RealSrcSpan, String)
infoTableProv :: !(Maybe (RealSrcSpan, String)) }
                               -- Position and information about the info table
                               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)

-- Constructing Cost Center Labels
mkCCLabel  :: CostCentre      -> CLabel
mkCCSLabel :: CostCentreStack -> CLabel
mkIPELabel :: InfoProvEnt -> 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 :: InfoProvEnt -> CLabel
mkIPELabel          InfoProvEnt
ipe         = InfoProvEnt -> CLabel
IPE_Label InfoProvEnt
ipe

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)


-- Constructing Code Coverage Labels
mkHpcTicksLabel :: Module -> CLabel
mkHpcTicksLabel :: Module -> CLabel
mkHpcTicksLabel                = Module -> CLabel
HpcTicksLabel


-- Constructing labels used for dynamic linking
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


-- Constructing miscellaneous other labels
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 -> String -> CLabel
mkInitializerStubLabel :: Module -> String -> CLabel
mkInitializerStubLabel Module
mod String
s    = Module -> ModuleLabelKind -> CLabel
ModuleLabel Module
mod (String -> ModuleLabelKind
MLK_Initializer String
s)

mkInitializerArrayLabel :: Module -> CLabel
mkInitializerArrayLabel :: Module -> CLabel
mkInitializerArrayLabel Module
mod     = Module -> ModuleLabelKind -> CLabel
ModuleLabel Module
mod ModuleLabelKind
MLK_InitializerArray


mkFinalizerStubLabel :: Module -> String -> CLabel
mkFinalizerStubLabel :: Module -> String -> CLabel
mkFinalizerStubLabel Module
mod String
s      = Module -> ModuleLabelKind -> CLabel
ModuleLabel Module
mod (String -> ModuleLabelKind
MLK_Finalizer String
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")

-- | A label indicating the end of a procedure.
mkAsmTempProcEndLabel :: CLabel -> CLabel
mkAsmTempProcEndLabel :: CLabel -> CLabel
mkAsmTempProcEndLabel CLabel
l = CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel CLabel
l (String -> FastString
fsLit String
"_proc_end")

-- | Construct a label for a DWARF Debug Information Entity (DIE)
-- describing another symbol.
mkAsmTempDieLabel :: CLabel -> CLabel
mkAsmTempDieLabel :: CLabel -> CLabel
mkAsmTempDieLabel CLabel
l = CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel CLabel
l (String -> FastString
fsLit String
"_die")

-- -----------------------------------------------------------------------------
-- Convert between different kinds of label

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)
                   -- See Note [Proc-point local block entry-points].
   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

-- -----------------------------------------------------------------------------
-- Does a CLabel's referent itself refer to a CAF?
hasCAF :: CLabel -> Bool
hasCAF :: CLabel -> Bool
hasCAF (IdLabel Name
_ CafInfo
_ (IdTickyInfo TickyIdInfo
TickyRednCounts)) = Bool
False -- See Note [ticky for LNE]
hasCAF (IdLabel Name
_ CafInfo
MayHaveCafRefs IdLabelInfo
_) = Bool
True
hasCAF CLabel
_                            = Bool
False

-- Note [ticky for LNE]
-- ~~~~~~~~~~~~~~~~~~~~~
-- Until 14 Feb 2013, every ticky counter was associated with a
-- closure. Thus, ticky labels used IdLabel. It is odd that
-- GHC.Cmm.Info.Build.cafTransfers would consider such a ticky label
-- reason to add the name to the CAFEnv (and thus eventually the SRT),
-- but it was harmless because the ticky was only used if the closure
-- was also.
--
-- Since we now have ticky counters for LNEs, it is no longer the case
-- that every ticky counter has an actual closure. So I changed the
-- generation of ticky counters' CLabels to not result in their
-- associated id ending up in the SRT.
--
-- NB IdLabel is still appropriate for ticky ids (as opposed to
-- CmmLabel) because the LNE's counter is still related to an .hs Id,
-- that Id just isn't for a proper closure.

-- -----------------------------------------------------------------------------
-- Does a CLabel need declaring before use or not?
--
-- See wiki:commentary/compiler/backends/ppr-c#prototypes

needsCDecl :: CLabel -> Bool
  -- False <=> it's pre-declared; don't bother
  -- don't bother declaring Bitmap labels, we always make sure
  -- they are defined before use.
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
_)
        -- local labels mustn't have it
        | Bool -> Bool
not Bool
external                  = Bool
False

        -- Prototypes for labels defined in the runtime system are imported
        --      into HC files via rts/include/Stg.h.
        | UnitId
pkgId UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
rtsUnitId            = Bool
False

        -- For other labels we inline one into the HC file directly.
        | 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. String -> a
panic String
"needsCDecl DynamicLinkerLabel"
needsCDecl CLabel
PicBaseLabel                 = String -> Bool
forall a. String -> a
panic String
"needsCDecl PicBaseLabel"
needsCDecl (DeadStripPreventer {})      = String -> Bool
forall a. String -> a
panic String
"needsCDecl DeadStripPreventer"

modLabelNeedsCDecl :: ModuleLabelKind -> Bool
-- Code for finalizers and initializers are emitted in stub objects
modLabelNeedsCDecl :: ModuleLabelKind -> Bool
modLabelNeedsCDecl (MLK_Initializer String
_)  = Bool
True
modLabelNeedsCDecl (MLK_Finalizer   String
_)  = Bool
True
-- The finalizer and initializer arrays are emitted in the code of the module
modLabelNeedsCDecl ModuleLabelKind
MLK_InitializerArray = Bool
False
modLabelNeedsCDecl ModuleLabelKind
MLK_FinalizerArray   = Bool
False

-- | If a label is a local block label then return just its 'BlockId', otherwise
-- 'Nothing'.
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


-- | Check whether a label corresponds to a C function that has
--      a prototype in a system header somewhere, or is built-in
--      to the C compiler. For these labels we avoid generating our
--      own C prototypes.
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 [
        -- _ISOC99_SOURCE
        (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"),
        -- ISO C 99 also defines these function-like macros in math.h:
        -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
        -- isgreaterequal, isless, islessequal, islessgreater, isunordered

        -- additional symbols from _BSD_SOURCE
        (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"),

        -- These functions are described in IEEE Std 754-2008 -
        -- Standard for Floating-Point Arithmetic and ISO/IEC TS 18661
        (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")
    ]

-- -----------------------------------------------------------------------------
-- | Is a CLabel visible outside this object file or not?
--      From the point of view of the code generator, a name is
--      externally visible if it has to be declared as exported
--      in the .o file's symbol table; that is, made non-static.
externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
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. String -> a
panic String
"externallyVisibleCLabel PicBaseLabel"
externallyVisibleCLabel (DeadStripPreventer {}) = String -> Bool
forall a. 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

-- -----------------------------------------------------------------------------
-- Finding the "type" of a CLabel

-- For generating correct types in label declarations:

data CLabelType
  = CodeLabel   -- Address of some executable instructions
  | DataLabel   -- Address of data, not a GC ptr
  | GcPtrLabel  -- Address of a (presumably static) GC object

isCFunctionLabel :: CLabel -> Bool
isCFunctionLabel :: 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


-- | Work out the general type of data at the address of this label
--    whether it be code, data, or static GC object.
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 (RtsApInfoTable Bool
_ Int
_))       = CLabelType
DataLabel
labelType (RtsLabel (RtsApFast NonDetFastString
_))              = CLabelType
CodeLabel
labelType (RtsLabel RtsLabelInfo
_)                          = 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. String -> a
panic String
"labelType(AsmTempLabel)"
labelType (AsmTempDerivedLabel CLabel
_ FastString
_)             = String -> CLabelType
forall a. 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 -- Is this right?
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 String
_    -> CLabelType
CodeLabel
    ModuleLabelKind
MLK_InitializerArray -> CLabelType
DataLabel
    MLK_Finalizer String
_      -> CLabelType
CodeLabel
    ModuleLabelKind
MLK_FinalizerArray   -> 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


-- -----------------------------------------------------------------------------

-- | Is a 'CLabel' defined in the current module being compiled?
--
-- Sometimes we can optimise references within a compilation unit in ways that
-- we couldn't for inter-module references. This provides a conservative
-- estimate of whether a 'CLabel' lives in the current module.
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

-- -----------------------------------------------------------------------------

-- | Does a 'CLabel' need dynamic linkage?
--
-- When referring to data in code, we need to know whether
-- that data resides in a DLL or not. [Win32 only.]
-- @labelDynamic@ returns @True@ if the label is located
-- in a DLL, be it a data reference or not.
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
   -- is the RTS in a DLL or not?
   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

   -- When compiling in the "dyn" way, each package is to be linked into
   -- its own shared library.
   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
            -- Foreign label is in some un-named foreign package (or DLL).
            ForeignLabelSource
ForeignLabelInExternalPackage -> Bool
True

            -- Foreign label is linked into the same package as the
            -- source file currently being compiled.
            ForeignLabelSource
ForeignLabelInThisPackage -> Bool
False

            -- Foreign label is in some named package.
            -- When compiling in the "dyn" way, each package is to be
            -- linked into its own DLL.
            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 -- On Mac OS X and on ELF platforms, false positives are OK,
            -- so we claim that all foreign imports come from dynamic
            -- libraries
            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 always contains a CostCentre defined in the current module
   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

   -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
   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)

-----------------------------------------------------------------------------
-- Printing out CLabels.

{-
Convention:

      <name>_<type>

where <name> is <Module>_<name> for external names and <unique> for
internal names. <type> is one of the following:

         info                   Info table
         srt                    Static reference table
         entry                  Entry code (function, closure)
         slow                   Slow entry code (if any)
         ret                    Direct return address
         vtbl                   Vector table
         <n>_alt                Case alternative (tag n)
         dflt                   Default case alternative
         btm                    Large bitmap vector
         closure                Static closure
         con_entry              Dynamic Constructor entry code
         con_info               Dynamic Constructor info table
         static_entry           Static Constructor entry code
         static_info            Static Constructor info table
         sel_info               Selector info table
         sel_entry              Selector entry code
         cc                     Cost centre
         ccs                    Cost centre stack

Many of these distinctions are only for documentation reasons.  For
example, _ret is only distinguished from _entry to make it easy to
tell whether a code fragment is a return point or a closure/function
entry.

Note [Closure and info labels]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For a function 'foo, we have:
   foo_info    : Points to the info table describing foo's closure
                 (and entry code for foo with tables next to code)
   foo_closure : Static (no-free-var) closure only:
                 points to the statically-allocated closure

For a data constructor (such as Just or Nothing), we have:
    Just_con_info: Info table for the data constructor itself
                   the first word of a heap-allocated Just
    Just_info:     Info table for the *worker function*, an
                   ordinary Haskell function of arity 1 that
                   allocates a (Just x) box:
                      Just = \x -> Just x
    Just_closure:  The closure for this worker

    Nothing_closure: a statically allocated closure for Nothing
    Nothing_static_info: info table for Nothing_closure

All these must be exported symbol, EXCEPT Just_info.  We don't need to
export this because in other modules we either have
       * A reference to 'Just'; use Just_closure
       * A saturated call 'Just x'; allocate using Just_con_info
Not exporting these Just_info labels reduces the number of symbols
somewhat.

Note [Bytes label]
~~~~~~~~~~~~~~~~~~
For a top-level string literal 'foo', we have just one symbol 'foo_bytes', which
points to a static data block containing the content of the literal.

Note [Proc-point local block entry-points]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A label for a proc-point local block entry-point has no "_entry" suffix. With
`infoTblLbl` we derive an info table label from a proc-point block ID. If
we convert such an info table label into an entry label we must produce
the label without an "_entry" suffix. So an info table label records
the fact that it was derived from a block ID in `IdLabelInfo` as
`BlockInfoTable`.

The info table label and the local block label are both local labels
and are not externally visible.

Note [Bangs in CLabel]
~~~~~~~~~~~~~~~~~~~~~~
There are some carefully placed strictness annotations in this module,
which were discovered in !5226 to significantly reduce compile-time
allocation.  Take care if you want to remove them!

-}

instance OutputableP Platform CLabel where
  {-# INLINE pdoc #-} -- see Note [Bangs in CLabel]
  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 ->
                        let !sty :: LabelStyle
sty = case PprStyle
pp_sty of
                                    PprCode LabelStyle
sty -> LabelStyle
sty
                                    PprStyle
_           -> LabelStyle
CStyle
                        in Platform -> LabelStyle -> CLabel -> SDoc
pprCLabel Platform
platform LabelStyle
sty CLabel
lbl

pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc
pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc
pprCLabel !Platform
platform !LabelStyle
sty CLabel
lbl = -- see Note [Bangs in CLabel]
  let
    !use_leading_underscores :: Bool
use_leading_underscores = Platform -> Bool
platformLeadingUnderscore Platform
platform

    -- some platform (e.g. Darwin) require a leading "_" for exported asm
    -- symbols
    maybe_underscore :: SDoc -> SDoc
    maybe_underscore :: SDoc -> SDoc
maybe_underscore SDoc
doc = case LabelStyle
sty of
      LabelStyle
AsmStyle | Bool
use_leading_underscores -> SDoc
pp_cSEP SDoc -> SDoc -> SDoc
<> SDoc
doc
      LabelStyle
_                                  -> SDoc
doc

    tempLabelPrefixOrUnderscore :: Platform -> SDoc
    tempLabelPrefixOrUnderscore :: Platform -> SDoc
tempLabelPrefixOrUnderscore Platform
platform = case LabelStyle
sty of
      LabelStyle
AsmStyle -> Platform -> SDoc
asmTempLabelPrefix Platform
platform
      LabelStyle
CStyle   -> Char -> SDoc
char Char
'_'


  in case CLabel
lbl of
   LocalBlockLabel Unique
u -> case LabelStyle
sty of
      LabelStyle
AsmStyle -> Platform -> SDoc
tempLabelPrefixOrUnderscore Platform
platform SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
      LabelStyle
CStyle   -> Platform -> SDoc
tempLabelPrefixOrUnderscore Platform
platform SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"blk_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u

   AsmTempLabel Unique
u
      -> Platform -> SDoc
tempLabelPrefixOrUnderscore Platform
platform SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u

   AsmTempDerivedLabel CLabel
l FastString
suf
      -> Platform -> SDoc
asmTempLabelPrefix Platform
platform
         SDoc -> SDoc -> SDoc
<> case CLabel
l of AsmTempLabel Unique
u    -> Unique -> SDoc
pprUniqueAlways Unique
u
                      LocalBlockLabel Unique
u -> Unique -> SDoc
pprUniqueAlways Unique
u
                      CLabel
_other            -> Platform -> LabelStyle -> CLabel -> SDoc
pprCLabel Platform
platform LabelStyle
sty CLabel
l
         SDoc -> SDoc -> SDoc
<> FastString -> SDoc
ftext FastString
suf

   DynamicLinkerLabel DynamicLinkerLabelInfo
info CLabel
lbl
      -> Platform -> DynamicLinkerLabelInfo -> SDoc -> SDoc
pprDynamicLinkerAsmLabel Platform
platform DynamicLinkerLabelInfo
info (Platform -> LabelStyle -> CLabel -> SDoc
pprCLabel Platform
platform LabelStyle
AsmStyle CLabel
lbl)

   CLabel
PicBaseLabel
      -> String -> SDoc
text String
"1b"

   DeadStripPreventer CLabel
lbl
      ->
      {-
         `lbl` can be temp one but we need to ensure that dsp label will stay
         in the final binary so we prepend non-temp prefix ("dsp_") and
         optional `_` (underscore) because this is how you mark non-temp symbols
         on some platforms (Darwin)
      -}
      SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"dsp_" SDoc -> SDoc -> SDoc
<> Platform -> LabelStyle -> CLabel -> SDoc
pprCLabel Platform
platform LabelStyle
sty CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_dsp"

   StringLitLabel Unique
u
      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Unique -> SDoc
pprUniqueAlways Unique
u SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_str"

   ForeignLabel FastString
fs (Just Int
sz) ForeignLabelSource
_ FunctionOrData
_
      | LabelStyle
AsmStyle <- LabelStyle
sty
      , OS
OSMinGW32 <- Platform -> OS
platformOS Platform
platform
      -> -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
         -- (The C compiler does this itself).
         SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext FastString
fs SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
sz

   ForeignLabel FastString
fs Maybe Int
_ ForeignLabelSource
_ FunctionOrData
_
      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext FastString
fs


   IdLabel Name
name CafInfo
_cafs IdLabelInfo
flavor -> case LabelStyle
sty of
      LabelStyle
AsmStyle -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
internalNamePrefix SDoc -> SDoc -> SDoc
<> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
<> IdLabelInfo -> SDoc
ppIdFlavor IdLabelInfo
flavor
                   where
                      isRandomGenerated :: Bool
isRandomGenerated = Bool -> Bool
not (Name -> Bool
isExternalName Name
name)
                      internalNamePrefix :: SDoc
internalNamePrefix =
                         if Bool
isRandomGenerated
                            then Platform -> SDoc
asmTempLabelPrefix Platform
platform
                            else SDoc
empty
      LabelStyle
CStyle   -> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
<> IdLabelInfo -> SDoc
ppIdFlavor IdLabelInfo
flavor

   SRTLabel Unique
u
      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Platform -> SDoc
tempLabelPrefixOrUnderscore Platform
platform SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u SDoc -> SDoc -> SDoc
<> SDoc
pp_cSEP SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"srt"

   RtsLabel (RtsApFast (NonDetFastString FastString
str))
      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext FastString
str SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_fast"

   RtsLabel (RtsSelectorInfoTable Bool
upd_reqd Int
offset)
      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"stg_sel_", String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
offset)
                                 , if Bool
upd_reqd
                                    then String -> SDoc
text String
"_upd_info"
                                    else String -> SDoc
text String
"_noupd_info"
                                 ]

   RtsLabel (RtsSelectorEntry Bool
upd_reqd Int
offset)
      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"stg_sel_", String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
offset)
                                 , if Bool
upd_reqd
                                    then String -> SDoc
text String
"_upd_entry"
                                    else String -> SDoc
text String
"_noupd_entry"
                                 ]

   RtsLabel (RtsApInfoTable Bool
upd_reqd Int
arity)
      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"stg_ap_", String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
arity)
                                 , if Bool
upd_reqd
                                    then String -> SDoc
text String
"_upd_info"
                                    else String -> SDoc
text String
"_noupd_info"
                                 ]

   RtsLabel (RtsApEntry Bool
upd_reqd Int
arity)
      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"stg_ap_", String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
arity)
                                 , if Bool
upd_reqd
                                    then String -> SDoc
text String
"_upd_entry"
                                    else String -> SDoc
text String
"_noupd_entry"
                                 ]

   RtsLabel (RtsPrimOp PrimOp
primop)
      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"stg_" SDoc -> SDoc -> SDoc
<> PrimOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimOp
primop

   RtsLabel (RtsSlowFastTickyCtr String
pat)
      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"SLOW_CALL_fast_" SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
pat SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_ctr"

   LargeBitmapLabel Unique
u
      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Platform -> SDoc
tempLabelPrefixOrUnderscore Platform
platform
                            SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'b' SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u SDoc -> SDoc -> SDoc
<> SDoc
pp_cSEP SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"btm"
                            -- Some bitmaps for tuple constructors have a numeric tag (e.g. '7')
                            -- until that gets resolved we'll just force them to start
                            -- with a letter so the label will be legal assembly code.

   HpcTicksLabel Module
mod
      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"_hpc_tickboxes_"  SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_hpc"

   CC_Label CostCentre
cc   -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ CostCentre -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentre
cc
   CCS_Label CostCentreStack
ccs -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ CostCentreStack -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentreStack
ccs
   IPE_Label (InfoProvEnt CLabel
l Int
_ String
_ Module
m Maybe (RealSrcSpan, String)
_) -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ (LabelStyle -> SDoc -> SDoc
pprCode LabelStyle
CStyle (Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
l) SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_" SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_ipe")
   ModuleLabel Module
mod ModuleLabelKind
kind        -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_" SDoc -> SDoc -> SDoc
<> ModuleLabelKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleLabelKind
kind

   CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmCode     -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext FastString
fs
   CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmData     -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext FastString
fs
   CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmPrimCall -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext FastString
fs
   CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmInfo     -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext FastString
fs SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_info"
   CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmEntry    -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext FastString
fs SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_entry"
   CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmRetInfo  -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext FastString
fs SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_info"
   CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmRet      -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext FastString
fs SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_ret"
   CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmClosure  -> SDoc -> SDoc
maybe_underscore (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext FastString
fs SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_closure"

-- Note [Internal proc labels]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Some tools (e.g. the `perf` utility on Linux) rely on the symbol table
-- for resolution of function names. To help these tools we provide the
-- (enabled by default) -fexpose-all-symbols flag which causes GHC to produce
-- symbols even for symbols with are internal to a module (although such
-- symbols will have only local linkage).
--
-- Note that these labels are *not* referred to by code. They are strictly for
-- diagnostics purposes.
--
-- To avoid confusion, it is desirable to add a module-qualifier to the
-- symbol name. However, the Name type's Internal constructor doesn't carry
-- knowledge of the current Module. Consequently, we have to pass this around
-- explicitly.

-- | Generate a label for a procedure internal to a module (if
-- 'Opt_ExposeAllSymbols' is enabled).
-- See Note [Internal proc labels].
ppInternalProcLabel :: Module     -- ^ the current module
                    -> CLabel
                    -> Maybe SDoc -- ^ the internal proc label
ppInternalProcLabel :: Module -> CLabel -> Maybe SDoc
ppInternalProcLabel Module
this_mod (IdLabel Name
nm CafInfo
_ IdLabelInfo
flavour)
  | Name -> Bool
isInternalName Name
nm
  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just
     (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"_" SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod
    SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'_'
    SDoc -> SDoc -> SDoc
<> FastZString -> SDoc
ztext (FastString -> FastZString
zEncodeFS (OccName -> FastString
occNameFS (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
nm)))
    SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'_'
    SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways (Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique Name
nm)
    SDoc -> SDoc -> SDoc
<> IdLabelInfo -> SDoc
ppIdFlavor IdLabelInfo
flavour
ppInternalProcLabel Module
_ CLabel
_ = Maybe SDoc
forall a. Maybe a
Nothing

ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor IdLabelInfo
x = SDoc
pp_cSEP SDoc -> SDoc -> SDoc
<> case IdLabelInfo
x of
   IdLabelInfo
Closure          -> String -> SDoc
text String
"closure"
   IdLabelInfo
InfoTable        -> String -> SDoc
text String
"info"
   IdLabelInfo
LocalInfoTable   -> String -> SDoc
text String
"info"
   IdLabelInfo
Entry            -> String -> SDoc
text String
"entry"
   IdLabelInfo
LocalEntry       -> String -> SDoc
text String
"entry"
   IdLabelInfo
Slow             -> String -> SDoc
text String
"slow"
   IdTickyInfo TickyIdInfo
TickyRednCounts
      -> String -> SDoc
text String
"ct"
   IdTickyInfo (TickyInferedTag Unique
unique)
      -> String -> SDoc
text String
"ct_inf_tag" SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'_' SDoc -> SDoc -> SDoc
<> Unique -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unique
unique
   ConEntry ConInfoTableLocation
loc      ->
      case ConInfoTableLocation
loc of
        ConInfoTableLocation
DefinitionSite -> String -> SDoc
text String
"con_entry"
        UsageSite Module
m Int
n ->
          Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m SDoc -> SDoc -> SDoc
<> SDoc
pp_cSEP SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n SDoc -> SDoc -> SDoc
<> SDoc
pp_cSEP SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"con_entry"
   ConInfoTable ConInfoTableLocation
k   ->
    case ConInfoTableLocation
k of
      ConInfoTableLocation
DefinitionSite -> String -> SDoc
text String
"con_info"
      UsageSite Module
m Int
n ->
        Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m SDoc -> SDoc -> SDoc
<> SDoc
pp_cSEP SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n SDoc -> SDoc -> SDoc
<> SDoc
pp_cSEP SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"con_info"
   IdLabelInfo
ClosureTable     -> String -> SDoc
text String
"closure_tbl"
   IdLabelInfo
Bytes            -> String -> SDoc
text String
"bytes"
   IdLabelInfo
BlockInfoTable   -> String -> SDoc
text String
"info"

pp_cSEP :: SDoc
pp_cSEP :: SDoc
pp_cSEP = Char -> SDoc
char Char
'_'


instance Outputable ForeignLabelSource where
 ppr :: ForeignLabelSource -> SDoc
ppr ForeignLabelSource
fs
  = case ForeignLabelSource
fs of
        ForeignLabelInPackage UnitId
pkgId     -> SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"package: " SDoc -> SDoc -> SDoc
<> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pkgId
        ForeignLabelSource
ForeignLabelInThisPackage       -> SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"this package"
        ForeignLabelSource
ForeignLabelInExternalPackage   -> SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"external package"

-- -----------------------------------------------------------------------------
-- Machine-dependent knowledge about labels.

asmTempLabelPrefix :: Platform -> SDoc  -- for formatting labels
asmTempLabelPrefix :: Platform -> SDoc
asmTempLabelPrefix !Platform
platform = case Platform -> OS
platformOS Platform
platform of
    OS
OSDarwin -> String -> SDoc
text String
"L"
    OS
OSAIX    -> String -> SDoc
text String
"__L" -- follow IBM XL C's convention
    OS
_        -> String -> SDoc
text String
".L"

pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> SDoc -> SDoc
pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> SDoc -> SDoc
pprDynamicLinkerAsmLabel !Platform
platform DynamicLinkerLabelInfo
dllInfo SDoc
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 -> SDoc
char Char
'L' SDoc -> SDoc -> SDoc
<> SDoc
ppLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$stub"
            DynamicLinkerLabelInfo
SymbolPtr       -> Char -> SDoc
char Char
'L' SDoc -> SDoc -> SDoc
<> SDoc
ppLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$non_lazy_ptr"
            DynamicLinkerLabelInfo
GotSymbolPtr    -> SDoc
ppLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@GOTPCREL"
            DynamicLinkerLabelInfo
GotSymbolOffset -> SDoc
ppLbl
        | Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchAArch64 -> SDoc
ppLbl
        | Bool
otherwise ->
          case DynamicLinkerLabelInfo
dllInfo of
            DynamicLinkerLabelInfo
CodeStub  -> Char -> SDoc
char Char
'L' SDoc -> SDoc -> SDoc
<> SDoc
ppLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$stub"
            DynamicLinkerLabelInfo
SymbolPtr -> Char -> SDoc
char Char
'L' SDoc -> SDoc -> SDoc
<> SDoc
ppLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$non_lazy_ptr"
            DynamicLinkerLabelInfo
_         -> String -> SDoc
forall a. String -> a
panic String
"pprDynamicLinkerAsmLabel"

      OS
OSAIX ->
          case DynamicLinkerLabelInfo
dllInfo of
            DynamicLinkerLabelInfo
SymbolPtr -> String -> SDoc
text String
"LC.." SDoc -> SDoc -> SDoc
<> SDoc
ppLbl -- GCC's naming convention
            DynamicLinkerLabelInfo
_         -> String -> SDoc
forall a. String -> a
panic String
"pprDynamicLinkerAsmLabel"

      OS
_ | OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform) -> SDoc
elfLabel

      OS
OSMinGW32 ->
          case DynamicLinkerLabelInfo
dllInfo of
            DynamicLinkerLabelInfo
SymbolPtr -> String -> SDoc
text String
"__imp_" SDoc -> SDoc -> SDoc
<> SDoc
ppLbl
            DynamicLinkerLabelInfo
_         -> String -> SDoc
forall a. String -> a
panic String
"pprDynamicLinkerAsmLabel"

      OS
_ -> String -> SDoc
forall a. String -> a
panic String
"pprDynamicLinkerAsmLabel"
  where
    elfLabel :: SDoc
elfLabel
      | Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchPPC
      = case DynamicLinkerLabelInfo
dllInfo of
          DynamicLinkerLabelInfo
CodeStub  -> -- See Note [.LCTOC1 in PPC PIC code]
                       SDoc
ppLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"+32768@plt"
          DynamicLinkerLabelInfo
SymbolPtr -> String -> SDoc
text String
".LC_" SDoc -> SDoc -> SDoc
<> SDoc
ppLbl
          DynamicLinkerLabelInfo
_         -> String -> SDoc
forall a. String -> a
panic String
"pprDynamicLinkerAsmLabel"

      | Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchAArch64
      = SDoc
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        -> SDoc
ppLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@plt"
          DynamicLinkerLabelInfo
GotSymbolPtr    -> SDoc
ppLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@gotpcrel"
          DynamicLinkerLabelInfo
GotSymbolOffset -> SDoc
ppLbl
          DynamicLinkerLabelInfo
SymbolPtr       -> String -> SDoc
text String
".LC_" SDoc -> SDoc -> SDoc
<> SDoc
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 -> SDoc
text String
".LC_"  SDoc -> SDoc -> SDoc
<> SDoc
ppLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@toc"
          DynamicLinkerLabelInfo
GotSymbolOffset -> SDoc
ppLbl
          DynamicLinkerLabelInfo
SymbolPtr       -> String -> SDoc
text String
".LC_" SDoc -> SDoc -> SDoc
<> SDoc
ppLbl
          DynamicLinkerLabelInfo
_               -> String -> SDoc
forall a. String -> a
panic String
"pprDynamicLinkerAsmLabel"

      | Bool
otherwise
      = case DynamicLinkerLabelInfo
dllInfo of
          DynamicLinkerLabelInfo
CodeStub        -> SDoc
ppLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@plt"
          DynamicLinkerLabelInfo
SymbolPtr       -> String -> SDoc
text String
".LC_" SDoc -> SDoc -> SDoc
<> SDoc
ppLbl
          DynamicLinkerLabelInfo
GotSymbolPtr    -> SDoc
ppLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@got"
          DynamicLinkerLabelInfo
GotSymbolOffset -> SDoc
ppLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@gotoff"

-- Figure out whether `symbol` may serve as an alias
-- to `target` within one compilation unit.
--
-- This is true if any of these holds:
-- * `target` is a module-internal haskell name.
-- * `target` is an exported name, but comes from the same
--   module as `symbol`
--
-- These are sufficient conditions for establishing e.g. a
-- GNU assembly alias ('.equiv' directive). Sadly, there is
-- no such thing as an alias to an imported symbol (conf.
-- http://blog.omega-prime.co.uk/2011/07/06/the-sad-state-of-symbol-aliases/)
-- See Note [emit-time elimination of static indirections].
--
-- Precondition is that both labels represent the
-- same semantic value.

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


{-
Note [emit-time elimination of static indirections]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As described in #15155, certain static values are representationally
equivalent, e.g. 'cast'ed values (when created by 'newtype' wrappers).

             newtype A = A Int
             {-# NOINLINE a #-}
             a = A 42

a1_rYB :: Int
[GblId, Caf=NoCafRefs, Unf=OtherCon []]
a1_rYB = GHC.Types.I# 42#

a [InlPrag=NOINLINE] :: A
[GblId, Unf=OtherCon []]
a = a1_rYB `cast` (Sym (T15155.N:A[0]) :: Int ~R# A)

Formerly we created static indirections for these (IND_STATIC), which
consist of a statically allocated forwarding closure that contains
the (possibly tagged) indirectee. (See CMM/assembly below.)
This approach is suboptimal for two reasons:
  (a) they occupy extra space,
  (b) they need to be entered in order to obtain the indirectee,
      thus they cannot be tagged.

Fortunately there is a common case where static indirections can be
eliminated while emitting assembly (native or LLVM), viz. when the
indirectee is in the same module (object file) as the symbol that
points to it. In this case an assembly-level identification can
be created ('.equiv' directive), and as such the same object will
be assigned two names in the symbol table. Any of the identified
symbols can be referenced by a tagged pointer.

Currently the 'mayRedirectTo' predicate will
give a clue whether a label can be equated with another, already
emitted, label (which can in turn be an alias). The general mechanics
is that we identify data (IND_STATIC closures) that are amenable
to aliasing while pretty-printing of assembly output, and emit the
'.equiv' directive instead of static data in such a case.

Here is a sketch how the output is massaged:

                     Consider
newtype A = A Int
{-# NOINLINE a #-}
a = A 42                                -- I# 42# is the indirectee
                                        -- 'a' is exported

                 results in STG

a1_rXq :: GHC.Types.Int
[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
    CCS_DONT_CARE GHC.Types.I#! [42#];

T15155.a [InlPrag=NOINLINE] :: T15155.A
[GblId, Unf=OtherCon []] =
    CAF_ccs  \ u  []  a1_rXq;

                 and CMM

[section ""data" . a1_rXq_closure" {
     a1_rXq_closure:
         const GHC.Types.I#_con_info;
         const 42;
 }]

[section ""data" . T15155.a_closure" {
     T15155.a_closure:
         const stg_IND_STATIC_info;
         const a1_rXq_closure+1;
         const 0;
         const 0;
 }]

The emitted assembly is

==== INDIRECTEE
a1_rXq_closure:                         -- module local haskell value
        .quad   GHC.Types.I#_con_info   -- an Int
        .quad   42

==== BEFORE
.globl T15155.a_closure                 -- exported newtype wrapped value
T15155.a_closure:
        .quad   stg_IND_STATIC_info     -- the closure info
        .quad   a1_rXq_closure+1        -- indirectee ('+1' being the tag)
        .quad   0
        .quad   0

==== AFTER
.globl T15155.a_closure                 -- exported newtype wrapped value
.equiv a1_rXq_closure,T15155.a_closure  -- both are shared

The transformation is performed because
     T15155.a_closure `mayRedirectTo` a1_rXq_closure+1
returns True.
-}