Implemented and fixed bugs in CmmInfo handling
[ghc.git] / compiler / cmm / CLabel.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Object-file symbols (called CLabel for histerical raisins).
4 --
5 -- (c) The University of Glasgow 2004-2006
6 --
7 -----------------------------------------------------------------------------
8
9 module CLabel (
10 CLabel, -- abstract type
11
12 mkClosureLabel,
13 mkSRTLabel,
14 mkInfoTableLabel,
15 mkEntryLabel,
16 mkSlowEntryLabel,
17 mkConEntryLabel,
18 mkStaticConEntryLabel,
19 mkRednCountsLabel,
20 mkConInfoTableLabel,
21 mkStaticInfoTableLabel,
22 mkLargeSRTLabel,
23 mkApEntryLabel,
24 mkApInfoTableLabel,
25 mkClosureTableLabel,
26
27 mkLocalClosureLabel,
28 mkLocalInfoTableLabel,
29 mkLocalEntryLabel,
30 mkLocalConEntryLabel,
31 mkLocalStaticConEntryLabel,
32 mkLocalConInfoTableLabel,
33 mkLocalStaticInfoTableLabel,
34 mkLocalClosureTableLabel,
35
36 mkReturnPtLabel,
37 mkReturnInfoLabel,
38 mkAltLabel,
39 mkDefaultLabel,
40 mkBitmapLabel,
41 mkStringLitLabel,
42
43 mkAsmTempLabel,
44
45 mkModuleInitLabel,
46 mkPlainModuleInitLabel,
47
48 mkSplitMarkerLabel,
49 mkDirty_MUT_VAR_Label,
50 mkUpdInfoLabel,
51 mkIndStaticInfoLabel,
52 mkMainCapabilityLabel,
53 mkMAP_FROZEN_infoLabel,
54 mkMAP_DIRTY_infoLabel,
55 mkEMPTY_MVAR_infoLabel,
56
57 mkTopTickyCtrLabel,
58 mkCAFBlackHoleInfoTableLabel,
59 mkSECAFBlackHoleInfoTableLabel,
60 mkRtsPrimOpLabel,
61 mkRtsSlowTickyCtrLabel,
62
63 moduleRegdLabel,
64
65 mkSelectorInfoLabel,
66 mkSelectorEntryLabel,
67
68 mkRtsInfoLabel,
69 mkRtsEntryLabel,
70 mkRtsRetInfoLabel,
71 mkRtsRetLabel,
72 mkRtsCodeLabel,
73 mkRtsDataLabel,
74
75 mkRtsInfoLabelFS,
76 mkRtsEntryLabelFS,
77 mkRtsRetInfoLabelFS,
78 mkRtsRetLabelFS,
79 mkRtsCodeLabelFS,
80 mkRtsDataLabelFS,
81
82 mkRtsApFastLabel,
83
84 mkForeignLabel,
85
86 mkCCLabel, mkCCSLabel,
87
88 DynamicLinkerLabelInfo(..),
89 mkDynamicLinkerLabel,
90 dynamicLinkerLabelInfo,
91
92 mkPicBaseLabel,
93 mkDeadStripPreventer,
94
95 mkHpcTicksLabel,
96 mkHpcModuleNameLabel,
97
98 infoLblToEntryLbl, entryLblToInfoLbl,
99 needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
100 CLabelType(..), labelType, labelDynamic,
101
102 pprCLabel
103 ) where
104
105
106 #include "HsVersions.h"
107
108 import StaticFlags
109 import Packages
110 import DataCon
111 import PackageConfig
112 import Module
113 import Name
114 import Unique
115 import PrimOp
116 import Config
117 import CostCentre
118 import Outputable
119 import FastString
120
121 -- -----------------------------------------------------------------------------
122 -- The CLabel type
123
124 {-
125 CLabel is an abstract type that supports the following operations:
126
127 - Pretty printing
128
129 - In a C file, does it need to be declared before use? (i.e. is it
130 guaranteed to be already in scope in the places we need to refer to it?)
131
132 - If it needs to be declared, what type (code or data) should it be
133 declared to have?
134
135 - Is it visible outside this object file or not?
136
137 - Is it "dynamic" (see details below)
138
139 - Eq and Ord, so that we can make sets of CLabels (currently only
140 used in outputting C as far as I can tell, to avoid generating
141 more than one declaration for any given label).
142
143 - Converting an info table label into an entry label.
144 -}
145
146 data CLabel
147 = IdLabel -- A family of labels related to the
148 Name -- definition of a particular Id or Con
149 IdLabelInfo
150
151 | DynIdLabel -- like IdLabel, but in a separate package,
152 Name -- and might therefore need a dynamic
153 IdLabelInfo -- reference.
154
155 | CaseLabel -- A family of labels related to a particular
156 -- case expression.
157 {-# UNPACK #-} !Unique -- Unique says which case expression
158 CaseLabelInfo
159
160 | AsmTempLabel
161 {-# UNPACK #-} !Unique
162
163 | StringLitLabel
164 {-# UNPACK #-} !Unique
165
166 | ModuleInitLabel
167 Module -- the module name
168 String -- its "way"
169 Bool -- True <=> is in a different package
170 -- at some point we might want some kind of version number in
171 -- the module init label, to guard against compiling modules in
172 -- the wrong order. We can't use the interface file version however,
173 -- because we don't always recompile modules which depend on a module
174 -- whose version has changed.
175
176 | PlainModuleInitLabel -- without the vesrion & way info
177 Module
178 Bool -- True <=> is in a different package
179
180 | ModuleRegdLabel
181
182 | RtsLabel RtsLabelInfo
183
184 | ForeignLabel FastString -- a 'C' (or otherwise foreign) label
185 (Maybe Int) -- possible '@n' suffix for stdcall functions
186 -- When generating C, the '@n' suffix is omitted, but when
187 -- generating assembler we must add it to the label.
188 Bool -- True <=> is dynamic
189
190 | CC_Label CostCentre
191 | CCS_Label CostCentreStack
192
193 -- Dynamic Linking in the NCG:
194 -- generated and used inside the NCG only,
195 -- see module PositionIndependentCode for details.
196
197 | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
198 -- special variants of a label used for dynamic linking
199
200 | PicBaseLabel -- a label used as a base for PIC calculations
201 -- on some platforms.
202 -- It takes the form of a local numeric
203 -- assembler label '1'; it is pretty-printed
204 -- as 1b, referring to the previous definition
205 -- of 1: in the assembler source file.
206
207 | DeadStripPreventer CLabel
208 -- label before an info table to prevent excessive dead-stripping on darwin
209
210 | HpcTicksLabel Module -- Per-module table of tick locations
211 | HpcModuleNameLabel -- Per-module name of the module for Hpc
212
213 | LargeSRTLabel -- Label of an StgLargeSRT
214 {-# UNPACK #-} !Unique
215
216 | LargeBitmapLabel -- A bitmap (function or case return)
217 {-# UNPACK #-} !Unique
218
219 deriving (Eq, Ord)
220
221 data IdLabelInfo
222 = Closure -- Label for closure
223 | SRT -- Static reference table
224 | InfoTable -- Info tables for closures; always read-only
225 | Entry -- entry point
226 | Slow -- slow entry point
227
228 | RednCounts -- Label of place to keep Ticky-ticky info for
229 -- this Id
230
231 | ConEntry -- constructor entry point
232 | ConInfoTable -- corresponding info table
233 | StaticConEntry -- static constructor entry point
234 | StaticInfoTable -- corresponding info table
235
236 | ClosureTable -- table of closures for Enum tycons
237
238 deriving (Eq, Ord)
239
240
241 data CaseLabelInfo
242 = CaseReturnPt
243 | CaseReturnInfo
244 | CaseAlt ConTag
245 | CaseDefault
246 deriving (Eq, Ord)
247
248
249 data RtsLabelInfo
250 = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- Selector thunks
251 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
252
253 | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- AP thunks
254 | RtsApEntry Bool{-updatable-} Int{-arity-}
255
256 | RtsPrimOp PrimOp
257
258 | RtsInfo LitString -- misc rts info tables
259 | RtsEntry LitString -- misc rts entry points
260 | RtsRetInfo LitString -- misc rts ret info tables
261 | RtsRet LitString -- misc rts return points
262 | RtsData LitString -- misc rts data bits, eg CHARLIKE_closure
263 | RtsCode LitString -- misc rts code
264
265 | RtsInfoFS FastString -- misc rts info tables
266 | RtsEntryFS FastString -- misc rts entry points
267 | RtsRetInfoFS FastString -- misc rts ret info tables
268 | RtsRetFS FastString -- misc rts return points
269 | RtsDataFS FastString -- misc rts data bits, eg CHARLIKE_closure
270 | RtsCodeFS FastString -- misc rts code
271
272 | RtsApFast LitString -- _fast versions of generic apply
273
274 | RtsSlowTickyCtr String
275
276 deriving (Eq, Ord)
277 -- NOTE: Eq on LitString compares the pointer only, so this isn't
278 -- a real equality.
279
280 data DynamicLinkerLabelInfo
281 = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
282 | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
283 | GotSymbolPtr -- ELF: foo@got
284 | GotSymbolOffset -- ELF: foo@gotoff
285
286 deriving (Eq, Ord)
287
288 -- -----------------------------------------------------------------------------
289 -- Constructing CLabels
290
291 -- These are always local:
292 mkSRTLabel name = IdLabel name SRT
293 mkSlowEntryLabel name = IdLabel name Slow
294 mkRednCountsLabel name = IdLabel name RednCounts
295
296 -- These have local & (possibly) external variants:
297 mkLocalClosureLabel name = IdLabel name Closure
298 mkLocalInfoTableLabel name = IdLabel name InfoTable
299 mkLocalEntryLabel name = IdLabel name Entry
300 mkLocalClosureTableLabel name = IdLabel name ClosureTable
301
302 mkClosureLabel this_pkg name
303 | isDllName this_pkg name = DynIdLabel name Closure
304 | otherwise = IdLabel name Closure
305
306 mkInfoTableLabel this_pkg name
307 | isDllName this_pkg name = DynIdLabel name InfoTable
308 | otherwise = IdLabel name InfoTable
309
310 mkEntryLabel this_pkg name
311 | isDllName this_pkg name = DynIdLabel name Entry
312 | otherwise = IdLabel name Entry
313
314 mkClosureTableLabel this_pkg name
315 | isDllName this_pkg name = DynIdLabel name ClosureTable
316 | otherwise = IdLabel name ClosureTable
317
318 mkLocalConInfoTableLabel con = IdLabel con ConInfoTable
319 mkLocalConEntryLabel con = IdLabel con ConEntry
320 mkLocalStaticInfoTableLabel con = IdLabel con StaticInfoTable
321 mkLocalStaticConEntryLabel con = IdLabel con StaticConEntry
322
323 mkConInfoTableLabel name False = IdLabel name ConInfoTable
324 mkConInfoTableLabel name True = DynIdLabel name ConInfoTable
325
326 mkStaticInfoTableLabel name False = IdLabel name StaticInfoTable
327 mkStaticInfoTableLabel name True = DynIdLabel name StaticInfoTable
328
329 mkConEntryLabel this_pkg name
330 | isDllName this_pkg name = DynIdLabel name ConEntry
331 | otherwise = IdLabel name ConEntry
332
333 mkStaticConEntryLabel this_pkg name
334 | isDllName this_pkg name = DynIdLabel name StaticConEntry
335 | otherwise = IdLabel name StaticConEntry
336
337 mkLargeSRTLabel uniq = LargeSRTLabel uniq
338 mkBitmapLabel uniq = LargeBitmapLabel uniq
339
340 mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
341 mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
342 mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
343 mkDefaultLabel uniq = CaseLabel uniq CaseDefault
344
345 mkStringLitLabel = StringLitLabel
346 mkAsmTempLabel = AsmTempLabel
347
348 mkModuleInitLabel :: PackageId -> Module -> String -> CLabel
349 mkModuleInitLabel this_pkg mod way
350 = ModuleInitLabel mod way $! modulePackageId mod /= this_pkg
351
352 mkPlainModuleInitLabel :: PackageId -> Module -> CLabel
353 mkPlainModuleInitLabel this_pkg mod
354 = PlainModuleInitLabel mod $! modulePackageId mod /= this_pkg
355
356 -- Some fixed runtime system labels
357
358 mkSplitMarkerLabel = RtsLabel (RtsCode SLIT("__stg_split_marker"))
359 mkDirty_MUT_VAR_Label = RtsLabel (RtsCode SLIT("dirty_MUT_VAR"))
360 mkUpdInfoLabel = RtsLabel (RtsInfo SLIT("stg_upd_frame"))
361 mkIndStaticInfoLabel = RtsLabel (RtsInfo SLIT("stg_IND_STATIC"))
362 mkMainCapabilityLabel = RtsLabel (RtsData SLIT("MainCapability"))
363 mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN0"))
364 mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_DIRTY"))
365 mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo SLIT("stg_EMPTY_MVAR"))
366
367 mkTopTickyCtrLabel = RtsLabel (RtsData SLIT("top_ct"))
368 mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo SLIT("stg_CAF_BLACKHOLE"))
369 mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
370 RtsLabel (RtsInfo SLIT("stg_SE_CAF_BLACKHOLE"))
371 else -- RTS won't have info table unless -ticky is on
372 panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
373 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
374
375 moduleRegdLabel = ModuleRegdLabel
376
377 mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
378 mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
379
380 mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
381 mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
382
383 -- Foreign labels
384
385 mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel
386 mkForeignLabel str mb_sz is_dynamic = ForeignLabel str mb_sz is_dynamic
387
388 -- Cost centres etc.
389
390 mkCCLabel cc = CC_Label cc
391 mkCCSLabel ccs = CCS_Label ccs
392
393 mkRtsInfoLabel str = RtsLabel (RtsInfo str)
394 mkRtsEntryLabel str = RtsLabel (RtsEntry str)
395 mkRtsRetInfoLabel str = RtsLabel (RtsRetInfo str)
396 mkRtsRetLabel str = RtsLabel (RtsRet str)
397 mkRtsCodeLabel str = RtsLabel (RtsCode str)
398 mkRtsDataLabel str = RtsLabel (RtsData str)
399
400 mkRtsInfoLabelFS str = RtsLabel (RtsInfoFS str)
401 mkRtsEntryLabelFS str = RtsLabel (RtsEntryFS str)
402 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
403 mkRtsRetLabelFS str = RtsLabel (RtsRetFS str)
404 mkRtsCodeLabelFS str = RtsLabel (RtsCodeFS str)
405 mkRtsDataLabelFS str = RtsLabel (RtsDataFS str)
406
407 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
408
409 mkRtsSlowTickyCtrLabel :: String -> CLabel
410 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
411
412 -- Coverage
413
414 mkHpcTicksLabel = HpcTicksLabel
415 mkHpcModuleNameLabel = HpcModuleNameLabel
416
417 -- Dynamic linking
418
419 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
420 mkDynamicLinkerLabel = DynamicLinkerLabel
421
422 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
423 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
424 dynamicLinkerLabelInfo _ = Nothing
425
426 -- Position independent code
427
428 mkPicBaseLabel :: CLabel
429 mkPicBaseLabel = PicBaseLabel
430
431 mkDeadStripPreventer :: CLabel -> CLabel
432 mkDeadStripPreventer lbl = DeadStripPreventer lbl
433
434 -- -----------------------------------------------------------------------------
435 -- Converting info labels to entry labels.
436
437 infoLblToEntryLbl :: CLabel -> CLabel
438 infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
439 infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
440 infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
441 infoLblToEntryLbl (DynIdLabel n InfoTable) = DynIdLabel n Entry
442 infoLblToEntryLbl (DynIdLabel n ConInfoTable) = DynIdLabel n ConEntry
443 infoLblToEntryLbl (DynIdLabel n StaticInfoTable) = DynIdLabel n StaticConEntry
444 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
445 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
446 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
447 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
448 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
449 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
450
451 entryLblToInfoLbl :: CLabel -> CLabel
452 entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
453 entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
454 entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
455 entryLblToInfoLbl (DynIdLabel n Entry) = DynIdLabel n InfoTable
456 entryLblToInfoLbl (DynIdLabel n ConEntry) = DynIdLabel n ConInfoTable
457 entryLblToInfoLbl (DynIdLabel n StaticConEntry) = DynIdLabel n StaticInfoTable
458 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
459 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
460 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
461 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
462 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
463 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
464
465 -- -----------------------------------------------------------------------------
466 -- Does a CLabel need declaring before use or not?
467
468 needsCDecl :: CLabel -> Bool
469 -- False <=> it's pre-declared; don't bother
470 -- don't bother declaring SRT & Bitmap labels, we always make sure
471 -- they are defined before use.
472 needsCDecl (IdLabel _ SRT) = False
473 needsCDecl (LargeSRTLabel _) = False
474 needsCDecl (LargeBitmapLabel _) = False
475 needsCDecl (IdLabel _ _) = True
476 needsCDecl (DynIdLabel _ _) = True
477 needsCDecl (CaseLabel _ _) = True
478 needsCDecl (ModuleInitLabel _ _ _) = True
479 needsCDecl (PlainModuleInitLabel _ _) = True
480 needsCDecl ModuleRegdLabel = False
481
482 needsCDecl (StringLitLabel _) = False
483 needsCDecl (AsmTempLabel _) = False
484 needsCDecl (RtsLabel _) = False
485 needsCDecl (ForeignLabel _ _ _) = False
486 needsCDecl (CC_Label _) = True
487 needsCDecl (CCS_Label _) = True
488 needsCDecl (HpcTicksLabel _) = True
489 needsCDecl HpcModuleNameLabel = False
490
491 -- Whether the label is an assembler temporary:
492
493 isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
494 isAsmTemp (AsmTempLabel _) = True
495 isAsmTemp _ = False
496
497 maybeAsmTemp :: CLabel -> Maybe Unique
498 maybeAsmTemp (AsmTempLabel uq) = Just uq
499 maybeAsmTemp _ = Nothing
500
501 -- -----------------------------------------------------------------------------
502 -- Is a CLabel visible outside this object file or not?
503
504 -- From the point of view of the code generator, a name is
505 -- externally visible if it has to be declared as exported
506 -- in the .o file's symbol table; that is, made non-static.
507
508 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
509 externallyVisibleCLabel (CaseLabel _ _) = False
510 externallyVisibleCLabel (StringLitLabel _) = False
511 externallyVisibleCLabel (AsmTempLabel _) = False
512 externallyVisibleCLabel (ModuleInitLabel _ _ _)= True
513 externallyVisibleCLabel (PlainModuleInitLabel _ _)= True
514 externallyVisibleCLabel ModuleRegdLabel = False
515 externallyVisibleCLabel (RtsLabel _) = True
516 externallyVisibleCLabel (ForeignLabel _ _ _) = True
517 externallyVisibleCLabel (IdLabel name _) = isExternalName name
518 externallyVisibleCLabel (DynIdLabel name _) = isExternalName name
519 externallyVisibleCLabel (CC_Label _) = True
520 externallyVisibleCLabel (CCS_Label _) = True
521 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
522 externallyVisibleCLabel (HpcTicksLabel _) = True
523 externallyVisibleCLabel HpcModuleNameLabel = False
524 externallyVisibleCLabel (LargeBitmapLabel _) = False
525 externallyVisibleCLabel (LargeSRTLabel _) = False
526
527 -- -----------------------------------------------------------------------------
528 -- Finding the "type" of a CLabel
529
530 -- For generating correct types in label declarations:
531
532 data CLabelType
533 = CodeLabel
534 | DataLabel
535
536 labelType :: CLabel -> CLabelType
537 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
538 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
539 labelType (RtsLabel (RtsData _)) = DataLabel
540 labelType (RtsLabel (RtsCode _)) = CodeLabel
541 labelType (RtsLabel (RtsInfo _)) = DataLabel
542 labelType (RtsLabel (RtsEntry _)) = CodeLabel
543 labelType (RtsLabel (RtsRetInfo _)) = DataLabel
544 labelType (RtsLabel (RtsRet _)) = CodeLabel
545 labelType (RtsLabel (RtsDataFS _)) = DataLabel
546 labelType (RtsLabel (RtsCodeFS _)) = CodeLabel
547 labelType (RtsLabel (RtsInfoFS _)) = DataLabel
548 labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
549 labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
550 labelType (RtsLabel (RtsRetFS _)) = CodeLabel
551 labelType (RtsLabel (RtsApFast _)) = CodeLabel
552 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
553 labelType (CaseLabel _ _) = CodeLabel
554 labelType (ModuleInitLabel _ _ _) = CodeLabel
555 labelType (PlainModuleInitLabel _ _) = CodeLabel
556 labelType (LargeSRTLabel _) = DataLabel
557 labelType (LargeBitmapLabel _) = DataLabel
558
559 labelType (IdLabel _ info) = idInfoLabelType info
560 labelType (DynIdLabel _ info) = idInfoLabelType info
561 labelType _ = DataLabel
562
563 idInfoLabelType info =
564 case info of
565 InfoTable -> DataLabel
566 Closure -> DataLabel
567 ConInfoTable -> DataLabel
568 StaticInfoTable -> DataLabel
569 ClosureTable -> DataLabel
570 -- krc: aie! a ticky counter label is data
571 RednCounts -> DataLabel
572 _ -> CodeLabel
573
574
575 -- -----------------------------------------------------------------------------
576 -- Does a CLabel need dynamic linkage?
577
578 -- When referring to data in code, we need to know whether
579 -- that data resides in a DLL or not. [Win32 only.]
580 -- @labelDynamic@ returns @True@ if the label is located
581 -- in a DLL, be it a data reference or not.
582
583 labelDynamic :: CLabel -> Bool
584 labelDynamic lbl =
585 case lbl of
586 RtsLabel _ -> not opt_Static -- i.e., is the RTS in a DLL or not?
587 IdLabel n k -> False
588 DynIdLabel n k -> True
589 #if mingw32_TARGET_OS
590 ForeignLabel _ _ d -> d
591 #else
592 -- On Mac OS X and on ELF platforms, false positives are OK,
593 -- so we claim that all foreign imports come from dynamic libraries
594 ForeignLabel _ _ _ -> True
595 #endif
596 ModuleInitLabel m _ dyn -> not opt_Static && dyn
597 PlainModuleInitLabel m dyn -> not opt_Static && dyn
598
599 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
600 _ -> False
601
602 {-
603 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
604 right places. It is used to detect when the abstractC statement of an
605 CCodeBlock actually contains the code for a slow entry point. -- HWL
606
607 We need at least @Eq@ for @CLabels@, because we want to avoid
608 duplicate declarations in generating C (see @labelSeenTE@ in
609 @PprAbsC@).
610 -}
611
612 -----------------------------------------------------------------------------
613 -- Printing out CLabels.
614
615 {-
616 Convention:
617
618 <name>_<type>
619
620 where <name> is <Module>_<name> for external names and <unique> for
621 internal names. <type> is one of the following:
622
623 info Info table
624 srt Static reference table
625 srtd Static reference table descriptor
626 entry Entry code (function, closure)
627 slow Slow entry code (if any)
628 ret Direct return address
629 vtbl Vector table
630 <n>_alt Case alternative (tag n)
631 dflt Default case alternative
632 btm Large bitmap vector
633 closure Static closure
634 con_entry Dynamic Constructor entry code
635 con_info Dynamic Constructor info table
636 static_entry Static Constructor entry code
637 static_info Static Constructor info table
638 sel_info Selector info table
639 sel_entry Selector entry code
640 cc Cost centre
641 ccs Cost centre stack
642
643 Many of these distinctions are only for documentation reasons. For
644 example, _ret is only distinguished from _entry to make it easy to
645 tell whether a code fragment is a return point or a closure/function
646 entry.
647 -}
648
649 instance Outputable CLabel where
650 ppr = pprCLabel
651
652 pprCLabel :: CLabel -> SDoc
653
654 #if ! OMIT_NATIVE_CODEGEN
655 pprCLabel (AsmTempLabel u)
656 = getPprStyle $ \ sty ->
657 if asmStyle sty then
658 ptext asmTempLabelPrefix <> pprUnique u
659 else
660 char '_' <> pprUnique u
661
662 pprCLabel (DynamicLinkerLabel info lbl)
663 = pprDynamicLinkerAsmLabel info lbl
664
665 pprCLabel PicBaseLabel
666 = ptext SLIT("1b")
667
668 pprCLabel (DeadStripPreventer lbl)
669 = pprCLabel lbl <> ptext SLIT("_dsp")
670 #endif
671
672 pprCLabel lbl =
673 #if ! OMIT_NATIVE_CODEGEN
674 getPprStyle $ \ sty ->
675 if asmStyle sty then
676 maybe_underscore (pprAsmCLbl lbl)
677 else
678 #endif
679 pprCLbl lbl
680
681 maybe_underscore doc
682 | underscorePrefix = pp_cSEP <> doc
683 | otherwise = doc
684
685 #ifdef mingw32_TARGET_OS
686 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
687 -- (The C compiler does this itself).
688 pprAsmCLbl (ForeignLabel fs (Just sz) _)
689 = ftext fs <> char '@' <> int sz
690 #endif
691 pprAsmCLbl lbl
692 = pprCLbl lbl
693
694 pprCLbl (StringLitLabel u)
695 = pprUnique u <> ptext SLIT("_str")
696
697 pprCLbl (CaseLabel u CaseReturnPt)
698 = hcat [pprUnique u, ptext SLIT("_ret")]
699 pprCLbl (CaseLabel u CaseReturnInfo)
700 = hcat [pprUnique u, ptext SLIT("_info")]
701 pprCLbl (CaseLabel u (CaseAlt tag))
702 = hcat [pprUnique u, pp_cSEP, int tag, ptext SLIT("_alt")]
703 pprCLbl (CaseLabel u CaseDefault)
704 = hcat [pprUnique u, ptext SLIT("_dflt")]
705
706 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext SLIT("srtd")
707 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext SLIT("btm")
708 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
709 -- until that gets resolved we'll just force them to start
710 -- with a letter so the label will be legal assmbly code.
711
712
713 pprCLbl (RtsLabel (RtsCode str)) = ptext str
714 pprCLbl (RtsLabel (RtsData str)) = ptext str
715 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
716 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
717
718 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext SLIT("_fast")
719
720 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
721 = hcat [ptext SLIT("stg_sel_"), text (show offset),
722 ptext (if upd_reqd
723 then SLIT("_upd_info")
724 else SLIT("_noupd_info"))
725 ]
726
727 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
728 = hcat [ptext SLIT("stg_sel_"), text (show offset),
729 ptext (if upd_reqd
730 then SLIT("_upd_entry")
731 else SLIT("_noupd_entry"))
732 ]
733
734 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
735 = hcat [ptext SLIT("stg_ap_"), text (show arity),
736 ptext (if upd_reqd
737 then SLIT("_upd_info")
738 else SLIT("_noupd_info"))
739 ]
740
741 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
742 = hcat [ptext SLIT("stg_ap_"), text (show arity),
743 ptext (if upd_reqd
744 then SLIT("_upd_entry")
745 else SLIT("_noupd_entry"))
746 ]
747
748 pprCLbl (RtsLabel (RtsInfo fs))
749 = ptext fs <> ptext SLIT("_info")
750
751 pprCLbl (RtsLabel (RtsEntry fs))
752 = ptext fs <> ptext SLIT("_entry")
753
754 pprCLbl (RtsLabel (RtsRetInfo fs))
755 = ptext fs <> ptext SLIT("_info")
756
757 pprCLbl (RtsLabel (RtsRet fs))
758 = ptext fs <> ptext SLIT("_ret")
759
760 pprCLbl (RtsLabel (RtsInfoFS fs))
761 = ftext fs <> ptext SLIT("_info")
762
763 pprCLbl (RtsLabel (RtsEntryFS fs))
764 = ftext fs <> ptext SLIT("_entry")
765
766 pprCLbl (RtsLabel (RtsRetInfoFS fs))
767 = ftext fs <> ptext SLIT("_info")
768
769 pprCLbl (RtsLabel (RtsRetFS fs))
770 = ftext fs <> ptext SLIT("_ret")
771
772 pprCLbl (RtsLabel (RtsPrimOp primop))
773 = ppr primop <> ptext SLIT("_fast")
774
775 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
776 = ptext SLIT("SLOW_CALL_") <> text pat <> ptext SLIT("_ctr")
777
778 pprCLbl ModuleRegdLabel
779 = ptext SLIT("_module_registered")
780
781 pprCLbl (ForeignLabel str _ _)
782 = ftext str
783
784 pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor
785 pprCLbl (DynIdLabel name flavor) = ppr name <> ppIdFlavor flavor
786
787 pprCLbl (CC_Label cc) = ppr cc
788 pprCLbl (CCS_Label ccs) = ppr ccs
789
790 pprCLbl (ModuleInitLabel mod way _)
791 = ptext SLIT("__stginit_") <> ppr mod
792 <> char '_' <> text way
793 pprCLbl (PlainModuleInitLabel mod _)
794 = ptext SLIT("__stginit_") <> ppr mod
795
796 pprCLbl (HpcTicksLabel mod)
797 = ptext SLIT("_hpc_tickboxes_") <> ppr mod <> ptext SLIT("_hpc")
798
799 pprCLbl HpcModuleNameLabel
800 = ptext SLIT("_hpc_module_name_str")
801
802 ppIdFlavor :: IdLabelInfo -> SDoc
803 ppIdFlavor x = pp_cSEP <>
804 (case x of
805 Closure -> ptext SLIT("closure")
806 SRT -> ptext SLIT("srt")
807 InfoTable -> ptext SLIT("info")
808 Entry -> ptext SLIT("entry")
809 Slow -> ptext SLIT("slow")
810 RednCounts -> ptext SLIT("ct")
811 ConEntry -> ptext SLIT("con_entry")
812 ConInfoTable -> ptext SLIT("con_info")
813 StaticConEntry -> ptext SLIT("static_entry")
814 StaticInfoTable -> ptext SLIT("static_info")
815 ClosureTable -> ptext SLIT("closure_tbl")
816 )
817
818
819 pp_cSEP = char '_'
820
821 -- -----------------------------------------------------------------------------
822 -- Machine-dependent knowledge about labels.
823
824 underscorePrefix :: Bool -- leading underscore on assembler labels?
825 underscorePrefix = (cLeadingUnderscore == "YES")
826
827 asmTempLabelPrefix :: LitString -- for formatting labels
828 asmTempLabelPrefix =
829 #if alpha_TARGET_OS
830 {- The alpha assembler likes temporary labels to look like $L123
831 instead of L123. (Don't toss the L, because then Lf28
832 turns into $f28.)
833 -}
834 SLIT("$")
835 #elif darwin_TARGET_OS
836 SLIT("L")
837 #else
838 SLIT(".L")
839 #endif
840
841 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
842
843 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
844 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
845 = pprCLabel lbl <> text "@GOTPCREL"
846 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
847 = pprCLabel lbl
848 pprDynamicLinkerAsmLabel _ _
849 = panic "pprDynamicLinkerAsmLabel"
850 #elif darwin_TARGET_OS
851 pprDynamicLinkerAsmLabel CodeStub lbl
852 = char 'L' <> pprCLabel lbl <> text "$stub"
853 pprDynamicLinkerAsmLabel SymbolPtr lbl
854 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
855 pprDynamicLinkerAsmLabel _ _
856 = panic "pprDynamicLinkerAsmLabel"
857 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
858 pprDynamicLinkerAsmLabel CodeStub lbl
859 = pprCLabel lbl <> text "@plt"
860 pprDynamicLinkerAsmLabel SymbolPtr lbl
861 = text ".LC_" <> pprCLabel lbl
862 pprDynamicLinkerAsmLabel _ _
863 = panic "pprDynamicLinkerAsmLabel"
864 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
865 pprDynamicLinkerAsmLabel CodeStub lbl
866 = pprCLabel lbl <> text "@plt"
867 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
868 = pprCLabel lbl <> text "@gotpcrel"
869 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
870 = pprCLabel lbl
871 pprDynamicLinkerAsmLabel SymbolPtr lbl
872 = text ".LC_" <> pprCLabel lbl
873 #elif linux_TARGET_OS
874 pprDynamicLinkerAsmLabel CodeStub lbl
875 = pprCLabel lbl <> text "@plt"
876 pprDynamicLinkerAsmLabel SymbolPtr lbl
877 = text ".LC_" <> pprCLabel lbl
878 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
879 = pprCLabel lbl <> text "@got"
880 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
881 = pprCLabel lbl <> text "@gotoff"
882 #elif mingw32_TARGET_OS
883 pprDynamicLinkerAsmLabel SymbolPtr lbl
884 = text "__imp_" <> pprCLabel lbl
885 pprDynamicLinkerAsmLabel _ _
886 = panic "pprDynamicLinkerAsmLabel"
887 #else
888 pprDynamicLinkerAsmLabel _ _
889 = panic "pprDynamicLinkerAsmLabel"
890 #endif