root/compiler/cmm/CLabel.hs

Revision a6f9ebc58b0dc632bb01d0f202a7581ed02466ce, 45.0 KB (checked in by Ian Lynagh <igloo@…>, 7 months ago)

Add "have subsections via symbols" to the Platform type
  • Property mode set to 100644
Line 
1-----------------------------------------------------------------------------
2--
3-- Object-file symbols (called CLabel for histerical raisins).
4--
5-- (c) The University of Glasgow 2004-2006
6--
7-----------------------------------------------------------------------------
8
9module CLabel (
10        CLabel, -- abstract type
11        ForeignLabelSource(..),
12        pprDebugCLabel,
13
14        mkClosureLabel,
15        mkSRTLabel,
16        mkInfoTableLabel,
17        mkEntryLabel,
18        mkSlowEntryLabel,
19        mkConEntryLabel,
20        mkStaticConEntryLabel,
21        mkRednCountsLabel,
22        mkConInfoTableLabel,
23        mkStaticInfoTableLabel,
24        mkLargeSRTLabel,
25        mkApEntryLabel,
26        mkApInfoTableLabel,
27        mkClosureTableLabel,
28
29        mkLocalClosureLabel,
30        mkLocalInfoTableLabel,
31        mkLocalEntryLabel,
32        mkLocalConEntryLabel,
33        mkLocalStaticConEntryLabel,
34        mkLocalConInfoTableLabel,
35        mkLocalStaticInfoTableLabel,
36        mkLocalClosureTableLabel,
37
38        mkReturnPtLabel,
39        mkReturnInfoLabel,
40        mkAltLabel,
41        mkDefaultLabel,
42        mkBitmapLabel,
43        mkStringLitLabel,
44
45        mkAsmTempLabel,
46
47        mkPlainModuleInitLabel,
48
49        mkSplitMarkerLabel,
50        mkDirty_MUT_VAR_Label,
51        mkUpdInfoLabel,
52        mkBHUpdInfoLabel,
53        mkIndStaticInfoLabel,
54        mkMainCapabilityLabel,
55        mkMAP_FROZEN_infoLabel,
56        mkMAP_DIRTY_infoLabel,
57        mkEMPTY_MVAR_infoLabel,
58
59        mkTopTickyCtrLabel,
60        mkCAFBlackHoleInfoTableLabel,
61        mkCAFBlackHoleEntryLabel,
62        mkRtsPrimOpLabel,
63        mkRtsSlowTickyCtrLabel,
64
65        mkSelectorInfoLabel,
66        mkSelectorEntryLabel,
67
68        mkCmmInfoLabel,
69        mkCmmEntryLabel,
70        mkCmmRetInfoLabel,
71        mkCmmRetLabel,
72        mkCmmCodeLabel,
73        mkCmmDataLabel,
74        mkCmmGcPtrLabel,
75
76        mkRtsApFastLabel,
77
78        mkPrimCallLabel,
79
80        mkForeignLabel,
81        addLabelSize,
82        foreignLabelStdcallInfo,
83
84        mkCCLabel, mkCCSLabel,
85
86        DynamicLinkerLabelInfo(..),
87        mkDynamicLinkerLabel,
88        dynamicLinkerLabelInfo,
89
90        mkPicBaseLabel,
91        mkDeadStripPreventer,
92
93        mkHpcTicksLabel,
94
95        hasCAF,
96        needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
97        isMathFun,
98        isCFunctionLabel, isGcPtrLabel, labelDynamic,
99
100        -- * Conversions
101        toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl,
102
103        pprCLabel
104    ) where
105
106import IdInfo
107import StaticFlags
108import BasicTypes
109import Packages
110import DataCon
111import Module
112import Name
113import Unique
114import PrimOp
115import Config
116import CostCentre
117import Outputable
118import FastString
119import DynFlags
120import Platform
121import UniqSet
122
123-- -----------------------------------------------------------------------------
124-- The CLabel type
125
126{-
127  | CLabel is an abstract type that supports the following operations:
128
129  - Pretty printing
130
131  - In a C file, does it need to be declared before use?  (i.e. is it
132    guaranteed to be already in scope in the places we need to refer to it?)
133
134  - If it needs to be declared, what type (code or data) should it be
135    declared to have?
136
137  - Is it visible outside this object file or not?
138
139  - Is it "dynamic" (see details below)
140
141  - Eq and Ord, so that we can make sets of CLabels (currently only
142    used in outputting C as far as I can tell, to avoid generating
143    more than one declaration for any given label).
144
145  - Converting an info table label into an entry label.
146-}
147
148data CLabel
149  = -- | A label related to the definition of a particular Id or Con in a .hs file.
150    IdLabel
151        Name
152        CafInfo
153        IdLabelInfo             -- encodes the suffix of the label
154
155  -- | A label from a .cmm file that is not associated with a .hs level Id.
156  | CmmLabel
157        PackageId               -- what package the label belongs to.
158        FastString              -- identifier giving the prefix of the label
159        CmmLabelInfo            -- encodes the suffix of the label
160
161  -- | A label with a baked-in \/ algorithmically generated name that definitely
162  --    comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
163  --    If it doesn't have an algorithmically generated name then use a CmmLabel
164  --    instead and give it an appropriate PackageId argument.
165  | RtsLabel
166        RtsLabelInfo
167
168  -- | A 'C' (or otherwise foreign) label.
169  --
170  | ForeignLabel
171        FastString              -- name of the imported label.
172
173        (Maybe Int)             -- possible '@n' suffix for stdcall functions
174                                -- When generating C, the '@n' suffix is omitted, but when
175                                -- generating assembler we must add it to the label.
176
177        ForeignLabelSource      -- what package the foreign label is in.
178
179        FunctionOrData
180
181  -- | A family of labels related to a particular case expression.
182  | CaseLabel
183        {-# UNPACK #-} !Unique  -- Unique says which case expression
184        CaseLabelInfo
185
186  | AsmTempLabel
187        {-# UNPACK #-} !Unique
188
189  | StringLitLabel
190        {-# UNPACK #-} !Unique
191
192  | PlainModuleInitLabel        -- without the version & way info
193        Module
194
195  | CC_Label  CostCentre
196  | CCS_Label CostCentreStack
197
198
199  -- | These labels are generated and used inside the NCG only.
200  --    They are special variants of a label used for dynamic linking
201  --    see module PositionIndependentCode for details.
202  | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
203
204  -- | This label is generated and used inside the NCG only.
205  --    It is used as a base for PIC calculations on some platforms.
206  --    It takes the form of a local numeric assembler label '1'; and
207  --    is pretty-printed as 1b, referring to the previous definition
208  --    of 1: in the assembler source file.
209  | PicBaseLabel
210
211  -- | A label before an info table to prevent excessive dead-stripping on darwin
212  | DeadStripPreventer CLabel
213
214
215  -- | Per-module table of tick locations
216  | HpcTicksLabel Module
217
218  -- | Label of an StgLargeSRT
219  | LargeSRTLabel
220        {-# UNPACK #-} !Unique
221
222  -- | A bitmap (function or case return)
223  | LargeBitmapLabel
224        {-# UNPACK #-} !Unique
225
226  deriving (Eq, Ord)
227
228
229-- | Record where a foreign label is stored.
230data ForeignLabelSource
231
232   -- | Label is in a named package
233   = ForeignLabelInPackage      PackageId
234
235   -- | Label is in some external, system package that doesn't also
236   --   contain compiled Haskell code, and is not associated with any .hi files.
237   --   We don't have to worry about Haskell code being inlined from
238   --   external packages. It is safe to treat the RTS package as "external".
239   | ForeignLabelInExternalPackage
240
241   -- | Label is in the package currenly being compiled.
242   --   This is only used for creating hacky tmp labels during code generation.
243   --   Don't use it in any code that might be inlined across a package boundary
244   --   (ie, core code) else the information will be wrong relative to the
245   --   destination module.
246   | ForeignLabelInThisPackage
247
248   deriving (Eq, Ord)
249
250
251-- | For debugging problems with the CLabel representation.
252--      We can't make a Show instance for CLabel because lots of its components don't have instances.
253--      The regular Outputable instance only shows the label name, and not its other info.
254--
255pprDebugCLabel :: Platform -> CLabel -> SDoc
256pprDebugCLabel platform lbl
257 = case lbl of
258        IdLabel{}       -> pprPlatform platform lbl <> (parens $ text "IdLabel")
259        CmmLabel pkg _name _info
260         -> pprPlatform platform lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
261
262        RtsLabel{}      -> pprPlatform platform lbl <> (parens $ text "RtsLabel")
263
264        ForeignLabel _name mSuffix src funOrData
265         -> pprPlatform platform lbl <> (parens
266                                $ text "ForeignLabel"
267                                <+> ppr mSuffix
268                                <+> ppr src
269                                <+> ppr funOrData)
270
271        _               -> pprPlatform platform lbl <> (parens $ text "other CLabel)")
272
273
274data IdLabelInfo
275  = Closure             -- ^ Label for closure
276  | SRT                 -- ^ Static reference table
277  | InfoTable           -- ^ Info tables for closures; always read-only
278  | Entry               -- ^ Entry point
279  | Slow                -- ^ Slow entry point
280
281  | LocalInfoTable      -- ^ Like InfoTable but not externally visible
282  | LocalEntry          -- ^ Like Entry but not externally visible
283
284  | RednCounts          -- ^ Label of place to keep Ticky-ticky  info for this Id
285
286  | ConEntry            -- ^ Constructor entry point
287  | ConInfoTable        -- ^ Corresponding info table
288  | StaticConEntry      -- ^ Static constructor entry point
289  | StaticInfoTable     -- ^ Corresponding info table
290
291  | ClosureTable        -- ^ Table of closures for Enum tycons
292
293  deriving (Eq, Ord)
294
295
296data CaseLabelInfo
297  = CaseReturnPt
298  | CaseReturnInfo
299  | CaseAlt ConTag
300  | CaseDefault
301  deriving (Eq, Ord)
302
303
304data RtsLabelInfo
305  = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}  -- ^ Selector thunks
306  | RtsSelectorEntry     Bool{-updatable-} Int{-offset-}
307
308  | RtsApInfoTable       Bool{-updatable-} Int{-arity-}    -- ^ AP thunks
309  | RtsApEntry           Bool{-updatable-} Int{-arity-}
310
311  | RtsPrimOp PrimOp
312  | RtsApFast     FastString    -- ^ _fast versions of generic apply
313  | RtsSlowTickyCtr String
314
315  deriving (Eq, Ord)
316  -- NOTE: Eq on LitString compares the pointer only, so this isn't
317  -- a real equality.
318
319
320-- | What type of Cmm label we're dealing with.
321--      Determines the suffix appended to the name when a CLabel.CmmLabel
322--      is pretty printed.
323data CmmLabelInfo
324  = CmmInfo                     -- ^ misc rts info tabless,     suffix _info
325  | CmmEntry                    -- ^ misc rts entry points,     suffix _entry
326  | CmmRetInfo                  -- ^ misc rts ret info tables,  suffix _info
327  | CmmRet                      -- ^ misc rts return points,    suffix _ret
328  | CmmData                     -- ^ misc rts data bits, eg CHARLIKE_closure
329  | CmmCode                     -- ^ misc rts code
330  | CmmGcPtr                    -- ^ GcPtrs eg CHARLIKE_closure
331  | CmmPrimCall                 -- ^ a prim call to some hand written Cmm code
332  deriving (Eq, Ord)
333
334data DynamicLinkerLabelInfo
335  = CodeStub                    -- MachO: Lfoo$stub, ELF: foo@plt
336  | SymbolPtr                   -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
337  | GotSymbolPtr                -- ELF: foo@got
338  | GotSymbolOffset             -- ELF: foo@gotoff
339
340  deriving (Eq, Ord)
341
342
343-- -----------------------------------------------------------------------------
344-- Constructing CLabels
345-- -----------------------------------------------------------------------------
346
347-- Constructing IdLabels
348-- These are always local:
349mkSlowEntryLabel :: Name -> CafInfo -> CLabel
350mkSlowEntryLabel        name c         = IdLabel name  c Slow
351
352mkSRTLabel        :: Name -> CafInfo -> CLabel
353mkRednCountsLabel :: Name -> CafInfo -> CLabel
354mkSRTLabel              name c  = IdLabel name  c SRT
355mkRednCountsLabel       name c  = IdLabel name  c RednCounts
356
357-- These have local & (possibly) external variants:
358mkLocalClosureLabel      :: Name -> CafInfo -> CLabel
359mkLocalInfoTableLabel    :: Name -> CafInfo -> CLabel
360mkLocalEntryLabel        :: Name -> CafInfo -> CLabel
361mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
362mkLocalClosureLabel     name c  = IdLabel name  c Closure
363mkLocalInfoTableLabel   name c  = IdLabel name  c LocalInfoTable
364mkLocalEntryLabel       name c  = IdLabel name  c LocalEntry
365mkLocalClosureTableLabel name c = IdLabel name  c ClosureTable
366
367mkClosureLabel              :: Name -> CafInfo -> CLabel
368mkInfoTableLabel            :: Name -> CafInfo -> CLabel
369mkEntryLabel                :: Name -> CafInfo -> CLabel
370mkClosureTableLabel         :: Name -> CafInfo -> CLabel
371mkLocalConInfoTableLabel    :: CafInfo -> Name -> CLabel
372mkLocalConEntryLabel        :: CafInfo -> Name -> CLabel
373mkLocalStaticInfoTableLabel :: CafInfo -> Name -> CLabel
374mkLocalStaticConEntryLabel  :: CafInfo -> Name -> CLabel
375mkConInfoTableLabel         :: Name -> CafInfo -> CLabel
376mkStaticInfoTableLabel      :: Name -> CafInfo -> CLabel
377mkClosureLabel name         c     = IdLabel name c Closure
378mkInfoTableLabel name       c     = IdLabel name c InfoTable
379mkEntryLabel name           c     = IdLabel name c Entry
380mkClosureTableLabel name    c     = IdLabel name c ClosureTable
381mkLocalConInfoTableLabel    c con = IdLabel con c ConInfoTable
382mkLocalConEntryLabel        c con = IdLabel con c ConEntry
383mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
384mkLocalStaticConEntryLabel  c con = IdLabel con c StaticConEntry
385mkConInfoTableLabel name    c     = IdLabel name c ConInfoTable
386mkStaticInfoTableLabel name c     = IdLabel name c StaticInfoTable
387
388mkConEntryLabel       :: Name -> CafInfo -> CLabel
389mkStaticConEntryLabel :: Name -> CafInfo -> CLabel
390mkConEntryLabel name        c     = IdLabel name c ConEntry
391mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry
392
393-- Constructing Cmm Labels
394mkSplitMarkerLabel, mkDirty_MUT_VAR_Label, mkUpdInfoLabel,
395    mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
396    mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel,
397    mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel,
398    mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel :: CLabel
399mkSplitMarkerLabel              = CmmLabel rtsPackageId (fsLit "__stg_split_marker")    CmmCode
400mkDirty_MUT_VAR_Label           = CmmLabel rtsPackageId (fsLit "dirty_MUT_VAR")         CmmCode
401mkUpdInfoLabel                  = CmmLabel rtsPackageId (fsLit "stg_upd_frame")         CmmInfo
402mkBHUpdInfoLabel                = CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" )     CmmInfo
403mkIndStaticInfoLabel            = CmmLabel rtsPackageId (fsLit "stg_IND_STATIC")        CmmInfo
404mkMainCapabilityLabel           = CmmLabel rtsPackageId (fsLit "MainCapability")        CmmData
405mkMAP_FROZEN_infoLabel          = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
406mkMAP_DIRTY_infoLabel           = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
407mkEMPTY_MVAR_infoLabel          = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR")        CmmInfo
408mkTopTickyCtrLabel              = CmmLabel rtsPackageId (fsLit "top_ct")                CmmData
409mkCAFBlackHoleInfoTableLabel    = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
410mkCAFBlackHoleEntryLabel        = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")     CmmEntry
411
412-----
413mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
414  mkCmmCodeLabel, mkCmmDataLabel,  mkCmmGcPtrLabel
415        :: PackageId -> FastString -> CLabel
416
417mkCmmInfoLabel      pkg str     = CmmLabel pkg str CmmInfo
418mkCmmEntryLabel     pkg str     = CmmLabel pkg str CmmEntry
419mkCmmRetInfoLabel   pkg str     = CmmLabel pkg str CmmRetInfo
420mkCmmRetLabel       pkg str     = CmmLabel pkg str CmmRet
421mkCmmCodeLabel      pkg str     = CmmLabel pkg str CmmCode
422mkCmmDataLabel      pkg str     = CmmLabel pkg str CmmData
423mkCmmGcPtrLabel     pkg str     = CmmLabel pkg str CmmGcPtr
424
425
426-- Constructing RtsLabels
427mkRtsPrimOpLabel :: PrimOp -> CLabel
428mkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)
429
430mkSelectorInfoLabel  :: Bool -> Int -> CLabel
431mkSelectorEntryLabel :: Bool -> Int -> CLabel
432mkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTable upd off)
433mkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry     upd off)
434
435mkApInfoTableLabel :: Bool -> Int -> CLabel
436mkApEntryLabel     :: Bool -> Int -> CLabel
437mkApInfoTableLabel   upd off    = RtsLabel (RtsApInfoTable       upd off)
438mkApEntryLabel       upd off    = RtsLabel (RtsApEntry           upd off)
439
440
441-- A call to some primitive hand written Cmm code
442mkPrimCallLabel :: PrimCall -> CLabel
443mkPrimCallLabel (PrimCall str pkg)
444        = CmmLabel pkg str CmmPrimCall
445
446
447-- Constructing ForeignLabels
448
449-- | Make a foreign label
450mkForeignLabel
451        :: FastString           -- name
452        -> Maybe Int            -- size prefix
453        -> ForeignLabelSource   -- what package it's in
454        -> FunctionOrData
455        -> CLabel
456
457mkForeignLabel str mb_sz src fod
458    = ForeignLabel str mb_sz src  fod
459
460
461-- | Update the label size field in a ForeignLabel
462addLabelSize :: CLabel -> Int -> CLabel
463addLabelSize (ForeignLabel str _ src  fod) sz
464    = ForeignLabel str (Just sz) src fod
465addLabelSize label _
466    = label
467
468-- | Get the label size field from a ForeignLabel
469foreignLabelStdcallInfo :: CLabel -> Maybe Int
470foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
471foreignLabelStdcallInfo _lbl = Nothing
472
473
474-- Constructing Large*Labels
475mkLargeSRTLabel :: Unique -> CLabel
476mkBitmapLabel   :: Unique -> CLabel
477mkLargeSRTLabel uniq            = LargeSRTLabel uniq
478mkBitmapLabel   uniq            = LargeBitmapLabel uniq
479
480
481-- Constructin CaseLabels
482mkReturnPtLabel   :: Unique -> CLabel
483mkReturnInfoLabel :: Unique -> CLabel
484mkAltLabel        :: Unique -> ConTag -> CLabel
485mkDefaultLabel    :: Unique -> CLabel
486mkReturnPtLabel uniq            = CaseLabel uniq CaseReturnPt
487mkReturnInfoLabel uniq          = CaseLabel uniq CaseReturnInfo
488mkAltLabel      uniq tag        = CaseLabel uniq (CaseAlt tag)
489mkDefaultLabel  uniq            = CaseLabel uniq CaseDefault
490
491-- Constructing Cost Center Labels
492mkCCLabel  :: CostCentre      -> CLabel
493mkCCSLabel :: CostCentreStack -> CLabel
494mkCCLabel           cc          = CC_Label cc
495mkCCSLabel          ccs         = CCS_Label ccs
496
497mkRtsApFastLabel :: FastString -> CLabel
498mkRtsApFastLabel str = RtsLabel (RtsApFast str)
499
500mkRtsSlowTickyCtrLabel :: String -> CLabel
501mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
502
503
504-- Constructing Code Coverage Labels
505mkHpcTicksLabel :: Module -> CLabel
506mkHpcTicksLabel                = HpcTicksLabel
507
508
509-- Constructing labels used for dynamic linking
510mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
511mkDynamicLinkerLabel            = DynamicLinkerLabel
512
513dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
514dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
515dynamicLinkerLabelInfo _        = Nothing
516
517mkPicBaseLabel :: CLabel
518mkPicBaseLabel                  = PicBaseLabel
519
520
521-- Constructing miscellaneous other labels
522mkDeadStripPreventer :: CLabel -> CLabel
523mkDeadStripPreventer lbl        = DeadStripPreventer lbl
524
525mkStringLitLabel :: Unique -> CLabel
526mkStringLitLabel                = StringLitLabel
527
528mkAsmTempLabel :: Uniquable a => a -> CLabel
529mkAsmTempLabel a                = AsmTempLabel (getUnique a)
530
531mkPlainModuleInitLabel :: Module -> CLabel
532mkPlainModuleInitLabel mod      = PlainModuleInitLabel mod
533
534-- -----------------------------------------------------------------------------
535-- Convert between different kinds of label
536
537toClosureLbl :: Platform -> CLabel -> CLabel
538toClosureLbl _ (IdLabel n c _) = IdLabel n c Closure
539toClosureLbl platform l = pprPanic "toClosureLbl" (pprCLabel platform l)
540
541toSlowEntryLbl :: Platform -> CLabel -> CLabel
542toSlowEntryLbl _ (IdLabel n c _) = IdLabel n c Slow
543toSlowEntryLbl platform l = pprPanic "toSlowEntryLbl" (pprCLabel platform l)
544
545toRednCountsLbl :: Platform -> CLabel -> CLabel
546toRednCountsLbl _ (IdLabel n c _) = IdLabel n c RednCounts
547toRednCountsLbl platform l = pprPanic "toRednCountsLbl" (pprCLabel platform l)
548
549toEntryLbl :: Platform -> CLabel -> CLabel
550toEntryLbl _ (IdLabel n c LocalInfoTable)  = IdLabel n c LocalEntry
551toEntryLbl _ (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry
552toEntryLbl _ (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
553toEntryLbl _ (IdLabel n c _)               = IdLabel n c Entry
554toEntryLbl _ (CaseLabel n CaseReturnInfo)  = CaseLabel n CaseReturnPt
555toEntryLbl _ (CmmLabel m str CmmInfo)      = CmmLabel m str CmmEntry
556toEntryLbl _ (CmmLabel m str CmmRetInfo)   = CmmLabel m str CmmRet
557toEntryLbl platform l = pprPanic "toEntryLbl" (pprCLabel platform l)
558
559toInfoLbl :: Platform -> CLabel -> CLabel
560toInfoLbl _ (IdLabel n c Entry)          = IdLabel n c InfoTable
561toInfoLbl _ (IdLabel n c LocalEntry)     = IdLabel n c LocalInfoTable
562toInfoLbl _ (IdLabel n c ConEntry)       = IdLabel n c ConInfoTable
563toInfoLbl _ (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
564toInfoLbl _ (IdLabel n c _)              = IdLabel n c InfoTable
565toInfoLbl _ (CaseLabel n CaseReturnPt)   = CaseLabel n CaseReturnInfo
566toInfoLbl _ (CmmLabel m str CmmEntry)    = CmmLabel m str CmmInfo
567toInfoLbl _ (CmmLabel m str CmmRet)      = CmmLabel m str CmmRetInfo
568toInfoLbl platform l = pprPanic "CLabel.toInfoLbl" (pprCLabel platform l)
569
570-- -----------------------------------------------------------------------------
571-- Does a CLabel refer to a CAF?
572hasCAF :: CLabel -> Bool
573hasCAF (IdLabel _ MayHaveCafRefs _) = True
574hasCAF _                            = False
575
576
577-- -----------------------------------------------------------------------------
578-- Does a CLabel need declaring before use or not?
579--
580-- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
581
582needsCDecl :: CLabel -> Bool
583  -- False <=> it's pre-declared; don't bother
584  -- don't bother declaring SRT & Bitmap labels, we always make sure
585  -- they are defined before use.
586needsCDecl (IdLabel _ _ SRT)            = False
587needsCDecl (LargeSRTLabel _)            = False
588needsCDecl (LargeBitmapLabel _)         = False
589needsCDecl (IdLabel _ _ _)              = True
590needsCDecl (CaseLabel _ _)              = True
591needsCDecl (PlainModuleInitLabel _)     = True
592
593needsCDecl (StringLitLabel _)           = False
594needsCDecl (AsmTempLabel _)             = False
595needsCDecl (RtsLabel _)                 = False
596
597needsCDecl (CmmLabel pkgId _ _)
598        -- Prototypes for labels defined in the runtime system are imported
599        --      into HC files via includes/Stg.h.
600        | pkgId == rtsPackageId         = False
601
602        -- For other labels we inline one into the HC file directly.
603        | otherwise                     = True
604
605needsCDecl l@(ForeignLabel{})           = not (isMathFun l)
606needsCDecl (CC_Label _)                 = True
607needsCDecl (CCS_Label _)                = True
608needsCDecl (HpcTicksLabel _)            = True
609needsCDecl (DynamicLinkerLabel {})      = panic "needsCDecl DynamicLinkerLabel"
610needsCDecl PicBaseLabel                 = panic "needsCDecl PicBaseLabel"
611needsCDecl (DeadStripPreventer {})      = panic "needsCDecl DeadStripPreventer"
612
613-- | Check whether a label is a local temporary for native code generation
614isAsmTemp  :: CLabel -> Bool
615isAsmTemp (AsmTempLabel _)              = True
616isAsmTemp _                             = False
617
618
619-- | If a label is a local temporary used for native code generation
620--      then return just its unique, otherwise nothing.
621maybeAsmTemp :: CLabel -> Maybe Unique
622maybeAsmTemp (AsmTempLabel uq)          = Just uq
623maybeAsmTemp _                          = Nothing
624
625
626-- | Check whether a label corresponds to a C function that has
627--      a prototype in a system header somehere, or is built-in
628--      to the C compiler. For these labels we avoid generating our
629--      own C prototypes.
630isMathFun :: CLabel -> Bool
631isMathFun (ForeignLabel fs _ _ _)       = fs `elementOfUniqSet` math_funs
632isMathFun _ = False
633
634math_funs :: UniqSet FastString
635math_funs = mkUniqSet [
636        -- _ISOC99_SOURCE
637        (fsLit "acos"),         (fsLit "acosf"),        (fsLit "acosh"),
638        (fsLit "acoshf"),       (fsLit "acoshl"),       (fsLit "acosl"),
639        (fsLit "asin"),         (fsLit "asinf"),        (fsLit "asinl"),
640        (fsLit "asinh"),        (fsLit "asinhf"),       (fsLit "asinhl"),
641        (fsLit "atan"),         (fsLit "atanf"),        (fsLit "atanl"),
642        (fsLit "atan2"),        (fsLit "atan2f"),       (fsLit "atan2l"),
643        (fsLit "atanh"),        (fsLit "atanhf"),       (fsLit "atanhl"),
644        (fsLit "cbrt"),         (fsLit "cbrtf"),        (fsLit "cbrtl"),
645        (fsLit "ceil"),         (fsLit "ceilf"),        (fsLit "ceill"),
646        (fsLit "copysign"),     (fsLit "copysignf"),    (fsLit "copysignl"),
647        (fsLit "cos"),          (fsLit "cosf"),         (fsLit "cosl"),
648        (fsLit "cosh"),         (fsLit "coshf"),        (fsLit "coshl"),
649        (fsLit "erf"),          (fsLit "erff"),         (fsLit "erfl"),
650        (fsLit "erfc"),         (fsLit "erfcf"),        (fsLit "erfcl"),
651        (fsLit "exp"),          (fsLit "expf"),         (fsLit "expl"),
652        (fsLit "exp2"),         (fsLit "exp2f"),        (fsLit "exp2l"),
653        (fsLit "expm1"),        (fsLit "expm1f"),       (fsLit "expm1l"),
654        (fsLit "fabs"),         (fsLit "fabsf"),        (fsLit "fabsl"),
655        (fsLit "fdim"),         (fsLit "fdimf"),        (fsLit "fdiml"),
656        (fsLit "floor"),        (fsLit "floorf"),       (fsLit "floorl"),
657        (fsLit "fma"),          (fsLit "fmaf"),         (fsLit "fmal"),
658        (fsLit "fmax"),         (fsLit "fmaxf"),        (fsLit "fmaxl"),
659        (fsLit "fmin"),         (fsLit "fminf"),        (fsLit "fminl"),
660        (fsLit "fmod"),         (fsLit "fmodf"),        (fsLit "fmodl"),
661        (fsLit "frexp"),        (fsLit "frexpf"),       (fsLit "frexpl"),
662        (fsLit "hypot"),        (fsLit "hypotf"),       (fsLit "hypotl"),
663        (fsLit "ilogb"),        (fsLit "ilogbf"),       (fsLit "ilogbl"),
664        (fsLit "ldexp"),        (fsLit "ldexpf"),       (fsLit "ldexpl"),
665        (fsLit "lgamma"),       (fsLit "lgammaf"),      (fsLit "lgammal"),
666        (fsLit "llrint"),       (fsLit "llrintf"),      (fsLit "llrintl"),
667        (fsLit "llround"),      (fsLit "llroundf"),     (fsLit "llroundl"),
668        (fsLit "log"),          (fsLit "logf"),         (fsLit "logl"),
669        (fsLit "log10l"),       (fsLit "log10"),        (fsLit "log10f"),
670        (fsLit "log1pl"),       (fsLit "log1p"),        (fsLit "log1pf"),
671        (fsLit "log2"),         (fsLit "log2f"),        (fsLit "log2l"),
672        (fsLit "logb"),         (fsLit "logbf"),        (fsLit "logbl"),
673        (fsLit "lrint"),        (fsLit "lrintf"),       (fsLit "lrintl"),
674        (fsLit "lround"),       (fsLit "lroundf"),      (fsLit "lroundl"),
675        (fsLit "modf"),         (fsLit "modff"),        (fsLit "modfl"),
676        (fsLit "nan"),          (fsLit "nanf"),         (fsLit "nanl"),
677        (fsLit "nearbyint"),    (fsLit "nearbyintf"),   (fsLit "nearbyintl"),
678        (fsLit "nextafter"),    (fsLit "nextafterf"),   (fsLit "nextafterl"),
679        (fsLit "nexttoward"),   (fsLit "nexttowardf"),  (fsLit "nexttowardl"),
680        (fsLit "pow"),          (fsLit "powf"),         (fsLit "powl"),
681        (fsLit "remainder"),    (fsLit "remainderf"),   (fsLit "remainderl"),
682        (fsLit "remquo"),       (fsLit "remquof"),      (fsLit "remquol"),
683        (fsLit "rint"),         (fsLit "rintf"),        (fsLit "rintl"),
684        (fsLit "round"),        (fsLit "roundf"),       (fsLit "roundl"),
685        (fsLit "scalbln"),      (fsLit "scalblnf"),     (fsLit "scalblnl"),
686        (fsLit "scalbn"),       (fsLit "scalbnf"),      (fsLit "scalbnl"),
687        (fsLit "sin"),          (fsLit "sinf"),         (fsLit "sinl"),
688        (fsLit "sinh"),         (fsLit "sinhf"),        (fsLit "sinhl"),
689        (fsLit "sqrt"),         (fsLit "sqrtf"),        (fsLit "sqrtl"),
690        (fsLit "tan"),          (fsLit "tanf"),         (fsLit "tanl"),
691        (fsLit "tanh"),         (fsLit "tanhf"),        (fsLit "tanhl"),
692        (fsLit "tgamma"),       (fsLit "tgammaf"),      (fsLit "tgammal"),
693        (fsLit "trunc"),        (fsLit "truncf"),       (fsLit "truncl"),
694        -- ISO C 99 also defines these function-like macros in math.h:
695        -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
696        -- isgreaterequal, isless, islessequal, islessgreater, isunordered
697
698        -- additional symbols from _BSD_SOURCE
699        (fsLit "drem"),         (fsLit "dremf"),        (fsLit "dreml"),
700        (fsLit "finite"),       (fsLit "finitef"),      (fsLit "finitel"),
701        (fsLit "gamma"),        (fsLit "gammaf"),       (fsLit "gammal"),
702        (fsLit "isinf"),        (fsLit "isinff"),       (fsLit "isinfl"),
703        (fsLit "isnan"),        (fsLit "isnanf"),       (fsLit "isnanl"),
704        (fsLit "j0"),           (fsLit "j0f"),          (fsLit "j0l"),
705        (fsLit "j1"),           (fsLit "j1f"),          (fsLit "j1l"),
706        (fsLit "jn"),           (fsLit "jnf"),          (fsLit "jnl"),
707        (fsLit "lgamma_r"),     (fsLit "lgammaf_r"),    (fsLit "lgammal_r"),
708        (fsLit "scalb"),        (fsLit "scalbf"),       (fsLit "scalbl"),
709        (fsLit "significand"),  (fsLit "significandf"), (fsLit "significandl"),
710        (fsLit "y0"),           (fsLit "y0f"),          (fsLit "y0l"),
711        (fsLit "y1"),           (fsLit "y1f"),          (fsLit "y1l"),
712        (fsLit "yn"),           (fsLit "ynf"),          (fsLit "ynl")
713    ]
714
715-- -----------------------------------------------------------------------------
716-- | Is a CLabel visible outside this object file or not?
717--      From the point of view of the code generator, a name is
718--      externally visible if it has to be declared as exported
719--      in the .o file's symbol table; that is, made non-static.
720externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
721externallyVisibleCLabel (CaseLabel _ _)         = False
722externallyVisibleCLabel (StringLitLabel _)      = False
723externallyVisibleCLabel (AsmTempLabel _)        = False
724externallyVisibleCLabel (PlainModuleInitLabel _)= True
725externallyVisibleCLabel (RtsLabel _)            = True
726externallyVisibleCLabel (CmmLabel _ _ _)        = True
727externallyVisibleCLabel (ForeignLabel{})        = True
728externallyVisibleCLabel (IdLabel name _ info)   = isExternalName name && externallyVisibleIdLabel info
729externallyVisibleCLabel (CC_Label _)            = True
730externallyVisibleCLabel (CCS_Label _)           = True
731externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
732externallyVisibleCLabel (HpcTicksLabel _)       = True
733externallyVisibleCLabel (LargeBitmapLabel _)    = False
734externallyVisibleCLabel (LargeSRTLabel _)       = False
735externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
736externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
737
738externallyVisibleIdLabel :: IdLabelInfo -> Bool
739externallyVisibleIdLabel SRT             = False
740externallyVisibleIdLabel LocalInfoTable  = False
741externallyVisibleIdLabel LocalEntry      = False
742externallyVisibleIdLabel _               = True
743
744-- -----------------------------------------------------------------------------
745-- Finding the "type" of a CLabel
746
747-- For generating correct types in label declarations:
748
749data CLabelType
750  = CodeLabel   -- Address of some executable instructions
751  | DataLabel   -- Address of data, not a GC ptr
752  | GcPtrLabel  -- Address of a (presumably static) GC object
753
754isCFunctionLabel :: CLabel -> Bool
755isCFunctionLabel lbl = case labelType lbl of
756                        CodeLabel -> True
757                        _other    -> False
758
759isGcPtrLabel :: CLabel -> Bool
760isGcPtrLabel lbl = case labelType lbl of
761                        GcPtrLabel -> True
762                        _other     -> False
763
764
765-- | Work out the general type of data at the address of this label
766--    whether it be code, data, or static GC object.
767labelType :: CLabel -> CLabelType
768labelType (CmmLabel _ _ CmmData)                = DataLabel
769labelType (CmmLabel _ _ CmmGcPtr)               = GcPtrLabel
770labelType (CmmLabel _ _ CmmCode)                = CodeLabel
771labelType (CmmLabel _ _ CmmInfo)                = DataLabel
772labelType (CmmLabel _ _ CmmEntry)               = CodeLabel
773labelType (CmmLabel _ _ CmmRetInfo)             = DataLabel
774labelType (CmmLabel _ _ CmmRet)                 = CodeLabel
775labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
776labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
777labelType (RtsLabel (RtsApFast _))              = CodeLabel
778labelType (CaseLabel _ CaseReturnInfo)          = DataLabel
779labelType (CaseLabel _ _)                       = CodeLabel
780labelType (PlainModuleInitLabel _)              = CodeLabel
781labelType (LargeSRTLabel _)                     = DataLabel
782labelType (LargeBitmapLabel _)                  = DataLabel
783labelType (ForeignLabel _ _ _ IsFunction)       = CodeLabel
784labelType (IdLabel _ _ info)                    = idInfoLabelType info
785labelType _                                     = DataLabel
786
787idInfoLabelType :: IdLabelInfo -> CLabelType
788idInfoLabelType info =
789  case info of
790    InfoTable     -> DataLabel
791    LocalInfoTable -> DataLabel
792    Closure       -> GcPtrLabel
793    ConInfoTable  -> DataLabel
794    StaticInfoTable -> DataLabel
795    ClosureTable  -> DataLabel
796    RednCounts    -> DataLabel
797    _             -> CodeLabel
798
799
800-- -----------------------------------------------------------------------------
801-- Does a CLabel need dynamic linkage?
802
803-- When referring to data in code, we need to know whether
804-- that data resides in a DLL or not. [Win32 only.]
805-- @labelDynamic@ returns @True@ if the label is located
806-- in a DLL, be it a data reference or not.
807
808labelDynamic :: DynFlags -> PackageId -> CLabel -> Bool
809labelDynamic dflags this_pkg lbl =
810  case lbl of
811   -- is the RTS in a DLL or not?
812   RtsLabel _           -> not opt_Static && (this_pkg /= rtsPackageId)
813
814   IdLabel n _ _        -> isDllName this_pkg n
815
816   -- When compiling in the "dyn" way, each package is to be linked into
817   -- its own shared library.
818   CmmLabel pkg _ _
819    | os == OSMinGW32 ->
820       not opt_Static && (this_pkg /= pkg)
821    | otherwise ->
822       True
823
824   ForeignLabel _ _ source _  ->
825       if os == OSMinGW32
826       then case source of
827            -- Foreign label is in some un-named foreign package (or DLL).
828            ForeignLabelInExternalPackage -> True
829
830            -- Foreign label is linked into the same package as the
831            -- source file currently being compiled.
832            ForeignLabelInThisPackage -> False
833
834            -- Foreign label is in some named package.
835            -- When compiling in the "dyn" way, each package is to be
836            -- linked into its own DLL.
837            ForeignLabelInPackage pkgId ->
838                (not opt_Static) && (this_pkg /= pkgId)
839
840       else -- On Mac OS X and on ELF platforms, false positives are OK,
841            -- so we claim that all foreign imports come from dynamic
842            -- libraries
843            True
844
845   PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
846
847   -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
848   _                 -> False
849  where os = platformOS (targetPlatform dflags)
850
851{-
852OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
853right places. It is used to detect when the abstractC statement of an
854CCodeBlock actually contains the code for a slow entry point.  -- HWL
855
856We need at least @Eq@ for @CLabels@, because we want to avoid
857duplicate declarations in generating C (see @labelSeenTE@ in
858@PprAbsC@).
859-}
860
861-----------------------------------------------------------------------------
862-- Printing out CLabels.
863
864{-
865Convention:
866
867      <name>_<type>
868
869where <name> is <Module>_<name> for external names and <unique> for
870internal names. <type> is one of the following:
871
872         info                   Info table
873         srt                    Static reference table
874         srtd                   Static reference table descriptor
875         entry                  Entry code (function, closure)
876         slow                   Slow entry code (if any)
877         ret                    Direct return address
878         vtbl                   Vector table
879         <n>_alt                Case alternative (tag n)
880         dflt                   Default case alternative
881         btm                    Large bitmap vector
882         closure                Static closure
883         con_entry              Dynamic Constructor entry code
884         con_info               Dynamic Constructor info table
885         static_entry           Static Constructor entry code
886         static_info            Static Constructor info table
887         sel_info               Selector info table
888         sel_entry              Selector entry code
889         cc                     Cost centre
890         ccs                    Cost centre stack
891
892Many of these distinctions are only for documentation reasons.  For
893example, _ret is only distinguished from _entry to make it easy to
894tell whether a code fragment is a return point or a closure/function
895entry.
896
897Note [Closure and info labels]
898~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
899For a function 'foo, we have:
900   foo_info    : Points to the info table describing foo's closure
901                 (and entry code for foo with tables next to code)
902   foo_closure : Static (no-free-var) closure only:
903                 points to the statically-allocated closure
904
905For a data constructor (such as Just or Nothing), we have:
906    Just_con_info: Info table for the data constructor itself
907                   the first word of a heap-allocated Just
908    Just_info:     Info table for the *worker function*, an
909                   ordinary Haskell function of arity 1 that
910                   allocates a (Just x) box:
911                      Just = \x -> Just x
912    Just_closure:  The closure for this worker
913
914    Nothing_closure: a statically allocated closure for Nothing
915    Nothing_static_info: info table for Nothing_closure
916
917All these must be exported symbol, EXCEPT Just_info.  We don't need to
918export this because in other modules we either have
919       * A reference to 'Just'; use Just_closure
920       * A saturated call 'Just x'; allocate using Just_con_info
921Not exporting these Just_info labels reduces the number of symbols
922somewhat.
923-}
924
925instance PlatformOutputable CLabel where
926  pprPlatform = pprCLabel
927
928pprCLabel :: Platform -> CLabel -> SDoc
929
930pprCLabel platform (AsmTempLabel u)
931 | cGhcWithNativeCodeGen == "YES"
932  =  getPprStyle $ \ sty ->
933     if asmStyle sty then
934        ptext (asmTempLabelPrefix platform) <> pprUnique u
935     else
936        char '_' <> pprUnique u
937
938pprCLabel platform (DynamicLinkerLabel info lbl)
939 | cGhcWithNativeCodeGen == "YES"
940   = pprDynamicLinkerAsmLabel platform info lbl
941
942pprCLabel _ PicBaseLabel
943 | cGhcWithNativeCodeGen == "YES"
944   = ptext (sLit "1b")
945
946pprCLabel platform (DeadStripPreventer lbl)
947 | cGhcWithNativeCodeGen == "YES"
948   = pprCLabel platform lbl <> ptext (sLit "_dsp")
949
950pprCLabel platform lbl
951   = getPprStyle $ \ sty ->
952     if cGhcWithNativeCodeGen == "YES" && asmStyle sty
953     then maybe_underscore (pprAsmCLbl platform lbl)
954     else pprCLbl lbl
955
956maybe_underscore :: SDoc -> SDoc
957maybe_underscore doc
958  | underscorePrefix = pp_cSEP <> doc
959  | otherwise        = doc
960
961pprAsmCLbl :: Platform -> CLabel -> SDoc
962pprAsmCLbl platform (ForeignLabel fs (Just sz) _ _)
963 | platformOS platform == OSMinGW32
964    -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
965    -- (The C compiler does this itself).
966    = ftext fs <> char '@' <> int sz
967pprAsmCLbl _ lbl
968   = pprCLbl lbl
969
970pprCLbl :: CLabel -> SDoc
971pprCLbl (StringLitLabel u)
972  = pprUnique u <> ptext (sLit "_str")
973
974pprCLbl (CaseLabel u CaseReturnPt)
975  = hcat [pprUnique u, ptext (sLit "_ret")]
976pprCLbl (CaseLabel u CaseReturnInfo)
977  = hcat [pprUnique u, ptext (sLit "_info")]
978pprCLbl (CaseLabel u (CaseAlt tag))
979  = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
980pprCLbl (CaseLabel u CaseDefault)
981  = hcat [pprUnique u, ptext (sLit "_dflt")]
982
983pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
984pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
985-- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
986-- until that gets resolved we'll just force them to start
987-- with a letter so the label will be legal assmbly code.
988
989
990pprCLbl (CmmLabel _ str CmmCode)        = ftext str
991pprCLbl (CmmLabel _ str CmmData)        = ftext str
992pprCLbl (CmmLabel _ str CmmGcPtr)       = ftext str
993pprCLbl (CmmLabel _ str CmmPrimCall)    = ftext str
994
995pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> ptext (sLit "_fast")
996
997pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
998  = hcat [ptext (sLit "stg_sel_"), text (show offset),
999                ptext (if upd_reqd
1000                        then (sLit "_upd_info")
1001                        else (sLit "_noupd_info"))
1002        ]
1003
1004pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
1005  = hcat [ptext (sLit "stg_sel_"), text (show offset),
1006                ptext (if upd_reqd
1007                        then (sLit "_upd_entry")
1008                        else (sLit "_noupd_entry"))
1009        ]
1010
1011pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
1012  = hcat [ptext (sLit "stg_ap_"), text (show arity),
1013                ptext (if upd_reqd
1014                        then (sLit "_upd_info")
1015                        else (sLit "_noupd_info"))
1016        ]
1017
1018pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
1019  = hcat [ptext (sLit "stg_ap_"), text (show arity),
1020                ptext (if upd_reqd
1021                        then (sLit "_upd_entry")
1022                        else (sLit "_noupd_entry"))
1023        ]
1024
1025pprCLbl (CmmLabel _ fs CmmInfo)
1026  = ftext fs <> ptext (sLit "_info")
1027
1028pprCLbl (CmmLabel _ fs CmmEntry)
1029  = ftext fs <> ptext (sLit "_entry")
1030
1031pprCLbl (CmmLabel _ fs CmmRetInfo)
1032  = ftext fs <> ptext (sLit "_info")
1033
1034pprCLbl (CmmLabel _ fs CmmRet)
1035  = ftext fs <> ptext (sLit "_ret")
1036
1037pprCLbl (RtsLabel (RtsPrimOp primop))
1038  = ptext (sLit "stg_") <> ppr primop
1039
1040pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
1041  = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
1042
1043pprCLbl (ForeignLabel str _ _ _)
1044  = ftext str
1045
1046pprCLbl (IdLabel name _cafs flavor) = ppr name <> ppIdFlavor flavor
1047
1048pprCLbl (CC_Label cc)           = ppr cc
1049pprCLbl (CCS_Label ccs)         = ppr ccs
1050
1051pprCLbl (PlainModuleInitLabel mod)
1052   = ptext (sLit "__stginit_") <> ppr mod
1053
1054pprCLbl (HpcTicksLabel mod)
1055  = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
1056
1057pprCLbl (AsmTempLabel {})       = panic "pprCLbl AsmTempLabel"
1058pprCLbl (DynamicLinkerLabel {}) = panic "pprCLbl DynamicLinkerLabel"
1059pprCLbl (PicBaseLabel {})       = panic "pprCLbl PicBaseLabel"
1060pprCLbl (DeadStripPreventer {}) = panic "pprCLbl DeadStripPreventer"
1061
1062ppIdFlavor :: IdLabelInfo -> SDoc
1063ppIdFlavor x = pp_cSEP <>
1064               (case x of
1065                       Closure          -> ptext (sLit "closure")
1066                       SRT              -> ptext (sLit "srt")
1067                       InfoTable        -> ptext (sLit "info")
1068                       LocalInfoTable   -> ptext (sLit "info")
1069                       Entry            -> ptext (sLit "entry")
1070                       LocalEntry       -> ptext (sLit "entry")
1071                       Slow             -> ptext (sLit "slow")
1072                       RednCounts       -> ptext (sLit "ct")
1073                       ConEntry         -> ptext (sLit "con_entry")
1074                       ConInfoTable     -> ptext (sLit "con_info")
1075                       StaticConEntry   -> ptext (sLit "static_entry")
1076                       StaticInfoTable  -> ptext (sLit "static_info")
1077                       ClosureTable     -> ptext (sLit "closure_tbl")
1078                      )
1079
1080
1081pp_cSEP :: SDoc
1082pp_cSEP = char '_'
1083
1084
1085instance Outputable ForeignLabelSource where
1086 ppr fs
1087  = case fs of
1088        ForeignLabelInPackage pkgId     -> parens $ text "package: " <> ppr pkgId
1089        ForeignLabelInThisPackage       -> parens $ text "this package"
1090        ForeignLabelInExternalPackage   -> parens $ text "external package"
1091
1092-- -----------------------------------------------------------------------------
1093-- Machine-dependent knowledge about labels.
1094
1095underscorePrefix :: Bool   -- leading underscore on assembler labels?
1096underscorePrefix = (cLeadingUnderscore == "YES")
1097
1098asmTempLabelPrefix :: Platform -> LitString  -- for formatting labels
1099asmTempLabelPrefix platform =
1100    if platformOS platform == OSDarwin
1101    then sLit "L"
1102    else sLit ".L"
1103
1104pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc
1105pprDynamicLinkerAsmLabel platform dllInfo lbl
1106 = if platformOS platform == OSDarwin
1107   then if platformArch platform == ArchX86_64
1108        then case dllInfo of
1109             CodeStub        -> char 'L' <> pprCLabel platform lbl <> text "$stub"
1110             SymbolPtr       -> char 'L' <> pprCLabel platform lbl <> text "$non_lazy_ptr"
1111             GotSymbolPtr    -> pprCLabel platform lbl <> text "@GOTPCREL"
1112             GotSymbolOffset -> pprCLabel platform lbl
1113        else case dllInfo of
1114             CodeStub  -> char 'L' <> pprCLabel platform lbl <> text "$stub"
1115             SymbolPtr -> char 'L' <> pprCLabel platform lbl <> text "$non_lazy_ptr"
1116             _         -> panic "pprDynamicLinkerAsmLabel"
1117
1118   else if osElfTarget (platformOS platform)
1119        then if platformArch platform == ArchPPC
1120             then case dllInfo of
1121                  CodeStub  -> pprCLabel platform lbl <> text "@plt"
1122                  SymbolPtr -> text ".LC_" <> pprCLabel platform lbl
1123                  _         -> panic "pprDynamicLinkerAsmLabel"
1124             else if platformArch platform == ArchX86_64
1125                  then case dllInfo of
1126                       CodeStub        -> pprCLabel platform lbl <> text "@plt"
1127                       GotSymbolPtr    -> pprCLabel platform lbl <> text "@gotpcrel"
1128                       GotSymbolOffset -> pprCLabel platform lbl
1129                       SymbolPtr       -> text ".LC_" <> pprCLabel platform lbl
1130        else case dllInfo of
1131             CodeStub        -> pprCLabel platform lbl <> text "@plt"
1132             SymbolPtr       -> text ".LC_" <> pprCLabel platform lbl
1133             GotSymbolPtr    -> pprCLabel platform lbl <> text "@got"
1134             GotSymbolOffset -> pprCLabel platform lbl <> text "@gotoff"
1135   else if platformOS platform == OSMinGW32
1136        then case dllInfo of
1137             SymbolPtr -> text "__imp_" <> pprCLabel platform lbl
1138             _         -> panic "pprDynamicLinkerAsmLabel"
1139   else panic "pprDynamicLinkerAsmLabel"
Note: See TracBrowser for help on using the browser.