X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FCLabel.lhs;h=c8712f5f17a94e7a5ec8680b7def072129eecafb;hb=fb7a723bfd7650a705cb226e07c5b08b7a8e9279;hp=7d925e6b86707689393df7977b81ac04f8f7edd3;hpb=c49c5ebae0a4d98348505db55cb370dfe896db6c;p=ghc-hetmet.git diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs index 7d925e6..c8712f5 100644 --- a/ghc/compiler/absCSyn/CLabel.lhs +++ b/ghc/compiler/absCSyn/CLabel.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CLabel.lhs,v 1.37 2000/07/03 14:59:25 simonmar Exp $ +% $Id: CLabel.lhs,v 1.47 2001/09/04 18:29:20 ken Exp $ % \section[CLabel]{@CLabel@: Information to make C Labels} @@ -48,6 +48,7 @@ module CLabel ( mkCharlikeClosureLabel, mkIntlikeClosureLabel, mkMAP_FROZEN_infoLabel, + mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel, mkBlackHoleInfoTableLabel, @@ -83,14 +84,14 @@ import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl ) import CmdLineOpts ( opt_Static, opt_DoTickyProfiling ) import CStrings ( pp_cSEP ) -import DataCon ( ConTag, DataCon ) -import Module ( ModuleName ) +import DataCon ( ConTag ) +import Module ( moduleName, moduleNameFS, + Module, isHomeModule ) import Name ( Name, getName, isDllName, isExternallyVisibleName ) import TyCon ( TyCon ) import Unique ( pprUnique, Unique ) -import PrimOp ( PrimOp, pprPrimOp ) +import PrimOp ( PrimOp ) import CostCentre ( CostCentre, CostCentreStack ) -import Util import Outputable \end{code} @@ -124,7 +125,7 @@ data CLabel | AsmTempLabel Unique - | ModuleInitLabel ModuleName + | ModuleInitLabel Module | RtsLabel RtsLabelInfo @@ -241,25 +242,25 @@ mkModuleInitLabel = ModuleInitLabel -- Some fixed runtime system labels -mkErrorStdEntryLabel = RtsLabel RtsShouldNeverHappenCode - +mkErrorStdEntryLabel = RtsLabel RtsShouldNeverHappenCode mkStgUpdatePAPLabel = RtsLabel (Rts_Code "stg_update_PAP") mkSplitMarkerLabel = RtsLabel (Rts_Code "__stg_split_marker") mkUpdInfoLabel = RtsLabel RtsUpdInfo mkSeqInfoLabel = RtsLabel RtsSeqInfo -mkIndInfoLabel = RtsLabel (Rts_Info "IND_info") -mkIndStaticInfoLabel = RtsLabel (Rts_Info "IND_STATIC_info") +mkIndInfoLabel = RtsLabel (Rts_Info "stg_IND_info") +mkIndStaticInfoLabel = RtsLabel (Rts_Info "stg_IND_STATIC_info") mkRtsGCEntryLabel str = RtsLabel (RtsGCEntryLabel str) mkMainRegTableLabel = RtsLabel RtsMainRegTable -mkCharlikeClosureLabel = RtsLabel (Rts_Closure "CHARLIKE_closure") -mkIntlikeClosureLabel = RtsLabel (Rts_Closure "INTLIKE_closure") -mkMAP_FROZEN_infoLabel = RtsLabel (Rts_Info "MUT_ARR_PTRS_FROZEN_info") +mkCharlikeClosureLabel = RtsLabel (Rts_Closure "stg_CHARLIKE_closure") +mkIntlikeClosureLabel = RtsLabel (Rts_Closure "stg_INTLIKE_closure") +mkMAP_FROZEN_infoLabel = RtsLabel (Rts_Info "stg_MUT_ARR_PTRS_FROZEN_info") +mkEMPTY_MVAR_infoLabel = RtsLabel (Rts_Info "stg_EMPTY_MVAR_info") mkTopTickyCtrLabel = RtsLabel RtsTopTickyCtr -mkBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("BLACKHOLE_info")) -mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("CAF_BLACKHOLE_info")) +mkBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_BLACKHOLE_info")) +mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_CAF_BLACKHOLE_info")) mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then - RtsLabel (RtsBlackHoleInfoTbl SLIT("SE_CAF_BLACKHOLE_info")) + RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_SE_CAF_BLACKHOLE_info")) else -- RTS won't have info table unless -ticky is on panic "mkSECAFBlackHoleInfoTableLabel requires -ticky" mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop) @@ -305,11 +306,11 @@ let-no-escapes, which can be recursive. needsCDecl (IdLabel _ _) = True needsCDecl (CaseLabel _ CaseReturnPt) = True needsCDecl (DataConLabel _ _) = True -needsCDecl (CaseLabel _ _) = False needsCDecl (TyConLabel _) = True +needsCDecl (ModuleInitLabel _) = True +needsCDecl (CaseLabel _ _) = False needsCDecl (AsmTempLabel _) = False -needsCDecl (ModuleInitLabel _) = False needsCDecl (RtsLabel _) = False needsCDecl (ForeignLabel _ _) = False needsCDecl (CC_Label _) = False @@ -354,6 +355,7 @@ labelType (CaseLabel _ CaseReturnInfo) = InfoTblType labelType (CaseLabel _ CaseReturnPt) = CodeType labelType (CaseLabel _ CaseVecTbl) = VecTblType labelType (TyConLabel _) = ClosureTblType +labelType (ModuleInitLabel _ ) = CodeType labelType (IdLabel _ info) = case info of @@ -379,12 +381,16 @@ in a DLL, be it a data reference or not. labelDynamic :: CLabel -> Bool labelDynamic lbl = case lbl of - RtsLabel _ -> not opt_Static -- i.e., is the RTS in a DLL or not? - IdLabel n k -> isDllName n - DataConLabel n k -> isDllName n - TyConLabel tc -> isDllName (getName tc) - ForeignLabel _ d -> d - _ -> False + -- The special case for RtsShouldNeverHappenCode is because the associated address is + -- NULL, i.e. not a DLL entry point + RtsLabel RtsShouldNeverHappenCode -> False + RtsLabel _ -> not opt_Static -- i.e., is the RTS in a DLL or not? + IdLabel n k -> isDllName n + DataConLabel n k -> isDllName n + TyConLabel tc -> isDllName (getName tc) + ForeignLabel _ d -> d + ModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m)) + _ -> False \end{code} @@ -459,10 +465,12 @@ pprCLbl (CaseLabel u CaseDefault) pprCLbl (CaseLabel u CaseBitmap) = hcat [pprUnique u, pp_cSEP, ptext SLIT("btm")] -pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("stg_error_entry") +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("upd_frame_info") -pprCLbl (RtsLabel RtsSeqInfo) = ptext SLIT("seq_frame_info") +pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("stg_upd_frame_info") +pprCLbl (RtsLabel RtsSeqInfo) = ptext SLIT("stg_seq_frame_info") pprCLbl (RtsLabel RtsMainRegTable) = ptext SLIT("MainRegTable") pprCLbl (RtsLabel (RtsGCEntryLabel str)) = text str pprCLbl (RtsLabel (Rts_Closure str)) = text str @@ -474,35 +482,35 @@ pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct") pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ptext info pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset)) - = hcat [ptext SLIT("__sel_"), text (show 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("__sel_"), text (show 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("__ap_"), text (show 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("__ap_"), text (show arity), + = hcat [ptext SLIT("stg_ap_"), text (show arity), ptext (if upd_reqd then SLIT("_upd_entry") else SLIT("_noupd_entry")) ] pprCLbl (RtsLabel (RtsPrimOp primop)) - = pprPrimOp primop <> ptext SLIT("_fast") + = ppr primop <> ptext SLIT("_fast") pprCLbl (RtsLabel RtsModuleRegd) = ptext SLIT("module_registered") @@ -519,7 +527,8 @@ pprCLbl (DataConLabel con flavor) = ppr con <> ppConFlavor flavor pprCLbl (CC_Label cc) = ppr cc pprCLbl (CCS_Label ccs) = ppr ccs -pprCLbl (ModuleInitLabel mod) = ptext SLIT("__init_") <> ptext mod +pprCLbl (ModuleInitLabel mod) + = ptext SLIT("__stginit_") <> ptext (moduleNameFS (moduleName mod)) ppIdFlavor :: IdLabelInfo -> SDoc