CLabel.lhs 18 KB
Newer Older
1
%
2
% (c) The University of Glasgow, 1992-2002
3
%
4
\section[CLabel]{@CLabel@: Information to make C Labels}
5 6

\begin{code}
7
module CLabel (
8 9 10
	CLabel,	-- abstract type

	mkClosureLabel,
11
	mkSRTLabel,
12
	mkSRTDescLabel,
13
	mkInfoTableLabel,
14 15
	mkEntryLabel,
	mkSlowEntryLabel,
16 17 18
	mkConEntryLabel,
	mkStaticConEntryLabel,
	mkRednCountsLabel,
19
	mkConInfoTableLabel,
20
	mkStaticInfoTableLabel,
21 22
	mkApEntryLabel,
	mkApInfoTableLabel,
23 24

	mkReturnPtLabel,
25
	mkReturnInfoLabel,
26 27 28
	mkVecTblLabel,
	mkAltLabel,
	mkDefaultLabel,
29 30 31
	mkBitmapLabel,

	mkClosureTblLabel,
32 33 34

	mkAsmTempLabel,

35
	mkModuleInitLabel,
36
	mkPlainModuleInitLabel,
37

38
	mkErrorStdEntryLabel,
39 40

	mkStgUpdatePAPLabel,
41
	mkSplitMarkerLabel,
42
	mkUpdInfoLabel,
43 44 45 46
	mkSeqInfoLabel,
	mkIndInfoLabel,
	mkIndStaticInfoLabel,
	mkRtsGCEntryLabel,
47
        mkMainCapabilityLabel,
48 49 50
	mkCharlikeClosureLabel,
	mkIntlikeClosureLabel,
	mkMAP_FROZEN_infoLabel,
51
        mkEMPTY_MVAR_infoLabel,
52

53
	mkTopTickyCtrLabel,
54
	mkBlackHoleInfoTableLabel,
55 56
        mkCAFBlackHoleInfoTableLabel,
        mkSECAFBlackHoleInfoTableLabel,
57 58
	mkRtsPrimOpLabel,

59 60
	moduleRegdLabel,

61 62
	mkSelectorInfoLabel,
	mkSelectorEntryLabel,
63

64 65 66
	mkRtsApplyInfoLabel,
	mkRtsApplyEntryLabel,

67 68
	mkForeignLabel,

69 70
	mkCC_Label, mkCCS_Label,
	
71
	needsCDecl, isAsmTemp, externallyVisibleCLabel,
72

sof's avatar
sof committed
73
	CLabelType(..), labelType, labelDynamic,
74

75
	pprCLabel
76 77
    ) where

sof's avatar
sof committed
78

79
#include "HsVersions.h"
sof's avatar
sof committed
80

81
#if ! OMIT_NATIVE_CODEGEN
sof's avatar
sof committed
82
import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl )
83
#endif
84

85
import CmdLineOpts      ( opt_Static, opt_DoTickyProfiling )
86
import CStrings		( pp_cSEP )
87 88
import DataCon		( ConTag )
import Module		( moduleName, moduleNameFS, 
89
			  Module, isHomeModule )
90
import Name		( Name, getName, isDllName, isExternalName )
91
import TyCon		( TyCon )
92
import Unique		( pprUnique, Unique )
93
import PrimOp		( PrimOp )
94
import CostCentre	( CostCentre, CostCentreStack )
95
import Outputable
96
import FastString
97 98 99 100 101 102 103 104 105 106
\end{code}

things we want to find out:

* should the labelled things be declared "static" (visible only in this file)?

* should it be declared "const" (read-only text space)?

* does it need declarations at all? (v common Prelude things are pre-declared)

107 108 109
* what type does it have? (for generating accurate enough C declarations
  so that the C compiler won't complain).

110 111
\begin{code}
data CLabel
112
  = IdLabel	    		-- A family of labels related to the
113 114
	Name			-- definition of a particular Id
	IdLabelInfo
115

116 117 118
  | DataConLabel		-- Ditto data constructors
	Name
	DataConLabelInfo
119 120 121 122 123

  | CaseLabel			-- A family of labels related to a particular case expression
	Unique			-- Unique says which case expression
	CaseLabelInfo

124 125 126
  | TyConLabel TyCon		-- currently only one kind of TyconLabel,
				-- a 'Closure Table'.

127 128
  | AsmTempLabel    Unique

129 130 131
  | ModuleInitLabel 
	Module			-- the module name
	String			-- its "way"
132 133 134 135 136
	-- at some point we might want some kind of version number in
	-- the module init label, to guard against compiling modules in
	-- the wrong order.  We can't use the interface file version however,
	-- because we don't always recompile modules which depend on a module
	-- whose version has changed.
137 138

  | PlainModuleInitLabel Module	 -- without the vesrion & way info
139

140 141
  | RtsLabel	    RtsLabelInfo

142
  | ForeignLabel FastString Bool  -- a 'C' (or otherwise foreign) label
143 144
				   -- Bool <=> is dynamic

145 146
  | CC_Label CostCentre
  | CCS_Label CostCentreStack
147

148
  deriving (Eq, Ord)
149 150 151 152 153
\end{code}

\begin{code}
data IdLabelInfo
  = Closure		-- Label for (static???) closure
154
  | SRT                 -- Static reference table
155
  | SRTDesc             -- Static reference table descriptor
156 157 158
  | InfoTbl		-- Info tables for closures; always read-only
  | Entry		-- entry point
  | Slow		-- slow entry point
159

160 161 162
			-- Ticky-ticky counting
  | RednCounts		-- Label of place to keep reduction-count info for 
			-- this Id
163 164 165

  | Bitmap		-- A bitmap (function or case return)

166 167 168 169
  deriving (Eq, Ord)

data DataConLabelInfo
  = ConEntry		-- the only kind of entry pt for constructors
170 171
  | ConInfoTbl		-- corresponding info table
  | StaticConEntry  	-- static constructor entry point
172 173 174
  | StaticInfoTbl   	-- corresponding info table
  deriving (Eq, Ord)

175
data CaseLabelInfo
176
  = CaseReturnPt
177
  | CaseReturnInfo
178 179 180 181 182 183 184 185
  | CaseVecTbl
  | CaseAlt ConTag
  | CaseDefault
  deriving (Eq, Ord)

data RtsLabelInfo
  = RtsShouldNeverHappenCode

186
  | RtsBlackHoleInfoTbl LitString  -- black hole with info table name
187

188 189 190
  | RtsUpdInfo            	-- upd_frame_info
  | RtsSeqInfo			-- seq_frame_info
  | RtsGCEntryLabel String 	-- a heap check fail handler, eg  stg_chk_2
191
  | RtsMainCapability           -- MainCapability
192 193
  | Rts_Closure String		-- misc rts closures, eg CHARLIKE_closure
  | Rts_Info String		-- misc rts itbls, eg MUT_ARR_PTRS_FROZEN_info
194
  | Rts_Code String		-- misc rts code
195 196 197 198 199 200 201 202

  | RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-}	-- Selector thunks
  | RtsSelectorEntry   Bool{-updatable-} Int{-offset-}

  | RtsApInfoTbl Bool{-updatable-} Int{-arity-}	        -- AP thunks
  | RtsApEntry   Bool{-updatable-} Int{-arity-}

  | RtsPrimOp PrimOp
203

204 205
  | RtsTopTickyCtr

206 207
  | RtsModuleRegd

208 209 210
  | RtsApplyInfoLabel  LitString
  | RtsApplyEntryLabel LitString

211
  deriving (Eq, Ord)
212 213 214 215

-- Label Type: for generating C declarations.

data CLabelType
216 217
  = RetInfoTblType
  | InfoTblType
218 219
  | ClosureType
  | VecTblType
220
  | ClosureTblType
221 222
  | CodeType
  | DataType
223 224 225
\end{code}

\begin{code}
226 227
mkClosureLabel	      	id 		= IdLabel id  Closure
mkSRTLabel		id		= IdLabel id  SRT
228
mkSRTDescLabel		id		= IdLabel id  SRTDesc
229 230 231 232
mkInfoTableLabel  	id 		= IdLabel id  InfoTbl
mkEntryLabel	      	id 		= IdLabel id  Entry
mkSlowEntryLabel      	id 		= IdLabel id  Slow
mkBitmapLabel   	id		= IdLabel id  Bitmap
233 234 235 236 237 238 239
mkRednCountsLabel     	id		= IdLabel id  RednCounts

mkStaticInfoTableLabel  con		= DataConLabel con StaticInfoTbl
mkConInfoTableLabel     con		= DataConLabel con ConInfoTbl
mkConEntryLabel	      	con		= DataConLabel con ConEntry
mkStaticConEntryLabel 	con		= DataConLabel con StaticConEntry

240 241

mkReturnPtLabel uniq		= CaseLabel uniq CaseReturnPt
242
mkReturnInfoLabel uniq		= CaseLabel uniq CaseReturnInfo
243 244 245
mkVecTblLabel   uniq		= CaseLabel uniq CaseVecTbl
mkAltLabel      uniq tag	= CaseLabel uniq (CaseAlt tag)
mkDefaultLabel  uniq 		= CaseLabel uniq CaseDefault
246

247 248

mkClosureTblLabel tycon		= TyConLabel tycon
249 250 251

mkAsmTempLabel 			= AsmTempLabel

252
mkModuleInitLabel		= ModuleInitLabel
253
mkPlainModuleInitLabel		= PlainModuleInitLabel
254

255 256
	-- Some fixed runtime system labels

rrt's avatar
rrt committed
257
mkErrorStdEntryLabel 		= RtsLabel RtsShouldNeverHappenCode
258
mkStgUpdatePAPLabel		= RtsLabel (Rts_Code "stg_update_PAP")
259
mkSplitMarkerLabel		= RtsLabel (Rts_Code "__stg_split_marker")
260
mkUpdInfoLabel			= RtsLabel RtsUpdInfo
261
mkSeqInfoLabel			= RtsLabel RtsSeqInfo
262 263
mkIndInfoLabel			= RtsLabel (Rts_Info "stg_IND_info")
mkIndStaticInfoLabel		= RtsLabel (Rts_Info "stg_IND_STATIC_info")
264
mkRtsGCEntryLabel str		= RtsLabel (RtsGCEntryLabel str)
265
mkMainCapabilityLabel		= RtsLabel RtsMainCapability
266 267 268
mkCharlikeClosureLabel		= RtsLabel (Rts_Closure "stg_CHARLIKE_closure")
mkIntlikeClosureLabel		= RtsLabel (Rts_Closure "stg_INTLIKE_closure")
mkMAP_FROZEN_infoLabel		= RtsLabel (Rts_Info "stg_MUT_ARR_PTRS_FROZEN_info")
269
mkEMPTY_MVAR_infoLabel		= RtsLabel (Rts_Info "stg_EMPTY_MVAR_info")
270

271
mkTopTickyCtrLabel		= RtsLabel RtsTopTickyCtr
272 273
mkBlackHoleInfoTableLabel	= RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_BLACKHOLE_info"))
mkCAFBlackHoleInfoTableLabel	= RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_CAF_BLACKHOLE_info"))
274
mkSECAFBlackHoleInfoTableLabel	= if opt_DoTickyProfiling then
275
                                    RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_SE_CAF_BLACKHOLE_info"))
276 277
                                  else  -- RTS won't have info table unless -ticky is on
                                    panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
278 279
mkRtsPrimOpLabel primop		= RtsLabel (RtsPrimOp primop)

280 281
moduleRegdLabel			= RtsLabel RtsModuleRegd

282 283 284 285 286 287
mkSelectorInfoLabel  upd off	= RtsLabel (RtsSelectorInfoTbl upd off)
mkSelectorEntryLabel upd off	= RtsLabel (RtsSelectorEntry   upd off)

mkApInfoTableLabel  upd off	= RtsLabel (RtsApInfoTbl upd off)
mkApEntryLabel upd off		= RtsLabel (RtsApEntry   upd off)

288 289
	-- Foreign labels

290
mkForeignLabel :: FastString -> Bool -> CLabel
291 292
mkForeignLabel str is_dynamic	= ForeignLabel str is_dynamic

293 294 295 296
	-- Cost centres etc.

mkCC_Label	cc		= CC_Label cc
mkCCS_Label	ccs		= CCS_Label ccs
297 298 299 300 301

-- Std RTS application routines

mkRtsApplyInfoLabel  = RtsLabel . RtsApplyInfoLabel
mkRtsApplyEntryLabel = RtsLabel . RtsApplyEntryLabel
302 303 304 305 306 307 308 309 310 311
\end{code}

\begin{code}
needsCDecl :: CLabel -> Bool	-- False <=> it's pre-declared; don't bother
isAsmTemp  :: CLabel -> Bool    -- is a local temporary for native code generation
externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
\end{code}

@needsCDecl@ is @True@ unless the thing is a deeply-@PreludeCore@-ish
object.  {\em Also:} No need to spit out labels for things generated
312
by the flattener (in @AbsCUtils@)---it is careful to ensure references
313 314 315 316 317 318
to them are always backwards.  These are return-point and vector-table
labels.

Declarations for (non-prelude) @Id@-based things are needed because of
mutual recursion.

319 320
Declarations for direct return points are needed, because they may be
let-no-escapes, which can be recursive.
321

322
\begin{code}
323 324 325
  -- don't bother declaring SRT & Bitmap labels, we always make sure
  -- they are defined before use.
needsCDecl (IdLabel _ SRT)		= False
326
needsCDecl (IdLabel _ SRTDesc)		= False
327
needsCDecl (IdLabel _ Bitmap)		= False
328 329 330
needsCDecl (IdLabel _ _)		= True
needsCDecl (CaseLabel _ CaseReturnPt)	= True
needsCDecl (DataConLabel _ _)		= True
331
needsCDecl (TyConLabel _)		= True
332
needsCDecl (ModuleInitLabel _ _)	= True
333
needsCDecl (PlainModuleInitLabel _)	= True
334

rrt's avatar
rrt committed
335
needsCDecl (CaseLabel _ _)		= False
336 337
needsCDecl (AsmTempLabel _)		= False
needsCDecl (RtsLabel _)			= False
338
needsCDecl (ForeignLabel _ _)		= False
339 340
needsCDecl (CC_Label _)			= False
needsCDecl (CCS_Label _)		= False
341 342 343
\end{code}

Whether the label is an assembler temporary:
344

345 346 347 348 349 350
\begin{code}
isAsmTemp (AsmTempLabel _) = True
isAsmTemp _ 	    	   = False
\end{code}

C ``static'' or not...
351
From the point of view of the code generator, a name is
352 353 354 355 356 357 358 359
externally visible if it has to be declared as exported
in the .o file's symbol table; that is, made non-static.

\begin{code}
externallyVisibleCLabel (DataConLabel _ _) = True
externallyVisibleCLabel (TyConLabel tc)    = True
externallyVisibleCLabel (CaseLabel _ _)	   = False
externallyVisibleCLabel (AsmTempLabel _)   = False
360
externallyVisibleCLabel (ModuleInitLabel _ _)= True
361
externallyVisibleCLabel (PlainModuleInitLabel _)= True
362
externallyVisibleCLabel (RtsLabel RtsModuleRegd) = False --hack
363
externallyVisibleCLabel (RtsLabel _)	   = True
364
externallyVisibleCLabel (ForeignLabel _ _) = True
365
externallyVisibleCLabel (IdLabel id _)     = isExternalName id
366 367 368 369
externallyVisibleCLabel (CC_Label _)	   = False -- not strictly true
externallyVisibleCLabel (CCS_Label _)	   = False -- not strictly true
\end{code}

370 371 372
For generating correct types in label declarations, and also for
deciding whether the C compiler would like us to use '&' before the
label to get its address:
373

374
\begin{code}
375
labelType :: CLabel -> CLabelType
376
labelType (RtsLabel (RtsBlackHoleInfoTbl _))  = InfoTblType
377 378
labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = InfoTblType
labelType (RtsLabel (RtsApInfoTbl _ _))       = InfoTblType
379 380 381
labelType (RtsLabel RtsUpdInfo)       	      = RetInfoTblType
labelType (RtsLabel RtsSeqInfo)       	      = RetInfoTblType
labelType (RtsLabel RtsTopTickyCtr)	      = CodeType -- XXX
382
labelType (RtsLabel (Rts_Info _))             = InfoTblType
383 384 385
labelType (RtsLabel (RtsApplyInfoLabel _))    = RetInfoTblType
labelType (RtsLabel (RtsApplyEntryLabel _))   = CodeType
labelType (CaseLabel _ CaseReturnInfo)        = RetInfoTblType
386 387
labelType (CaseLabel _ CaseReturnPt)	      = CodeType
labelType (CaseLabel _ CaseVecTbl)            = VecTblType
388
labelType (TyConLabel _)		      = ClosureTblType
389
labelType (ModuleInitLabel _ _)               = CodeType
390
labelType (PlainModuleInitLabel _)            = CodeType
391 392
labelType (CC_Label _)			      = CodeType -- hack
labelType (CCS_Label _)			      = CodeType -- hack
393 394 395

labelType (IdLabel _ info) = 
  case info of
396 397 398 399
    InfoTbl   -> InfoTblType
    Closure   -> ClosureType
    Bitmap    -> DataType
    _	      -> CodeType
400 401 402 403 404 405 406 407

labelType (DataConLabel _ info) = 
  case info of
     ConInfoTbl    -> InfoTblType
     StaticInfoTbl -> InfoTblType
     _		   -> CodeType

labelType _        = DataType
408 409
\end{code}

sof's avatar
sof committed
410 411 412 413 414 415 416 417 418
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.

\begin{code}
labelDynamic :: CLabel -> Bool
labelDynamic lbl = 
  case lbl of
rrt's avatar
rrt committed
419 420 421 422 423 424 425 426
   -- The special case for RtsShouldNeverHappenCode is because the associated address is
   -- NULL, i.e. not a DLL entry point
   RtsLabel RtsShouldNeverHappenCode -> False
   RtsLabel _  	     -> not opt_Static  -- i.e., is the RTS in a DLL or not?
   IdLabel n k       -> isDllName n
   DataConLabel n k  -> isDllName n
   TyConLabel tc     -> isDllName (getName tc)
   ForeignLabel _ d  -> d
427
   ModuleInitLabel m _  -> (not opt_Static) && (not (isHomeModule m))
428
   PlainModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m))
rrt's avatar
rrt committed
429
   _ 		     -> False
sof's avatar
sof committed
430 431 432
\end{code}


433
OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
434 435 436 437 438 439 440
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@).

441 442 443 444 445 446 447 448 449 450 451 452
-----------------------------------------------------------------------------
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
453
	 srtd			Static reference table descriptor
454
	 entry			Entry code
455
	 slow			Slow entry code (if any)
456 457 458 459 460 461 462 463 464 465 466 467
	 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
468 469
	 cc			Cost centre
	 ccs			Cost centre stack
470

471
\begin{code}
472
pprCLabel :: CLabel -> SDoc
473

474
#if ! OMIT_NATIVE_CODEGEN
475
pprCLabel (AsmTempLabel u)
476
  = text (fmtAsmLbl (show u))
477
#endif
478

479 480 481
pprCLabel lbl = 
#if ! OMIT_NATIVE_CODEGEN
    getPprStyle $ \ sty ->
482 483 484
    if asmStyle sty && underscorePrefix then
       pp_cSEP <> pprCLbl lbl
    else
485
#endif
486 487 488
       pprCLbl lbl

pprCLbl (CaseLabel u CaseReturnPt)
489 490 491
  = hcat [pprUnique u, pp_cSEP, ptext SLIT("ret")]
pprCLbl (CaseLabel u CaseReturnInfo)
  = hcat [pprUnique u, pp_cSEP, ptext SLIT("info")]
492
pprCLbl (CaseLabel u CaseVecTbl)
493
  = hcat [pprUnique u, pp_cSEP, ptext SLIT("vtbl")]
494
pprCLbl (CaseLabel u (CaseAlt tag))
495
  = hcat [pprUnique u, pp_cSEP, int tag, pp_cSEP, ptext SLIT("alt")]
496
pprCLbl (CaseLabel u CaseDefault)
497 498
  = hcat [pprUnique u, pp_cSEP, ptext SLIT("dflt")]

rrt's avatar
rrt committed
499 500 501
pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("NULL")
-- used to be stg_error_entry but Windows can't have DLL entry points as static
-- initialisers, and besides, this ShouldNeverHappen, right?
502

503 504
pprCLbl (RtsLabel RtsUpdInfo)            = ptext SLIT("stg_upd_frame_info")
pprCLbl (RtsLabel RtsSeqInfo)            = ptext SLIT("stg_seq_frame_info")
505
pprCLbl (RtsLabel RtsMainCapability)     = ptext SLIT("MainCapability")
506 507 508 509
pprCLbl (RtsLabel (RtsGCEntryLabel str)) = text str
pprCLbl (RtsLabel (Rts_Closure str))     = text str
pprCLbl (RtsLabel (Rts_Info str))        = text str
pprCLbl (RtsLabel (Rts_Code str))        = text str
510

511 512
pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct")

513
pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ptext info
514

515
pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
516
  = hcat [ptext SLIT("stg_sel_"), text (show offset),
517 518 519 520
		ptext (if upd_reqd 
			then SLIT("_upd_info") 
			else SLIT("_noupd_info"))
	]
521

522
pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
523
  = hcat [ptext SLIT("stg_sel_"), text (show offset),
524 525 526 527 528 529
		ptext (if upd_reqd 
			then SLIT("_upd_entry") 
			else SLIT("_noupd_entry"))
	]

pprCLbl (RtsLabel (RtsApInfoTbl upd_reqd arity))
530
  = hcat [ptext SLIT("stg_ap_"), text (show arity),
531 532 533 534 535 536
		ptext (if upd_reqd 
			then SLIT("_upd_info") 
			else SLIT("_noupd_info"))
	]

pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
537
  = hcat [ptext SLIT("stg_ap_"), text (show arity),
538 539 540 541 542
		ptext (if upd_reqd 
			then SLIT("_upd_entry") 
			else SLIT("_noupd_entry"))
	]

543 544 545 546 547 548
pprCLbl (RtsLabel (RtsApplyInfoLabel  fs))
  = ptext SLIT("stg_ap_") <> ptext fs <> ptext SLIT("_info")

pprCLbl (RtsLabel (RtsApplyEntryLabel fs))
  = ptext SLIT("stg_ap_") <> ptext fs <> ptext SLIT("_ret")

549
pprCLbl (RtsLabel (RtsPrimOp primop)) 
550
  = ppr primop <> ptext SLIT("_fast")
551

552 553 554
pprCLbl (RtsLabel RtsModuleRegd)
  = ptext SLIT("module_registered")

555
pprCLbl (ForeignLabel str _)
556
  = ftext str
557

558 559 560 561 562 563 564 565 566
pprCLbl (TyConLabel tc)
  = hcat [ppr tc, pp_cSEP, ptext SLIT("closure_tbl")]

pprCLbl (IdLabel      id  flavor) = ppr id <> ppIdFlavor flavor
pprCLbl (DataConLabel con flavor) = ppr con <> ppConFlavor flavor

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

567
pprCLbl (ModuleInitLabel mod way)	
568
   = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
569
	<> char '_' <> text way
570
pprCLbl (PlainModuleInitLabel mod)	
571
   = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
572

573 574 575 576
ppIdFlavor :: IdLabelInfo -> SDoc

ppIdFlavor x = pp_cSEP <>
	       (case x of
sof's avatar
sof committed
577
		       Closure	    	-> ptext SLIT("closure")
578
		       SRT		-> ptext SLIT("srt")
579
		       SRTDesc		-> ptext SLIT("srtd")
580 581 582
		       InfoTbl    	-> ptext SLIT("info")
		       Entry	    	-> ptext SLIT("entry")
		       Slow	    	-> ptext SLIT("slow")
583
		       RednCounts	-> ptext SLIT("ct")
584
		       Bitmap		-> ptext SLIT("btm")
585 586 587 588
		      )

ppConFlavor x = pp_cSEP <>
	     	(case x of
sof's avatar
sof committed
589 590 591 592
		       ConEntry	    	-> ptext SLIT("con_entry")
		       ConInfoTbl    	-> ptext SLIT("con_info")
		       StaticConEntry  	-> ptext SLIT("static_entry")
		       StaticInfoTbl 	-> ptext SLIT("static_info")
593
		)
594
\end{code}