CLabel.hs 37.1 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 25 26 27 28 29 30

	mkClosureLabel,
	mkSRTLabel,
	mkInfoTableLabel,
	mkEntryLabel,
	mkSlowEntryLabel,
	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
	entryLblToInfoLbl, 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 289
  | InfoTable IsLocal	-- ^ Info tables for closures; always read-only
  | Entry IsLocal	-- ^ 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
mkSRTLabel		name c	= IdLabel name  c SRT
358 359
mkSlowEntryLabel      	name c 	= IdLabel name  c Slow
mkRednCountsLabel     	name c 	= IdLabel name  c RednCounts
360 361

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

mkClosureLabel name         c     = IdLabel name c Closure
368 369
mkInfoTableLabel name       c     = IdLabel name c (InfoTable False)
mkEntryLabel name           c     = IdLabel name c (Entry False)
370 371 372 373 374 375 376 377 378 379
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
mkConInfoTableLabel name    c     = IdLabel    name c ConInfoTable
mkStaticInfoTableLabel name c     = IdLabel    name c StaticInfoTable

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

381
-- Constructing Cmm Labels
382 383 384
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
385
mkBHUpdInfoLabel		= CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" )     CmmInfo
386 387 388 389 390 391 392
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
393
mkCAFBlackHoleEntryLabel	= CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")	CmmEntry
394 395

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

400 401 402 403 404 405 406
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
407 408 409


-- Constructing RtsLabels
410 411
mkRtsPrimOpLabel primop		= RtsLabel (RtsPrimOp primop)

412
mkSelectorInfoLabel  upd off	= RtsLabel (RtsSelectorInfoTable upd off)
413
mkSelectorEntryLabel upd off	= RtsLabel (RtsSelectorEntry     upd off)
414

415 416
mkApInfoTableLabel   upd off	= RtsLabel (RtsApInfoTable       upd off)
mkApEntryLabel       upd off	= RtsLabel (RtsApEntry           upd off)
417

418

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

424

425
-- Constructing ForeignLabels
426

427 428 429 430 431 432 433 434 435 436 437 438 439
-- | 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
440
addLabelSize :: CLabel -> Int -> CLabel
441 442
addLabelSize (ForeignLabel str _ src  fod) sz
    = ForeignLabel str (Just sz) src fod
443
addLabelSize label _
444
    = label
445

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

451

452 453 454 455 456 457 458 459 460 461
-- 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
462

463 464 465
-- Constructing Cost Center Labels
mkCCLabel	    cc		= CC_Label cc
mkCCSLabel	    ccs		= CCS_Label ccs
466

467 468
mkRtsApFastLabel str = RtsLabel (RtsApFast str)

469 470 471
mkRtsSlowTickyCtrLabel :: String -> CLabel
mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)

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

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

476 477

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

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

488 489

-- Constructing miscellaneous other labels
490
mkDeadStripPreventer :: CLabel -> CLabel
491 492 493 494 495 496 497 498 499 500 501
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

502
-- -----------------------------------------------------------------------------
Ian Lynagh's avatar
Ian Lynagh committed
503
-- Converting between info labels and entry/ret labels.
504 505

entryLblToInfoLbl :: CLabel -> CLabel 
506
entryLblToInfoLbl (IdLabel n c (Entry lcl))	= IdLabel n c (InfoTable lcl)
507 508 509 510 511 512 513 514 515
entryLblToInfoLbl (IdLabel n c ConEntry)	= IdLabel n c ConInfoTable
entryLblToInfoLbl (IdLabel n c StaticConEntry)	= IdLabel n c StaticInfoTable
entryLblToInfoLbl (CaseLabel n CaseReturnPt)	= CaseLabel n CaseReturnInfo
entryLblToInfoLbl (CmmLabel m str CmmEntry)	= CmmLabel m str CmmInfo
entryLblToInfoLbl (CmmLabel m str CmmRet)	= CmmLabel m str CmmRetInfo
entryLblToInfoLbl l				
	= pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)


516 517
cvtToClosureLbl   (IdLabel n c (InfoTable _))	= IdLabel n c Closure
cvtToClosureLbl   (IdLabel n c (Entry _))	= IdLabel n c Closure
518
cvtToClosureLbl   (IdLabel n c ConEntry)	= IdLabel n c Closure
519
cvtToClosureLbl   (IdLabel n c RednCounts)	= IdLabel n c Closure
520 521 522 523 524
cvtToClosureLbl l@(IdLabel n c Closure)		= l
cvtToClosureLbl l 
	= pprPanic "cvtToClosureLbl" (pprCLabel l)


525 526 527
-- -----------------------------------------------------------------------------
-- Does a CLabel refer to a CAF?
hasCAF :: CLabel -> Bool
528 529
hasCAF (IdLabel _ MayHaveCafRefs _) = True
hasCAF _                            = False
530

531

532 533
-- -----------------------------------------------------------------------------
-- Does a CLabel need declaring before use or not?
534 535
--
-- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
536 537 538 539 540

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.
541
needsCDecl (IdLabel _ _ SRT)		= False
542
needsCDecl (LargeSRTLabel _)		= False
543
needsCDecl (LargeBitmapLabel _)		= False
544
needsCDecl (IdLabel _ _ _)		= True
545
needsCDecl (CaseLabel _ _)	        = True
546
needsCDecl (PlainModuleInitLabel _)     = True
547

548
needsCDecl (StringLitLabel _)		= False
549 550
needsCDecl (AsmTempLabel _)		= False
needsCDecl (RtsLabel _)			= False
551 552 553 554 555 556 557 558 559

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

560
needsCDecl l@(ForeignLabel{})		= not (isMathFun l)
561 562
needsCDecl (CC_Label _)			= True
needsCDecl (CCS_Label _)		= True
andy@galois.com's avatar
andy@galois.com committed
563
needsCDecl (HpcTicksLabel _)            = True
564 565


566 567 568 569
-- | Check whether a label is a local temporary for native code generation
isAsmTemp  :: CLabel -> Bool    
isAsmTemp (AsmTempLabel _) 		= True
isAsmTemp _ 	    	   		= False
570

571 572 573

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

578

579
-- | Check whether a label corresponds to a C function that has 
580
--      a prototype in a system header somehere, or is built-in
581
--      to the C compiler. For these labels we avoid generating our
582
--      own C prototypes.
583
isMathFun :: CLabel -> Bool
584
isMathFun (ForeignLabel fs _ _ _) 	= fs `elementOfUniqSet` math_funs
585 586 587
isMathFun _ = False

math_funs = mkUniqSet [
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 656 657 658 659 660 661 662 663 664
        -- _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")
665
    ]
666

667
-- -----------------------------------------------------------------------------
668 669 670 671
-- | 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.
672
externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
673 674 675
externallyVisibleCLabel (CaseLabel _ _)		= False
externallyVisibleCLabel (StringLitLabel _)	= False
externallyVisibleCLabel (AsmTempLabel _)	= False
676
externallyVisibleCLabel (PlainModuleInitLabel _)= True
677
externallyVisibleCLabel (RtsLabel _)            = True
678
externallyVisibleCLabel (CmmLabel _ _ _)	= True
679
externallyVisibleCLabel (ForeignLabel{})	= True
batterseapower's avatar
batterseapower committed
680
externallyVisibleCLabel (IdLabel name _ info)	= isExternalName name && externallyVisibleIdLabel info
681 682
externallyVisibleCLabel (CC_Label _)		= True
externallyVisibleCLabel (CCS_Label _)		= True
683
externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
684
externallyVisibleCLabel (HpcTicksLabel _)	= True
685
externallyVisibleCLabel (LargeBitmapLabel _)    = False
686
externallyVisibleCLabel (LargeSRTLabel _)	= False
687

batterseapower's avatar
batterseapower committed
688
externallyVisibleIdLabel :: IdLabelInfo -> Bool
689 690 691 692
externallyVisibleIdLabel SRT             = False
externallyVisibleIdLabel (Entry lcl)     = not lcl
externallyVisibleIdLabel (InfoTable lcl) = not lcl
externallyVisibleIdLabel _               = True
batterseapower's avatar
batterseapower committed
693

694 695 696 697 698 699
-- -----------------------------------------------------------------------------
-- Finding the "type" of a CLabel 

-- For generating correct types in label declarations:

data CLabelType
700 701 702 703 704 705 706 707 708 709 710 711 712
  = 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
713

714 715 716

-- | Work out the general type of data at the address of this label
--    whether it be code, data, or static GC object.
717
labelType :: CLabel -> CLabelType
718 719 720 721 722 723 724
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
725 726
labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
727 728 729 730 731 732
labelType (RtsLabel (RtsApFast _))              = CodeLabel
labelType (CaseLabel _ CaseReturnInfo)          = DataLabel
labelType (CaseLabel _ _)	                = CodeLabel
labelType (PlainModuleInitLabel _)              = CodeLabel
labelType (LargeSRTLabel _)                     = DataLabel
labelType (LargeBitmapLabel _)                  = DataLabel
733
labelType (ForeignLabel _ _ _ IsFunction)	= CodeLabel
734 735
labelType (IdLabel _ _ info)                    = idInfoLabelType info
labelType _                                     = DataLabel
736 737

idInfoLabelType info =
738
  case info of
739
    InfoTable _   -> DataLabel
740
    Closure    	  -> GcPtrLabel
741 742
    ConInfoTable  -> DataLabel
    StaticInfoTable -> DataLabel
743
    ClosureTable  -> DataLabel
744
    RednCounts    -> DataLabel
745 746 747 748 749 750 751 752 753 754 755
    _	          -> 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.

756 757
labelDynamic :: PackageId -> CLabel -> Bool
labelDynamic this_pkg lbl =
758
  case lbl of
759 760 761
   -- is the RTS in a DLL or not?
   RtsLabel _  	     	-> not opt_Static && (this_pkg /= rtsPackageId)

762 763 764
   IdLabel n _ k     	-> isDllName this_pkg n

#if mingw32_TARGET_OS
765 766 767 768 769 770 771 772 773 774 775 776 777 778 779
   -- 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)

780 781 782
#else
   -- On Mac OS X and on ELF platforms, false positives are OK,
   -- so we claim that all foreign imports come from dynamic libraries
783
   ForeignLabel _ _ _ _ -> True
784

785 786
   CmmLabel pkg _ _     -> True 

787
#endif
788
   PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
789

790
   -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
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 828 829 830 831 832 833 834 835 836 837 838 839
   _ 		     -> 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.
-}

Simon Marlow's avatar
Simon Marlow committed
840 841
instance Outputable CLabel where
  ppr = pprCLabel
842 843
instance PlatformOutputable CLabel where
  pprPlatform _ = pprCLabel
Simon Marlow's avatar
Simon Marlow committed
844

845 846 847
pprCLabel :: CLabel -> SDoc

pprCLabel (AsmTempLabel u)
848
 | cGhcWithNativeCodeGen == "YES"
849 850 851 852 853
  =  getPprStyle $ \ sty ->
     if asmStyle sty then 
	ptext asmTempLabelPrefix <> pprUnique u
     else
	char '_' <> pprUnique u
854 855

pprCLabel (DynamicLinkerLabel info lbl)
856
 | cGhcWithNativeCodeGen == "YES"
857 858 859
   = pprDynamicLinkerAsmLabel info lbl
   
pprCLabel PicBaseLabel
860
 | cGhcWithNativeCodeGen == "YES"
Ian Lynagh's avatar
Ian Lynagh committed
861
   = ptext (sLit "1b")
862 863
   
pprCLabel (DeadStripPreventer lbl)
864
 | cGhcWithNativeCodeGen == "YES"
Ian Lynagh's avatar
Ian Lynagh committed
865
   = pprCLabel lbl <> ptext (sLit "_dsp")
866

867 868 869 870 871
pprCLabel lbl
   = getPprStyle $ \ sty ->
     if cGhcWithNativeCodeGen == "YES" && asmStyle sty
     then maybe_underscore (pprAsmCLbl lbl)
     else pprCLbl lbl
872 873 874 875 876

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

877
#ifdef mingw32_TARGET_OS
878 879
-- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
-- (The C compiler does this itself).
880
pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
881
   = ftext fs <> char '@' <> int sz
882
#endif
883 884 885
pprAsmCLbl lbl
   = pprCLbl lbl

886
pprCLbl (StringLitLabel u)
Ian Lynagh's avatar
Ian Lynagh committed
887
  = pprUnique u <> ptext (sLit "_str")
888

889
pprCLbl (CaseLabel u CaseReturnPt)
Ian Lynagh's avatar
Ian Lynagh committed
890
  = hcat [pprUnique u, ptext (sLit "_ret")]
891
pprCLbl (CaseLabel u CaseReturnInfo)
Ian Lynagh's avatar
Ian Lynagh committed
892
  = hcat [pprUnique u, ptext (sLit "_info")]
893
pprCLbl (CaseLabel u (CaseAlt tag))
Ian Lynagh's avatar
Ian Lynagh committed
894
  = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
895
pprCLbl (CaseLabel u CaseDefault)
Ian Lynagh's avatar
Ian Lynagh committed
896
  = hcat [pprUnique u, ptext (sLit "_dflt")]
897

Ian Lynagh's avatar
Ian Lynagh committed
898 899
pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
900 901 902 903
-- 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.
        
904

905 906 907
pprCLbl (CmmLabel _ str CmmCode)	= ftext str
pprCLbl (CmmLabel _ str CmmData)	= ftext str
pprCLbl (CmmLabel _ str CmmGcPtr)	= ftext str
908
pprCLbl (CmmLabel _ str CmmPrimCall)	= ftext str
909

910
pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> ptext (sLit "_fast")
911

912
pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
Ian Lynagh's avatar
Ian Lynagh committed
913
  = hcat [ptext (sLit "stg_sel_"), text (show offset),
914
		ptext (if upd_reqd 
Ian Lynagh's avatar
Ian Lynagh committed
915 916
			then (sLit "_upd_info") 
			else (sLit "_noupd_info"))
917 918 919
	]

pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
Ian Lynagh's avatar
Ian Lynagh committed
920
  = hcat [ptext (sLit "stg_sel_"), text (show offset),
921
		ptext (if upd_reqd 
Ian Lynagh's avatar
Ian Lynagh committed
922 923
			then (sLit "_upd_entry") 
			else (sLit "_noupd_entry"))
924 925
	]

926
pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
Ian Lynagh's avatar
Ian Lynagh committed
927
  = hcat [ptext (sLit "stg_ap_"), text (show arity),
928
		ptext (if upd_reqd 
Ian Lynagh's avatar
Ian Lynagh committed
929 930
			then (sLit "_upd_info") 
			else (sLit "_noupd_info"))
931 932 933
	]

pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
Ian Lynagh's avatar
Ian Lynagh committed
934
  = hcat [ptext (sLit "stg_ap_"), text (show arity),
935
		ptext (if upd_reqd 
Ian Lynagh's avatar
Ian Lynagh committed
936 937
			then (sLit "_upd_entry") 
			else (sLit "_noupd_entry"))
938 939
	]

940
pprCLbl (CmmLabel _ fs CmmInfo)
Ian Lynagh's avatar
Ian Lynagh committed
941
  = ftext fs <> ptext (sLit "_info")
942

943
pprCLbl (CmmLabel _ fs CmmEntry)
Ian Lynagh's avatar
Ian Lynagh committed
944
  = ftext fs <> ptext (sLit "_entry")
945

946
pprCLbl (CmmLabel _ fs CmmRetInfo)
Ian Lynagh's avatar
Ian Lynagh committed
947
  = ftext fs <> ptext (sLit "_info")
948

949
pprCLbl (CmmLabel _ fs CmmRet)
Ian Lynagh's avatar
Ian Lynagh committed
950
  = ftext fs <> ptext (sLit "_ret")
951 952

pprCLbl (RtsLabel (RtsPrimOp primop)) 
953
  = ptext (sLit "stg_") <> ppr primop
954 955

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

958
pprCLbl (ForeignLabel str _ _ _)
959 960
  = ftext str

961
pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
962 963 964 965

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

966
pprCLbl (PlainModuleInitLabel mod)
Ian Lynagh's avatar
Ian Lynagh committed
967
   = ptext (sLit "__stginit_") <> ppr mod
968

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

972 973 974
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <>
	       (case x of
Ian Lynagh's avatar
Ian Lynagh committed
975 976
		       Closure	    	-> ptext (sLit "closure")
		       SRT		-> ptext (sLit "srt")
977 978
		       InfoTable _	-> ptext (sLit "info")
		       Entry _	    	-> ptext (sLit "entry")
Ian Lynagh's avatar
Ian Lynagh committed
979 980 981 982 983 984 985
		       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")
986 987 988 989 990
		      )


pp_cSEP = char '_'

991 992 993 994 995 996 997 998

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"

999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011
-- -----------------------------------------------------------------------------
-- Machine-dependent knowledge about labels.

underscorePrefix :: Bool   -- leading underscore on assembler labels?
underscorePrefix = (cLeadingUnderscore == "YES")

asmTempLabelPrefix :: LitString  -- for formatting labels
asmTempLabelPrefix =
#if alpha_TARGET_OS
     {- The alpha assembler likes temporary labels to look like $L123
	instead of L123.  (Don't toss the L, because then Lf28
	turns into $f28.)
     -}
Ian Lynagh's avatar
Ian Lynagh committed
1012
     (sLit "$")
1013
#elif darwin_TARGET_OS
Ian Lynagh's avatar
Ian Lynagh committed
1014
     (sLit "L")
1015
#else
Ian Lynagh's avatar
Ian Lynagh committed
1016
     (sLit ".L")
1017
#endif
1018 1019 1020

pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc

1021
#if x86_64_TARGET_ARCH && darwin_TARGET_OS