never executed always true always false
    1 -----------------------------------------------------------------------------
    2 --
    3 -- Object-file symbols (called CLabel for histerical raisins).
    4 --
    5 -- (c) The University of Glasgow 2004-2006
    6 --
    7 -----------------------------------------------------------------------------
    8 
    9 {-# LANGUAGE BangPatterns #-}
   10 {-# LANGUAGE MultiParamTypeClasses #-}
   11 {-# LANGUAGE FlexibleInstances #-}
   12 
   13 
   14 module GHC.Cmm.CLabel (
   15         CLabel, -- abstract type
   16         NeedExternDecl (..),
   17         ForeignLabelSource(..),
   18         DynamicLinkerLabelInfo(..),
   19         ConInfoTableLocation(..),
   20         getConInfoTableLocation,
   21 
   22         -- * Constructors
   23         mkClosureLabel,
   24         mkSRTLabel,
   25         mkInfoTableLabel,
   26         mkEntryLabel,
   27         mkRednCountsLabel,
   28         mkConInfoTableLabel,
   29         mkApEntryLabel,
   30         mkApInfoTableLabel,
   31         mkClosureTableLabel,
   32         mkBytesLabel,
   33 
   34         mkLocalBlockLabel,
   35         mkLocalClosureLabel,
   36         mkLocalInfoTableLabel,
   37         mkLocalClosureTableLabel,
   38 
   39         mkBlockInfoTableLabel,
   40 
   41         mkBitmapLabel,
   42         mkStringLitLabel,
   43 
   44         mkAsmTempLabel,
   45         mkAsmTempDerivedLabel,
   46         mkAsmTempEndLabel,
   47         mkAsmTempProcEndLabel,
   48         mkAsmTempDieLabel,
   49 
   50         mkDirty_MUT_VAR_Label,
   51         mkNonmovingWriteBarrierEnabledLabel,
   52         mkUpdInfoLabel,
   53         mkBHUpdInfoLabel,
   54         mkIndStaticInfoLabel,
   55         mkMainCapabilityLabel,
   56         mkMAP_FROZEN_CLEAN_infoLabel,
   57         mkMAP_FROZEN_DIRTY_infoLabel,
   58         mkMAP_DIRTY_infoLabel,
   59         mkSMAP_FROZEN_CLEAN_infoLabel,
   60         mkSMAP_FROZEN_DIRTY_infoLabel,
   61         mkSMAP_DIRTY_infoLabel,
   62         mkBadAlignmentLabel,
   63         mkArrWords_infoLabel,
   64         mkSRTInfoLabel,
   65 
   66         mkTopTickyCtrLabel,
   67         mkCAFBlackHoleInfoTableLabel,
   68         mkRtsPrimOpLabel,
   69         mkRtsSlowFastTickyCtrLabel,
   70 
   71         mkSelectorInfoLabel,
   72         mkSelectorEntryLabel,
   73         mkCmmInfoLabel,
   74         mkCmmEntryLabel,
   75         mkCmmRetInfoLabel,
   76         mkCmmRetLabel,
   77         mkCmmCodeLabel,
   78         mkCmmDataLabel,
   79         mkRtsCmmDataLabel,
   80         mkCmmClosureLabel,
   81         mkRtsApFastLabel,
   82         mkPrimCallLabel,
   83         mkForeignLabel,
   84         mkCCLabel,
   85         mkCCSLabel,
   86         mkIPELabel,
   87         InfoProvEnt(..),
   88 
   89         mkDynamicLinkerLabel,
   90         mkPicBaseLabel,
   91         mkDeadStripPreventer,
   92         mkHpcTicksLabel,
   93 
   94         -- * Predicates
   95         hasCAF,
   96         needsCDecl,
   97         maybeLocalBlockLabel,
   98         externallyVisibleCLabel,
   99         isMathFun,
  100         isCFunctionLabel,
  101         isGcPtrLabel,
  102         labelDynamic,
  103         isLocalCLabel,
  104         mayRedirectTo,
  105         isInfoTableLabel,
  106         isConInfoTableLabel,
  107         isIdLabel,
  108         isTickyLabel,
  109         hasHaskellName,
  110         hasIdLabelInfo,
  111         isBytesLabel,
  112         isForeignLabel,
  113         isSomeRODataLabel,
  114         isStaticClosureLabel,
  115 
  116         -- * Conversions
  117         toClosureLbl,
  118         toSlowEntryLbl,
  119         toEntryLbl,
  120         toInfoLbl,
  121 
  122         -- * Pretty-printing
  123         LabelStyle (..),
  124         pprDebugCLabel,
  125         pprCLabel,
  126         ppInternalProcLabel,
  127 
  128         -- * Others
  129         dynamicLinkerLabelInfo,
  130         addLabelSize,
  131         foreignLabelStdcallInfo
  132     ) where
  133 
  134 import GHC.Prelude
  135 
  136 import GHC.Types.Id.Info
  137 import GHC.Types.Basic
  138 import {-# SOURCE #-} GHC.Cmm.BlockId (BlockId, mkBlockId)
  139 import GHC.Unit.Types
  140 import GHC.Types.Name
  141 import GHC.Types.Unique
  142 import GHC.Builtin.PrimOps
  143 import GHC.Types.CostCentre
  144 import GHC.Utils.Outputable
  145 import GHC.Utils.Panic
  146 import GHC.Utils.Panic.Plain
  147 import GHC.Data.FastString
  148 import GHC.Driver.Session
  149 import GHC.Platform
  150 import GHC.Types.Unique.Set
  151 import GHC.Utils.Misc
  152 import GHC.Core.Ppr ( {- instances -} )
  153 import GHC.CmmToAsm.Config
  154 import GHC.Types.SrcLoc
  155 
  156 -- -----------------------------------------------------------------------------
  157 -- The CLabel type
  158 
  159 {- |
  160   'CLabel' is an abstract type that supports the following operations:
  161 
  162   - Pretty printing
  163 
  164   - In a C file, does it need to be declared before use?  (i.e. is it
  165     guaranteed to be already in scope in the places we need to refer to it?)
  166 
  167   - If it needs to be declared, what type (code or data) should it be
  168     declared to have?
  169 
  170   - Is it visible outside this object file or not?
  171 
  172   - Is it "dynamic" (see details below)
  173 
  174   - Eq and Ord, so that we can make sets of CLabels (currently only
  175     used in outputting C as far as I can tell, to avoid generating
  176     more than one declaration for any given label).
  177 
  178   - Converting an info table label into an entry label.
  179 
  180   CLabel usage is a bit messy in GHC as they are used in a number of different
  181   contexts:
  182 
  183   - By the C-- AST to identify labels
  184 
  185   - By the unregisterised C code generator (\"PprC\") for naming functions (hence
  186     the name 'CLabel')
  187 
  188   - By the native and LLVM code generators to identify labels
  189 
  190   For extra fun, each of these uses a slightly different subset of constructors
  191   (e.g. 'AsmTempLabel' and 'AsmTempDerivedLabel' are used only in the NCG and
  192   LLVM backends).
  193 
  194   In general, we use 'IdLabel' to represent Haskell things early in the
  195   pipeline. However, later optimization passes will often represent blocks they
  196   create with 'LocalBlockLabel' where there is no obvious 'Name' to hang off the
  197   label.
  198 -}
  199 
  200 data CLabel
  201   = -- | A label related to the definition of a particular Id or Con in a .hs file.
  202     IdLabel
  203         Name
  204         CafInfo
  205         IdLabelInfo             -- ^ encodes the suffix of the label
  206 
  207   -- | A label from a .cmm file that is not associated with a .hs level Id.
  208   | CmmLabel
  209         UnitId                  -- ^ what package the label belongs to.
  210         NeedExternDecl          -- ^ does the label need an "extern .." declaration
  211         FastString              -- ^ identifier giving the prefix of the label
  212         CmmLabelInfo            -- ^ encodes the suffix of the label
  213 
  214   -- | A label with a baked-in \/ algorithmically generated name that definitely
  215   --    comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
  216   --    If it doesn't have an algorithmically generated name then use a CmmLabel
  217   --    instead and give it an appropriate UnitId argument.
  218   | RtsLabel
  219         RtsLabelInfo
  220 
  221   -- | A label associated with a block. These aren't visible outside of the
  222   -- compilation unit in which they are defined. These are generally used to
  223   -- name blocks produced by Cmm-to-Cmm passes and the native code generator,
  224   -- where we don't have a 'Name' to associate the label to and therefore can't
  225   -- use 'IdLabel'.
  226   | LocalBlockLabel
  227         {-# UNPACK #-} !Unique
  228 
  229   -- | A 'C' (or otherwise foreign) label.
  230   --
  231   | ForeignLabel
  232         FastString              -- ^ name of the imported label.
  233 
  234         (Maybe Int)             -- ^ possible '@n' suffix for stdcall functions
  235                                 -- When generating C, the '@n' suffix is omitted, but when
  236                                 -- generating assembler we must add it to the label.
  237 
  238         ForeignLabelSource      -- ^ what package the foreign label is in.
  239 
  240         FunctionOrData
  241 
  242   -- | Local temporary label used for native (or LLVM) code generation; must not
  243   -- appear outside of these contexts. Use primarily for debug information
  244   | AsmTempLabel
  245         {-# UNPACK #-} !Unique
  246 
  247   -- | A label \"derived\" from another 'CLabel' by the addition of a suffix.
  248   -- Must not occur outside of the NCG or LLVM code generators.
  249   | AsmTempDerivedLabel
  250         CLabel
  251         FastString              -- ^ suffix
  252 
  253   | StringLitLabel
  254         {-# UNPACK #-} !Unique
  255 
  256   | CC_Label  CostCentre
  257   | CCS_Label CostCentreStack
  258   | IPE_Label InfoProvEnt
  259 
  260 
  261   -- | These labels are generated and used inside the NCG only.
  262   --    They are special variants of a label used for dynamic linking
  263   --    see module "GHC.CmmToAsm.PIC" for details.
  264   | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
  265 
  266   -- | This label is generated and used inside the NCG only.
  267   --    It is used as a base for PIC calculations on some platforms.
  268   --    It takes the form of a local numeric assembler label '1'; and
  269   --    is pretty-printed as 1b, referring to the previous definition
  270   --    of 1: in the assembler source file.
  271   | PicBaseLabel
  272 
  273   -- | A label before an info table to prevent excessive dead-stripping on darwin
  274   | DeadStripPreventer CLabel
  275 
  276 
  277   -- | Per-module table of tick locations
  278   | HpcTicksLabel Module
  279 
  280   -- | Static reference table
  281   | SRTLabel
  282         {-# UNPACK #-} !Unique
  283 
  284   -- | A bitmap (function or case return)
  285   | LargeBitmapLabel
  286         {-# UNPACK #-} !Unique
  287 
  288   deriving Eq
  289 
  290 instance Show CLabel where
  291   show = showPprUnsafe . pprDebugCLabel genericPlatform
  292 
  293 instance Outputable CLabel where
  294   ppr = text . show
  295 
  296 isIdLabel :: CLabel -> Bool
  297 isIdLabel IdLabel{} = True
  298 isIdLabel _ = False
  299 
  300 -- Used in SRT analysis. See Note [Ticky labels in SRT analysis] in
  301 -- GHC.Cmm.Info.Build.
  302 isTickyLabel :: CLabel -> Bool
  303 isTickyLabel (IdLabel _ _ RednCounts) = True
  304 isTickyLabel _ = False
  305 
  306 -- | Indicate if "GHC.CmmToC" has to generate an extern declaration for the
  307 -- label (e.g. "extern StgWordArray(foo)").  The type is fixed to StgWordArray.
  308 --
  309 -- Symbols from the RTS don't need "extern" declarations because they are
  310 -- exposed via "rts/include/Stg.h" with the appropriate type. See 'needsCDecl'.
  311 --
  312 -- The fixed StgWordArray type led to "conflicting types" issues with user
  313 -- provided Cmm files (not in the RTS) that declare data of another type (#15467
  314 -- and test for #17920).  Hence the Cmm parser considers that labels in data
  315 -- sections don't need the "extern" declaration (just add one explicitly if you
  316 -- need it).
  317 --
  318 -- See https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes
  319 -- for why extern declaration are needed at all.
  320 newtype NeedExternDecl
  321    = NeedExternDecl Bool
  322    deriving (Ord,Eq)
  323 
  324 -- This is laborious, but necessary. We can't derive Ord because
  325 -- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the
  326 -- implementation. See Note [No Ord for Unique]
  327 -- This is non-deterministic but we do not currently support deterministic
  328 -- code-generation. See Note [Unique Determinism and code generation]
  329 instance Ord CLabel where
  330   compare (IdLabel a1 b1 c1) (IdLabel a2 b2 c2) =
  331     compare a1 a2 `thenCmp`
  332     compare b1 b2 `thenCmp`
  333     compare c1 c2
  334   compare (CmmLabel a1 b1 c1 d1) (CmmLabel a2 b2 c2 d2) =
  335     compare a1 a2 `thenCmp`
  336     compare b1 b2 `thenCmp`
  337     -- This non-determinism is "safe" in the sense that it only affects object code,
  338     -- which is currently not covered by GHC's determinism guarantees. See #12935.
  339     uniqCompareFS c1 c2 `thenCmp`
  340     compare d1 d2
  341   compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2
  342   compare (LocalBlockLabel u1) (LocalBlockLabel u2) = nonDetCmpUnique u1 u2
  343   compare (ForeignLabel a1 b1 c1 d1) (ForeignLabel a2 b2 c2 d2) =
  344     uniqCompareFS a1 a2 `thenCmp`
  345     compare b1 b2 `thenCmp`
  346     compare c1 c2 `thenCmp`
  347     compare d1 d2
  348   compare (AsmTempLabel u1) (AsmTempLabel u2) = nonDetCmpUnique u1 u2
  349   compare (AsmTempDerivedLabel a1 b1) (AsmTempDerivedLabel a2 b2) =
  350     compare a1 a2 `thenCmp`
  351     lexicalCompareFS b1 b2
  352   compare (StringLitLabel u1) (StringLitLabel u2) =
  353     nonDetCmpUnique u1 u2
  354   compare (CC_Label a1) (CC_Label a2) =
  355     compare a1 a2
  356   compare (CCS_Label a1) (CCS_Label a2) =
  357     compare a1 a2
  358   compare (IPE_Label a1) (IPE_Label a2) =
  359     compare a1 a2
  360   compare (DynamicLinkerLabel a1 b1) (DynamicLinkerLabel a2 b2) =
  361     compare a1 a2 `thenCmp`
  362     compare b1 b2
  363   compare PicBaseLabel PicBaseLabel = EQ
  364   compare (DeadStripPreventer a1) (DeadStripPreventer a2) =
  365     compare a1 a2
  366   compare (HpcTicksLabel a1) (HpcTicksLabel a2) =
  367     compare a1 a2
  368   compare (SRTLabel u1) (SRTLabel u2) =
  369     nonDetCmpUnique u1 u2
  370   compare (LargeBitmapLabel u1) (LargeBitmapLabel u2) =
  371     nonDetCmpUnique u1 u2
  372   compare IdLabel{} _ = LT
  373   compare _ IdLabel{} = GT
  374   compare CmmLabel{} _ = LT
  375   compare _ CmmLabel{} = GT
  376   compare RtsLabel{} _ = LT
  377   compare _ RtsLabel{} = GT
  378   compare LocalBlockLabel{} _ = LT
  379   compare _ LocalBlockLabel{} = GT
  380   compare ForeignLabel{} _ = LT
  381   compare _ ForeignLabel{} = GT
  382   compare AsmTempLabel{} _ = LT
  383   compare _ AsmTempLabel{} = GT
  384   compare AsmTempDerivedLabel{} _ = LT
  385   compare _ AsmTempDerivedLabel{} = GT
  386   compare StringLitLabel{} _ = LT
  387   compare _ StringLitLabel{} = GT
  388   compare CC_Label{} _ = LT
  389   compare _ CC_Label{} = GT
  390   compare CCS_Label{} _ = LT
  391   compare _ CCS_Label{} = GT
  392   compare DynamicLinkerLabel{} _ = LT
  393   compare _ DynamicLinkerLabel{} = GT
  394   compare PicBaseLabel{} _ = LT
  395   compare _ PicBaseLabel{} = GT
  396   compare DeadStripPreventer{} _ = LT
  397   compare _ DeadStripPreventer{} = GT
  398   compare HpcTicksLabel{} _ = LT
  399   compare _ HpcTicksLabel{} = GT
  400   compare SRTLabel{} _ = LT
  401   compare _ SRTLabel{} = GT
  402   compare (IPE_Label {}) _ = LT
  403   compare  _ (IPE_Label{}) = GT
  404 
  405 -- | Record where a foreign label is stored.
  406 data ForeignLabelSource
  407 
  408    -- | Label is in a named package
  409    = ForeignLabelInPackage UnitId
  410 
  411    -- | Label is in some external, system package that doesn't also
  412    --   contain compiled Haskell code, and is not associated with any .hi files.
  413    --   We don't have to worry about Haskell code being inlined from
  414    --   external packages. It is safe to treat the RTS package as "external".
  415    | ForeignLabelInExternalPackage
  416 
  417    -- | Label is in the package currently being compiled.
  418    --   This is only used for creating hacky tmp labels during code generation.
  419    --   Don't use it in any code that might be inlined across a package boundary
  420    --   (ie, core code) else the information will be wrong relative to the
  421    --   destination module.
  422    | ForeignLabelInThisPackage
  423 
  424    deriving (Eq, Ord)
  425 
  426 
  427 -- | For debugging problems with the CLabel representation.
  428 --      We can't make a Show instance for CLabel because lots of its components don't have instances.
  429 --      The regular Outputable instance only shows the label name, and not its other info.
  430 --
  431 pprDebugCLabel :: Platform -> CLabel -> SDoc
  432 pprDebugCLabel platform lbl = pprCLabel platform AsmStyle lbl <> parens extra
  433    where
  434       extra = case lbl of
  435          IdLabel _ _ info
  436             -> text "IdLabel" <> whenPprDebug (text ":" <> ppr info)
  437 
  438          CmmLabel pkg _ext _name _info
  439             -> text "CmmLabel" <+> ppr pkg
  440 
  441          RtsLabel{}
  442             -> text "RtsLabel"
  443 
  444          ForeignLabel _name mSuffix src funOrData
  445              -> text "ForeignLabel" <+> ppr mSuffix <+> ppr src <+> ppr funOrData
  446 
  447          _  -> text "other CLabel"
  448 
  449 
  450 data IdLabelInfo
  451   = Closure             -- ^ Label for closure
  452   | InfoTable           -- ^ Info tables for closures; always read-only
  453   | Entry               -- ^ Entry point
  454   | Slow                -- ^ Slow entry point
  455 
  456   | LocalInfoTable      -- ^ Like InfoTable but not externally visible
  457   | LocalEntry          -- ^ Like Entry but not externally visible
  458 
  459   | RednCounts          -- ^ Label of place to keep Ticky-ticky  info for this Id
  460 
  461   | ConEntry ConInfoTableLocation
  462   -- ^ Constructor entry point, when `-fdistinct-info-tables` is enabled then
  463   -- each usage of a constructor will be given a unique number and a fresh info
  464   -- table will be created in the module where the constructor is used. The
  465   -- argument is used to keep track of which info table a usage of a constructor
  466   -- should use. When the argument is 'Nothing' then it uses the info table which
  467   -- is defined in the module where the datatype is declared, this is the usual case.
  468   -- When it is (Just (m, k)) it will use the kth info table defined in module m. The
  469   -- point of this inefficiency is so that you can work out where allocations of data
  470   -- constructors are coming from when you are debugging.
  471 
  472   | ConInfoTable ConInfoTableLocation        -- ^ Corresponding info table
  473 
  474   | ClosureTable        -- ^ Table of closures for Enum tycons
  475 
  476   | Bytes               -- ^ Content of a string literal. See
  477                         -- Note [Bytes label].
  478   | BlockInfoTable      -- ^ Like LocalInfoTable but for a proc-point block
  479                         -- instead of a closure entry-point.
  480                         -- See Note [Proc-point local block entry-point].
  481 
  482   deriving (Eq, Ord)
  483 
  484 -- | Which module is the info table from, and which number was it.
  485 data ConInfoTableLocation = UsageSite Module Int
  486                           | DefinitionSite
  487                               deriving (Eq, Ord)
  488 
  489 instance Outputable ConInfoTableLocation where
  490   ppr (UsageSite m n) = text "Loc(" <> ppr n <> text "):" <+> ppr m
  491   ppr DefinitionSite = empty
  492 
  493 getConInfoTableLocation :: IdLabelInfo -> Maybe ConInfoTableLocation
  494 getConInfoTableLocation (ConInfoTable ci) = Just ci
  495 getConInfoTableLocation _ = Nothing
  496 
  497 instance Outputable IdLabelInfo where
  498   ppr Closure    = text "Closure"
  499   ppr InfoTable  = text "InfoTable"
  500   ppr Entry      = text "Entry"
  501   ppr Slow       = text "Slow"
  502 
  503   ppr LocalInfoTable  = text "LocalInfoTable"
  504   ppr LocalEntry      = text "LocalEntry"
  505 
  506   ppr RednCounts      = text "RednCounts"
  507   ppr (ConEntry mn) = text "ConEntry" <+> ppr mn
  508   ppr (ConInfoTable mn) = text "ConInfoTable" <+> ppr mn
  509   ppr ClosureTable = text "ClosureTable"
  510   ppr Bytes        = text "Bytes"
  511   ppr BlockInfoTable  = text "BlockInfoTable"
  512 
  513 
  514 data RtsLabelInfo
  515   = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}  -- ^ Selector thunks
  516   | RtsSelectorEntry     Bool{-updatable-} Int{-offset-}
  517 
  518   | RtsApInfoTable       Bool{-updatable-} Int{-arity-}    -- ^ AP thunks
  519   | RtsApEntry           Bool{-updatable-} Int{-arity-}
  520 
  521   | RtsPrimOp            PrimOp
  522   | RtsApFast            NonDetFastString    -- ^ _fast versions of generic apply
  523   | RtsSlowFastTickyCtr String
  524 
  525   deriving (Eq,Ord)
  526 
  527 
  528 -- | What type of Cmm label we're dealing with.
  529 --      Determines the suffix appended to the name when a CLabel.CmmLabel
  530 --      is pretty printed.
  531 data CmmLabelInfo
  532   = CmmInfo                     -- ^ misc rts info tables,      suffix _info
  533   | CmmEntry                    -- ^ misc rts entry points,     suffix _entry
  534   | CmmRetInfo                  -- ^ misc rts ret info tables,  suffix _info
  535   | CmmRet                      -- ^ misc rts return points,    suffix _ret
  536   | CmmData                     -- ^ misc rts data bits, eg CHARLIKE_closure
  537   | CmmCode                     -- ^ misc rts code
  538   | CmmClosure                  -- ^ closures eg CHARLIKE_closure
  539   | CmmPrimCall                 -- ^ a prim call to some hand written Cmm code
  540   deriving (Eq, Ord)
  541 
  542 data DynamicLinkerLabelInfo
  543   = CodeStub                    -- MachO: Lfoo$stub, ELF: foo@plt
  544   | SymbolPtr                   -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
  545   | GotSymbolPtr                -- ELF: foo@got
  546   | GotSymbolOffset             -- ELF: foo@gotoff
  547 
  548   deriving (Eq, Ord)
  549 
  550 
  551 -- -----------------------------------------------------------------------------
  552 -- Constructing CLabels
  553 -- -----------------------------------------------------------------------------
  554 
  555 -- Constructing IdLabels
  556 -- These are always local:
  557 
  558 mkSRTLabel     :: Unique -> CLabel
  559 mkSRTLabel u = SRTLabel u
  560 
  561 mkRednCountsLabel :: Name -> CLabel
  562 mkRednCountsLabel name = IdLabel name NoCafRefs RednCounts  -- Note [ticky for LNE]
  563 
  564 -- These have local & (possibly) external variants:
  565 mkLocalClosureLabel      :: Name -> CafInfo -> CLabel
  566 mkLocalInfoTableLabel    :: Name -> CafInfo -> CLabel
  567 mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
  568 mkLocalClosureLabel   !name !c  = IdLabel name  c Closure
  569 mkLocalInfoTableLabel   name c  = IdLabel name  c LocalInfoTable
  570 mkLocalClosureTableLabel name c = IdLabel name  c ClosureTable
  571 
  572 mkClosureLabel              :: Name -> CafInfo -> CLabel
  573 mkInfoTableLabel            :: Name -> CafInfo -> CLabel
  574 mkEntryLabel                :: Name -> CafInfo -> CLabel
  575 mkClosureTableLabel         :: Name -> CafInfo -> CLabel
  576 mkConInfoTableLabel         :: Name -> ConInfoTableLocation -> CLabel
  577 mkBytesLabel                :: Name -> CLabel
  578 mkClosureLabel name         c     = IdLabel name c Closure
  579 mkInfoTableLabel name       c     = IdLabel name c InfoTable
  580 mkEntryLabel name           c     = IdLabel name c Entry
  581 mkClosureTableLabel name    c     = IdLabel name c ClosureTable
  582 -- Special case for the normal 'DefinitionSite' case so that the 'ConInfoTable' application can be floated to a CAF.
  583 mkConInfoTableLabel name DefinitionSite = IdLabel name NoCafRefs (ConInfoTable DefinitionSite)
  584 mkConInfoTableLabel name k = IdLabel name NoCafRefs (ConInfoTable k)
  585 mkBytesLabel name                 = IdLabel name NoCafRefs Bytes
  586 
  587 mkBlockInfoTableLabel :: Name -> CafInfo -> CLabel
  588 mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable
  589                                -- See Note [Proc-point local block entry-point].
  590 
  591 -- Constructing Cmm Labels
  592 mkDirty_MUT_VAR_Label,
  593     mkNonmovingWriteBarrierEnabledLabel,
  594     mkUpdInfoLabel,
  595     mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
  596     mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel,
  597     mkMAP_DIRTY_infoLabel,
  598     mkArrWords_infoLabel,
  599     mkTopTickyCtrLabel,
  600     mkCAFBlackHoleInfoTableLabel,
  601     mkSMAP_FROZEN_CLEAN_infoLabel, mkSMAP_FROZEN_DIRTY_infoLabel,
  602     mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel
  603 mkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
  604 mkNonmovingWriteBarrierEnabledLabel
  605                                 = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData
  606 mkUpdInfoLabel                  = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame")         CmmInfo
  607 mkBHUpdInfoLabel                = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" )     CmmInfo
  608 mkIndStaticInfoLabel            = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC")        CmmInfo
  609 mkMainCapabilityLabel           = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "MainCapability")        CmmData
  610 mkMAP_FROZEN_CLEAN_infoLabel    = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
  611 mkMAP_FROZEN_DIRTY_infoLabel    = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
  612 mkMAP_DIRTY_infoLabel           = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
  613 mkTopTickyCtrLabel              = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "top_ct")                CmmData
  614 mkCAFBlackHoleInfoTableLabel    = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
  615 mkArrWords_infoLabel            = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_ARR_WORDS")         CmmInfo
  616 mkSMAP_FROZEN_CLEAN_infoLabel   = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
  617 mkSMAP_FROZEN_DIRTY_infoLabel   = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
  618 mkSMAP_DIRTY_infoLabel          = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
  619 mkBadAlignmentLabel             = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment")      CmmEntry
  620 
  621 mkSRTInfoLabel :: Int -> CLabel
  622 mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo
  623  where
  624    lbl =
  625      case n of
  626        1 -> fsLit "stg_SRT_1"
  627        2 -> fsLit "stg_SRT_2"
  628        3 -> fsLit "stg_SRT_3"
  629        4 -> fsLit "stg_SRT_4"
  630        5 -> fsLit "stg_SRT_5"
  631        6 -> fsLit "stg_SRT_6"
  632        7 -> fsLit "stg_SRT_7"
  633        8 -> fsLit "stg_SRT_8"
  634        9 -> fsLit "stg_SRT_9"
  635        10 -> fsLit "stg_SRT_10"
  636        11 -> fsLit "stg_SRT_11"
  637        12 -> fsLit "stg_SRT_12"
  638        13 -> fsLit "stg_SRT_13"
  639        14 -> fsLit "stg_SRT_14"
  640        15 -> fsLit "stg_SRT_15"
  641        16 -> fsLit "stg_SRT_16"
  642        _ -> panic "mkSRTInfoLabel"
  643 
  644 -----
  645 mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
  646   mkCmmCodeLabel, mkCmmClosureLabel
  647         :: UnitId -> FastString -> CLabel
  648 
  649 mkCmmDataLabel    :: UnitId -> NeedExternDecl -> FastString -> CLabel
  650 mkRtsCmmDataLabel :: FastString -> CLabel
  651 
  652 mkCmmInfoLabel       pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmInfo
  653 mkCmmEntryLabel      pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmEntry
  654 mkCmmRetInfoLabel    pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmRetInfo
  655 mkCmmRetLabel        pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmRet
  656 mkCmmCodeLabel       pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmCode
  657 mkCmmClosureLabel    pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmClosure
  658 mkCmmDataLabel       pkg ext str = CmmLabel pkg ext  str CmmData
  659 mkRtsCmmDataLabel    str         = CmmLabel rtsUnitId (NeedExternDecl False)  str CmmData
  660                                     -- RTS symbols don't need "GHC.CmmToC" to
  661                                     -- generate \"extern\" declaration (they are
  662                                     -- exposed via rts/include/Stg.h)
  663 
  664 mkLocalBlockLabel :: Unique -> CLabel
  665 mkLocalBlockLabel u = LocalBlockLabel u
  666 
  667 -- Constructing RtsLabels
  668 mkRtsPrimOpLabel :: PrimOp -> CLabel
  669 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
  670 
  671 mkSelectorInfoLabel :: Platform -> Bool -> Int -> CLabel
  672 mkSelectorInfoLabel platform upd offset =
  673    assert (offset >= 0 && offset <= pc_MAX_SPEC_SELECTEE_SIZE (platformConstants platform)) $
  674    RtsLabel (RtsSelectorInfoTable upd offset)
  675 
  676 mkSelectorEntryLabel :: Platform -> Bool -> Int -> CLabel
  677 mkSelectorEntryLabel platform upd offset =
  678    assert (offset >= 0 && offset <= pc_MAX_SPEC_SELECTEE_SIZE (platformConstants platform)) $
  679    RtsLabel (RtsSelectorEntry upd offset)
  680 
  681 mkApInfoTableLabel :: Platform -> Bool -> Int -> CLabel
  682 mkApInfoTableLabel platform upd arity =
  683    assert (arity > 0 && arity <= pc_MAX_SPEC_AP_SIZE (platformConstants platform)) $
  684    RtsLabel (RtsApInfoTable upd arity)
  685 
  686 mkApEntryLabel :: Platform -> Bool -> Int -> CLabel
  687 mkApEntryLabel platform upd arity =
  688    assert (arity > 0 && arity <= pc_MAX_SPEC_AP_SIZE (platformConstants platform)) $
  689    RtsLabel (RtsApEntry upd arity)
  690 
  691 
  692 -- A call to some primitive hand written Cmm code
  693 mkPrimCallLabel :: PrimCall -> CLabel
  694 mkPrimCallLabel (PrimCall str pkg)
  695         = CmmLabel (toUnitId pkg) (NeedExternDecl True) str CmmPrimCall
  696 
  697 
  698 -- Constructing ForeignLabels
  699 
  700 -- | Make a foreign label
  701 mkForeignLabel
  702         :: FastString           -- name
  703         -> Maybe Int            -- size prefix
  704         -> ForeignLabelSource   -- what package it's in
  705         -> FunctionOrData
  706         -> CLabel
  707 
  708 mkForeignLabel = ForeignLabel
  709 
  710 
  711 -- | Update the label size field in a ForeignLabel
  712 addLabelSize :: CLabel -> Int -> CLabel
  713 addLabelSize (ForeignLabel str _ src  fod) sz
  714     = ForeignLabel str (Just sz) src fod
  715 addLabelSize label _
  716     = label
  717 
  718 -- | Whether label is a top-level string literal
  719 isBytesLabel :: CLabel -> Bool
  720 isBytesLabel (IdLabel _ _ Bytes) = True
  721 isBytesLabel _lbl = False
  722 
  723 -- | Whether label is a non-haskell label (defined in C code)
  724 isForeignLabel :: CLabel -> Bool
  725 isForeignLabel (ForeignLabel _ _ _ _) = True
  726 isForeignLabel _lbl = False
  727 
  728 -- | Whether label is a static closure label (can come from haskell or cmm)
  729 isStaticClosureLabel :: CLabel -> Bool
  730 -- Closure defined in haskell (.hs)
  731 isStaticClosureLabel (IdLabel _ _ Closure) = True
  732 -- Closure defined in cmm
  733 isStaticClosureLabel (CmmLabel _ _ _ CmmClosure) = True
  734 isStaticClosureLabel _lbl = False
  735 
  736 -- | Whether label is a .rodata label
  737 isSomeRODataLabel :: CLabel -> Bool
  738 -- info table defined in haskell (.hs)
  739 isSomeRODataLabel (IdLabel _ _ ClosureTable) = True
  740 isSomeRODataLabel (IdLabel _ _ ConInfoTable {}) = True
  741 isSomeRODataLabel (IdLabel _ _ InfoTable) = True
  742 isSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True
  743 isSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True
  744 -- info table defined in cmm (.cmm)
  745 isSomeRODataLabel (CmmLabel _ _ _ CmmInfo) = True
  746 isSomeRODataLabel _lbl = False
  747 
  748 -- | Whether label is points to some kind of info table
  749 isInfoTableLabel :: CLabel -> Bool
  750 isInfoTableLabel (IdLabel _ _ InfoTable)      = True
  751 isInfoTableLabel (IdLabel _ _ LocalInfoTable) = True
  752 isInfoTableLabel (IdLabel _ _ ConInfoTable {})   = True
  753 isInfoTableLabel (IdLabel _ _ BlockInfoTable) = True
  754 isInfoTableLabel _                            = False
  755 
  756 -- | Whether label is points to constructor info table
  757 isConInfoTableLabel :: CLabel -> Bool
  758 isConInfoTableLabel (IdLabel _ _ ConInfoTable {})   = True
  759 isConInfoTableLabel _                            = False
  760 
  761 -- | Get the label size field from a ForeignLabel
  762 foreignLabelStdcallInfo :: CLabel -> Maybe Int
  763 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
  764 foreignLabelStdcallInfo _lbl = Nothing
  765 
  766 
  767 -- Constructing Large*Labels
  768 mkBitmapLabel   :: Unique -> CLabel
  769 mkBitmapLabel   uniq            = LargeBitmapLabel uniq
  770 
  771 -- | Info Table Provenance Entry
  772 -- See Note [Mapping Info Tables to Source Positions]
  773 data InfoProvEnt = InfoProvEnt
  774                                { infoTablePtr :: !CLabel
  775                                -- Address of the info table
  776                                , infoProvEntClosureType :: !Int
  777                                -- The closure type of the info table (from ClosureMacros.h)
  778                                , infoTableType :: !String
  779                                -- The rendered Haskell type of the closure the table represents
  780                                , infoProvModule :: !Module
  781                                -- Origin module
  782                                , infoTableProv :: !(Maybe (RealSrcSpan, String)) }
  783                                -- Position and information about the info table
  784                                deriving (Eq, Ord)
  785 
  786 -- Constructing Cost Center Labels
  787 mkCCLabel  :: CostCentre      -> CLabel
  788 mkCCSLabel :: CostCentreStack -> CLabel
  789 mkIPELabel :: InfoProvEnt -> CLabel
  790 mkCCLabel           cc          = CC_Label cc
  791 mkCCSLabel          ccs         = CCS_Label ccs
  792 mkIPELabel          ipe         = IPE_Label ipe
  793 
  794 mkRtsApFastLabel :: FastString -> CLabel
  795 mkRtsApFastLabel str = RtsLabel (RtsApFast (NonDetFastString str))
  796 
  797 mkRtsSlowFastTickyCtrLabel :: String -> CLabel
  798 mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
  799 
  800 
  801 -- Constructing Code Coverage Labels
  802 mkHpcTicksLabel :: Module -> CLabel
  803 mkHpcTicksLabel                = HpcTicksLabel
  804 
  805 
  806 -- Constructing labels used for dynamic linking
  807 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
  808 mkDynamicLinkerLabel            = DynamicLinkerLabel
  809 
  810 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
  811 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
  812 dynamicLinkerLabelInfo _        = Nothing
  813 
  814 mkPicBaseLabel :: CLabel
  815 mkPicBaseLabel                  = PicBaseLabel
  816 
  817 
  818 -- Constructing miscellaneous other labels
  819 mkDeadStripPreventer :: CLabel -> CLabel
  820 mkDeadStripPreventer lbl        = DeadStripPreventer lbl
  821 
  822 mkStringLitLabel :: Unique -> CLabel
  823 mkStringLitLabel                = StringLitLabel
  824 
  825 mkAsmTempLabel :: Uniquable a => a -> CLabel
  826 mkAsmTempLabel a                = AsmTempLabel (getUnique a)
  827 
  828 mkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel
  829 mkAsmTempDerivedLabel = AsmTempDerivedLabel
  830 
  831 mkAsmTempEndLabel :: CLabel -> CLabel
  832 mkAsmTempEndLabel l = mkAsmTempDerivedLabel l (fsLit "_end")
  833 
  834 -- | A label indicating the end of a procedure.
  835 mkAsmTempProcEndLabel :: CLabel -> CLabel
  836 mkAsmTempProcEndLabel l = mkAsmTempDerivedLabel l (fsLit "_proc_end")
  837 
  838 -- | Construct a label for a DWARF Debug Information Entity (DIE)
  839 -- describing another symbol.
  840 mkAsmTempDieLabel :: CLabel -> CLabel
  841 mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die")
  842 
  843 -- -----------------------------------------------------------------------------
  844 -- Convert between different kinds of label
  845 
  846 toClosureLbl :: Platform -> CLabel -> CLabel
  847 toClosureLbl platform lbl = case lbl of
  848    IdLabel n c _        -> IdLabel n c Closure
  849    CmmLabel m ext str _ -> CmmLabel m ext str CmmClosure
  850    _                    -> pprPanic "toClosureLbl" (pprDebugCLabel platform lbl)
  851 
  852 toSlowEntryLbl :: Platform -> CLabel -> CLabel
  853 toSlowEntryLbl platform lbl = case lbl of
  854    IdLabel n _ BlockInfoTable -> pprPanic "toSlowEntryLbl" (ppr n)
  855    IdLabel n c _              -> IdLabel n c Slow
  856    _                          -> pprPanic "toSlowEntryLbl" (pprDebugCLabel platform lbl)
  857 
  858 toEntryLbl :: Platform -> CLabel -> CLabel
  859 toEntryLbl platform lbl = case lbl of
  860    IdLabel n c LocalInfoTable    -> IdLabel n c LocalEntry
  861    IdLabel n c (ConInfoTable k)  -> IdLabel n c (ConEntry k)
  862 
  863    IdLabel n _ BlockInfoTable    -> mkLocalBlockLabel (nameUnique n)
  864                    -- See Note [Proc-point local block entry-point].
  865    IdLabel n c _                 -> IdLabel n c Entry
  866    CmmLabel m ext str CmmInfo    -> CmmLabel m ext str CmmEntry
  867    CmmLabel m ext str CmmRetInfo -> CmmLabel m ext str CmmRet
  868    _                             -> pprPanic "toEntryLbl" (pprDebugCLabel platform lbl)
  869 
  870 toInfoLbl :: Platform -> CLabel -> CLabel
  871 toInfoLbl platform lbl = case lbl of
  872    IdLabel n c LocalEntry      -> IdLabel n c LocalInfoTable
  873    IdLabel n c (ConEntry k)    -> IdLabel n c (ConInfoTable k)
  874 
  875    IdLabel n c _               -> IdLabel n c InfoTable
  876    CmmLabel m ext str CmmEntry -> CmmLabel m ext str CmmInfo
  877    CmmLabel m ext str CmmRet   -> CmmLabel m ext str CmmRetInfo
  878    _                           -> pprPanic "CLabel.toInfoLbl" (pprDebugCLabel platform lbl)
  879 
  880 hasHaskellName :: CLabel -> Maybe Name
  881 hasHaskellName (IdLabel n _ _) = Just n
  882 hasHaskellName _               = Nothing
  883 
  884 hasIdLabelInfo :: CLabel -> Maybe IdLabelInfo
  885 hasIdLabelInfo (IdLabel _ _ l) = Just l
  886 hasIdLabelInfo _ = Nothing
  887 
  888 -- -----------------------------------------------------------------------------
  889 -- Does a CLabel's referent itself refer to a CAF?
  890 hasCAF :: CLabel -> Bool
  891 hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]
  892 hasCAF (IdLabel _ MayHaveCafRefs _) = True
  893 hasCAF _                            = False
  894 
  895 -- Note [ticky for LNE]
  896 -- ~~~~~~~~~~~~~~~~~~~~~
  897 
  898 -- Until 14 Feb 2013, every ticky counter was associated with a
  899 -- closure. Thus, ticky labels used IdLabel. It is odd that
  900 -- GHC.Cmm.Info.Build.cafTransfers would consider such a ticky label
  901 -- reason to add the name to the CAFEnv (and thus eventually the SRT),
  902 -- but it was harmless because the ticky was only used if the closure
  903 -- was also.
  904 --
  905 -- Since we now have ticky counters for LNEs, it is no longer the case
  906 -- that every ticky counter has an actual closure. So I changed the
  907 -- generation of ticky counters' CLabels to not result in their
  908 -- associated id ending up in the SRT.
  909 --
  910 -- NB IdLabel is still appropriate for ticky ids (as opposed to
  911 -- CmmLabel) because the LNE's counter is still related to an .hs Id,
  912 -- that Id just isn't for a proper closure.
  913 
  914 -- -----------------------------------------------------------------------------
  915 -- Does a CLabel need declaring before use or not?
  916 --
  917 -- See wiki:commentary/compiler/backends/ppr-c#prototypes
  918 
  919 needsCDecl :: CLabel -> Bool
  920   -- False <=> it's pre-declared; don't bother
  921   -- don't bother declaring Bitmap labels, we always make sure
  922   -- they are defined before use.
  923 needsCDecl (SRTLabel _)                 = True
  924 needsCDecl (LargeBitmapLabel _)         = False
  925 needsCDecl (IdLabel _ _ _)              = True
  926 needsCDecl (LocalBlockLabel _)          = True
  927 
  928 needsCDecl (StringLitLabel _)           = False
  929 needsCDecl (AsmTempLabel _)             = False
  930 needsCDecl (AsmTempDerivedLabel _ _)    = False
  931 needsCDecl (RtsLabel _)                 = False
  932 
  933 needsCDecl (CmmLabel pkgId (NeedExternDecl external) _ _)
  934         -- local labels mustn't have it
  935         | not external                  = False
  936 
  937         -- Prototypes for labels defined in the runtime system are imported
  938         --      into HC files via rts/include/Stg.h.
  939         | pkgId == rtsUnitId            = False
  940 
  941         -- For other labels we inline one into the HC file directly.
  942         | otherwise                     = True
  943 
  944 needsCDecl l@(ForeignLabel{})           = not (isMathFun l)
  945 needsCDecl (CC_Label _)                 = True
  946 needsCDecl (CCS_Label _)                = True
  947 needsCDecl (IPE_Label {})               = True
  948 needsCDecl (HpcTicksLabel _)            = True
  949 needsCDecl (DynamicLinkerLabel {})      = panic "needsCDecl DynamicLinkerLabel"
  950 needsCDecl PicBaseLabel                 = panic "needsCDecl PicBaseLabel"
  951 needsCDecl (DeadStripPreventer {})      = panic "needsCDecl DeadStripPreventer"
  952 
  953 -- | If a label is a local block label then return just its 'BlockId', otherwise
  954 -- 'Nothing'.
  955 maybeLocalBlockLabel :: CLabel -> Maybe BlockId
  956 maybeLocalBlockLabel (LocalBlockLabel uq)  = Just $ mkBlockId uq
  957 maybeLocalBlockLabel _                     = Nothing
  958 
  959 
  960 -- | Check whether a label corresponds to a C function that has
  961 --      a prototype in a system header somewhere, or is built-in
  962 --      to the C compiler. For these labels we avoid generating our
  963 --      own C prototypes.
  964 isMathFun :: CLabel -> Bool
  965 isMathFun (ForeignLabel fs _ _ _)       = fs `elementOfUniqSet` math_funs
  966 isMathFun _ = False
  967 
  968 math_funs :: UniqSet FastString
  969 math_funs = mkUniqSet [
  970         -- _ISOC99_SOURCE
  971         (fsLit "acos"),         (fsLit "acosf"),        (fsLit "acosh"),
  972         (fsLit "acoshf"),       (fsLit "acoshl"),       (fsLit "acosl"),
  973         (fsLit "asin"),         (fsLit "asinf"),        (fsLit "asinl"),
  974         (fsLit "asinh"),        (fsLit "asinhf"),       (fsLit "asinhl"),
  975         (fsLit "atan"),         (fsLit "atanf"),        (fsLit "atanl"),
  976         (fsLit "atan2"),        (fsLit "atan2f"),       (fsLit "atan2l"),
  977         (fsLit "atanh"),        (fsLit "atanhf"),       (fsLit "atanhl"),
  978         (fsLit "cbrt"),         (fsLit "cbrtf"),        (fsLit "cbrtl"),
  979         (fsLit "ceil"),         (fsLit "ceilf"),        (fsLit "ceill"),
  980         (fsLit "copysign"),     (fsLit "copysignf"),    (fsLit "copysignl"),
  981         (fsLit "cos"),          (fsLit "cosf"),         (fsLit "cosl"),
  982         (fsLit "cosh"),         (fsLit "coshf"),        (fsLit "coshl"),
  983         (fsLit "erf"),          (fsLit "erff"),         (fsLit "erfl"),
  984         (fsLit "erfc"),         (fsLit "erfcf"),        (fsLit "erfcl"),
  985         (fsLit "exp"),          (fsLit "expf"),         (fsLit "expl"),
  986         (fsLit "exp2"),         (fsLit "exp2f"),        (fsLit "exp2l"),
  987         (fsLit "expm1"),        (fsLit "expm1f"),       (fsLit "expm1l"),
  988         (fsLit "fabs"),         (fsLit "fabsf"),        (fsLit "fabsl"),
  989         (fsLit "fdim"),         (fsLit "fdimf"),        (fsLit "fdiml"),
  990         (fsLit "floor"),        (fsLit "floorf"),       (fsLit "floorl"),
  991         (fsLit "fma"),          (fsLit "fmaf"),         (fsLit "fmal"),
  992         (fsLit "fmax"),         (fsLit "fmaxf"),        (fsLit "fmaxl"),
  993         (fsLit "fmin"),         (fsLit "fminf"),        (fsLit "fminl"),
  994         (fsLit "fmod"),         (fsLit "fmodf"),        (fsLit "fmodl"),
  995         (fsLit "frexp"),        (fsLit "frexpf"),       (fsLit "frexpl"),
  996         (fsLit "hypot"),        (fsLit "hypotf"),       (fsLit "hypotl"),
  997         (fsLit "ilogb"),        (fsLit "ilogbf"),       (fsLit "ilogbl"),
  998         (fsLit "ldexp"),        (fsLit "ldexpf"),       (fsLit "ldexpl"),
  999         (fsLit "lgamma"),       (fsLit "lgammaf"),      (fsLit "lgammal"),
 1000         (fsLit "llrint"),       (fsLit "llrintf"),      (fsLit "llrintl"),
 1001         (fsLit "llround"),      (fsLit "llroundf"),     (fsLit "llroundl"),
 1002         (fsLit "log"),          (fsLit "logf"),         (fsLit "logl"),
 1003         (fsLit "log10l"),       (fsLit "log10"),        (fsLit "log10f"),
 1004         (fsLit "log1pl"),       (fsLit "log1p"),        (fsLit "log1pf"),
 1005         (fsLit "log2"),         (fsLit "log2f"),        (fsLit "log2l"),
 1006         (fsLit "logb"),         (fsLit "logbf"),        (fsLit "logbl"),
 1007         (fsLit "lrint"),        (fsLit "lrintf"),       (fsLit "lrintl"),
 1008         (fsLit "lround"),       (fsLit "lroundf"),      (fsLit "lroundl"),
 1009         (fsLit "modf"),         (fsLit "modff"),        (fsLit "modfl"),
 1010         (fsLit "nan"),          (fsLit "nanf"),         (fsLit "nanl"),
 1011         (fsLit "nearbyint"),    (fsLit "nearbyintf"),   (fsLit "nearbyintl"),
 1012         (fsLit "nextafter"),    (fsLit "nextafterf"),   (fsLit "nextafterl"),
 1013         (fsLit "nexttoward"),   (fsLit "nexttowardf"),  (fsLit "nexttowardl"),
 1014         (fsLit "pow"),          (fsLit "powf"),         (fsLit "powl"),
 1015         (fsLit "remainder"),    (fsLit "remainderf"),   (fsLit "remainderl"),
 1016         (fsLit "remquo"),       (fsLit "remquof"),      (fsLit "remquol"),
 1017         (fsLit "rint"),         (fsLit "rintf"),        (fsLit "rintl"),
 1018         (fsLit "round"),        (fsLit "roundf"),       (fsLit "roundl"),
 1019         (fsLit "scalbln"),      (fsLit "scalblnf"),     (fsLit "scalblnl"),
 1020         (fsLit "scalbn"),       (fsLit "scalbnf"),      (fsLit "scalbnl"),
 1021         (fsLit "sin"),          (fsLit "sinf"),         (fsLit "sinl"),
 1022         (fsLit "sinh"),         (fsLit "sinhf"),        (fsLit "sinhl"),
 1023         (fsLit "sqrt"),         (fsLit "sqrtf"),        (fsLit "sqrtl"),
 1024         (fsLit "tan"),          (fsLit "tanf"),         (fsLit "tanl"),
 1025         (fsLit "tanh"),         (fsLit "tanhf"),        (fsLit "tanhl"),
 1026         (fsLit "tgamma"),       (fsLit "tgammaf"),      (fsLit "tgammal"),
 1027         (fsLit "trunc"),        (fsLit "truncf"),       (fsLit "truncl"),
 1028         -- ISO C 99 also defines these function-like macros in math.h:
 1029         -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
 1030         -- isgreaterequal, isless, islessequal, islessgreater, isunordered
 1031 
 1032         -- additional symbols from _BSD_SOURCE
 1033         (fsLit "drem"),         (fsLit "dremf"),        (fsLit "dreml"),
 1034         (fsLit "finite"),       (fsLit "finitef"),      (fsLit "finitel"),
 1035         (fsLit "gamma"),        (fsLit "gammaf"),       (fsLit "gammal"),
 1036         (fsLit "isinf"),        (fsLit "isinff"),       (fsLit "isinfl"),
 1037         (fsLit "isnan"),        (fsLit "isnanf"),       (fsLit "isnanl"),
 1038         (fsLit "j0"),           (fsLit "j0f"),          (fsLit "j0l"),
 1039         (fsLit "j1"),           (fsLit "j1f"),          (fsLit "j1l"),
 1040         (fsLit "jn"),           (fsLit "jnf"),          (fsLit "jnl"),
 1041         (fsLit "lgamma_r"),     (fsLit "lgammaf_r"),    (fsLit "lgammal_r"),
 1042         (fsLit "scalb"),        (fsLit "scalbf"),       (fsLit "scalbl"),
 1043         (fsLit "significand"),  (fsLit "significandf"), (fsLit "significandl"),
 1044         (fsLit "y0"),           (fsLit "y0f"),          (fsLit "y0l"),
 1045         (fsLit "y1"),           (fsLit "y1f"),          (fsLit "y1l"),
 1046         (fsLit "yn"),           (fsLit "ynf"),          (fsLit "ynl"),
 1047 
 1048         -- These functions are described in IEEE Std 754-2008 -
 1049         -- Standard for Floating-Point Arithmetic and ISO/IEC TS 18661
 1050         (fsLit "nextup"),       (fsLit "nextupf"),      (fsLit "nextupl"),
 1051         (fsLit "nextdown"),     (fsLit "nextdownf"),    (fsLit "nextdownl")
 1052     ]
 1053 
 1054 -- -----------------------------------------------------------------------------
 1055 -- | Is a CLabel visible outside this object file or not?
 1056 --      From the point of view of the code generator, a name is
 1057 --      externally visible if it has to be declared as exported
 1058 --      in the .o file's symbol table; that is, made non-static.
 1059 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 1060 externallyVisibleCLabel (StringLitLabel _)      = False
 1061 externallyVisibleCLabel (AsmTempLabel _)        = False
 1062 externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False
 1063 externallyVisibleCLabel (RtsLabel _)            = True
 1064 externallyVisibleCLabel (LocalBlockLabel _)     = False
 1065 externallyVisibleCLabel (CmmLabel _ _ _ _)      = True
 1066 externallyVisibleCLabel (ForeignLabel{})        = True
 1067 externallyVisibleCLabel (IdLabel name _ info)   = isExternalName name && externallyVisibleIdLabel info
 1068 externallyVisibleCLabel (CC_Label _)            = True
 1069 externallyVisibleCLabel (CCS_Label _)           = True
 1070 externallyVisibleCLabel (IPE_Label {})          = True
 1071 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 1072 externallyVisibleCLabel (HpcTicksLabel _)       = True
 1073 externallyVisibleCLabel (LargeBitmapLabel _)    = False
 1074 externallyVisibleCLabel (SRTLabel _)            = False
 1075 externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
 1076 externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
 1077 
 1078 externallyVisibleIdLabel :: IdLabelInfo -> Bool
 1079 externallyVisibleIdLabel LocalInfoTable  = False
 1080 externallyVisibleIdLabel LocalEntry      = False
 1081 externallyVisibleIdLabel BlockInfoTable  = False
 1082 externallyVisibleIdLabel _               = True
 1083 
 1084 -- -----------------------------------------------------------------------------
 1085 -- Finding the "type" of a CLabel
 1086 
 1087 -- For generating correct types in label declarations:
 1088 
 1089 data CLabelType
 1090   = CodeLabel   -- Address of some executable instructions
 1091   | DataLabel   -- Address of data, not a GC ptr
 1092   | GcPtrLabel  -- Address of a (presumably static) GC object
 1093 
 1094 isCFunctionLabel :: CLabel -> Bool
 1095 isCFunctionLabel lbl = case labelType lbl of
 1096                         CodeLabel -> True
 1097                         _other    -> False
 1098 
 1099 isGcPtrLabel :: CLabel -> Bool
 1100 isGcPtrLabel lbl = case labelType lbl of
 1101                         GcPtrLabel -> True
 1102                         _other     -> False
 1103 
 1104 
 1105 -- | Work out the general type of data at the address of this label
 1106 --    whether it be code, data, or static GC object.
 1107 labelType :: CLabel -> CLabelType
 1108 labelType (IdLabel _ _ info)                    = idInfoLabelType info
 1109 labelType (CmmLabel _ _ _ CmmData)              = DataLabel
 1110 labelType (CmmLabel _ _ _ CmmClosure)           = GcPtrLabel
 1111 labelType (CmmLabel _ _ _ CmmCode)              = CodeLabel
 1112 labelType (CmmLabel _ _ _ CmmInfo)              = DataLabel
 1113 labelType (CmmLabel _ _ _ CmmEntry)             = CodeLabel
 1114 labelType (CmmLabel _ _ _ CmmPrimCall)          = CodeLabel
 1115 labelType (CmmLabel _ _ _ CmmRetInfo)           = DataLabel
 1116 labelType (CmmLabel _ _ _ CmmRet)               = CodeLabel
 1117 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 1118 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 1119 labelType (RtsLabel (RtsApFast _))              = CodeLabel
 1120 labelType (RtsLabel _)                          = DataLabel
 1121 labelType (LocalBlockLabel _)                   = CodeLabel
 1122 labelType (SRTLabel _)                          = DataLabel
 1123 labelType (ForeignLabel _ _ _ IsFunction)       = CodeLabel
 1124 labelType (ForeignLabel _ _ _ IsData)           = DataLabel
 1125 labelType (AsmTempLabel _)                      = panic "labelType(AsmTempLabel)"
 1126 labelType (AsmTempDerivedLabel _ _)             = panic "labelType(AsmTempDerivedLabel)"
 1127 labelType (StringLitLabel _)                    = DataLabel
 1128 labelType (CC_Label _)                          = DataLabel
 1129 labelType (CCS_Label _)                         = DataLabel
 1130 labelType (IPE_Label {})                        = DataLabel
 1131 labelType (DynamicLinkerLabel _ _)              = DataLabel -- Is this right?
 1132 labelType PicBaseLabel                          = DataLabel
 1133 labelType (DeadStripPreventer _)                = DataLabel
 1134 labelType (HpcTicksLabel _)                     = DataLabel
 1135 labelType (LargeBitmapLabel _)                  = DataLabel
 1136 
 1137 idInfoLabelType :: IdLabelInfo -> CLabelType
 1138 idInfoLabelType info =
 1139   case info of
 1140     InfoTable     -> DataLabel
 1141     LocalInfoTable -> DataLabel
 1142     BlockInfoTable -> DataLabel
 1143     Closure       -> GcPtrLabel
 1144     ConInfoTable {} -> DataLabel
 1145     ClosureTable  -> DataLabel
 1146     RednCounts    -> DataLabel
 1147     Bytes         -> DataLabel
 1148     _             -> CodeLabel
 1149 
 1150 
 1151 -- -----------------------------------------------------------------------------
 1152 
 1153 -- | Is a 'CLabel' defined in the current module being compiled?
 1154 --
 1155 -- Sometimes we can optimise references within a compilation unit in ways that
 1156 -- we couldn't for inter-module references. This provides a conservative
 1157 -- estimate of whether a 'CLabel' lives in the current module.
 1158 isLocalCLabel :: Module -> CLabel -> Bool
 1159 isLocalCLabel this_mod lbl =
 1160   case lbl of
 1161     IdLabel name _ _
 1162       | isInternalName name -> True
 1163       | otherwise           -> nameModule name == this_mod
 1164     LocalBlockLabel _       -> True
 1165     _                       -> False
 1166 
 1167 -- -----------------------------------------------------------------------------
 1168 
 1169 -- | Does a 'CLabel' need dynamic linkage?
 1170 --
 1171 -- When referring to data in code, we need to know whether
 1172 -- that data resides in a DLL or not. [Win32 only.]
 1173 -- @labelDynamic@ returns @True@ if the label is located
 1174 -- in a DLL, be it a data reference or not.
 1175 labelDynamic :: NCGConfig -> CLabel -> Bool
 1176 labelDynamic config lbl =
 1177   case lbl of
 1178    -- is the RTS in a DLL or not?
 1179    RtsLabel _ ->
 1180      externalDynamicRefs && (this_unit /= rtsUnitId)
 1181 
 1182    IdLabel n _ _ ->
 1183      externalDynamicRefs && isDynLinkName platform this_mod n
 1184 
 1185    -- When compiling in the "dyn" way, each package is to be linked into
 1186    -- its own shared library.
 1187    CmmLabel lbl_unit _ _ _
 1188     | os == OSMinGW32 -> externalDynamicRefs && (this_unit /= lbl_unit)
 1189     | otherwise       -> externalDynamicRefs
 1190 
 1191    LocalBlockLabel _    -> False
 1192 
 1193    ForeignLabel _ _ source _  ->
 1194        if os == OSMinGW32
 1195        then case source of
 1196             -- Foreign label is in some un-named foreign package (or DLL).
 1197             ForeignLabelInExternalPackage -> True
 1198 
 1199             -- Foreign label is linked into the same package as the
 1200             -- source file currently being compiled.
 1201             ForeignLabelInThisPackage -> False
 1202 
 1203             -- Foreign label is in some named package.
 1204             -- When compiling in the "dyn" way, each package is to be
 1205             -- linked into its own DLL.
 1206             ForeignLabelInPackage pkgId ->
 1207                 externalDynamicRefs && (this_unit /= pkgId)
 1208 
 1209        else -- On Mac OS X and on ELF platforms, false positives are OK,
 1210             -- so we claim that all foreign imports come from dynamic
 1211             -- libraries
 1212             True
 1213 
 1214    CC_Label cc ->
 1215      externalDynamicRefs && not (ccFromThisModule cc this_mod)
 1216 
 1217    -- CCS_Label always contains a CostCentre defined in the current module
 1218    CCS_Label _ -> False
 1219    IPE_Label {} -> True
 1220 
 1221    HpcTicksLabel m ->
 1222      externalDynamicRefs && this_mod /= m
 1223 
 1224    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
 1225    _                 -> False
 1226   where
 1227     externalDynamicRefs = ncgExternalDynamicRefs config
 1228     platform = ncgPlatform config
 1229     os = platformOS platform
 1230     this_mod = ncgThisModule config
 1231     this_unit = toUnitId (moduleUnit this_mod)
 1232 
 1233 
 1234 -----------------------------------------------------------------------------
 1235 -- Printing out CLabels.
 1236 
 1237 {-
 1238 Convention:
 1239 
 1240       <name>_<type>
 1241 
 1242 where <name> is <Module>_<name> for external names and <unique> for
 1243 internal names. <type> is one of the following:
 1244 
 1245          info                   Info table
 1246          srt                    Static reference table
 1247          entry                  Entry code (function, closure)
 1248          slow                   Slow entry code (if any)
 1249          ret                    Direct return address
 1250          vtbl                   Vector table
 1251          <n>_alt                Case alternative (tag n)
 1252          dflt                   Default case alternative
 1253          btm                    Large bitmap vector
 1254          closure                Static closure
 1255          con_entry              Dynamic Constructor entry code
 1256          con_info               Dynamic Constructor info table
 1257          static_entry           Static Constructor entry code
 1258          static_info            Static Constructor info table
 1259          sel_info               Selector info table
 1260          sel_entry              Selector entry code
 1261          cc                     Cost centre
 1262          ccs                    Cost centre stack
 1263 
 1264 Many of these distinctions are only for documentation reasons.  For
 1265 example, _ret is only distinguished from _entry to make it easy to
 1266 tell whether a code fragment is a return point or a closure/function
 1267 entry.
 1268 
 1269 Note [Closure and info labels]
 1270 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1271 For a function 'foo, we have:
 1272    foo_info    : Points to the info table describing foo's closure
 1273                  (and entry code for foo with tables next to code)
 1274    foo_closure : Static (no-free-var) closure only:
 1275                  points to the statically-allocated closure
 1276 
 1277 For a data constructor (such as Just or Nothing), we have:
 1278     Just_con_info: Info table for the data constructor itself
 1279                    the first word of a heap-allocated Just
 1280     Just_info:     Info table for the *worker function*, an
 1281                    ordinary Haskell function of arity 1 that
 1282                    allocates a (Just x) box:
 1283                       Just = \x -> Just x
 1284     Just_closure:  The closure for this worker
 1285 
 1286     Nothing_closure: a statically allocated closure for Nothing
 1287     Nothing_static_info: info table for Nothing_closure
 1288 
 1289 All these must be exported symbol, EXCEPT Just_info.  We don't need to
 1290 export this because in other modules we either have
 1291        * A reference to 'Just'; use Just_closure
 1292        * A saturated call 'Just x'; allocate using Just_con_info
 1293 Not exporting these Just_info labels reduces the number of symbols
 1294 somewhat.
 1295 
 1296 Note [Bytes label]
 1297 ~~~~~~~~~~~~~~~~~~
 1298 For a top-level string literal 'foo', we have just one symbol 'foo_bytes', which
 1299 points to a static data block containing the content of the literal.
 1300 
 1301 Note [Proc-point local block entry-points]
 1302 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1303 A label for a proc-point local block entry-point has no "_entry" suffix. With
 1304 `infoTblLbl` we derive an info table label from a proc-point block ID. If
 1305 we convert such an info table label into an entry label we must produce
 1306 the label without an "_entry" suffix. So an info table label records
 1307 the fact that it was derived from a block ID in `IdLabelInfo` as
 1308 `BlockInfoTable`.
 1309 
 1310 The info table label and the local block label are both local labels
 1311 and are not externally visible.
 1312 
 1313 Note [Bangs in CLabel]
 1314 ~~~~~~~~~~~~~~~~~~~~~~
 1315 There are some carefully placed strictness annotations in this module,
 1316 which were discovered in !5226 to significantly reduce compile-time
 1317 allocation.  Take care if you want to remove them!
 1318 
 1319 -}
 1320 
 1321 instance OutputableP Platform CLabel where
 1322   {-# INLINE pdoc #-} -- see Note [Bangs in CLabel]
 1323   pdoc !platform lbl = getPprStyle $ \pp_sty ->
 1324                         let !sty = case pp_sty of
 1325                                     PprCode sty -> sty
 1326                                     _           -> CStyle
 1327                         in pprCLabel platform sty lbl
 1328 
 1329 pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc
 1330 pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
 1331   let
 1332     !use_leading_underscores = platformLeadingUnderscore platform
 1333 
 1334     -- some platform (e.g. Darwin) require a leading "_" for exported asm
 1335     -- symbols
 1336     maybe_underscore :: SDoc -> SDoc
 1337     maybe_underscore doc = case sty of
 1338       AsmStyle | use_leading_underscores -> pp_cSEP <> doc
 1339       _                                  -> doc
 1340 
 1341     tempLabelPrefixOrUnderscore :: Platform -> SDoc
 1342     tempLabelPrefixOrUnderscore platform = case sty of
 1343       AsmStyle -> asmTempLabelPrefix platform
 1344       CStyle   -> char '_'
 1345 
 1346 
 1347   in case lbl of
 1348    LocalBlockLabel u -> case sty of
 1349       AsmStyle -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
 1350       CStyle   -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u
 1351 
 1352    AsmTempLabel u
 1353       -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
 1354 
 1355    AsmTempDerivedLabel l suf
 1356       -> asmTempLabelPrefix platform
 1357          <> case l of AsmTempLabel u    -> pprUniqueAlways u
 1358                       LocalBlockLabel u -> pprUniqueAlways u
 1359                       _other            -> pprCLabel platform sty l
 1360          <> ftext suf
 1361 
 1362    DynamicLinkerLabel info lbl
 1363       -> pprDynamicLinkerAsmLabel platform info (pprCLabel platform AsmStyle lbl)
 1364 
 1365    PicBaseLabel
 1366       -> text "1b"
 1367 
 1368    DeadStripPreventer lbl
 1369       ->
 1370       {-
 1371          `lbl` can be temp one but we need to ensure that dsp label will stay
 1372          in the final binary so we prepend non-temp prefix ("dsp_") and
 1373          optional `_` (underscore) because this is how you mark non-temp symbols
 1374          on some platforms (Darwin)
 1375       -}
 1376       maybe_underscore $ text "dsp_" <> pprCLabel platform sty lbl <> text "_dsp"
 1377 
 1378    StringLitLabel u
 1379       -> maybe_underscore $ pprUniqueAlways u <> text "_str"
 1380 
 1381    ForeignLabel fs (Just sz) _ _
 1382       | AsmStyle <- sty
 1383       , OSMinGW32 <- platformOS platform
 1384       -> -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 1385          -- (The C compiler does this itself).
 1386          maybe_underscore $ ftext fs <> char '@' <> int sz
 1387 
 1388    ForeignLabel fs _ _ _
 1389       -> maybe_underscore $ ftext fs
 1390 
 1391 
 1392    IdLabel name _cafs flavor -> case sty of
 1393       AsmStyle -> maybe_underscore $ internalNamePrefix <> ppr name <> ppIdFlavor flavor
 1394                    where
 1395                       isRandomGenerated = not (isExternalName name)
 1396                       internalNamePrefix =
 1397                          if isRandomGenerated
 1398                             then asmTempLabelPrefix platform
 1399                             else empty
 1400       CStyle   -> ppr name <> ppIdFlavor flavor
 1401 
 1402    SRTLabel u
 1403       -> maybe_underscore $ tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt"
 1404 
 1405    RtsLabel (RtsApFast (NonDetFastString str))
 1406       -> maybe_underscore $ ftext str <> text "_fast"
 1407 
 1408    RtsLabel (RtsSelectorInfoTable upd_reqd offset)
 1409       -> maybe_underscore $ hcat [ text "stg_sel_", text (show offset)
 1410                                  , if upd_reqd
 1411                                     then text "_upd_info"
 1412                                     else text "_noupd_info"
 1413                                  ]
 1414 
 1415    RtsLabel (RtsSelectorEntry upd_reqd offset)
 1416       -> maybe_underscore $ hcat [ text "stg_sel_", text (show offset)
 1417                                  , if upd_reqd
 1418                                     then text "_upd_entry"
 1419                                     else text "_noupd_entry"
 1420                                  ]
 1421 
 1422    RtsLabel (RtsApInfoTable upd_reqd arity)
 1423       -> maybe_underscore $ hcat [ text "stg_ap_", text (show arity)
 1424                                  , if upd_reqd
 1425                                     then text "_upd_info"
 1426                                     else text "_noupd_info"
 1427                                  ]
 1428 
 1429    RtsLabel (RtsApEntry upd_reqd arity)
 1430       -> maybe_underscore $ hcat [ text "stg_ap_", text (show arity)
 1431                                  , if upd_reqd
 1432                                     then text "_upd_entry"
 1433                                     else text "_noupd_entry"
 1434                                  ]
 1435 
 1436    RtsLabel (RtsPrimOp primop)
 1437       -> maybe_underscore $ text "stg_" <> ppr primop
 1438 
 1439    RtsLabel (RtsSlowFastTickyCtr pat)
 1440       -> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr"
 1441 
 1442    LargeBitmapLabel u
 1443       -> maybe_underscore $ tempLabelPrefixOrUnderscore platform
 1444                             <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm"
 1445                             -- Some bitmaps for tuple constructors have a numeric tag (e.g. '7')
 1446                             -- until that gets resolved we'll just force them to start
 1447                             -- with a letter so the label will be legal assembly code.
 1448 
 1449    HpcTicksLabel mod
 1450       -> maybe_underscore $ text "_hpc_tickboxes_"  <> ppr mod <> text "_hpc"
 1451 
 1452    CC_Label cc   -> maybe_underscore $ ppr cc
 1453    CCS_Label ccs -> maybe_underscore $ ppr ccs
 1454    IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCode CStyle (pdoc platform l) <> text "_" <> ppr m <> text "_ipe")
 1455 
 1456 
 1457    CmmLabel _ _ fs CmmCode     -> maybe_underscore $ ftext fs
 1458    CmmLabel _ _ fs CmmData     -> maybe_underscore $ ftext fs
 1459    CmmLabel _ _ fs CmmPrimCall -> maybe_underscore $ ftext fs
 1460    CmmLabel _ _ fs CmmInfo     -> maybe_underscore $ ftext fs <> text "_info"
 1461    CmmLabel _ _ fs CmmEntry    -> maybe_underscore $ ftext fs <> text "_entry"
 1462    CmmLabel _ _ fs CmmRetInfo  -> maybe_underscore $ ftext fs <> text "_info"
 1463    CmmLabel _ _ fs CmmRet      -> maybe_underscore $ ftext fs <> text "_ret"
 1464    CmmLabel _ _ fs CmmClosure  -> maybe_underscore $ ftext fs <> text "_closure"
 1465 
 1466 -- Note [Internal proc labels]
 1467 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1468 --
 1469 -- Some tools (e.g. the `perf` utility on Linux) rely on the symbol table
 1470 -- for resolution of function names. To help these tools we provide the
 1471 -- (enabled by default) -fexpose-all-symbols flag which causes GHC to produce
 1472 -- symbols even for symbols with are internal to a module (although such
 1473 -- symbols will have only local linkage).
 1474 --
 1475 -- Note that these labels are *not* referred to by code. They are strictly for
 1476 -- diagnostics purposes.
 1477 --
 1478 -- To avoid confusion, it is desirable to add a module-qualifier to the
 1479 -- symbol name. However, the Name type's Internal constructor doesn't carry
 1480 -- knowledge of the current Module. Consequently, we have to pass this around
 1481 -- explicitly.
 1482 
 1483 -- | Generate a label for a procedure internal to a module (if
 1484 -- 'Opt_ExposeAllSymbols' is enabled).
 1485 -- See Note [Internal proc labels].
 1486 ppInternalProcLabel :: Module     -- ^ the current module
 1487                     -> CLabel
 1488                     -> Maybe SDoc -- ^ the internal proc label
 1489 ppInternalProcLabel this_mod (IdLabel nm _ flavour)
 1490   | isInternalName nm
 1491   = Just
 1492      $ text "_" <> ppr this_mod
 1493     <> char '_'
 1494     <> ztext (zEncodeFS (occNameFS (occName nm)))
 1495     <> char '_'
 1496     <> pprUniqueAlways (getUnique nm)
 1497     <> ppIdFlavor flavour
 1498 ppInternalProcLabel _ _ = Nothing
 1499 
 1500 ppIdFlavor :: IdLabelInfo -> SDoc
 1501 ppIdFlavor x = pp_cSEP <> case x of
 1502    Closure          -> text "closure"
 1503    InfoTable        -> text "info"
 1504    LocalInfoTable   -> text "info"
 1505    Entry            -> text "entry"
 1506    LocalEntry       -> text "entry"
 1507    Slow             -> text "slow"
 1508    RednCounts       -> text "ct"
 1509    ConEntry loc      ->
 1510       case loc of
 1511         DefinitionSite -> text "con_entry"
 1512         UsageSite m n ->
 1513           ppr m <> pp_cSEP <> ppr n <> pp_cSEP <> text "con_entry"
 1514    ConInfoTable k   ->
 1515     case k of
 1516       DefinitionSite -> text "con_info"
 1517       UsageSite m n ->
 1518         ppr m <> pp_cSEP <> ppr n <> pp_cSEP <> text "con_info"
 1519    ClosureTable     -> text "closure_tbl"
 1520    Bytes            -> text "bytes"
 1521    BlockInfoTable   -> text "info"
 1522 
 1523 pp_cSEP :: SDoc
 1524 pp_cSEP = char '_'
 1525 
 1526 
 1527 instance Outputable ForeignLabelSource where
 1528  ppr fs
 1529   = case fs of
 1530         ForeignLabelInPackage pkgId     -> parens $ text "package: " <> ppr pkgId
 1531         ForeignLabelInThisPackage       -> parens $ text "this package"
 1532         ForeignLabelInExternalPackage   -> parens $ text "external package"
 1533 
 1534 -- -----------------------------------------------------------------------------
 1535 -- Machine-dependent knowledge about labels.
 1536 
 1537 asmTempLabelPrefix :: Platform -> SDoc  -- for formatting labels
 1538 asmTempLabelPrefix !platform = case platformOS platform of
 1539     OSDarwin -> text "L"
 1540     OSAIX    -> text "__L" -- follow IBM XL C's convention
 1541     _        -> text ".L"
 1542 
 1543 pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> SDoc -> SDoc
 1544 pprDynamicLinkerAsmLabel !platform dllInfo ppLbl =
 1545     case platformOS platform of
 1546       OSDarwin
 1547         | platformArch platform == ArchX86_64 ->
 1548           case dllInfo of
 1549             CodeStub        -> char 'L' <> ppLbl <> text "$stub"
 1550             SymbolPtr       -> char 'L' <> ppLbl <> text "$non_lazy_ptr"
 1551             GotSymbolPtr    -> ppLbl <> text "@GOTPCREL"
 1552             GotSymbolOffset -> ppLbl
 1553         | platformArch platform == ArchAArch64 -> ppLbl
 1554         | otherwise ->
 1555           case dllInfo of
 1556             CodeStub  -> char 'L' <> ppLbl <> text "$stub"
 1557             SymbolPtr -> char 'L' <> ppLbl <> text "$non_lazy_ptr"
 1558             _         -> panic "pprDynamicLinkerAsmLabel"
 1559 
 1560       OSAIX ->
 1561           case dllInfo of
 1562             SymbolPtr -> text "LC.." <> ppLbl -- GCC's naming convention
 1563             _         -> panic "pprDynamicLinkerAsmLabel"
 1564 
 1565       _ | osElfTarget (platformOS platform) -> elfLabel
 1566 
 1567       OSMinGW32 ->
 1568           case dllInfo of
 1569             SymbolPtr -> text "__imp_" <> ppLbl
 1570             _         -> panic "pprDynamicLinkerAsmLabel"
 1571 
 1572       _ -> panic "pprDynamicLinkerAsmLabel"
 1573   where
 1574     elfLabel
 1575       | platformArch platform == ArchPPC
 1576       = case dllInfo of
 1577           CodeStub  -> -- See Note [.LCTOC1 in PPC PIC code]
 1578                        ppLbl <> text "+32768@plt"
 1579           SymbolPtr -> text ".LC_" <> ppLbl
 1580           _         -> panic "pprDynamicLinkerAsmLabel"
 1581 
 1582       | platformArch platform == ArchAArch64
 1583       = ppLbl
 1584 
 1585 
 1586       | platformArch platform == ArchX86_64
 1587       = case dllInfo of
 1588           CodeStub        -> ppLbl <> text "@plt"
 1589           GotSymbolPtr    -> ppLbl <> text "@gotpcrel"
 1590           GotSymbolOffset -> ppLbl
 1591           SymbolPtr       -> text ".LC_" <> ppLbl
 1592 
 1593       | platformArch platform == ArchPPC_64 ELF_V1
 1594         || platformArch platform == ArchPPC_64 ELF_V2
 1595       = case dllInfo of
 1596           GotSymbolPtr    -> text ".LC_"  <> ppLbl <> text "@toc"
 1597           GotSymbolOffset -> ppLbl
 1598           SymbolPtr       -> text ".LC_" <> ppLbl
 1599           _               -> panic "pprDynamicLinkerAsmLabel"
 1600 
 1601       | otherwise
 1602       = case dllInfo of
 1603           CodeStub        -> ppLbl <> text "@plt"
 1604           SymbolPtr       -> text ".LC_" <> ppLbl
 1605           GotSymbolPtr    -> ppLbl <> text "@got"
 1606           GotSymbolOffset -> ppLbl <> text "@gotoff"
 1607 
 1608 -- Figure out whether `symbol` may serve as an alias
 1609 -- to `target` within one compilation unit.
 1610 --
 1611 -- This is true if any of these holds:
 1612 -- * `target` is a module-internal haskell name.
 1613 -- * `target` is an exported name, but comes from the same
 1614 --   module as `symbol`
 1615 --
 1616 -- These are sufficient conditions for establishing e.g. a
 1617 -- GNU assembly alias ('.equiv' directive). Sadly, there is
 1618 -- no such thing as an alias to an imported symbol (conf.
 1619 -- http://blog.omega-prime.co.uk/2011/07/06/the-sad-state-of-symbol-aliases/)
 1620 -- See note [emit-time elimination of static indirections].
 1621 --
 1622 -- Precondition is that both labels represent the
 1623 -- same semantic value.
 1624 
 1625 mayRedirectTo :: CLabel -> CLabel -> Bool
 1626 mayRedirectTo symbol target
 1627  | Just nam <- haskellName
 1628  , staticClosureLabel
 1629  , isExternalName nam
 1630  , Just mod <- nameModule_maybe nam
 1631  , Just anam <- hasHaskellName symbol
 1632  , Just amod <- nameModule_maybe anam
 1633  = amod == mod
 1634 
 1635  | Just nam <- haskellName
 1636  , staticClosureLabel
 1637  , isInternalName nam
 1638  = True
 1639 
 1640  | otherwise = False
 1641    where staticClosureLabel = isStaticClosureLabel target
 1642          haskellName = hasHaskellName target
 1643 
 1644 
 1645 {-
 1646 Note [emit-time elimination of static indirections]
 1647 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1648 As described in #15155, certain static values are representationally
 1649 equivalent, e.g. 'cast'ed values (when created by 'newtype' wrappers).
 1650 
 1651              newtype A = A Int
 1652              {-# NOINLINE a #-}
 1653              a = A 42
 1654 
 1655 a1_rYB :: Int
 1656 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 1657 a1_rYB = GHC.Types.I# 42#
 1658 
 1659 a [InlPrag=NOINLINE] :: A
 1660 [GblId, Unf=OtherCon []]
 1661 a = a1_rYB `cast` (Sym (T15155.N:A[0]) :: Int ~R# A)
 1662 
 1663 Formerly we created static indirections for these (IND_STATIC), which
 1664 consist of a statically allocated forwarding closure that contains
 1665 the (possibly tagged) indirectee. (See CMM/assembly below.)
 1666 This approach is suboptimal for two reasons:
 1667   (a) they occupy extra space,
 1668   (b) they need to be entered in order to obtain the indirectee,
 1669       thus they cannot be tagged.
 1670 
 1671 Fortunately there is a common case where static indirections can be
 1672 eliminated while emitting assembly (native or LLVM), viz. when the
 1673 indirectee is in the same module (object file) as the symbol that
 1674 points to it. In this case an assembly-level identification can
 1675 be created ('.equiv' directive), and as such the same object will
 1676 be assigned two names in the symbol table. Any of the identified
 1677 symbols can be referenced by a tagged pointer.
 1678 
 1679 Currently the 'mayRedirectTo' predicate will
 1680 give a clue whether a label can be equated with another, already
 1681 emitted, label (which can in turn be an alias). The general mechanics
 1682 is that we identify data (IND_STATIC closures) that are amenable
 1683 to aliasing while pretty-printing of assembly output, and emit the
 1684 '.equiv' directive instead of static data in such a case.
 1685 
 1686 Here is a sketch how the output is massaged:
 1687 
 1688                      Consider
 1689 newtype A = A Int
 1690 {-# NOINLINE a #-}
 1691 a = A 42                                -- I# 42# is the indirectee
 1692                                         -- 'a' is exported
 1693 
 1694                  results in STG
 1695 
 1696 a1_rXq :: GHC.Types.Int
 1697 [GblId, Caf=NoCafRefs, Unf=OtherCon []] =
 1698     CCS_DONT_CARE GHC.Types.I#! [42#];
 1699 
 1700 T15155.a [InlPrag=NOINLINE] :: T15155.A
 1701 [GblId, Unf=OtherCon []] =
 1702     CAF_ccs  \ u  []  a1_rXq;
 1703 
 1704                  and CMM
 1705 
 1706 [section ""data" . a1_rXq_closure" {
 1707      a1_rXq_closure:
 1708          const GHC.Types.I#_con_info;
 1709          const 42;
 1710  }]
 1711 
 1712 [section ""data" . T15155.a_closure" {
 1713      T15155.a_closure:
 1714          const stg_IND_STATIC_info;
 1715          const a1_rXq_closure+1;
 1716          const 0;
 1717          const 0;
 1718  }]
 1719 
 1720 The emitted assembly is
 1721 
 1722 ==== INDIRECTEE
 1723 a1_rXq_closure:                         -- module local haskell value
 1724         .quad   GHC.Types.I#_con_info   -- an Int
 1725         .quad   42
 1726 
 1727 ==== BEFORE
 1728 .globl T15155.a_closure                 -- exported newtype wrapped value
 1729 T15155.a_closure:
 1730         .quad   stg_IND_STATIC_info     -- the closure info
 1731         .quad   a1_rXq_closure+1        -- indirectee ('+1' being the tag)
 1732         .quad   0
 1733         .quad   0
 1734 
 1735 ==== AFTER
 1736 .globl T15155.a_closure                 -- exported newtype wrapped value
 1737 .equiv a1_rXq_closure,T15155.a_closure  -- both are shared
 1738 
 1739 The transformation is performed because
 1740      T15155.a_closure `mayRedirectTo` a1_rXq_closure+1
 1741 returns True.
 1742 -}