2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CLabel.lhs,v 1.33 2000/04/13 11:56:35 simonpj Exp $
6 \section[CLabel]{@CLabel@: Information to make C Labels}
10 CLabel, -- abstract type
18 mkStaticConEntryLabel,
21 mkStaticInfoTableLabel,
41 mkBlackHoleInfoTableLabel,
42 mkCAFBlackHoleInfoTableLabel,
43 mkSECAFBlackHoleInfoTableLabel,
51 mkCC_Label, mkCCS_Label,
53 needsCDecl, isAsmTemp, externallyVisibleCLabel,
55 CLabelType(..), labelType, labelDynamic,
58 #if ! OMIT_NATIVE_CODEGEN
64 #include "HsVersions.h"
66 #if ! OMIT_NATIVE_CODEGEN
67 import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl )
70 import CmdLineOpts ( opt_Static, opt_DoTickyProfiling )
71 import CStrings ( pp_cSEP )
72 import DataCon ( ConTag, DataCon )
73 import Module ( ModuleName )
74 import Name ( Name, getName, isDllName, isExternallyVisibleName )
75 import TyCon ( TyCon )
76 import Unique ( pprUnique, Unique )
77 import PrimOp ( PrimOp, pprPrimOp )
78 import CostCentre ( CostCentre, CostCentreStack )
83 things we want to find out:
85 * should the labelled things be declared "static" (visible only in this file)?
87 * should it be declared "const" (read-only text space)?
89 * does it need declarations at all? (v common Prelude things are pre-declared)
91 * what type does it have? (for generating accurate enough C declarations
92 so that the C compiler won't complain).
96 = IdLabel -- A family of labels related to the
97 Name -- definition of a particular Id
100 | DataConLabel -- Ditto data constructors
104 | CaseLabel -- A family of labels related to a particular case expression
105 Unique -- Unique says which case expression
108 | TyConLabel TyCon -- currently only one kind of TyconLabel,
109 -- a 'Closure Table'.
111 | AsmTempLabel Unique
113 | ModuleInitLabel ModuleName
115 | RtsLabel RtsLabelInfo
117 | CC_Label CostCentre
118 | CCS_Label CostCentreStack
125 = Closure -- Label for (static???) closure
127 | SRT -- Static reference table
129 | InfoTbl -- Info table for a closure; always read-only
131 | EntryStd -- Thunk, or "slow", code entry point
133 | EntryFast Int -- entry pt when no arg satisfaction chk needed;
134 -- Int is the arity of the function (to be
135 -- encoded into the name)
137 -- Ticky-ticky counting
138 | RednCounts -- Label of place to keep reduction-count info for
142 data DataConLabelInfo
143 = ConEntry -- the only kind of entry pt for constructors
144 | ConInfoTbl -- corresponding info table
145 | StaticConEntry -- static constructor entry point
146 | StaticInfoTbl -- corresponding info table
159 = RtsShouldNeverHappenCode
161 | RtsBlackHoleInfoTbl FAST_STRING -- black hole with info table name
165 | RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-} -- Selector thunks
166 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
168 | RtsApInfoTbl Bool{-updatable-} Int{-arity-} -- AP thunks
169 | RtsApEntry Bool{-updatable-} Int{-arity-}
179 -- Label Type: for generating C declarations.
191 mkClosureLabel id = IdLabel id Closure
192 mkSRTLabel id = IdLabel id SRT
193 mkInfoTableLabel id = IdLabel id InfoTbl
194 mkStdEntryLabel id = IdLabel id EntryStd
195 mkFastEntryLabel id arity = ASSERT(arity > 0)
196 IdLabel id (EntryFast arity)
198 mkRednCountsLabel id = IdLabel id RednCounts
200 mkStaticInfoTableLabel con = DataConLabel con StaticInfoTbl
201 mkConInfoTableLabel con = DataConLabel con ConInfoTbl
202 mkConEntryLabel con = DataConLabel con ConEntry
203 mkStaticConEntryLabel con = DataConLabel con StaticConEntry
206 mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
207 mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
208 mkVecTblLabel uniq = CaseLabel uniq CaseVecTbl
209 mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
210 mkDefaultLabel uniq = CaseLabel uniq CaseDefault
211 mkBitmapLabel uniq = CaseLabel uniq CaseBitmap
213 mkClosureTblLabel tycon = TyConLabel tycon
215 mkAsmTempLabel = AsmTempLabel
217 mkModuleInitLabel = ModuleInitLabel
219 -- Some fixed runtime system labels
221 mkErrorStdEntryLabel = RtsLabel RtsShouldNeverHappenCode
222 mkUpdInfoLabel = RtsLabel RtsUpdInfo
223 mkTopTickyCtrLabel = RtsLabel RtsTopTickyCtr
224 mkBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("BLACKHOLE_info"))
225 mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("CAF_BLACKHOLE_info"))
226 mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
227 RtsLabel (RtsBlackHoleInfoTbl SLIT("SE_CAF_BLACKHOLE_info"))
228 else -- RTS won't have info table unless -ticky is on
229 panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
230 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
232 moduleRegdLabel = RtsLabel RtsModuleRegd
234 mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTbl upd off)
235 mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
237 mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTbl upd off)
238 mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
242 mkCC_Label cc = CC_Label cc
243 mkCCS_Label ccs = CCS_Label ccs
247 needsCDecl :: CLabel -> Bool -- False <=> it's pre-declared; don't bother
248 isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
249 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
252 @needsCDecl@ is @True@ unless the thing is a deeply-@PreludeCore@-ish
253 object. {\em Also:} No need to spit out labels for things generated
254 by the flattener (in @AbsCUtils@)---it is careful to ensure references
255 to them are always backwards. These are return-point and vector-table
258 Declarations for (non-prelude) @Id@-based things are needed because of
261 Declarations for direct return points are needed, because they may be
262 let-no-escapes, which can be recursive.
265 needsCDecl (IdLabel _ _) = True
266 needsCDecl (CaseLabel _ CaseReturnPt) = True
267 needsCDecl (DataConLabel _ _) = True
268 needsCDecl (CaseLabel _ _) = False
269 needsCDecl (TyConLabel _) = True
271 needsCDecl (AsmTempLabel _) = False
272 needsCDecl (ModuleInitLabel _) = False
273 needsCDecl (RtsLabel _) = False
274 needsCDecl (CC_Label _) = False
275 needsCDecl (CCS_Label _) = False
278 Whether the label is an assembler temporary:
281 isAsmTemp (AsmTempLabel _) = True
285 C ``static'' or not...
286 From the point of view of the code generator, a name is
287 externally visible if it has to be declared as exported
288 in the .o file's symbol table; that is, made non-static.
291 externallyVisibleCLabel (DataConLabel _ _) = True
292 externallyVisibleCLabel (TyConLabel tc) = True
293 externallyVisibleCLabel (CaseLabel _ _) = False
294 externallyVisibleCLabel (AsmTempLabel _) = False
295 externallyVisibleCLabel (ModuleInitLabel _)= True
296 externallyVisibleCLabel (RtsLabel RtsModuleRegd) = False --hack
297 externallyVisibleCLabel (RtsLabel _) = True
298 externallyVisibleCLabel (IdLabel id _) = isExternallyVisibleName id
299 externallyVisibleCLabel (CC_Label _) = False -- not strictly true
300 externallyVisibleCLabel (CCS_Label _) = False -- not strictly true
303 For generating correct types in label declarations...
306 labelType :: CLabel -> CLabelType
307 labelType (RtsLabel (RtsBlackHoleInfoTbl _)) = InfoTblType
308 labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = InfoTblType
309 labelType (RtsLabel (RtsApInfoTbl _ _)) = InfoTblType
310 labelType (RtsLabel RtsUpdInfo) = InfoTblType
311 labelType (CaseLabel _ CaseReturnInfo) = InfoTblType
312 labelType (CaseLabel _ CaseReturnPt) = CodeType
313 labelType (CaseLabel _ CaseVecTbl) = VecTblType
314 labelType (TyConLabel _) = ClosureTblType
316 labelType (IdLabel _ info) =
318 InfoTbl -> InfoTblType
319 Closure -> ClosureType
322 labelType (DataConLabel _ info) =
324 ConInfoTbl -> InfoTblType
325 StaticInfoTbl -> InfoTblType
328 labelType _ = DataType
331 When referring to data in code, we need to know whether
332 that data resides in a DLL or not. [Win32 only.]
333 @labelDynamic@ returns @True@ if the label is located
334 in a DLL, be it a data reference or not.
337 labelDynamic :: CLabel -> Bool
340 RtsLabel _ -> not opt_Static -- i.e., is the RTS in a DLL or not?
341 IdLabel n k -> isDllName n
342 DataConLabel n k -> isDllName n
343 TyConLabel tc -> isDllName (getName tc)
348 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
349 right places. It is used to detect when the abstractC statement of an
350 CCodeBlock actually contains the code for a slow entry point. -- HWL
352 We need at least @Eq@ for @CLabels@, because we want to avoid
353 duplicate declarations in generating C (see @labelSeenTE@ in
356 -----------------------------------------------------------------------------
357 Printing out CLabels.
363 where <name> is <Module>_<name> for external names and <unique> for
364 internal names. <type> is one of the following:
367 srt Static reference table
369 ret Direct return address
371 <n>_alt Case alternative (tag n)
372 dflt Default case alternative
373 btm Large bitmap vector
374 closure Static closure
375 con_entry Dynamic Constructor entry code
376 con_info Dynamic Constructor info table
377 static_entry Static Constructor entry code
378 static_info Static Constructor info table
379 sel_info Selector info table
380 sel_entry Selector entry code
382 ccs Cost centre stack
385 -- specialised for PprAsm: saves lots of arg passing in NCG
386 #if ! OMIT_NATIVE_CODEGEN
387 pprCLabel_asm = pprCLabel
390 pprCLabel :: CLabel -> SDoc
392 #if ! OMIT_NATIVE_CODEGEN
393 pprCLabel (AsmTempLabel u)
394 = text (fmtAsmLbl (show u))
398 #if ! OMIT_NATIVE_CODEGEN
399 getPprStyle $ \ sty ->
400 if asmStyle sty && underscorePrefix then
401 pp_cSEP <> pprCLbl lbl
406 pprCLbl (CaseLabel u CaseReturnPt)
407 = hcat [pprUnique u, pp_cSEP, ptext SLIT("ret")]
408 pprCLbl (CaseLabel u CaseReturnInfo)
409 = hcat [pprUnique u, pp_cSEP, ptext SLIT("info")]
410 pprCLbl (CaseLabel u CaseVecTbl)
411 = hcat [pprUnique u, pp_cSEP, ptext SLIT("vtbl")]
412 pprCLbl (CaseLabel u (CaseAlt tag))
413 = hcat [pprUnique u, pp_cSEP, int tag, pp_cSEP, ptext SLIT("alt")]
414 pprCLbl (CaseLabel u CaseDefault)
415 = hcat [pprUnique u, pp_cSEP, ptext SLIT("dflt")]
416 pprCLbl (CaseLabel u CaseBitmap)
417 = hcat [pprUnique u, pp_cSEP, ptext SLIT("btm")]
419 pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("stg_error_entry")
421 pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("Upd_frame_info")
423 pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct")
425 pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ptext info
427 pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
428 = hcat [ptext SLIT("__sel_"), text (show offset),
430 then SLIT("_upd_info")
431 else SLIT("_noupd_info"))
434 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
435 = hcat [ptext SLIT("__sel_"), text (show offset),
437 then SLIT("_upd_entry")
438 else SLIT("_noupd_entry"))
441 pprCLbl (RtsLabel (RtsApInfoTbl upd_reqd arity))
442 = hcat [ptext SLIT("__ap_"), text (show arity),
444 then SLIT("_upd_info")
445 else SLIT("_noupd_info"))
448 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
449 = hcat [ptext SLIT("__ap_"), text (show arity),
451 then SLIT("_upd_entry")
452 else SLIT("_noupd_entry"))
455 pprCLbl (RtsLabel (RtsPrimOp primop))
456 = pprPrimOp primop <> ptext SLIT("_fast")
458 pprCLbl (RtsLabel RtsModuleRegd)
459 = ptext SLIT("module_registered")
461 pprCLbl (TyConLabel tc)
462 = hcat [ppr tc, pp_cSEP, ptext SLIT("closure_tbl")]
464 pprCLbl (IdLabel id flavor) = ppr id <> ppIdFlavor flavor
465 pprCLbl (DataConLabel con flavor) = ppr con <> ppConFlavor flavor
467 pprCLbl (CC_Label cc) = ppr cc
468 pprCLbl (CCS_Label ccs) = ppr ccs
470 pprCLbl (ModuleInitLabel mod) = ptext SLIT("__init_") <> ptext mod
472 ppIdFlavor :: IdLabelInfo -> SDoc
474 ppIdFlavor x = pp_cSEP <>
476 Closure -> ptext SLIT("closure")
477 SRT -> ptext SLIT("srt")
478 InfoTbl -> ptext SLIT("info")
479 EntryStd -> ptext SLIT("entry")
480 EntryFast arity -> --false:ASSERT (arity > 0)
481 (<>) (ptext SLIT("fast")) (int arity)
482 RednCounts -> ptext SLIT("ct")
485 ppConFlavor x = pp_cSEP <>
487 ConEntry -> ptext SLIT("con_entry")
488 ConInfoTbl -> ptext SLIT("con_info")
489 StaticConEntry -> ptext SLIT("static_entry")
490 StaticInfoTbl -> ptext SLIT("static_info")