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

{-# LANGUAGE CPP #-}

module CLabel (
        CLabel, -- abstract type
        NeedExternDecl (..),
        ForeignLabelSource(..),
        pprDebugCLabel,

        mkClosureLabel,
        mkSRTLabel,
        mkInfoTableLabel,
        mkEntryLabel,
        mkRednCountsLabel,
        mkConInfoTableLabel,
        mkApEntryLabel,
        mkApInfoTableLabel,
        mkClosureTableLabel,
        mkBytesLabel,

        mkLocalBlockLabel,
        mkLocalClosureLabel,
        mkLocalInfoTableLabel,
        mkLocalClosureTableLabel,

        mkBlockInfoTableLabel,

        mkBitmapLabel,
        mkStringLitLabel,

        mkAsmTempLabel,
        mkAsmTempDerivedLabel,
        mkAsmTempEndLabel,
        mkAsmTempDieLabel,

        mkDirty_MUT_VAR_Label,
        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,
        mkArrWords_infoLabel,
        mkSRTInfoLabel,

        mkTopTickyCtrLabel,
        mkCAFBlackHoleInfoTableLabel,
        mkRtsPrimOpLabel,
        mkRtsSlowFastTickyCtrLabel,

        mkSelectorInfoLabel,
        mkSelectorEntryLabel,

        mkCmmInfoLabel,
        mkCmmEntryLabel,
        mkCmmRetInfoLabel,
        mkCmmRetLabel,
        mkCmmCodeLabel,
        mkCmmDataLabel,
        mkRtsCmmDataLabel,
        mkCmmClosureLabel,

        mkRtsApFastLabel,

        mkPrimCallLabel,

        mkForeignLabel,
        addLabelSize,

        foreignLabelStdcallInfo,
        isBytesLabel,
        isForeignLabel,
        isSomeRODataLabel,
        isStaticClosureLabel,
        mkCCLabel, mkCCSLabel,

        DynamicLinkerLabelInfo(..),
        mkDynamicLinkerLabel,
        dynamicLinkerLabelInfo,

        mkPicBaseLabel,
        mkDeadStripPreventer,

        mkHpcTicksLabel,

        -- * Predicates
        hasCAF,
        needsCDecl, maybeLocalBlockLabel, externallyVisibleCLabel,
        isMathFun,
        isCFunctionLabel, isGcPtrLabel, labelDynamic,
        isLocalCLabel, mayRedirectTo,

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

        pprCLabel,
        isInfoTableLabel,
        isConInfoTableLabel
    ) where

#include "HsVersions.h"

import GhcPrelude

import IdInfo
import BasicTypes
import {-# SOURCE #-} BlockId (BlockId, mkBlockId)
import Packages
import Module
import Name
import Unique
import PrimOp
import CostCentre
import Outputable
import FastString
import DynFlags
import GHC.Platform
import UniqSet
import Util
import PprCore ( {- instances -} )

-- -----------------------------------------------------------------------------
-- 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


  -- | These labels are generated and used inside the NCG only.
  --    They are special variants of a label used for dynamic linking
  --    see module PositionIndependentCode 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
/= :: CLabel -> CLabel -> Bool
$c/= :: CLabel -> CLabel -> Bool
== :: CLabel -> CLabel -> Bool
$c== :: CLabel -> CLabel -> Bool
Eq

-- | 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 "includes/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
min :: NeedExternDecl -> NeedExternDecl -> NeedExternDecl
$cmin :: NeedExternDecl -> NeedExternDecl -> NeedExternDecl
max :: NeedExternDecl -> NeedExternDecl -> NeedExternDecl
$cmax :: NeedExternDecl -> NeedExternDecl -> NeedExternDecl
>= :: NeedExternDecl -> NeedExternDecl -> Bool
$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
compare :: NeedExternDecl -> NeedExternDecl -> Ordering
$ccompare :: NeedExternDecl -> NeedExternDecl -> Ordering
$cp1Ord :: Eq NeedExternDecl
Ord,NeedExternDecl -> NeedExternDecl -> Bool
(NeedExternDecl -> NeedExternDecl -> Bool)
-> (NeedExternDecl -> NeedExternDecl -> Bool) -> Eq NeedExternDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NeedExternDecl -> NeedExternDecl -> Bool
$c/= :: NeedExternDecl -> NeedExternDecl -> Bool
== :: NeedExternDecl -> NeedExternDecl -> Bool
$c== :: 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`
    FastString -> FastString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare 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
forall a. Ord a => a -> a -> Ordering
compare 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
forall a. Ord a => a -> a -> Ordering
compare 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 (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

-- | 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 currenly 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
/= :: ForeignLabelSource -> ForeignLabelSource -> Bool
$c/= :: ForeignLabelSource -> ForeignLabelSource -> Bool
== :: ForeignLabelSource -> ForeignLabelSource -> Bool
$c== :: 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
min :: ForeignLabelSource -> ForeignLabelSource -> ForeignLabelSource
$cmin :: ForeignLabelSource -> ForeignLabelSource -> ForeignLabelSource
max :: ForeignLabelSource -> ForeignLabelSource -> ForeignLabelSource
$cmax :: ForeignLabelSource -> ForeignLabelSource -> ForeignLabelSource
>= :: ForeignLabelSource -> ForeignLabelSource -> Bool
$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
compare :: ForeignLabelSource -> ForeignLabelSource -> Ordering
$ccompare :: ForeignLabelSource -> ForeignLabelSource -> Ordering
$cp1Ord :: Eq 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 :: CLabel -> SDoc
pprDebugCLabel :: CLabel -> SDoc
pprDebugCLabel CLabel
lbl
 = case CLabel
lbl of
        IdLabel Name
_ CafInfo
_ IdLabelInfo
info-> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> (SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"IdLabel"
                                       SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
whenPprDebug (String -> SDoc
text String
":" SDoc -> SDoc -> SDoc
<> String -> SDoc
text (IdLabelInfo -> String
forall a. Show a => a -> String
show IdLabelInfo
info)))
        CmmLabel UnitId
pkg NeedExternDecl
_ext FastString
_name CmmLabelInfo
_info
         -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> (SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"CmmLabel" SDoc -> SDoc -> SDoc
<+> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pkg)

        RtsLabel{}      -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> (SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"RtsLabel")

        ForeignLabel FastString
_name Maybe Int
mSuffix ForeignLabelSource
src FunctionOrData
funOrData
            -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> (SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ 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
_               -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> (SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"other CLabel")


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

  | RednCounts          -- ^ Label of place to keep Ticky-ticky  info for this Id

  | ConEntry            -- ^ Constructor entry point
  | ConInfoTable        -- ^ 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-point].

  deriving (IdLabelInfo -> IdLabelInfo -> Bool
(IdLabelInfo -> IdLabelInfo -> Bool)
-> (IdLabelInfo -> IdLabelInfo -> Bool) -> Eq IdLabelInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdLabelInfo -> IdLabelInfo -> Bool
$c/= :: IdLabelInfo -> IdLabelInfo -> Bool
== :: IdLabelInfo -> IdLabelInfo -> Bool
$c== :: 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
min :: IdLabelInfo -> IdLabelInfo -> IdLabelInfo
$cmin :: IdLabelInfo -> IdLabelInfo -> IdLabelInfo
max :: IdLabelInfo -> IdLabelInfo -> IdLabelInfo
$cmax :: IdLabelInfo -> IdLabelInfo -> IdLabelInfo
>= :: IdLabelInfo -> IdLabelInfo -> Bool
$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
compare :: IdLabelInfo -> IdLabelInfo -> Ordering
$ccompare :: IdLabelInfo -> IdLabelInfo -> Ordering
$cp1Ord :: Eq IdLabelInfo
Ord, Int -> IdLabelInfo -> ShowS
[IdLabelInfo] -> ShowS
IdLabelInfo -> String
(Int -> IdLabelInfo -> ShowS)
-> (IdLabelInfo -> String)
-> ([IdLabelInfo] -> ShowS)
-> Show IdLabelInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdLabelInfo] -> ShowS
$cshowList :: [IdLabelInfo] -> ShowS
show :: IdLabelInfo -> String
$cshow :: IdLabelInfo -> String
showsPrec :: Int -> IdLabelInfo -> ShowS
$cshowsPrec :: Int -> IdLabelInfo -> ShowS
Show)


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     FastString    -- ^ _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
/= :: RtsLabelInfo -> RtsLabelInfo -> Bool
$c/= :: RtsLabelInfo -> RtsLabelInfo -> Bool
== :: RtsLabelInfo -> RtsLabelInfo -> Bool
$c== :: 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
min :: RtsLabelInfo -> RtsLabelInfo -> RtsLabelInfo
$cmin :: RtsLabelInfo -> RtsLabelInfo -> RtsLabelInfo
max :: RtsLabelInfo -> RtsLabelInfo -> RtsLabelInfo
$cmax :: RtsLabelInfo -> RtsLabelInfo -> RtsLabelInfo
>= :: RtsLabelInfo -> RtsLabelInfo -> Bool
$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
compare :: RtsLabelInfo -> RtsLabelInfo -> Ordering
$ccompare :: RtsLabelInfo -> RtsLabelInfo -> Ordering
$cp1Ord :: Eq RtsLabelInfo
Ord)
  -- NOTE: Eq on PtrString compares the pointer only, so this isn't
  -- a real equality.


-- | 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
/= :: CmmLabelInfo -> CmmLabelInfo -> Bool
$c/= :: CmmLabelInfo -> CmmLabelInfo -> Bool
== :: CmmLabelInfo -> CmmLabelInfo -> Bool
$c== :: 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
min :: CmmLabelInfo -> CmmLabelInfo -> CmmLabelInfo
$cmin :: CmmLabelInfo -> CmmLabelInfo -> CmmLabelInfo
max :: CmmLabelInfo -> CmmLabelInfo -> CmmLabelInfo
$cmax :: CmmLabelInfo -> CmmLabelInfo -> CmmLabelInfo
>= :: CmmLabelInfo -> CmmLabelInfo -> Bool
$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
compare :: CmmLabelInfo -> CmmLabelInfo -> Ordering
$ccompare :: CmmLabelInfo -> CmmLabelInfo -> Ordering
$cp1Ord :: Eq 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
/= :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
$c/= :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
== :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
$c== :: 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
min :: DynamicLinkerLabelInfo
-> DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo
$cmin :: DynamicLinkerLabelInfo
-> DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo
max :: DynamicLinkerLabelInfo
-> DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo
$cmax :: DynamicLinkerLabelInfo
-> DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo
>= :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Bool
$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
compare :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Ordering
$ccompare :: DynamicLinkerLabelInfo -> DynamicLinkerLabelInfo -> Ordering
$cp1Ord :: Eq DynamicLinkerLabelInfo
Ord)


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

-- Constructing IdLabels
-- These are always local:

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

mkRednCountsLabel :: Name -> CLabel
mkRednCountsLabel :: Name -> CLabel
mkRednCountsLabel       Name
name    =
  Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
NoCafRefs IdLabelInfo
RednCounts  -- Note [ticky for LNE]

-- These have local & (possibly) external variants:
mkLocalClosureLabel      :: Name -> CafInfo -> CLabel
mkLocalInfoTableLabel    :: Name -> CafInfo -> CLabel
mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
mkLocalClosureLabel :: Name -> CafInfo -> CLabel
mkLocalClosureLabel     Name
name CafInfo
c  = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name  CafInfo
c IdLabelInfo
Closure
mkLocalInfoTableLabel :: Name -> CafInfo -> CLabel
mkLocalInfoTableLabel   Name
name CafInfo
c  = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name  CafInfo
c IdLabelInfo
LocalInfoTable
mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
mkLocalClosureTableLabel Name
name CafInfo
c = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name  CafInfo
c IdLabelInfo
ClosureTable

mkClosureLabel              :: Name -> CafInfo -> CLabel
mkInfoTableLabel            :: Name -> CafInfo -> CLabel
mkEntryLabel                :: Name -> CafInfo -> CLabel
mkClosureTableLabel         :: Name -> CafInfo -> CLabel
mkConInfoTableLabel         :: Name -> CafInfo -> CLabel
mkBytesLabel                :: Name -> CLabel
mkClosureLabel :: Name -> CafInfo -> CLabel
mkClosureLabel Name
name         CafInfo
c     = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
c IdLabelInfo
Closure
mkInfoTableLabel :: Name -> CafInfo -> CLabel
mkInfoTableLabel Name
name       CafInfo
c     = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
c IdLabelInfo
InfoTable
mkEntryLabel :: Name -> CafInfo -> CLabel
mkEntryLabel Name
name           CafInfo
c     = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
c IdLabelInfo
Entry
mkClosureTableLabel :: Name -> CafInfo -> CLabel
mkClosureTableLabel Name
name    CafInfo
c     = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
c IdLabelInfo
ClosureTable
mkConInfoTableLabel :: Name -> CafInfo -> CLabel
mkConInfoTableLabel Name
name    CafInfo
c     = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
name CafInfo
c IdLabelInfo
ConInfoTable
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-point].

-- 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 :: 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

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 includes/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  :: Bool -> Int -> CLabel
mkSelectorEntryLabel :: Bool -> Int -> CLabel
mkSelectorInfoLabel :: Bool -> Int -> CLabel
mkSelectorInfoLabel  Bool
upd Int
off    = RtsLabelInfo -> CLabel
RtsLabel (Bool -> Int -> RtsLabelInfo
RtsSelectorInfoTable Bool
upd Int
off)
mkSelectorEntryLabel :: Bool -> Int -> CLabel
mkSelectorEntryLabel Bool
upd Int
off    = RtsLabelInfo -> CLabel
RtsLabel (Bool -> Int -> RtsLabelInfo
RtsSelectorEntry     Bool
upd Int
off)

mkApInfoTableLabel :: Bool -> Int -> CLabel
mkApEntryLabel     :: Bool -> Int -> CLabel
mkApInfoTableLabel :: Bool -> Int -> CLabel
mkApInfoTableLabel   Bool
upd Int
off    = RtsLabelInfo -> CLabel
RtsLabel (Bool -> Int -> RtsLabelInfo
RtsApInfoTable       Bool
upd Int
off)
mkApEntryLabel :: Bool -> Int -> CLabel
mkApEntryLabel       Bool
upd Int
off    = RtsLabelInfo -> CLabel
RtsLabel (Bool -> Int -> RtsLabelInfo
RtsApEntry           Bool
upd Int
off)


-- A call to some primitive hand written Cmm code
mkPrimCallLabel :: PrimCall -> CLabel
mkPrimCallLabel :: PrimCall -> CLabel
mkPrimCallLabel (PrimCall FastString
str UnitId
pkg)
        = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel 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
_ IdLabelInfo
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
_ IdLabelInfo
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
_ IdLabelInfo
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

-- Constructing Cost Center Labels
mkCCLabel  :: CostCentre      -> CLabel
mkCCSLabel :: CostCentreStack -> 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

mkRtsApFastLabel :: FastString -> CLabel
mkRtsApFastLabel :: FastString -> CLabel
mkRtsApFastLabel FastString
str = RtsLabelInfo -> CLabel
RtsLabel (FastString -> RtsLabelInfo
RtsApFast 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

mkAsmTempLabel :: Uniquable a => a -> CLabel
mkAsmTempLabel :: 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")

-- | 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 :: CLabel -> CLabel
toClosureLbl :: CLabel -> CLabel
toClosureLbl (IdLabel Name
n CafInfo
c IdLabelInfo
_) = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
Closure
toClosureLbl (CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
_) = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmClosure
toClosureLbl CLabel
l = String -> SDoc -> CLabel
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"toClosureLbl" (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l)

toSlowEntryLbl :: CLabel -> CLabel
toSlowEntryLbl :: CLabel -> CLabel
toSlowEntryLbl (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)
toSlowEntryLbl (IdLabel Name
n CafInfo
c IdLabelInfo
_) = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
Slow
toSlowEntryLbl CLabel
l = String -> SDoc -> CLabel
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"toSlowEntryLbl" (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l)

toEntryLbl :: CLabel -> CLabel
toEntryLbl :: CLabel -> CLabel
toEntryLbl (IdLabel Name
n CafInfo
c IdLabelInfo
LocalInfoTable)  = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
LocalEntry
toEntryLbl (IdLabel Name
n CafInfo
c IdLabelInfo
ConInfoTable)    = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
ConEntry
toEntryLbl (IdLabel Name
n CafInfo
_ IdLabelInfo
BlockInfoTable)  = Unique -> CLabel
mkLocalBlockLabel (Name -> Unique
nameUnique Name
n)
                              -- See Note [Proc-point local block entry-point].
toEntryLbl (IdLabel Name
n CafInfo
c IdLabelInfo
_)               = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
Entry
toEntryLbl (CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmInfo)    = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmEntry
toEntryLbl (CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmRetInfo) = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmRet
toEntryLbl CLabel
l = String -> SDoc -> CLabel
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"toEntryLbl" (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l)

toInfoLbl :: CLabel -> CLabel
toInfoLbl :: CLabel -> CLabel
toInfoLbl (IdLabel Name
n CafInfo
c IdLabelInfo
LocalEntry)     = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
LocalInfoTable
toInfoLbl (IdLabel Name
n CafInfo
c IdLabelInfo
ConEntry)       = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
ConInfoTable
toInfoLbl (IdLabel Name
n CafInfo
c IdLabelInfo
_)              = Name -> CafInfo -> IdLabelInfo -> CLabel
IdLabel Name
n CafInfo
c IdLabelInfo
InfoTable
toInfoLbl (CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmEntry)= UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmInfo
toInfoLbl (CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmRet)  = UnitId -> NeedExternDecl -> FastString -> CmmLabelInfo -> CLabel
CmmLabel UnitId
m NeedExternDecl
ext FastString
str CmmLabelInfo
CmmRetInfo
toInfoLbl CLabel
l = String -> SDoc -> CLabel
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"CLabel.toInfoLbl" (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l)

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

-- -----------------------------------------------------------------------------
-- Does a CLabel's referent itself refer to a CAF?
hasCAF :: CLabel -> Bool
hasCAF :: CLabel -> Bool
hasCAF (IdLabel Name
_ CafInfo
_ IdLabelInfo
RednCounts) = Bool
False -- 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
-- CmmBuildInfoTables.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 includes/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 (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"

-- | 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 somehere, 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 (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 FastString
_))              = 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 (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

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
    IdLabelInfo
ConInfoTable  -> CLabelType
DataLabel
    IdLabelInfo
ClosureTable  -> CLabelType
DataLabel
    IdLabelInfo
RednCounts    -> 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           -> HasDebugCallStack => 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 :: DynFlags -> Module -> CLabel -> Bool
labelDynamic :: DynFlags -> Module -> CLabel -> Bool
labelDynamic DynFlags
dflags Module
this_mod CLabel
lbl =
  case CLabel
lbl of
   -- is the RTS in a DLL or not?
   RtsLabel RtsLabelInfo
_ ->
     Bool
externalDynamicRefs Bool -> Bool -> Bool
&& (UnitId
this_pkg UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= UnitId
rtsUnitId)

   IdLabel Name
n CafInfo
_ IdLabelInfo
_ ->
     DynFlags -> Module -> Name -> Bool
isDllName DynFlags
dflags Module
this_mod Name
n

   -- When compiling in the "dyn" way, each package is to be linked into
   -- its own shared library.
   CmmLabel UnitId
pkg NeedExternDecl
_ FastString
_ CmmLabelInfo
_
    | OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32 ->
       Bool
externalDynamicRefs Bool -> Bool -> Bool
&& (UnitId
this_pkg UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= UnitId
pkg)
    | Bool
otherwise ->
       GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalDynamicRefs DynFlags
dflags

   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
externalDynamicRefs Bool -> Bool -> Bool
&& (UnitId
this_pkg 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
externalDynamicRefs 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

   HpcTicksLabel Module
m ->
     Bool
externalDynamicRefs 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
    externalDynamicRefs :: Bool
externalDynamicRefs = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalDynamicRefs DynFlags
dflags
    os :: OS
os = Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags)
    this_pkg :: UnitId
this_pkg = Module -> UnitId
moduleUnitId 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.
-}

instance Outputable CLabel where
  ppr :: CLabel -> SDoc
ppr CLabel
c = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dynFlags -> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dynFlags CLabel
c

pprCLabel :: DynFlags -> CLabel -> SDoc

pprCLabel :: DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
_ (LocalBlockLabel Unique
u)
  =  SDoc
tempLabelPrefixOrUnderscore SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u

pprCLabel DynFlags
dynFlags (AsmTempLabel Unique
u)
 | Bool -> Bool
not (Platform -> Bool
platformUnregisterised (Platform -> Bool) -> Platform -> Bool
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dynFlags)
  =  SDoc
tempLabelPrefixOrUnderscore SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u

pprCLabel DynFlags
dynFlags (AsmTempDerivedLabel CLabel
l FastString
suf)
 | PlatformMisc -> Bool
platformMisc_ghcWithNativeCodeGen (PlatformMisc -> Bool) -> PlatformMisc -> Bool
forall a b. (a -> b) -> a -> b
$ DynFlags -> PlatformMisc
platformMisc DynFlags
dynFlags
   = PtrString -> SDoc
ptext (Platform -> PtrString
asmTempLabelPrefix (Platform -> PtrString) -> Platform -> PtrString
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dynFlags)
     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            -> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dynFlags CLabel
l
     SDoc -> SDoc -> SDoc
<> FastString -> SDoc
ftext FastString
suf

pprCLabel DynFlags
dynFlags (DynamicLinkerLabel DynamicLinkerLabelInfo
info CLabel
lbl)
 | PlatformMisc -> Bool
platformMisc_ghcWithNativeCodeGen (PlatformMisc -> Bool) -> PlatformMisc -> Bool
forall a b. (a -> b) -> a -> b
$ DynFlags -> PlatformMisc
platformMisc DynFlags
dynFlags
   = Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc
pprDynamicLinkerAsmLabel (DynFlags -> Platform
targetPlatform DynFlags
dynFlags) DynamicLinkerLabelInfo
info CLabel
lbl

pprCLabel DynFlags
dynFlags CLabel
PicBaseLabel
 | PlatformMisc -> Bool
platformMisc_ghcWithNativeCodeGen (PlatformMisc -> Bool) -> PlatformMisc -> Bool
forall a b. (a -> b) -> a -> b
$ DynFlags -> PlatformMisc
platformMisc DynFlags
dynFlags
   = String -> SDoc
text String
"1b"

pprCLabel DynFlags
dynFlags (DeadStripPreventer CLabel
lbl)
 | PlatformMisc -> Bool
platformMisc_ghcWithNativeCodeGen (PlatformMisc -> Bool) -> PlatformMisc -> Bool
forall a b. (a -> b) -> a -> b
$ DynFlags -> PlatformMisc
platformMisc DynFlags
dynFlags
   =
   {-
      `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)
   -}
   DynFlags -> SDoc -> SDoc
maybe_underscore DynFlags
dynFlags (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"dsp_"
   SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprCLabel DynFlags
dynFlags CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_dsp"

pprCLabel DynFlags
dynFlags (StringLitLabel Unique
u)
 | PlatformMisc -> Bool
platformMisc_ghcWithNativeCodeGen (PlatformMisc -> Bool) -> PlatformMisc -> Bool
forall a b. (a -> b) -> a -> b
$ DynFlags -> PlatformMisc
platformMisc DynFlags
dynFlags
  = Unique -> SDoc
pprUniqueAlways Unique
u SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"_str")

pprCLabel DynFlags
dynFlags CLabel
lbl
   = (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ PprStyle
sty ->
     if PlatformMisc -> Bool
platformMisc_ghcWithNativeCodeGen (DynFlags -> PlatformMisc
platformMisc DynFlags
dynFlags) Bool -> Bool -> Bool
&& PprStyle -> Bool
asmStyle PprStyle
sty
     then DynFlags -> SDoc -> SDoc
maybe_underscore DynFlags
dynFlags (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Platform -> CLabel -> SDoc
pprAsmCLbl (DynFlags -> Platform
targetPlatform DynFlags
dynFlags) CLabel
lbl
     else CLabel -> SDoc
pprCLbl CLabel
lbl

maybe_underscore :: DynFlags -> SDoc -> SDoc
maybe_underscore :: DynFlags -> SDoc -> SDoc
maybe_underscore DynFlags
dynFlags SDoc
doc =
  if PlatformMisc -> Bool
platformMisc_leadingUnderscore (PlatformMisc -> Bool) -> PlatformMisc -> Bool
forall a b. (a -> b) -> a -> b
$ DynFlags -> PlatformMisc
platformMisc DynFlags
dynFlags
  then SDoc
pp_cSEP SDoc -> SDoc -> SDoc
<> SDoc
doc
  else SDoc
doc

pprAsmCLbl :: Platform -> CLabel -> SDoc
pprAsmCLbl :: Platform -> CLabel -> SDoc
pprAsmCLbl Platform
platform (ForeignLabel FastString
fs (Just Int
sz) ForeignLabelSource
_ FunctionOrData
_)
 | Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
    -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
    -- (The C compiler does this itself).
    = FastString -> SDoc
ftext FastString
fs SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
sz
pprAsmCLbl Platform
_ CLabel
lbl
   = CLabel -> SDoc
pprCLbl CLabel
lbl

pprCLbl :: CLabel -> SDoc
pprCLbl :: CLabel -> SDoc
pprCLbl (StringLitLabel Unique
u)
  = Unique -> SDoc
pprUniqueAlways Unique
u SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_str"

pprCLbl (SRTLabel Unique
u)
  = SDoc
tempLabelPrefixOrUnderscore SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u SDoc -> SDoc -> SDoc
<> SDoc
pp_cSEP SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"srt"

pprCLbl (LargeBitmapLabel Unique
u)  =
  SDoc
tempLabelPrefixOrUnderscore
  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 bitsmaps 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.


pprCLbl (CmmLabel UnitId
_ NeedExternDecl
_ FastString
str CmmLabelInfo
CmmCode)        = FastString -> SDoc
ftext FastString
str
pprCLbl (CmmLabel UnitId
_ NeedExternDecl
_ FastString
str CmmLabelInfo
CmmData)        = FastString -> SDoc
ftext FastString
str
pprCLbl (CmmLabel UnitId
_ NeedExternDecl
_ FastString
str CmmLabelInfo
CmmPrimCall)    = FastString -> SDoc
ftext FastString
str

pprCLbl (LocalBlockLabel Unique
u)             =
    SDoc
tempLabelPrefixOrUnderscore SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"blk_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u

pprCLbl (RtsLabel (RtsApFast FastString
str))   = FastString -> SDoc
ftext FastString
str SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_fast"

pprCLbl (RtsLabel (RtsSelectorInfoTable Bool
upd_reqd Int
offset))
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
    ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
    [SDoc] -> SDoc
hcat [String -> SDoc
text String
"stg_sel_", String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
offset),
          PtrString -> SDoc
ptext (if Bool
upd_reqd
                 then (String -> PtrString
sLit String
"_upd_info")
                 else (String -> PtrString
sLit String
"_noupd_info"))
        ]

pprCLbl (RtsLabel (RtsSelectorEntry Bool
upd_reqd Int
offset))
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
    ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
    [SDoc] -> SDoc
hcat [String -> SDoc
text String
"stg_sel_", String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
offset),
                PtrString -> SDoc
ptext (if Bool
upd_reqd
                        then (String -> PtrString
sLit String
"_upd_entry")
                        else (String -> PtrString
sLit String
"_noupd_entry"))
        ]

pprCLbl (RtsLabel (RtsApInfoTable Bool
upd_reqd Int
arity))
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
    ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
    [SDoc] -> SDoc
hcat [String -> SDoc
text String
"stg_ap_", String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
arity),
                PtrString -> SDoc
ptext (if Bool
upd_reqd
                        then (String -> PtrString
sLit String
"_upd_info")
                        else (String -> PtrString
sLit String
"_noupd_info"))
        ]

pprCLbl (RtsLabel (RtsApEntry Bool
upd_reqd Int
arity))
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
    ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
    [SDoc] -> SDoc
hcat [String -> SDoc
text String
"stg_ap_", String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
arity),
                PtrString -> SDoc
ptext (if Bool
upd_reqd
                        then (String -> PtrString
sLit String
"_upd_entry")
                        else (String -> PtrString
sLit String
"_noupd_entry"))
        ]

pprCLbl (CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmInfo)
  = FastString -> SDoc
ftext FastString
fs SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_info"

pprCLbl (CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmEntry)
  = FastString -> SDoc
ftext FastString
fs SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_entry"

pprCLbl (CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmRetInfo)
  = FastString -> SDoc
ftext FastString
fs SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_info"

pprCLbl (CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmRet)
  = FastString -> SDoc
ftext FastString
fs SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_ret"

pprCLbl (CmmLabel UnitId
_ NeedExternDecl
_ FastString
fs CmmLabelInfo
CmmClosure)
  = FastString -> SDoc
ftext FastString
fs SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_closure"

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

pprCLbl (RtsLabel (RtsSlowFastTickyCtr String
pat))
  = String -> SDoc
text String
"SLOW_CALL_fast_" SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
pat SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"_ctr")

pprCLbl (ForeignLabel FastString
str Maybe Int
_ ForeignLabelSource
_ FunctionOrData
_)
  = FastString -> SDoc
ftext FastString
str

pprCLbl (IdLabel Name
name CafInfo
_cafs IdLabelInfo
flavor) =
  Name -> SDoc
internalNamePrefix Name
name SDoc -> SDoc -> SDoc
<> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
<> IdLabelInfo -> SDoc
ppIdFlavor IdLabelInfo
flavor

pprCLbl (CC_Label CostCentre
cc)           = CostCentre -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentre
cc
pprCLbl (CCS_Label CostCentreStack
ccs)         = CostCentreStack -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentreStack
ccs

pprCLbl (HpcTicksLabel Module
mod)
  = String -> SDoc
text String
"_hpc_tickboxes_"  SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"_hpc")

pprCLbl (AsmTempLabel {})       = String -> SDoc
forall a. String -> a
panic String
"pprCLbl AsmTempLabel"
pprCLbl (AsmTempDerivedLabel {})= String -> SDoc
forall a. String -> a
panic String
"pprCLbl AsmTempDerivedLabel"
pprCLbl (DynamicLinkerLabel {}) = String -> SDoc
forall a. String -> a
panic String
"pprCLbl DynamicLinkerLabel"
pprCLbl (PicBaseLabel {})       = String -> SDoc
forall a. String -> a
panic String
"pprCLbl PicBaseLabel"
pprCLbl (DeadStripPreventer {}) = String -> SDoc
forall a. String -> a
panic String
"pprCLbl DeadStripPreventer"

ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor IdLabelInfo
x = SDoc
pp_cSEP SDoc -> SDoc -> SDoc
<> String -> SDoc
text
               (case IdLabelInfo
x of
                       IdLabelInfo
Closure          -> String
"closure"
                       IdLabelInfo
InfoTable        -> String
"info"
                       IdLabelInfo
LocalInfoTable   -> String
"info"
                       IdLabelInfo
Entry            -> String
"entry"
                       IdLabelInfo
LocalEntry       -> String
"entry"
                       IdLabelInfo
Slow             -> String
"slow"
                       IdLabelInfo
RednCounts       -> String
"ct"
                       IdLabelInfo
ConEntry         -> String
"con_entry"
                       IdLabelInfo
ConInfoTable     -> String
"con_info"
                       IdLabelInfo
ClosureTable     -> String
"closure_tbl"
                       IdLabelInfo
Bytes            -> String
"bytes"
                       IdLabelInfo
BlockInfoTable   -> 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"

internalNamePrefix :: Name -> SDoc
internalNamePrefix :: Name -> SDoc
internalNamePrefix Name
name = (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ PprStyle
sty ->
  if PprStyle -> Bool
asmStyle PprStyle
sty Bool -> Bool -> Bool
&& Bool
isRandomGenerated then
    (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
      PtrString -> SDoc
ptext (Platform -> PtrString
asmTempLabelPrefix Platform
platform)
  else
    SDoc
empty
  where
    isRandomGenerated :: Bool
isRandomGenerated = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> Bool
isExternalName Name
name

tempLabelPrefixOrUnderscore :: SDoc
tempLabelPrefixOrUnderscore :: SDoc
tempLabelPrefixOrUnderscore = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
  (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ PprStyle
sty ->
   if PprStyle -> Bool
asmStyle PprStyle
sty then
      PtrString -> SDoc
ptext (Platform -> PtrString
asmTempLabelPrefix Platform
platform)
   else
      Char -> SDoc
char Char
'_'

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

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

pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc
pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc
pprDynamicLinkerAsmLabel Platform
platform DynamicLinkerLabelInfo
dllInfo CLabel
lbl =
    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
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$stub"
            DynamicLinkerLabelInfo
SymbolPtr       -> Char -> SDoc
char Char
'L' SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$non_lazy_ptr"
            DynamicLinkerLabelInfo
GotSymbolPtr    -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@GOTPCREL"
            DynamicLinkerLabelInfo
GotSymbolOffset -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
        | Bool
otherwise ->
          case DynamicLinkerLabelInfo
dllInfo of
            DynamicLinkerLabelInfo
CodeStub  -> Char -> SDoc
char Char
'L' SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$stub"
            DynamicLinkerLabelInfo
SymbolPtr -> Char -> SDoc
char Char
'L' SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl 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
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl -- 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
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
            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]
                       CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"+32768@plt"
          DynamicLinkerLabelInfo
SymbolPtr -> String -> SDoc
text String
".LC_" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
          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
ArchX86_64
      = case DynamicLinkerLabelInfo
dllInfo of
          DynamicLinkerLabelInfo
CodeStub        -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@plt"
          DynamicLinkerLabelInfo
GotSymbolPtr    -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@gotpcrel"
          DynamicLinkerLabelInfo
GotSymbolOffset -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
          DynamicLinkerLabelInfo
SymbolPtr       -> String -> SDoc
text String
".LC_" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl

      | 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
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
                                  SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@toc"
          DynamicLinkerLabelInfo
GotSymbolOffset -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
          DynamicLinkerLabelInfo
SymbolPtr       -> String -> SDoc
text String
".LC_" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
          DynamicLinkerLabelInfo
_               -> String -> SDoc
forall a. String -> a
panic String
"pprDynamicLinkerAsmLabel"

      | Bool
otherwise
      = case DynamicLinkerLabelInfo
dllInfo of
          DynamicLinkerLabelInfo
CodeStub        -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@plt"
          DynamicLinkerLabelInfo
SymbolPtr       -> String -> SDoc
text String
".LC_" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
          DynamicLinkerLabelInfo
GotSymbolPtr    -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@got"
          DynamicLinkerLabelInfo
GotSymbolOffset -> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl 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 repesentationally
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.
-}