94ae64af55ad131f1a282e278428dfeaa3dc6e2d
[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
525 -- -----------------------------------------------------------------------------
526 -- Finding the "type" of a CLabel
527
528 -- For generating correct types in label declarations:
529
530 data CLabelType
531 = CodeLabel
532 | DataLabel
533
534 labelType :: CLabel -> CLabelType
535 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
536 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
537 labelType (RtsLabel (RtsData _)) = DataLabel
538 labelType (RtsLabel (RtsCode _)) = CodeLabel
539 labelType (RtsLabel (RtsInfo _)) = DataLabel
540 labelType (RtsLabel (RtsEntry _)) = CodeLabel
541 labelType (RtsLabel (RtsRetInfo _)) = DataLabel
542 labelType (RtsLabel (RtsRet _)) = CodeLabel
543 labelType (RtsLabel (RtsDataFS _)) = DataLabel
544 labelType (RtsLabel (RtsCodeFS _)) = CodeLabel
545 labelType (RtsLabel (RtsInfoFS _)) = DataLabel
546 labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
547 labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
548 labelType (RtsLabel (RtsRetFS _)) = CodeLabel
549 labelType (RtsLabel (RtsApFast _)) = CodeLabel
550 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
551 labelType (CaseLabel _ _) = CodeLabel
552 labelType (ModuleInitLabel _ _ _) = CodeLabel
553 labelType (PlainModuleInitLabel _ _) = CodeLabel
554 labelType (LargeSRTLabel _) = DataLabel
555 labelType (LargeBitmapLabel _) = DataLabel
556
557 labelType (IdLabel _ info) = idInfoLabelType info
558 labelType (DynIdLabel _ info) = idInfoLabelType info
559 labelType _ = DataLabel
560
561 idInfoLabelType info =
562 case info of
563 InfoTable -> DataLabel
564 Closure -> DataLabel
565 ConInfoTable -> DataLabel
566 StaticInfoTable -> DataLabel
567 ClosureTable -> DataLabel
568 -- krc: aie! a ticky counter label is data
569 RednCounts -> DataLabel
570 _ -> CodeLabel
571
572
573 -- -----------------------------------------------------------------------------
574 -- Does a CLabel need dynamic linkage?
575
576 -- When referring to data in code, we need to know whether
577 -- that data resides in a DLL or not. [Win32 only.]
578 -- @labelDynamic@ returns @True@ if the label is located
579 -- in a DLL, be it a data reference or not.
580
581 labelDynamic :: CLabel -> Bool
582 labelDynamic lbl =
583 case lbl of
584 RtsLabel _ -> not opt_Static -- i.e., is the RTS in a DLL or not?
585 IdLabel n k -> False
586 DynIdLabel n k -> True
587 #if mingw32_TARGET_OS
588 ForeignLabel _ _ d -> d
589 #else
590 -- On Mac OS X and on ELF platforms, false positives are OK,
591 -- so we claim that all foreign imports come from dynamic libraries
592 ForeignLabel _ _ _ -> True
593 #endif
594 ModuleInitLabel m _ dyn -> not opt_Static && dyn
595 PlainModuleInitLabel m dyn -> not opt_Static && dyn
596
597 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
598 _ -> False
599
600 {-
601 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
602 right places. It is used to detect when the abstractC statement of an
603 CCodeBlock actually contains the code for a slow entry point. -- HWL
604
605 We need at least @Eq@ for @CLabels@, because we want to avoid
606 duplicate declarations in generating C (see @labelSeenTE@ in
607 @PprAbsC@).
608 -}
609
610 -----------------------------------------------------------------------------
611 -- Printing out CLabels.
612
613 {-
614 Convention:
615
616 <name>_<type>
617
618 where <name> is <Module>_<name> for external names and <unique> for
619 internal names. <type> is one of the following:
620
621 info Info table
622 srt Static reference table
623 srtd Static reference table descriptor
624 entry Entry code (function, closure)
625 slow Slow entry code (if any)
626 ret Direct return address
627 vtbl Vector table
628 <n>_alt Case alternative (tag n)
629 dflt Default case alternative
630 btm Large bitmap vector
631 closure Static closure
632 con_entry Dynamic Constructor entry code
633 con_info Dynamic Constructor info table
634 static_entry Static Constructor entry code
635 static_info Static Constructor info table
636 sel_info Selector info table
637 sel_entry Selector entry code
638 cc Cost centre
639 ccs Cost centre stack
640
641 Many of these distinctions are only for documentation reasons. For
642 example, _ret is only distinguished from _entry to make it easy to
643 tell whether a code fragment is a return point or a closure/function
644 entry.
645 -}
646
647 instance Outputable CLabel where
648 ppr = pprCLabel
649
650 pprCLabel :: CLabel -> SDoc
651
652 #if ! OMIT_NATIVE_CODEGEN
653 pprCLabel (AsmTempLabel u)
654 = getPprStyle $ \ sty ->
655 if asmStyle sty then
656 ptext asmTempLabelPrefix <> pprUnique u
657 else
658 char '_' <> pprUnique u
659
660 pprCLabel (DynamicLinkerLabel info lbl)
661 = pprDynamicLinkerAsmLabel info lbl
662
663 pprCLabel PicBaseLabel
664 = ptext SLIT("1b")
665
666 pprCLabel (DeadStripPreventer lbl)
667 = pprCLabel lbl <> ptext SLIT("_dsp")
668 #endif
669
670 pprCLabel lbl =
671 #if ! OMIT_NATIVE_CODEGEN
672 getPprStyle $ \ sty ->
673 if asmStyle sty then
674 maybe_underscore (pprAsmCLbl lbl)
675 else
676 #endif
677 pprCLbl lbl
678
679 maybe_underscore doc
680 | underscorePrefix = pp_cSEP <> doc
681 | otherwise = doc
682
683 #ifdef mingw32_TARGET_OS
684 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
685 -- (The C compiler does this itself).
686 pprAsmCLbl (ForeignLabel fs (Just sz) _)
687 = ftext fs <> char '@' <> int sz
688 #endif
689 pprAsmCLbl lbl
690 = pprCLbl lbl
691
692 pprCLbl (StringLitLabel u)
693 = pprUnique u <> ptext SLIT("_str")
694
695 pprCLbl (CaseLabel u CaseReturnPt)
696 = hcat [pprUnique u, ptext SLIT("_ret")]
697 pprCLbl (CaseLabel u CaseReturnInfo)
698 = hcat [pprUnique u, ptext SLIT("_info")]
699 pprCLbl (CaseLabel u (CaseAlt tag))
700 = hcat [pprUnique u, pp_cSEP, int tag, ptext SLIT("_alt")]
701 pprCLbl (CaseLabel u CaseDefault)
702 = hcat [pprUnique u, ptext SLIT("_dflt")]
703
704 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext SLIT("srtd")
705 pprCLbl (LargeBitmapLabel u) = pprUnique u <> pp_cSEP <> ptext SLIT("btm")
706
707 pprCLbl (RtsLabel (RtsCode str)) = ptext str
708 pprCLbl (RtsLabel (RtsData str)) = ptext str
709 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
710 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
711
712 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext SLIT("_fast")
713
714 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
715 = hcat [ptext SLIT("stg_sel_"), text (show offset),
716 ptext (if upd_reqd
717 then SLIT("_upd_info")
718 else SLIT("_noupd_info"))
719 ]
720
721 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
722 = hcat [ptext SLIT("stg_sel_"), text (show offset),
723 ptext (if upd_reqd
724 then SLIT("_upd_entry")
725 else SLIT("_noupd_entry"))
726 ]
727
728 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
729 = hcat [ptext SLIT("stg_ap_"), text (show arity),
730 ptext (if upd_reqd
731 then SLIT("_upd_info")
732 else SLIT("_noupd_info"))
733 ]
734
735 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
736 = hcat [ptext SLIT("stg_ap_"), text (show arity),
737 ptext (if upd_reqd
738 then SLIT("_upd_entry")
739 else SLIT("_noupd_entry"))
740 ]
741
742 pprCLbl (RtsLabel (RtsInfo fs))
743 = ptext fs <> ptext SLIT("_info")
744
745 pprCLbl (RtsLabel (RtsEntry fs))
746 = ptext fs <> ptext SLIT("_entry")
747
748 pprCLbl (RtsLabel (RtsRetInfo fs))
749 = ptext fs <> ptext SLIT("_info")
750
751 pprCLbl (RtsLabel (RtsRet fs))
752 = ptext fs <> ptext SLIT("_ret")
753
754 pprCLbl (RtsLabel (RtsInfoFS fs))
755 = ftext fs <> ptext SLIT("_info")
756
757 pprCLbl (RtsLabel (RtsEntryFS fs))
758 = ftext fs <> ptext SLIT("_entry")
759
760 pprCLbl (RtsLabel (RtsRetInfoFS fs))
761 = ftext fs <> ptext SLIT("_info")
762
763 pprCLbl (RtsLabel (RtsRetFS fs))
764 = ftext fs <> ptext SLIT("_ret")
765
766 pprCLbl (RtsLabel (RtsPrimOp primop))
767 = ppr primop <> ptext SLIT("_fast")
768
769 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
770 = ptext SLIT("SLOW_CALL_") <> text pat <> ptext SLIT("_ctr")
771
772 pprCLbl ModuleRegdLabel
773 = ptext SLIT("_module_registered")
774
775 pprCLbl (ForeignLabel str _ _)
776 = ftext str
777
778 pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor
779 pprCLbl (DynIdLabel name flavor) = ppr name <> ppIdFlavor flavor
780
781 pprCLbl (CC_Label cc) = ppr cc
782 pprCLbl (CCS_Label ccs) = ppr ccs
783
784 pprCLbl (ModuleInitLabel mod way _)
785 = ptext SLIT("__stginit_") <> ppr mod
786 <> char '_' <> text way
787 pprCLbl (PlainModuleInitLabel mod _)
788 = ptext SLIT("__stginit_") <> ppr mod
789
790 pprCLbl (HpcTicksLabel mod)
791 = ptext SLIT("_hpc_tickboxes_") <> ppr mod <> ptext SLIT("_hpc")
792
793 pprCLbl HpcModuleNameLabel
794 = ptext SLIT("_hpc_module_name_str")
795
796 ppIdFlavor :: IdLabelInfo -> SDoc
797 ppIdFlavor x = pp_cSEP <>
798 (case x of
799 Closure -> ptext SLIT("closure")
800 SRT -> ptext SLIT("srt")
801 InfoTable -> ptext SLIT("info")
802 Entry -> ptext SLIT("entry")
803 Slow -> ptext SLIT("slow")
804 RednCounts -> ptext SLIT("ct")
805 ConEntry -> ptext SLIT("con_entry")
806 ConInfoTable -> ptext SLIT("con_info")
807 StaticConEntry -> ptext SLIT("static_entry")
808 StaticInfoTable -> ptext SLIT("static_info")
809 ClosureTable -> ptext SLIT("closure_tbl")
810 )
811
812
813 pp_cSEP = char '_'
814
815 -- -----------------------------------------------------------------------------
816 -- Machine-dependent knowledge about labels.
817
818 underscorePrefix :: Bool -- leading underscore on assembler labels?
819 underscorePrefix = (cLeadingUnderscore == "YES")
820
821 asmTempLabelPrefix :: LitString -- for formatting labels
822 asmTempLabelPrefix =
823 #if alpha_TARGET_OS
824 {- The alpha assembler likes temporary labels to look like $L123
825 instead of L123. (Don't toss the L, because then Lf28
826 turns into $f28.)
827 -}
828 SLIT("$")
829 #elif darwin_TARGET_OS
830 SLIT("L")
831 #else
832 SLIT(".L")
833 #endif
834
835 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
836
837 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
838 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
839 = pprCLabel lbl <> text "@GOTPCREL"
840 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
841 = pprCLabel lbl
842 pprDynamicLinkerAsmLabel _ _
843 = panic "pprDynamicLinkerAsmLabel"
844 #elif darwin_TARGET_OS
845 pprDynamicLinkerAsmLabel CodeStub lbl
846 = char 'L' <> pprCLabel lbl <> text "$stub"
847 pprDynamicLinkerAsmLabel SymbolPtr lbl
848 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
849 pprDynamicLinkerAsmLabel _ _
850 = panic "pprDynamicLinkerAsmLabel"
851 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
852 pprDynamicLinkerAsmLabel CodeStub lbl
853 = pprCLabel lbl <> text "@plt"
854 pprDynamicLinkerAsmLabel SymbolPtr lbl
855 = text ".LC_" <> pprCLabel lbl
856 pprDynamicLinkerAsmLabel _ _
857 = panic "pprDynamicLinkerAsmLabel"
858 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
859 pprDynamicLinkerAsmLabel CodeStub lbl
860 = pprCLabel lbl <> text "@plt"
861 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
862 = pprCLabel lbl <> text "@gotpcrel"
863 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
864 = pprCLabel lbl
865 pprDynamicLinkerAsmLabel SymbolPtr lbl
866 = text ".LC_" <> pprCLabel lbl
867 #elif linux_TARGET_OS
868 pprDynamicLinkerAsmLabel CodeStub lbl
869 = pprCLabel lbl <> text "@plt"
870 pprDynamicLinkerAsmLabel SymbolPtr lbl
871 = text ".LC_" <> pprCLabel lbl
872 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
873 = pprCLabel lbl <> text "@got"
874 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
875 = pprCLabel lbl <> text "@gotoff"
876 #elif mingw32_TARGET_OS
877 pprDynamicLinkerAsmLabel SymbolPtr lbl
878 = text "__imp_" <> pprCLabel lbl
879 pprDynamicLinkerAsmLabel _ _
880 = panic "pprDynamicLinkerAsmLabel"
881 #else
882 pprDynamicLinkerAsmLabel _ _
883 = panic "pprDynamicLinkerAsmLabel"
884 #endif