-pprCLabel :: PprStyle -> CLabel -> Unpretty
-
-pprCLabel (PprForAsm _ fmtAsmLbl) (AsmTempLabel u)
- = uppStr (fmtAsmLbl (_UNPK_ (showUnique u)))
-
-pprCLabel (PprForAsm prepend_cSEP _) lbl
- = if prepend_cSEP
- then uppBeside pp_cSEP prLbl
- else prLbl
- where
- prLbl = pprCLabel PprForC lbl
-
-pprCLabel sty (TyConLabel tc UnvecConUpdCode)
- = uppBesides [uppPStr SLIT("ret"), pp_cSEP, ppr_tycon sty tc,
- pp_cSEP, uppPStr SLIT("upd")]
-
-pprCLabel sty (TyConLabel tc (VecConUpdCode tag))
- = uppBesides [uppPStr SLIT("ret"), pp_cSEP, ppr_tycon sty tc, pp_cSEP,
- uppInt tag, pp_cSEP, uppPStr SLIT("upd")]
-
-pprCLabel sty (TyConLabel tc (StdUpdCode tag))
- = case (ctrlReturnConvAlg tc) of
- UnvectoredReturn _ -> uppPStr SLIT("IndUpdRetDir")
- VectoredReturn _ -> uppBeside (uppPStr SLIT("IndUpdRetV")) (uppInt (tag - fIRST_TAG))
-
-pprCLabel sty (TyConLabel tc InfoTblVecTbl)
- = uppBesides [ppr_tycon sty tc, pp_cSEP, uppPStr SLIT("itblvtbl")]
-
-pprCLabel sty (TyConLabel tc StdUpdVecTbl)
- = uppBesides [uppPStr SLIT("vtbl"), pp_cSEP, ppr_tycon sty tc,
- pp_cSEP, uppPStr SLIT("upd")]
-
-pprCLabel sty (CaseLabel u CaseReturnPt)
- = uppBesides [uppPStr SLIT("ret"), pp_cSEP, ppr_u u]
-pprCLabel sty (CaseLabel u CaseVecTbl)
- = uppBesides [uppPStr SLIT("vtbl"), pp_cSEP, ppr_u u]
-pprCLabel sty (CaseLabel u (CaseAlt tag))
- = uppBesides [uppPStr SLIT("djn"), pp_cSEP, ppr_u u, pp_cSEP, uppInt tag]
-pprCLabel sty (CaseLabel u CaseDefault)
- = uppBesides [uppPStr SLIT("djn"), pp_cSEP, ppr_u u]
-
-pprCLabel sty (RtsLabel RtsShouldNeverHappenCode) = uppPStr SLIT("StdErrorCode")
-
-pprCLabel sty (RtsLabel RtsBlackHoleInfoTbl) = uppPStr SLIT("BH_UPD_info")
-
-pprCLabel sty (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
- = uppBesides [uppPStr SLIT("__sel_info_"), uppStr (show offset),
- uppStr (if upd_reqd then "upd" else "noupd"),
- uppPStr SLIT("__")]
-
-pprCLabel sty (RtsLabel (RtsSelectorEntry upd_reqd offset))
- = uppBesides [uppPStr SLIT("__sel_entry_"), uppStr (show offset),
- uppStr (if upd_reqd then "upd" else "noupd"),
- uppPStr SLIT("__")]
-
-pprCLabel sty (IdLabel (CLabelId id) flavor)
- = uppBeside (prettyToUn (ppr sty id)) (ppFlavor flavor)
-
-ppr_u u = prettyToUn (pprUnique u)
-
-ppr_tycon sty tc
- = let
- str = showTyCon sty tc
- in
- --pprTrace "ppr_tycon:" (ppStr str) $
- uppStr str
-
-ppFlavor :: IdLabelInfo -> Unpretty
-
-ppFlavor x = uppBeside pp_cSEP
- (case x of
- Closure -> uppPStr SLIT("closure")
- InfoTbl -> uppPStr SLIT("info")
- EntryStd -> uppPStr SLIT("entry")
- EntryFast arity -> --false:ASSERT (arity > 0)
- uppBeside (uppPStr SLIT("fast")) (uppInt arity)
- StaticClosure -> uppPStr SLIT("static_closure")
- ConEntry -> uppPStr SLIT("con_entry")
- ConInfoTbl -> uppPStr SLIT("con_info")
- StaticConEntry -> uppPStr SLIT("static_entry")
- StaticInfoTbl -> uppPStr SLIT("static_info")
- PhantomInfoTbl -> uppPStr SLIT("inregs_info")
- VapInfoTbl True -> uppPStr SLIT("vap_info")
- VapInfoTbl False -> uppPStr SLIT("vap_noupd_info")
- VapEntry True -> uppPStr SLIT("vap_entry")
- VapEntry False -> uppPStr SLIT("vap_noupd_entry")
- RednCounts -> uppPStr SLIT("ct")
+pprCLabel lbl =
+#if ! OMIT_NATIVE_CODEGEN
+ getPprStyle $ \ sty ->
+ if asmStyle sty && underscorePrefix then
+ pp_cSEP <> pprCLbl lbl
+ else
+#endif
+ pprCLbl lbl
+
+pprCLbl (CaseLabel u CaseReturnPt)
+ = hcat [pprUnique u, pp_cSEP, ptext SLIT("ret")]
+pprCLbl (CaseLabel u CaseReturnInfo)
+ = hcat [pprUnique u, pp_cSEP, ptext SLIT("info")]
+pprCLbl (CaseLabel u CaseVecTbl)
+ = hcat [pprUnique u, pp_cSEP, ptext SLIT("vtbl")]
+pprCLbl (CaseLabel u (CaseAlt tag))
+ = hcat [pprUnique u, pp_cSEP, int tag, pp_cSEP, ptext SLIT("alt")]
+pprCLbl (CaseLabel u CaseDefault)
+ = hcat [pprUnique u, pp_cSEP, ptext SLIT("dflt")]
+
+pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("NULL")
+-- used to be stg_error_entry but Windows can't have DLL entry points as static
+-- initialisers, and besides, this ShouldNeverHappen, right?
+
+pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("stg_upd_frame_info")
+pprCLbl (RtsLabel RtsSeqInfo) = ptext SLIT("stg_seq_frame_info")
+pprCLbl (RtsLabel RtsMainCapability) = ptext SLIT("MainCapability")
+pprCLbl (RtsLabel (RtsGCEntryLabel str)) = text str
+pprCLbl (RtsLabel (Rts_Closure str)) = text str
+pprCLbl (RtsLabel (Rts_Info str)) = text str
+pprCLbl (RtsLabel (Rts_Code str)) = text str
+
+pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct")
+
+pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ptext info
+
+pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
+ = hcat [ptext SLIT("stg_sel_"), text (show offset),
+ ptext (if upd_reqd
+ then SLIT("_upd_info")
+ else SLIT("_noupd_info"))
+ ]
+
+pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
+ = hcat [ptext SLIT("stg_sel_"), text (show offset),
+ ptext (if upd_reqd
+ then SLIT("_upd_entry")
+ else SLIT("_noupd_entry"))
+ ]
+
+pprCLbl (RtsLabel (RtsApInfoTbl upd_reqd arity))
+ = hcat [ptext SLIT("stg_ap_"), text (show arity),
+ ptext (if upd_reqd
+ then SLIT("_upd_info")
+ else SLIT("_noupd_info"))
+ ]
+
+pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
+ = hcat [ptext SLIT("stg_ap_"), text (show arity),
+ ptext (if upd_reqd
+ then SLIT("_upd_entry")
+ else SLIT("_noupd_entry"))
+ ]
+
+pprCLbl (RtsLabel (RtsApplyInfoLabel fs))
+ = ptext SLIT("stg_ap_") <> ptext fs <> ptext SLIT("_info")
+
+pprCLbl (RtsLabel (RtsApplyEntryLabel fs))
+ = ptext SLIT("stg_ap_") <> ptext fs <> ptext SLIT("_ret")
+
+pprCLbl (RtsLabel (RtsPrimOp primop))
+ = ppr primop <> ptext SLIT("_fast")
+
+pprCLbl (RtsLabel RtsModuleRegd)
+ = ptext SLIT("module_registered")
+
+pprCLbl (ForeignLabel str _)
+ = ftext str
+
+pprCLbl (TyConLabel tc)
+ = hcat [ppr tc, pp_cSEP, ptext SLIT("closure_tbl")]
+
+pprCLbl (IdLabel id flavor) = ppr id <> ppIdFlavor flavor
+pprCLbl (DataConLabel con flavor) = ppr con <> ppConFlavor flavor
+
+pprCLbl (CC_Label cc) = ppr cc
+pprCLbl (CCS_Label ccs) = ppr ccs
+
+pprCLbl (ModuleInitLabel mod way)
+ = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
+ <> char '_' <> text way
+pprCLbl (PlainModuleInitLabel mod)
+ = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
+
+ppIdFlavor :: IdLabelInfo -> SDoc
+
+ppIdFlavor x = pp_cSEP <>
+ (case x of
+ Closure -> ptext SLIT("closure")
+ SRT -> ptext SLIT("srt")
+ SRTDesc -> ptext SLIT("srtd")
+ InfoTbl -> ptext SLIT("info")
+ Entry -> ptext SLIT("entry")
+ Slow -> ptext SLIT("slow")
+ RednCounts -> ptext SLIT("ct")
+ Bitmap -> ptext SLIT("btm")