CLabel.hs 37.7 KB
Newer Older
1 2 3 4 5 6 7
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details

8 9 10 11
-----------------------------------------------------------------------------
--
-- Object-file symbols (called CLabel for histerical raisins).
--
Simon Marlow's avatar
Simon Marlow committed
12
-- (c) The University of Glasgow 2004-2006
13 14 15 16 17
--
-----------------------------------------------------------------------------

module CLabel (
	CLabel,	-- abstract type
18 19
	ForeignLabelSource(..),
	pprDebugCLabel,
20 21 22 23 24

	mkClosureLabel,
	mkSRTLabel,
	mkInfoTableLabel,
	mkEntryLabel,
25
	mkSlowEntryLabel, slowEntryFromInfoLabel,
26 27 28 29 30
	mkConEntryLabel,
	mkStaticConEntryLabel,
	mkRednCountsLabel,
	mkConInfoTableLabel,
	mkStaticInfoTableLabel,
31
	mkLargeSRTLabel,
32 33
	mkApEntryLabel,
	mkApInfoTableLabel,
34 35 36 37 38 39 40 41 42 43
	mkClosureTableLabel,

	mkLocalClosureLabel,
	mkLocalInfoTableLabel,
	mkLocalEntryLabel,
	mkLocalConEntryLabel,
	mkLocalStaticConEntryLabel,
	mkLocalConInfoTableLabel,
	mkLocalStaticInfoTableLabel,
	mkLocalClosureTableLabel,
44 45 46 47 48 49

	mkReturnPtLabel,
	mkReturnInfoLabel,
	mkAltLabel,
	mkDefaultLabel,
	mkBitmapLabel,
50
	mkStringLitLabel,
51 52 53

	mkAsmTempLabel,

54
        mkPlainModuleInitLabel,
55 56

	mkSplitMarkerLabel,
57
	mkDirty_MUT_VAR_Label,
58
	mkUpdInfoLabel,
59
	mkBHUpdInfoLabel,
60 61 62
	mkIndStaticInfoLabel,
        mkMainCapabilityLabel,
	mkMAP_FROZEN_infoLabel,
63
	mkMAP_DIRTY_infoLabel,
64 65 66 67
        mkEMPTY_MVAR_infoLabel,

	mkTopTickyCtrLabel,
        mkCAFBlackHoleInfoTableLabel,
batterseapower's avatar
batterseapower committed
68
        mkCAFBlackHoleEntryLabel,
69 70 71
	mkRtsPrimOpLabel,
	mkRtsSlowTickyCtrLabel,

72
        mkSelectorInfoLabel,
73 74
	mkSelectorEntryLabel,

75 76 77 78 79 80 81
	mkCmmInfoLabel,
	mkCmmEntryLabel,
	mkCmmRetInfoLabel,
	mkCmmRetLabel,
	mkCmmCodeLabel,
	mkCmmDataLabel,
	mkCmmGcPtrLabel,
82

83 84
	mkRtsApFastLabel,

85 86
        mkPrimCallLabel,

87
	mkForeignLabel,
88
        addLabelSize,
89
        foreignLabelStdcallInfo,
90 91 92

	mkCCLabel, mkCCSLabel,

93 94 95 96 97
        DynamicLinkerLabelInfo(..),
        mkDynamicLinkerLabel,
        dynamicLinkerLabelInfo,
        
        mkPicBaseLabel,
98
        mkDeadStripPreventer,
99

andy@galois.com's avatar
andy@galois.com committed
100 101
        mkHpcTicksLabel,

102
        hasCAF,
103
	cvtToClosureLbl,
104
	needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
105
        isMathFun,
106
 	isCFunctionLabel, isGcPtrLabel, labelDynamic,
107 108 109 110

	pprCLabel
    ) where

111 112
#include "HsVersions.h"

113
import IdInfo
Simon Marlow's avatar
Simon Marlow committed
114
import StaticFlags
115 116
import BasicTypes
import Literal
Simon Marlow's avatar
Simon Marlow committed
117 118 119 120 121 122 123 124 125
import Packages
import DataCon
import PackageConfig
import Module
import Name
import Unique
import PrimOp
import Config
import CostCentre
126 127
import Outputable
import FastString
128
import DynFlags
129
import UniqSet
130 131 132 133 134

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

{-
135
  | CLabel is an abstract type that supports the following operations:
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156

  - Pretty printing

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

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

  - Is it visible outside this object file or not?

  - Is it "dynamic" (see details below)

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

  - Converting an info table label into an entry label.
-}

data CLabel
157 158 159
  = -- | A label related to the definition of a particular Id or Con in a .hs file.
    IdLabel	    		
	Name			
160
        CafInfo
161 162 163 164
	IdLabelInfo		-- encodes the suffix of the label
  
  -- | A label from a .cmm file that is not associated with a .hs level Id.
  | CmmLabel			
165
	PackageId		-- what package the label belongs to.
166 167 168 169 170 171
	FastString		-- identifier giving the prefix of the label
	CmmLabelInfo		-- encodes the suffix of the label

  -- | A label with a baked-in \/ algorithmically generated name that definitely
  --    comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
  --    If it doesn't have an algorithmically generated name then use a CmmLabel 
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
172
  --    instead and give it an appropriate PackageId argument.
173 174 175
  | RtsLabel 			
	RtsLabelInfo

176 177 178 179 180
  -- | A 'C' (or otherwise foreign) label.
  --
  | ForeignLabel 
  	FastString    		-- name of the imported label.

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

	ForeignLabelSource	-- what package the foreign label is in.
	
187 188 189 190
        FunctionOrData

  -- | A family of labels related to a particular case expression.
  | CaseLabel			
191 192 193 194 195 196
	{-# UNPACK #-} !Unique	-- Unique says which case expression
	CaseLabelInfo

  | AsmTempLabel 
	{-# UNPACK #-} !Unique

197 198 199
  | StringLitLabel
	{-# UNPACK #-} !Unique

200
  | PlainModuleInitLabel        -- without the version & way info
201 202
	Module

203 204 205
  | CC_Label  CostCentre
  | CCS_Label CostCentreStack

206 207 208 209
    
  -- | These labels are generated and used inside the NCG only. 
  -- 	They are special variants of a label used for dynamic linking
  --    see module PositionIndependentCode for details.
210
  | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
211 212 213 214 215 216 217 218 219 220
 
  -- | This label is generated and used inside the NCG only. 
  -- 	It is used as a base for PIC calculations on some platforms.
  --    It takes the form of a local numeric assembler label '1'; and 
  --    is pretty-printed as 1b, referring to the previous definition
  --    of 1: in the assembler source file.
  | PicBaseLabel                
 
  -- | A label before an info table to prevent excessive dead-stripping on darwin
  | DeadStripPreventer CLabel
221

222

223 224
  -- | Per-module table of tick locations
  | HpcTicksLabel Module
225

226 227
  -- | Label of an StgLargeSRT
  | LargeSRTLabel
228 229
        {-# UNPACK #-} !Unique

230 231
  -- | A bitmap (function or case return)
  | LargeBitmapLabel
232 233
        {-# UNPACK #-} !Unique

234 235
  deriving (Eq, Ord)

236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281

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

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

   -- | Label is in the package currenly being compiled.
   --	This is only used for creating hacky tmp labels during code generation.
   --	Don't use it in any code that might be inlined across a package boundary
   --	(ie, core code) else the information will be wrong relative to the
   --	destination module.
   | ForeignLabelInThisPackage
      
   deriving (Eq, Ord)   


-- | For debugging problems with the CLabel representation.
--	We can't make a Show instance for CLabel because lots of its components don't have instances.
--	The regular Outputable instance only shows the label name, and not its other info.
--
pprDebugCLabel :: CLabel -> SDoc
pprDebugCLabel lbl
 = case lbl of
 	IdLabel{}	-> ppr lbl <> (parens $ text "IdLabel")
	CmmLabel pkg name _info	
	 -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)

	RtsLabel{}	-> ppr lbl <> (parens $ text "RtsLabel")

	ForeignLabel name mSuffix src funOrData
	 -> ppr lbl <> (parens 
	 			$ text "ForeignLabel" 
	 			<+> ppr mSuffix
				<+> ppr src  
				<+> ppr funOrData)

	_		-> ppr lbl <> (parens $ text "other CLabel)")


282 283 284
-- True if a local IdLabel that we won't mark as exported
type IsLocal = Bool

285
data IdLabelInfo
286 287
  = Closure		-- ^ Label for closure
  | SRT                 -- ^ Static reference table
288
  | InfoTable IsLocal	-- ^ Info tables for closures; always read-only
289
  | Entry	        -- ^ Entry point
290
  | Slow		-- ^ Slow entry point
291

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

294 295 296 297
  | ConEntry	  	-- ^ Constructor entry point
  | ConInfoTable 	-- ^ Corresponding info table
  | StaticConEntry  	-- ^ Static constructor entry point
  | StaticInfoTable   	-- ^ Corresponding info table
298

299
  | ClosureTable	-- ^ Table of closures for Enum tycons
300 301 302 303 304 305 306 307 308 309 310 311 312

  deriving (Eq, Ord)


data CaseLabelInfo
  = CaseReturnPt
  | CaseReturnInfo
  | CaseAlt ConTag
  | CaseDefault
  deriving (Eq, Ord)


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

316 317
  | RtsApInfoTable       Bool{-updatable-} Int{-arity-}    -- ^ AP thunks
  | RtsApEntry           Bool{-updatable-} Int{-arity-}
318 319

  | RtsPrimOp PrimOp
320
  | RtsApFast	  FastString	-- ^ _fast versions of generic apply
321 322 323
  | RtsSlowTickyCtr String

  deriving (Eq, Ord)
324 325
  -- NOTE: Eq on LitString compares the pointer only, so this isn't
  -- a real equality.
326

327 328 329 330 331 332 333 334 335 336 337 338

-- | What type of Cmm label we're dealing with.
-- 	Determines the suffix appended to the name when a CLabel.CmmLabel
--	is pretty printed.
data CmmLabelInfo
  = CmmInfo       		-- ^ misc rts info tabless,	suffix _info
  | CmmEntry      		-- ^ misc rts entry points,	suffix _entry
  | CmmRetInfo    		-- ^ misc rts ret info tables,	suffix _info
  | CmmRet        		-- ^ misc rts return points,	suffix _ret
  | CmmData       		-- ^ misc rts data bits, eg CHARLIKE_closure
  | CmmCode       		-- ^ misc rts code
  | CmmGcPtr			-- ^ GcPtrs eg CHARLIKE_closure  
339
  | CmmPrimCall			-- ^ a prim call to some hand written Cmm code
340 341
  deriving (Eq, Ord)

342
data DynamicLinkerLabelInfo
343 344 345 346
  = CodeStub			-- MachO: Lfoo$stub, ELF: foo@plt
  | SymbolPtr			-- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
  | GotSymbolPtr		-- ELF: foo@got
  | GotSymbolOffset		-- ELF: foo@gotoff
347 348
  
  deriving (Eq, Ord)
349 350
 

351 352
-- -----------------------------------------------------------------------------
-- Constructing CLabels
353
-- -----------------------------------------------------------------------------
354

355
-- Constructing IdLabels 
356
-- These are always local:
357 358 359
mkSlowEntryLabel      	name c 	       = IdLabel name  c Slow
slowEntryFromInfoLabel (IdLabel n c _) = IdLabel n c Slow

360
mkSRTLabel		name c	= IdLabel name  c SRT
361
mkRednCountsLabel     	name c 	= IdLabel name  c RednCounts
362 363

-- These have local & (possibly) external variants:
364
mkLocalClosureLabel	name c 	= IdLabel name  c Closure
365
mkLocalInfoTableLabel  	name c 	= IdLabel name  c (InfoTable True)
366
mkLocalEntryLabel	name c 	= IdLabel name  c Entry
367 368 369
mkLocalClosureTableLabel name c = IdLabel name  c ClosureTable

mkClosureLabel name         c     = IdLabel name c Closure
370
mkInfoTableLabel name       c     = IdLabel name c (InfoTable False)
371
mkEntryLabel name           c     = IdLabel name c Entry
372 373 374 375 376
mkClosureTableLabel name    c     = IdLabel name c ClosureTable
mkLocalConInfoTableLabel    c con = IdLabel con c ConInfoTable
mkLocalConEntryLabel	    c con = IdLabel con c ConEntry
mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
mkLocalStaticConEntryLabel  c con = IdLabel con c StaticConEntry
377 378
mkConInfoTableLabel name    c     = IdLabel name c ConInfoTable
mkStaticInfoTableLabel name c     = IdLabel name c StaticInfoTable
379 380 381

mkConEntryLabel name        c     = IdLabel name c ConEntry
mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry
382

383
-- Constructing Cmm Labels
384 385 386
mkSplitMarkerLabel		= CmmLabel rtsPackageId (fsLit "__stg_split_marker")	CmmCode
mkDirty_MUT_VAR_Label		= CmmLabel rtsPackageId (fsLit "dirty_MUT_VAR")		CmmCode
mkUpdInfoLabel			= CmmLabel rtsPackageId (fsLit "stg_upd_frame")		CmmInfo
387
mkBHUpdInfoLabel		= CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" )     CmmInfo
388 389 390 391 392 393 394
mkIndStaticInfoLabel		= CmmLabel rtsPackageId (fsLit "stg_IND_STATIC")	CmmInfo
mkMainCapabilityLabel		= CmmLabel rtsPackageId (fsLit "MainCapability")	CmmData
mkMAP_FROZEN_infoLabel		= CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkMAP_DIRTY_infoLabel		= CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
mkEMPTY_MVAR_infoLabel		= CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR")	CmmInfo
mkTopTickyCtrLabel		= CmmLabel rtsPackageId (fsLit "top_ct")		CmmData
mkCAFBlackHoleInfoTableLabel	= CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")	CmmInfo
batterseapower's avatar
batterseapower committed
395
mkCAFBlackHoleEntryLabel	= CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")	CmmEntry
396 397

-----
398 399 400
mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
  mkCmmCodeLabel, mkCmmDataLabel,  mkCmmGcPtrLabel
	:: PackageId -> FastString -> CLabel
401

402 403 404 405 406 407 408
mkCmmInfoLabel      pkg str 	= CmmLabel pkg str CmmInfo
mkCmmEntryLabel     pkg str 	= CmmLabel pkg str CmmEntry
mkCmmRetInfoLabel   pkg str 	= CmmLabel pkg str CmmRetInfo
mkCmmRetLabel       pkg str 	= CmmLabel pkg str CmmRet
mkCmmCodeLabel      pkg str	= CmmLabel pkg str CmmCode
mkCmmDataLabel      pkg str	= CmmLabel pkg str CmmData
mkCmmGcPtrLabel     pkg str	= CmmLabel pkg str CmmGcPtr
409 410 411


-- Constructing RtsLabels
412 413
mkRtsPrimOpLabel primop		= RtsLabel (RtsPrimOp primop)

414
mkSelectorInfoLabel  upd off	= RtsLabel (RtsSelectorInfoTable upd off)
415
mkSelectorEntryLabel upd off	= RtsLabel (RtsSelectorEntry     upd off)
416

417 418
mkApInfoTableLabel   upd off	= RtsLabel (RtsApInfoTable       upd off)
mkApEntryLabel       upd off	= RtsLabel (RtsApEntry           upd off)
419

420

421
-- A call to some primitive hand written Cmm code
422
mkPrimCallLabel :: PrimCall -> CLabel
423 424 425
mkPrimCallLabel (PrimCall str pkg)  
	= CmmLabel pkg str CmmPrimCall

426

427
-- Constructing ForeignLabels
428

429 430 431 432 433 434 435 436 437 438 439 440 441
-- | Make a foreign label
mkForeignLabel 
	:: FastString 		-- name
	-> Maybe Int 		-- size prefix
	-> ForeignLabelSource	-- what package it's in
	-> FunctionOrData 	
	-> CLabel

mkForeignLabel str mb_sz src fod
    = ForeignLabel str mb_sz src  fod


-- | Update the label size field in a ForeignLabel
442
addLabelSize :: CLabel -> Int -> CLabel
443 444
addLabelSize (ForeignLabel str _ src  fod) sz
    = ForeignLabel str (Just sz) src fod
445
addLabelSize label _
446
    = label
447

448
-- | Get the label size field from a ForeignLabel
449
foreignLabelStdcallInfo :: CLabel -> Maybe Int
450
foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
451 452
foreignLabelStdcallInfo _lbl = Nothing

453

454 455 456 457 458 459 460 461 462 463
-- Constructing Large*Labels
mkLargeSRTLabel	uniq		= LargeSRTLabel uniq
mkBitmapLabel	uniq		= LargeBitmapLabel uniq


-- Constructin CaseLabels
mkReturnPtLabel uniq		= CaseLabel uniq CaseReturnPt
mkReturnInfoLabel uniq		= CaseLabel uniq CaseReturnInfo
mkAltLabel      uniq tag	= CaseLabel uniq (CaseAlt tag)
mkDefaultLabel  uniq 		= CaseLabel uniq CaseDefault
464

465 466 467
-- Constructing Cost Center Labels
mkCCLabel	    cc		= CC_Label cc
mkCCSLabel	    ccs		= CCS_Label ccs
468

469 470
mkRtsApFastLabel str = RtsLabel (RtsApFast str)

471 472 473
mkRtsSlowTickyCtrLabel :: String -> CLabel
mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)

andy@galois.com's avatar
andy@galois.com committed
474

475
-- Constructing Code Coverage Labels
andy@galois.com's avatar
andy@galois.com committed
476 477
mkHpcTicksLabel                = HpcTicksLabel

478 479

-- Constructing labels used for dynamic linking
480
mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
481
mkDynamicLinkerLabel 		= DynamicLinkerLabel
482 483 484

dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
485 486
dynamicLinkerLabelInfo _ 	= Nothing
    
487
mkPicBaseLabel :: CLabel
488
mkPicBaseLabel 			= PicBaseLabel
489

490 491

-- Constructing miscellaneous other labels
492
mkDeadStripPreventer :: CLabel -> CLabel
493 494 495 496 497 498 499 500 501 502 503
mkDeadStripPreventer lbl	= DeadStripPreventer lbl

mkStringLitLabel :: Unique -> CLabel
mkStringLitLabel		= StringLitLabel

mkAsmTempLabel :: Uniquable a => a -> CLabel
mkAsmTempLabel a		= AsmTempLabel (getUnique a)

mkPlainModuleInitLabel :: Module -> CLabel
mkPlainModuleInitLabel mod	= PlainModuleInitLabel mod

504
-- -----------------------------------------------------------------------------
505
-- Brutal method of obtaining a closure label
506

507
cvtToClosureLbl   (IdLabel n c (InfoTable _))	= IdLabel n c Closure
508
cvtToClosureLbl   (IdLabel n c Entry)	        = IdLabel n c Closure
509
cvtToClosureLbl   (IdLabel n c ConEntry)	= IdLabel n c Closure
510
cvtToClosureLbl   (IdLabel n c RednCounts)	= IdLabel n c Closure
511 512 513 514 515
cvtToClosureLbl l@(IdLabel n c Closure)		= l
cvtToClosureLbl l 
	= pprPanic "cvtToClosureLbl" (pprCLabel l)


516 517 518
-- -----------------------------------------------------------------------------
-- Does a CLabel refer to a CAF?
hasCAF :: CLabel -> Bool
519 520
hasCAF (IdLabel _ MayHaveCafRefs _) = True
hasCAF _                            = False
521

522

523 524
-- -----------------------------------------------------------------------------
-- Does a CLabel need declaring before use or not?
525 526
--
-- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
527 528 529 530 531

needsCDecl :: CLabel -> Bool
  -- False <=> it's pre-declared; don't bother
  -- don't bother declaring SRT & Bitmap labels, we always make sure
  -- they are defined before use.
532
needsCDecl (IdLabel _ _ SRT)		= False
533
needsCDecl (LargeSRTLabel _)		= False
534
needsCDecl (LargeBitmapLabel _)		= False
535
needsCDecl (IdLabel _ _ _)		= True
536
needsCDecl (CaseLabel _ _)	        = True
537
needsCDecl (PlainModuleInitLabel _)     = True
538

539
needsCDecl (StringLitLabel _)		= False
540 541
needsCDecl (AsmTempLabel _)		= False
needsCDecl (RtsLabel _)			= False
542 543 544 545 546 547 548 549 550

needsCDecl (CmmLabel pkgId _ _)		
	-- Prototypes for labels defined in the runtime system are imported
	--	into HC files via includes/Stg.h.
	| pkgId == rtsPackageId		= False
	
	-- For other labels we inline one into the HC file directly.
	| otherwise			= True

551
needsCDecl l@(ForeignLabel{})		= not (isMathFun l)
552 553
needsCDecl (CC_Label _)			= True
needsCDecl (CCS_Label _)		= True
andy@galois.com's avatar
andy@galois.com committed
554
needsCDecl (HpcTicksLabel _)            = True
555 556


557 558 559 560
-- | Check whether a label is a local temporary for native code generation
isAsmTemp  :: CLabel -> Bool    
isAsmTemp (AsmTempLabel _) 		= True
isAsmTemp _ 	    	   		= False
561

562 563 564

-- | If a label is a local temporary used for native code generation
--      then return just its unique, otherwise nothing.
565
maybeAsmTemp :: CLabel -> Maybe Unique
566 567 568
maybeAsmTemp (AsmTempLabel uq) 		= Just uq
maybeAsmTemp _ 	    	       		= Nothing

569

570
-- | Check whether a label corresponds to a C function that has 
571
--      a prototype in a system header somehere, or is built-in
572
--      to the C compiler. For these labels we avoid generating our
573
--      own C prototypes.
574
isMathFun :: CLabel -> Bool
575
isMathFun (ForeignLabel fs _ _ _) 	= fs `elementOfUniqSet` math_funs
576 577 578
isMathFun _ = False

math_funs = mkUniqSet [
579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655
        -- _ISOC99_SOURCE
        (fsLit "acos"),         (fsLit "acosf"),        (fsLit "acosh"),
        (fsLit "acoshf"),       (fsLit "acoshl"),       (fsLit "acosl"),
        (fsLit "asin"),         (fsLit "asinf"),        (fsLit "asinl"),
        (fsLit "asinh"),        (fsLit "asinhf"),       (fsLit "asinhl"),
        (fsLit "atan"),         (fsLit "atanf"),        (fsLit "atanl"),
        (fsLit "atan2"),        (fsLit "atan2f"),       (fsLit "atan2l"),
        (fsLit "atanh"),        (fsLit "atanhf"),       (fsLit "atanhl"),
        (fsLit "cbrt"),         (fsLit "cbrtf"),        (fsLit "cbrtl"),
        (fsLit "ceil"),         (fsLit "ceilf"),        (fsLit "ceill"),
        (fsLit "copysign"),     (fsLit "copysignf"),    (fsLit "copysignl"),
        (fsLit "cos"),          (fsLit "cosf"),         (fsLit "cosl"),
        (fsLit "cosh"),         (fsLit "coshf"),        (fsLit "coshl"),
        (fsLit "erf"),          (fsLit "erff"),         (fsLit "erfl"),
        (fsLit "erfc"),         (fsLit "erfcf"),        (fsLit "erfcl"),
        (fsLit "exp"),          (fsLit "expf"),         (fsLit "expl"),
        (fsLit "exp2"),         (fsLit "exp2f"),        (fsLit "exp2l"),
        (fsLit "expm1"),        (fsLit "expm1f"),       (fsLit "expm1l"),
        (fsLit "fabs"),         (fsLit "fabsf"),        (fsLit "fabsl"),
        (fsLit "fdim"),         (fsLit "fdimf"),        (fsLit "fdiml"),
        (fsLit "floor"),        (fsLit "floorf"),       (fsLit "floorl"),
        (fsLit "fma"),          (fsLit "fmaf"),         (fsLit "fmal"),
        (fsLit "fmax"),         (fsLit "fmaxf"),        (fsLit "fmaxl"),
        (fsLit "fmin"),         (fsLit "fminf"),        (fsLit "fminl"),
        (fsLit "fmod"),         (fsLit "fmodf"),        (fsLit "fmodl"),
        (fsLit "frexp"),        (fsLit "frexpf"),       (fsLit "frexpl"),
        (fsLit "hypot"),        (fsLit "hypotf"),       (fsLit "hypotl"),
        (fsLit "ilogb"),        (fsLit "ilogbf"),       (fsLit "ilogbl"),
        (fsLit "ldexp"),        (fsLit "ldexpf"),       (fsLit "ldexpl"),
        (fsLit "lgamma"),       (fsLit "lgammaf"),      (fsLit "lgammal"),
        (fsLit "llrint"),       (fsLit "llrintf"),      (fsLit "llrintl"),
        (fsLit "llround"),      (fsLit "llroundf"),     (fsLit "llroundl"),
        (fsLit "log"),          (fsLit "logf"),         (fsLit "logl"),
        (fsLit "log10l"),       (fsLit "log10"),        (fsLit "log10f"),
        (fsLit "log1pl"),       (fsLit "log1p"),        (fsLit "log1pf"),
        (fsLit "log2"),         (fsLit "log2f"),        (fsLit "log2l"),
        (fsLit "logb"),         (fsLit "logbf"),        (fsLit "logbl"),
        (fsLit "lrint"),        (fsLit "lrintf"),       (fsLit "lrintl"),
        (fsLit "lround"),       (fsLit "lroundf"),      (fsLit "lroundl"),
        (fsLit "modf"),         (fsLit "modff"),        (fsLit "modfl"),
        (fsLit "nan"),          (fsLit "nanf"),         (fsLit "nanl"),
        (fsLit "nearbyint"),    (fsLit "nearbyintf"),   (fsLit "nearbyintl"),
        (fsLit "nextafter"),    (fsLit "nextafterf"),   (fsLit "nextafterl"),
        (fsLit "nexttoward"),   (fsLit "nexttowardf"),  (fsLit "nexttowardl"),
        (fsLit "pow"),          (fsLit "powf"),         (fsLit "powl"),
        (fsLit "remainder"),    (fsLit "remainderf"),   (fsLit "remainderl"),
        (fsLit "remquo"),       (fsLit "remquof"),      (fsLit "remquol"),
        (fsLit "rint"),         (fsLit "rintf"),        (fsLit "rintl"),
        (fsLit "round"),        (fsLit "roundf"),       (fsLit "roundl"),
        (fsLit "scalbln"),      (fsLit "scalblnf"),     (fsLit "scalblnl"),
        (fsLit "scalbn"),       (fsLit "scalbnf"),      (fsLit "scalbnl"),
        (fsLit "sin"),          (fsLit "sinf"),         (fsLit "sinl"),
        (fsLit "sinh"),         (fsLit "sinhf"),        (fsLit "sinhl"),
        (fsLit "sqrt"),         (fsLit "sqrtf"),        (fsLit "sqrtl"),
        (fsLit "tan"),          (fsLit "tanf"),         (fsLit "tanl"),
        (fsLit "tanh"),         (fsLit "tanhf"),        (fsLit "tanhl"),
        (fsLit "tgamma"),       (fsLit "tgammaf"),      (fsLit "tgammal"),
        (fsLit "trunc"),        (fsLit "truncf"),       (fsLit "truncl"),
        -- ISO C 99 also defines these function-like macros in math.h:
        -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
        -- isgreaterequal, isless, islessequal, islessgreater, isunordered

        -- additional symbols from _BSD_SOURCE
        (fsLit "drem"),         (fsLit "dremf"),        (fsLit "dreml"),
        (fsLit "finite"),       (fsLit "finitef"),      (fsLit "finitel"),
        (fsLit "gamma"),        (fsLit "gammaf"),       (fsLit "gammal"),
        (fsLit "isinf"),        (fsLit "isinff"),       (fsLit "isinfl"),
        (fsLit "isnan"),        (fsLit "isnanf"),       (fsLit "isnanl"),
        (fsLit "j0"),           (fsLit "j0f"),          (fsLit "j0l"),
        (fsLit "j1"),           (fsLit "j1f"),          (fsLit "j1l"),
        (fsLit "jn"),           (fsLit "jnf"),          (fsLit "jnl"),
        (fsLit "lgamma_r"),     (fsLit "lgammaf_r"),    (fsLit "lgammal_r"),
        (fsLit "scalb"),        (fsLit "scalbf"),       (fsLit "scalbl"),
        (fsLit "significand"),  (fsLit "significandf"), (fsLit "significandl"),
        (fsLit "y0"),           (fsLit "y0f"),          (fsLit "y0l"),
        (fsLit "y1"),           (fsLit "y1f"),          (fsLit "y1l"),
        (fsLit "yn"),           (fsLit "ynf"),          (fsLit "ynl")
656
    ]
657

658
-- -----------------------------------------------------------------------------
659 660 661 662
-- | Is a CLabel visible outside this object file or not?
-- 	From the point of view of the code generator, a name is
-- 	externally visible if it has to be declared as exported
-- 	in the .o file's symbol table; that is, made non-static.
663
externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
664 665 666
externallyVisibleCLabel (CaseLabel _ _)		= False
externallyVisibleCLabel (StringLitLabel _)	= False
externallyVisibleCLabel (AsmTempLabel _)	= False
667
externallyVisibleCLabel (PlainModuleInitLabel _)= True
668
externallyVisibleCLabel (RtsLabel _)            = True
669
externallyVisibleCLabel (CmmLabel _ _ _)	= True
670
externallyVisibleCLabel (ForeignLabel{})	= True
batterseapower's avatar
batterseapower committed
671
externallyVisibleCLabel (IdLabel name _ info)	= isExternalName name && externallyVisibleIdLabel info
672 673
externallyVisibleCLabel (CC_Label _)		= True
externallyVisibleCLabel (CCS_Label _)		= True
674
externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
675
externallyVisibleCLabel (HpcTicksLabel _)	= True
676
externallyVisibleCLabel (LargeBitmapLabel _)    = False
677
externallyVisibleCLabel (LargeSRTLabel _)	= False
678

batterseapower's avatar
batterseapower committed
679
externallyVisibleIdLabel :: IdLabelInfo -> Bool
680 681 682
externallyVisibleIdLabel SRT             = False
externallyVisibleIdLabel (InfoTable lcl) = not lcl
externallyVisibleIdLabel _               = True
batterseapower's avatar
batterseapower committed
683

684 685 686 687 688 689
-- -----------------------------------------------------------------------------
-- Finding the "type" of a CLabel 

-- For generating correct types in label declarations:

data CLabelType
690 691 692 693 694 695 696 697 698 699 700 701 702
  = CodeLabel	-- Address of some executable instructions
  | DataLabel	-- Address of data, not a GC ptr
  | GcPtrLabel	-- Address of a (presumably static) GC object

isCFunctionLabel :: CLabel -> Bool
isCFunctionLabel lbl = case labelType lbl of
			CodeLabel -> True
			_other	  -> False

isGcPtrLabel :: CLabel -> Bool
isGcPtrLabel lbl = case labelType lbl of
			GcPtrLabel -> True
			_other	   -> False
703

704 705 706

-- | Work out the general type of data at the address of this label
--    whether it be code, data, or static GC object.
707
labelType :: CLabel -> CLabelType
708 709 710 711 712 713 714
labelType (CmmLabel _ _ CmmData)		= DataLabel
labelType (CmmLabel _ _ CmmGcPtr)		= GcPtrLabel
labelType (CmmLabel _ _ CmmCode)		= CodeLabel
labelType (CmmLabel _ _ CmmInfo)		= DataLabel
labelType (CmmLabel _ _ CmmEntry)		= CodeLabel
labelType (CmmLabel _ _ CmmRetInfo)		= DataLabel
labelType (CmmLabel _ _ CmmRet)			= CodeLabel
715 716
labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
717 718 719 720 721 722
labelType (RtsLabel (RtsApFast _))              = CodeLabel
labelType (CaseLabel _ CaseReturnInfo)          = DataLabel
labelType (CaseLabel _ _)	                = CodeLabel
labelType (PlainModuleInitLabel _)              = CodeLabel
labelType (LargeSRTLabel _)                     = DataLabel
labelType (LargeBitmapLabel _)                  = DataLabel
723
labelType (ForeignLabel _ _ _ IsFunction)	= CodeLabel
724 725
labelType (IdLabel _ _ info)                    = idInfoLabelType info
labelType _                                     = DataLabel
726 727

idInfoLabelType info =
728
  case info of
729
    InfoTable _   -> DataLabel
730
    Closure    	  -> GcPtrLabel
731 732
    ConInfoTable  -> DataLabel
    StaticInfoTable -> DataLabel
733
    ClosureTable  -> DataLabel
734
    RednCounts    -> DataLabel
735 736 737 738 739 740 741 742 743 744 745
    _	          -> CodeLabel


-- -----------------------------------------------------------------------------
-- Does a CLabel need dynamic linkage?

-- When referring to data in code, we need to know whether
-- that data resides in a DLL or not. [Win32 only.]
-- @labelDynamic@ returns @True@ if the label is located
-- in a DLL, be it a data reference or not.

746 747
labelDynamic :: PackageId -> CLabel -> Bool
labelDynamic this_pkg lbl =
748
  case lbl of
749 750 751
   -- is the RTS in a DLL or not?
   RtsLabel _  	     	-> not opt_Static && (this_pkg /= rtsPackageId)

752 753 754
   IdLabel n _ k     	-> isDllName this_pkg n

#if mingw32_TARGET_OS
755 756 757 758 759 760 761 762 763 764 765 766 767 768 769
   -- When compiling in the "dyn" way, eack package is to be linked into its own shared library.
   CmmLabel pkg _ _
    -> not opt_Static && (this_pkg /= pkg)

   -- Foreign label is in some un-named foreign package (or DLL)
   ForeignLabel _ _ ForeignLabelInExternalPackage _  -> True

   -- Foreign label is linked into the same package as the source file currently being compiled.
   ForeignLabel _ _ ForeignLabelInThisPackage  _     -> False
      
   -- Foreign label is in some named package.
   --	When compiling in the "dyn" way, each package is to be linked into its own DLL.
   ForeignLabel _ _ (ForeignLabelInPackage pkgId) _
    -> (not opt_Static) && (this_pkg /= pkgId)

770 771 772
#else
   -- On Mac OS X and on ELF platforms, false positives are OK,
   -- so we claim that all foreign imports come from dynamic libraries
773
   ForeignLabel _ _ _ _ -> True
774

775 776
   CmmLabel pkg _ _     -> True 

777
#endif
778
   PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
779

780
   -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827
   _ 		     -> False

{-
OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
right places. It is used to detect when the abstractC statement of an
CCodeBlock actually contains the code for a slow entry point.  -- HWL

We need at least @Eq@ for @CLabels@, because we want to avoid
duplicate declarations in generating C (see @labelSeenTE@ in
@PprAbsC@).
-}

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

{-
Convention:

      <name>_<type>

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

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

Many of these distinctions are only for documentation reasons.  For
example, _ret is only distinguished from _entry to make it easy to
tell whether a code fragment is a return point or a closure/function
entry.
828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854

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

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

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

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

Simon Marlow's avatar
Simon Marlow committed
857 858
instance Outputable CLabel where
  ppr = pprCLabel
859 860
instance PlatformOutputable CLabel where
  pprPlatform _ = pprCLabel
Simon Marlow's avatar
Simon Marlow committed
861

862 863 864
pprCLabel :: CLabel -> SDoc

pprCLabel (AsmTempLabel u)
865
 | cGhcWithNativeCodeGen == "YES"
866 867 868 869 870
  =  getPprStyle $ \ sty ->
     if asmStyle sty then 
	ptext asmTempLabelPrefix <> pprUnique u
     else
	char '_' <> pprUnique u
871 872

pprCLabel (DynamicLinkerLabel info lbl)
873
 | cGhcWithNativeCodeGen == "YES"
874 875 876
   = pprDynamicLinkerAsmLabel info lbl
   
pprCLabel PicBaseLabel
877
 | cGhcWithNativeCodeGen == "YES"
Ian Lynagh's avatar
Ian Lynagh committed
878
   = ptext (sLit "1b")
879 880
   
pprCLabel (DeadStripPreventer lbl)
881
 | cGhcWithNativeCodeGen == "YES"
Ian Lynagh's avatar
Ian Lynagh committed
882
   = pprCLabel lbl <> ptext (sLit "_dsp")
883

884 885 886 887 888
pprCLabel lbl
   = getPprStyle $ \ sty ->
     if cGhcWithNativeCodeGen == "YES" && asmStyle sty
     then maybe_underscore (pprAsmCLbl lbl)
     else pprCLbl lbl
889 890 891 892 893

maybe_underscore doc
  | underscorePrefix = pp_cSEP <> doc
  | otherwise        = doc

894
#ifdef mingw32_TARGET_OS
895 896
-- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
-- (The C compiler does this itself).
897
pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
898
   = ftext fs <> char '@' <> int sz
899
#endif
900 901 902
pprAsmCLbl lbl
   = pprCLbl lbl

903
pprCLbl (StringLitLabel u)
Ian Lynagh's avatar
Ian Lynagh committed
904
  = pprUnique u <> ptext (sLit "_str")
905

906
pprCLbl (CaseLabel u CaseReturnPt)
Ian Lynagh's avatar
Ian Lynagh committed
907
  = hcat [pprUnique u, ptext (sLit "_ret")]
908
pprCLbl (CaseLabel u CaseReturnInfo)
Ian Lynagh's avatar
Ian Lynagh committed
909
  = hcat [pprUnique u, ptext (sLit "_info")]
910
pprCLbl (CaseLabel u (CaseAlt tag))
Ian Lynagh's avatar
Ian Lynagh committed
911
  = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
912
pprCLbl (CaseLabel u CaseDefault)
Ian Lynagh's avatar
Ian Lynagh committed
913
  = hcat [pprUnique u, ptext (sLit "_dflt")]
914

Ian Lynagh's avatar
Ian Lynagh committed
915 916
pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
917 918 919 920
-- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
-- until that gets resolved we'll just force them to start
-- with a letter so the label will be legal assmbly code.
        
921

922 923 924
pprCLbl (CmmLabel _ str CmmCode)	= ftext str
pprCLbl (CmmLabel _ str CmmData)	= ftext str
pprCLbl (CmmLabel _ str CmmGcPtr)	= ftext str
925
pprCLbl (CmmLabel _ str CmmPrimCall)	= ftext str
926

927
pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> ptext (sLit "_fast")
928

929
pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
Ian Lynagh's avatar
Ian Lynagh committed
930
  = hcat [ptext (sLit "stg_sel_"), text (show offset),
931
		ptext (if upd_reqd 
Ian Lynagh's avatar
Ian Lynagh committed
932 933
			then (sLit "_upd_info") 
			else (sLit "_noupd_info"))
934 935 936
	]

pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
Ian Lynagh's avatar
Ian Lynagh committed
937
  = hcat [ptext (sLit "stg_sel_"), text (show offset),
938
		ptext (if upd_reqd 
Ian Lynagh's avatar
Ian Lynagh committed
939 940
			then (sLit "_upd_entry") 
			else (sLit "_noupd_entry"))
941 942
	]

943
pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
Ian Lynagh's avatar
Ian Lynagh committed
944
  = hcat [ptext (sLit "stg_ap_"), text (show arity),
945
		ptext (if upd_reqd 
Ian Lynagh's avatar
Ian Lynagh committed
946 947
			then (sLit "_upd_info") 
			else (sLit "_noupd_info"))
948 949 950
	]

pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
Ian Lynagh's avatar
Ian Lynagh committed
951
  = hcat [ptext (sLit "stg_ap_"), text (show arity),
952
		ptext (if upd_reqd 
Ian Lynagh's avatar
Ian Lynagh committed
953 954
			then (sLit "_upd_entry") 
			else (sLit "_noupd_entry"))
955 956
	]

957
pprCLbl (CmmLabel _ fs CmmInfo)
Ian Lynagh's avatar
Ian Lynagh committed
958
  = ftext fs <> ptext (sLit "_info")
959

960
pprCLbl (CmmLabel _ fs CmmEntry)
Ian Lynagh's avatar
Ian Lynagh committed
961
  = ftext fs <> ptext (sLit "_entry")
962

963
pprCLbl (CmmLabel _ fs CmmRetInfo)
Ian Lynagh's avatar
Ian Lynagh committed
964
  = ftext fs <> ptext (sLit "_info")
965

966
pprCLbl (CmmLabel _ fs CmmRet)
Ian Lynagh's avatar
Ian Lynagh committed
967
  = ftext fs <> ptext (sLit "_ret")
968 969

pprCLbl (RtsLabel (RtsPrimOp primop)) 
970
  = ptext (sLit "stg_") <> ppr primop
971 972

pprCLbl (RtsLabel (RtsSlowTickyCtr pat)) 
Ian Lynagh's avatar
Ian Lynagh committed
973
  = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
974

975
pprCLbl (ForeignLabel str _ _ _)
976 977
  = ftext str

978
pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
979 980 981 982

pprCLbl (CC_Label cc) 		= ppr cc
pprCLbl (CCS_Label ccs) 	= ppr ccs

983
pprCLbl (PlainModuleInitLabel mod)
Ian Lynagh's avatar
Ian Lynagh committed
984
   = ptext (sLit "__stginit_") <> ppr mod
985

andy@galois.com's avatar
andy@galois.com committed
986
pprCLbl (HpcTicksLabel mod)
Ian Lynagh's avatar
Ian Lynagh committed
987
  = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
andy@galois.com's avatar
andy@galois.com committed
988

989 990 991
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <>
	       (case x of
Ian Lynagh's avatar
Ian Lynagh committed
992 993
		       Closure	    	-> ptext (sLit "closure")
		       SRT		-> ptext (sLit "srt")
994
		       InfoTable _	-> ptext (sLit "info")
995
		       Entry	    	-> ptext (sLit "entry")
Ian Lynagh's avatar
Ian Lynagh committed
996 997 998 999 1000 1001 1002
		       Slow	    	-> ptext (sLit "slow")
		       RednCounts	-> ptext (sLit "ct")
		       ConEntry	    	-> ptext (sLit "con_entry")
		       ConInfoTable    	-> ptext (sLit "con_info")
		       StaticConEntry  	-> ptext (sLit "static_entry")
		       StaticInfoTable 	-> ptext (sLit "static_info")
		       ClosureTable     -> ptext (sLit "closure_tbl")
1003 1004 1005 1006 1007
		      )


pp_cSEP = char '_'

1008 1009 1010 1011 1012 1013 1014 1015

instance Outputable ForeignLabelSource where
 ppr fs
  = case fs of
  	ForeignLabelInPackage pkgId	-> parens $ text "package: " <> ppr pkgId 
	ForeignLabelInThisPackage	-> parens $ text "this package"
	ForeignLabelInExternalPackage	-> parens $ text "external package"

1016 1017 1018 1019 1020 1021 1022 1023