CLabel.hs 37.2 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
68
69
70
        mkEMPTY_MVAR_infoLabel,

	mkTopTickyCtrLabel,
        mkCAFBlackHoleInfoTableLabel,
	mkRtsPrimOpLabel,
	mkRtsSlowTickyCtrLabel,

71
        mkSelectorInfoLabel,
72
73
	mkSelectorEntryLabel,

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

82
83
	mkRtsApFastLabel,

84
85
        mkPrimCallLabel,

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

	mkCCLabel, mkCCSLabel,

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

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

101
        hasCAF,
102
	infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
103
	needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
104
        isMathFun,
105
 	isCFunctionLabel, isGcPtrLabel, labelDynamic,
106
107
108
109

	pprCLabel
    ) where

110
111
#include "HsVersions.h"

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

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

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

  - 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
156
157
158
  = -- | A label related to the definition of a particular Id or Con in a .hs file.
    IdLabel	    		
	Name			
159
        CafInfo
160
161
162
163
	IdLabelInfo		-- encodes the suffix of the label
  
  -- | A label from a .cmm file that is not associated with a .hs level Id.
  | CmmLabel			
164
	PackageId		-- what package the label belongs to.
165
166
167
168
169
170
	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
171
  --    instead and give it an appropriate PackageId argument.
172
173
174
  | RtsLabel 			
	RtsLabelInfo

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

180
181
182
        (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.
183
184
185

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

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

  | AsmTempLabel 
	{-# UNPACK #-} !Unique

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

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

202
203
204
  | CC_Label  CostCentre
  | CCS_Label CostCentreStack

205
206
207
208
    
  -- | 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.
209
  | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
210
211
212
213
214
215
216
217
218
219
 
  -- | 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
220

221

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

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

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

233
234
  deriving (Eq, Ord)

235
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

-- | 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)")


281
data IdLabelInfo
282
283
284
285
286
  = Closure		-- ^ Label for closure
  | SRT                 -- ^ Static reference table
  | InfoTable		-- ^ Info tables for closures; always read-only
  | Entry		-- ^ Entry point
  | Slow		-- ^ Slow entry point
287

288
  | RednCounts		-- ^ Label of place to keep Ticky-ticky  info for this Id
289

290
291
292
293
  | ConEntry	  	-- ^ Constructor entry point
  | ConInfoTable 	-- ^ Corresponding info table
  | StaticConEntry  	-- ^ Static constructor entry point
  | StaticInfoTable   	-- ^ Corresponding info table
294

295
  | ClosureTable	-- ^ Table of closures for Enum tycons
296
297
298
299
300
301
302
303
304
305
306
307
308

  deriving (Eq, Ord)


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


data RtsLabelInfo
309
310
  = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}  -- ^ Selector thunks
  | RtsSelectorEntry     Bool{-updatable-} Int{-offset-}
311

312
313
  | RtsApInfoTable       Bool{-updatable-} Int{-arity-}    -- ^ AP thunks
  | RtsApEntry           Bool{-updatable-} Int{-arity-}
314
315

  | RtsPrimOp PrimOp
316
  | RtsApFast	  FastString	-- ^ _fast versions of generic apply
317
318
319
  | RtsSlowTickyCtr String

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

323
324
325
326
327
328
329
330
331
332
333
334

-- | 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  
335
  | CmmPrimCall			-- ^ a prim call to some hand written Cmm code
336
337
  deriving (Eq, Ord)

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

347
348
-- -----------------------------------------------------------------------------
-- Constructing CLabels
349
-- -----------------------------------------------------------------------------
350

351
-- Constructing IdLabels 
352
-- These are always local:
353
mkSRTLabel		name c	= IdLabel name  c SRT
354
355
mkSlowEntryLabel      	name c 	= IdLabel name  c Slow
mkRednCountsLabel     	name c 	= IdLabel name  c RednCounts
356
357

-- These have local & (possibly) external variants:
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
mkLocalClosureLabel	name c 	= IdLabel name  c Closure
mkLocalInfoTableLabel  	name c 	= IdLabel name  c InfoTable
mkLocalEntryLabel	name c 	= IdLabel name  c Entry
mkLocalClosureTableLabel name c = IdLabel name  c ClosureTable

mkClosureLabel name         c     = IdLabel name c Closure
mkInfoTableLabel name       c     = IdLabel name c InfoTable
mkEntryLabel name           c     = IdLabel name c Entry
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
376

377
-- Constructing Cmm Labels
378
379
380
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
381
mkBHUpdInfoLabel		= CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" )     CmmInfo
382
383
384
385
386
387
388
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
389
390

-----
391
392
393
mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
  mkCmmCodeLabel, mkCmmDataLabel,  mkCmmGcPtrLabel
	:: PackageId -> FastString -> CLabel
394

395
396
397
398
399
400
401
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
402
403
404


-- Constructing RtsLabels
405
406
mkRtsPrimOpLabel primop		= RtsLabel (RtsPrimOp primop)

407
mkSelectorInfoLabel  upd off	= RtsLabel (RtsSelectorInfoTable upd off)
408
mkSelectorEntryLabel upd off	= RtsLabel (RtsSelectorEntry     upd off)
409

410
411
mkApInfoTableLabel   upd off	= RtsLabel (RtsApInfoTable       upd off)
mkApEntryLabel       upd off	= RtsLabel (RtsApEntry           upd off)
412

413

414
-- A call to some primitive hand written Cmm code
415
mkPrimCallLabel :: PrimCall -> CLabel
416
417
418
mkPrimCallLabel (PrimCall str pkg)  
	= CmmLabel pkg str CmmPrimCall

419

420
-- Constructing ForeignLabels
421

422
423
424
425
426
427
428
429
430
431
432
433
434
-- | 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
435
addLabelSize :: CLabel -> Int -> CLabel
436
437
addLabelSize (ForeignLabel str _ src  fod) sz
    = ForeignLabel str (Just sz) src fod
438
addLabelSize label _
439
    = label
440

441
-- | Get the label size field from a ForeignLabel
442
foreignLabelStdcallInfo :: CLabel -> Maybe Int
443
foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
444
445
foreignLabelStdcallInfo _lbl = Nothing

446

447
448
449
450
451
452
453
454
455
456
-- 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
457

458
459
460
-- Constructing Cost Center Labels
mkCCLabel	    cc		= CC_Label cc
mkCCSLabel	    ccs		= CCS_Label ccs
461

462
463
mkRtsApFastLabel str = RtsLabel (RtsApFast str)

464
465
466
mkRtsSlowTickyCtrLabel :: String -> CLabel
mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)

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

468
-- Constructing Code Coverage Labels
andy@galois.com's avatar
andy@galois.com committed
469
470
mkHpcTicksLabel                = HpcTicksLabel

471
472

-- Constructing labels used for dynamic linking
473
mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
474
mkDynamicLinkerLabel 		= DynamicLinkerLabel
475
476
477

dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
478
479
dynamicLinkerLabelInfo _ 	= Nothing
    
480
mkPicBaseLabel :: CLabel
481
mkPicBaseLabel 			= PicBaseLabel
482

483
484

-- Constructing miscellaneous other labels
485
mkDeadStripPreventer :: CLabel -> CLabel
486
487
488
489
490
491
492
493
494
495
496
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

497
-- -----------------------------------------------------------------------------
Ian Lynagh's avatar
Ian Lynagh committed
498
-- Converting between info labels and entry/ret labels.
499
500

infoLblToEntryLbl :: CLabel -> CLabel 
501
502
503
504
505
506
507
508
509
infoLblToEntryLbl (IdLabel n c InfoTable)	= IdLabel n c Entry
infoLblToEntryLbl (IdLabel n c ConInfoTable)	= IdLabel n c ConEntry
infoLblToEntryLbl (IdLabel n c StaticInfoTable)	= IdLabel n c StaticConEntry
infoLblToEntryLbl (CaseLabel n CaseReturnInfo)	= CaseLabel n CaseReturnPt
infoLblToEntryLbl (CmmLabel m str CmmInfo)	= CmmLabel m str CmmEntry
infoLblToEntryLbl (CmmLabel m str CmmRetInfo)	= CmmLabel m str CmmRet
infoLblToEntryLbl _
	= panic "CLabel.infoLblToEntryLbl"

510
511

entryLblToInfoLbl :: CLabel -> CLabel 
512
513
514
515
516
517
518
519
520
521
522
523
524
entryLblToInfoLbl (IdLabel n c Entry)		= IdLabel n c InfoTable
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)


cvtToClosureLbl   (IdLabel n c InfoTable)	= IdLabel n c Closure
cvtToClosureLbl   (IdLabel n c Entry)		= IdLabel n c Closure
cvtToClosureLbl   (IdLabel n c ConEntry)	= IdLabel n c Closure
525
cvtToClosureLbl   (IdLabel n c RednCounts)	= IdLabel n c Closure
526
527
528
529
530
531
532
533
534
535
536
537
cvtToClosureLbl l@(IdLabel n c Closure)		= l
cvtToClosureLbl l 
	= pprPanic "cvtToClosureLbl" (pprCLabel l)


cvtToSRTLbl   (IdLabel n c InfoTable)		= mkSRTLabel n c
cvtToSRTLbl   (IdLabel n c Entry)		= mkSRTLabel n c
cvtToSRTLbl   (IdLabel n c ConEntry)		= mkSRTLabel n c
cvtToSRTLbl l@(IdLabel n c Closure)		= mkSRTLabel n c
cvtToSRTLbl l 
	= pprPanic "cvtToSRTLbl" (pprCLabel l)

538

539
540
541
-- -----------------------------------------------------------------------------
-- Does a CLabel refer to a CAF?
hasCAF :: CLabel -> Bool
542
543
hasCAF (IdLabel _ MayHaveCafRefs _) = True
hasCAF _                            = False
544

545

546
547
-- -----------------------------------------------------------------------------
-- Does a CLabel need declaring before use or not?
548
549
--
-- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
550
551
552
553
554

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.
555
needsCDecl (IdLabel _ _ SRT)		= False
556
needsCDecl (LargeSRTLabel _)		= False
557
needsCDecl (LargeBitmapLabel _)		= False
558
needsCDecl (IdLabel _ _ _)		= True
559
needsCDecl (CaseLabel _ _)	        = True
560
needsCDecl (PlainModuleInitLabel _)     = True
561

562
needsCDecl (StringLitLabel _)		= False
563
564
needsCDecl (AsmTempLabel _)		= False
needsCDecl (RtsLabel _)			= False
565
566
567
568
569
570
571
572
573

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

574
needsCDecl l@(ForeignLabel{})		= not (isMathFun l)
575
576
needsCDecl (CC_Label _)			= True
needsCDecl (CCS_Label _)		= True
andy@galois.com's avatar
andy@galois.com committed
577
needsCDecl (HpcTicksLabel _)            = True
578
579


580
581
582
583
-- | Check whether a label is a local temporary for native code generation
isAsmTemp  :: CLabel -> Bool    
isAsmTemp (AsmTempLabel _) 		= True
isAsmTemp _ 	    	   		= False
584

585
586
587

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

592

593
-- | Check whether a label corresponds to a C function that has 
594
595
596
--      a prototype in a system header somehere, or is built-in
--      to the C compiler. For these labels we abovoid generating our
--      own C prototypes.
597
isMathFun :: CLabel -> Bool
598
isMathFun (ForeignLabel fs _ _ _) 	= fs `elementOfUniqSet` math_funs
599
600
601
isMathFun _ = False

math_funs = mkUniqSet [
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
665
666
667
668
669
670
671
672
673
674
675
676
677
678
        -- _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")
679
    ]
680

681
-- -----------------------------------------------------------------------------
682
683
684
685
-- | 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.
686
externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
687
688
689
externallyVisibleCLabel (CaseLabel _ _)		= False
externallyVisibleCLabel (StringLitLabel _)	= False
externallyVisibleCLabel (AsmTempLabel _)	= False
690
externallyVisibleCLabel (PlainModuleInitLabel _)= True
691
externallyVisibleCLabel (RtsLabel _)            = True
692
externallyVisibleCLabel (CmmLabel _ _ _)	= True
693
externallyVisibleCLabel (ForeignLabel{})	= True
694
695
696
externallyVisibleCLabel (IdLabel name _ _)	= isExternalName name
externallyVisibleCLabel (CC_Label _)		= True
externallyVisibleCLabel (CCS_Label _)		= True
697
externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
698
externallyVisibleCLabel (HpcTicksLabel _)	= True
699
externallyVisibleCLabel (LargeBitmapLabel _)    = False
700
externallyVisibleCLabel (LargeSRTLabel _)	= False
701
702
703
704
705
706
707

-- -----------------------------------------------------------------------------
-- Finding the "type" of a CLabel 

-- For generating correct types in label declarations:

data CLabelType
708
709
710
711
712
713
714
715
716
717
718
719
720
  = 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
721

722
723
724

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

idInfoLabelType info =
746
  case info of
747
    InfoTable  	  -> DataLabel
748
    Closure    	  -> GcPtrLabel
749
750
    ConInfoTable  -> DataLabel
    StaticInfoTable -> DataLabel
751
    ClosureTable  -> DataLabel
752
    RednCounts    -> DataLabel
753
754
755
756
757
758
759
760
761
762
763
    _	          -> 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.

764
765
labelDynamic :: PackageId -> CLabel -> Bool
labelDynamic this_pkg lbl =
766
  case lbl of
767
768
769
   -- is the RTS in a DLL or not?
   RtsLabel _  	     	-> not opt_Static && (this_pkg /= rtsPackageId)

770
771
772
   IdLabel n _ k     	-> isDllName this_pkg n

#if mingw32_TARGET_OS
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
   -- 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)

788
789
790
#else
   -- On Mac OS X and on ELF platforms, false positives are OK,
   -- so we claim that all foreign imports come from dynamic libraries
791
   ForeignLabel _ _ _ _ -> True
792

793
794
   CmmLabel pkg _ _     -> True 

795
#endif
796
   PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
797

798
   -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
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
840
841
842
843
844
845
846
847
   _ 		     -> 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
848
849
850
instance Outputable CLabel where
  ppr = pprCLabel

851
852
853
854
855
856
857
858
859
pprCLabel :: CLabel -> SDoc

#if ! OMIT_NATIVE_CODEGEN
pprCLabel (AsmTempLabel u)
  =  getPprStyle $ \ sty ->
     if asmStyle sty then 
	ptext asmTempLabelPrefix <> pprUnique u
     else
	char '_' <> pprUnique u
860
861
862
863
864

pprCLabel (DynamicLinkerLabel info lbl)
   = pprDynamicLinkerAsmLabel info lbl
   
pprCLabel PicBaseLabel
Ian Lynagh's avatar
Ian Lynagh committed
865
   = ptext (sLit "1b")
866
867
   
pprCLabel (DeadStripPreventer lbl)
Ian Lynagh's avatar
Ian Lynagh committed
868
   = pprCLabel lbl <> ptext (sLit "_dsp")
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
#endif

pprCLabel lbl = 
#if ! OMIT_NATIVE_CODEGEN
    getPprStyle $ \ sty ->
    if asmStyle sty then 
	maybe_underscore (pprAsmCLbl lbl)
    else
#endif
       pprCLbl lbl

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

884
#ifdef mingw32_TARGET_OS
885
886
-- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
-- (The C compiler does this itself).
887
pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
888
   = ftext fs <> char '@' <> int sz
889
#endif
890
891
892
pprAsmCLbl lbl
   = pprCLbl lbl

893
pprCLbl (StringLitLabel u)
Ian Lynagh's avatar
Ian Lynagh committed
894
  = pprUnique u <> ptext (sLit "_str")
895

896
pprCLbl (CaseLabel u CaseReturnPt)
Ian Lynagh's avatar
Ian Lynagh committed
897
  = hcat [pprUnique u, ptext (sLit "_ret")]
898
pprCLbl (CaseLabel u CaseReturnInfo)
Ian Lynagh's avatar
Ian Lynagh committed
899
  = hcat [pprUnique u, ptext (sLit "_info")]
900
pprCLbl (CaseLabel u (CaseAlt tag))
Ian Lynagh's avatar
Ian Lynagh committed
901
  = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
902
pprCLbl (CaseLabel u CaseDefault)
Ian Lynagh's avatar
Ian Lynagh committed
903
  = hcat [pprUnique u, ptext (sLit "_dflt")]
904

Ian Lynagh's avatar
Ian Lynagh committed
905
906
pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
907
908
909
910
-- 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.
        
911

912
913
914
pprCLbl (CmmLabel _ str CmmCode)	= ftext str
pprCLbl (CmmLabel _ str CmmData)	= ftext str
pprCLbl (CmmLabel _ str CmmGcPtr)	= ftext str
915
pprCLbl (CmmLabel _ str CmmPrimCall)	= ftext str
916

917
pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> ptext (sLit "_fast")
918

919
pprCLbl (RtsLabel (RtsSelectorInfoTable 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_info") 
			else (sLit "_noupd_info"))
924
925
926
	]

pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
Ian Lynagh's avatar
Ian Lynagh committed
927
  = hcat [ptext (sLit "stg_sel_"), text (show offset),
928
		ptext (if upd_reqd 
Ian Lynagh's avatar
Ian Lynagh committed
929
930
			then (sLit "_upd_entry") 
			else (sLit "_noupd_entry"))
931
932
	]

933
pprCLbl (RtsLabel (RtsApInfoTable 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_info") 
			else (sLit "_noupd_info"))
938
939
940
	]

pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
Ian Lynagh's avatar
Ian Lynagh committed
941
  = hcat [ptext (sLit "stg_ap_"), text (show arity),
942
		ptext (if upd_reqd 
Ian Lynagh's avatar
Ian Lynagh committed
943
944
			then (sLit "_upd_entry") 
			else (sLit "_noupd_entry"))
945
946
	]

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

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

953
pprCLbl (CmmLabel _ fs CmmRetInfo)
Ian Lynagh's avatar
Ian Lynagh committed
954
  = ftext fs <> ptext (sLit "_info")
955

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

pprCLbl (RtsLabel (RtsPrimOp primop)) 
960
  = ptext (sLit "stg_") <> ppr primop
961
962

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

965
pprCLbl (ForeignLabel str _ _ _)
966
967
  = ftext str

968
pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
969
970
971
972

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

973
pprCLbl (PlainModuleInitLabel mod)
Ian Lynagh's avatar
Ian Lynagh committed
974
   = ptext (sLit "__stginit_") <> ppr mod
975

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

979
980
981
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <>
	       (case x of
Ian Lynagh's avatar
Ian Lynagh committed
982
983
984
985
986
987
988
989
990
991
992
		       Closure	    	-> ptext (sLit "closure")
		       SRT		-> ptext (sLit "srt")
		       InfoTable    	-> ptext (sLit "info")
		       Entry	    	-> ptext (sLit "entry")
		       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")
993
994
995
996
997
		      )


pp_cSEP = char '_'

998
999
1000
1001
1002
1003
1004
1005

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"

1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
-- -----------------------------------------------------------------------------
-- 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
1019
     (sLit "$")
1020
#elif darwin_TARGET_OS
Ian Lynagh's avatar
Ian Lynagh committed
1021
     (sLit "L")
1022
#else
Ian Lynagh's avatar
Ian Lynagh committed
1023
     (sLit ".L")
1024
#endif
1025
1026
1027

pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc

1028
#if x86_64_TARGET_ARCH && darwin_TARGET_OS
1029
1030
1031
1032
pprDynamicLinkerAsmLabel CodeStub lbl
  = char 'L' <> pprCLabel lbl <> text "$stub"
pprDynamicLinkerAsmLabel SymbolPtr lbl
  = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
1033
1034
1035
1036
1037
1038
pprDynamicLinkerAsmLabel GotSymbolPtr lbl
  = pprCLabel lbl <> text "@GOTPCREL"
pprDynamicLinkerAsmLabel GotSymbolOffset lbl
  = pprCLabel lbl
pprDynamicLinkerAsmLabel _ _
  = panic "pprDynamicLinkerAsmLabel"
1039

1040
#elif darwin_TARGET_OS
1041
1042
pprDynamicLinkerAsmLabel CodeStub lbl
  = char 'L' <> pprCLabel lbl <> text "$stub"
1043
1044
1045
1046
pprDynamicLinkerAsmLabel SymbolPtr lbl
  = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
pprDynamicLinkerAsmLabel _ _
  = panic "pprDynamicLinkerAsmLabel"
1047

1048
#elif powerpc_TARGET_ARCH && elf_OBJ_FORMAT
1049
1050
1051
1052
pprDynamicLinkerAsmLabel CodeStub lbl
  = pprCLabel lbl <> text "@plt"
pprDynamicLinkerAsmLabel SymbolPtr lbl
  = text ".LC_" <> pprCLabel lbl
1053
1054
pprDynamicLinkerAsmLabel _ _
  = panic "pprDynamicLinkerAsmLabel"
1055

1056
#elif x86_64_TARGET_ARCH && elf_OBJ_FORMAT
1057
1058
1059
1060
1061
1062
pprDynamicLinkerAsmLabel CodeStub lbl
  = pprCLabel lbl <> text "@plt"
pprDynamicLinkerAsmLabel GotSymbolPtr lbl
  = pprCLabel lbl <> text "@gotpcrel"
pprDynamicLinkerAsmLabel GotSymbolOffset lbl
  = pprCLabel lbl
1063
1064
pprDynamicLinkerAsmLabel SymbolPtr lbl
  = text ".LC_" <> pprCLabel lbl
1065

1066
#elif elf_OBJ_FORMAT
1067
1068
pprDynamicLinkerAsmLabel CodeStub lbl
  = pprCLabel lbl <> text "@plt"
1069
1070
pprDynamicLinkerAsmLabel SymbolPtr lbl
  = text ".LC_" <> pprCLabel lbl
1071
1072
1073
1074
pprDynamicLinkerAsmLabel GotSymbolPtr lbl
  = pprCLabel lbl <> text "@got"
pprDynamicLinkerAsmLabel GotSymbolOffset lbl
  = pprCLabel lbl <> text "@gotoff"
1075

1076
1077
1078
#elif mingw32_TARGET_OS
pprDynamicLinkerAsmLabel SymbolPtr lbl
  = text "__imp_" <> pprCLabel lbl
1079
1080
pprDynamicLinkerAsmLabel _ _
  = panic "pprDynamicLinkerAsmLabel"
1081

1082
#else
1083
1084
pprDynamicLinkerAsmLabel _ _
  = panic "pprDynamicLinkerAsmLabel"
1085
#endif