X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FCLabel.lhs;h=7d925e6b86707689393df7977b81ac04f8f7edd3;hb=c49c5ebae0a4d98348505db55cb370dfe896db6c;hp=523fc096b89deccf3129c453a4e841f056172b35;hpb=9579283cadf4ac68a6f4252244041b5127e16811;p=ghc-hetmet.git

diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index 523fc09..7d925e6 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.33 2000/04/13 11:56:35 simonpj Exp $
+% $Id: CLabel.lhs,v 1.37 2000/07/03 14:59:25 simonmar Exp $
 %
 \section[CLabel]{@CLabel@: Information to make C Labels}
 
@@ -36,7 +36,19 @@ module CLabel (
 	mkModuleInitLabel,
 
 	mkErrorStdEntryLabel,
+
+	mkStgUpdatePAPLabel,
+	mkSplitMarkerLabel,
 	mkUpdInfoLabel,
+	mkSeqInfoLabel,
+	mkIndInfoLabel,
+	mkIndStaticInfoLabel,
+	mkRtsGCEntryLabel,
+        mkMainRegTableLabel,
+	mkCharlikeClosureLabel,
+	mkIntlikeClosureLabel,
+	mkMAP_FROZEN_infoLabel,
+
 	mkTopTickyCtrLabel,
 	mkBlackHoleInfoTableLabel,
         mkCAFBlackHoleInfoTableLabel,
@@ -48,6 +60,8 @@ module CLabel (
 	mkSelectorInfoLabel,
 	mkSelectorEntryLabel,
 
+	mkForeignLabel,
+
 	mkCC_Label, mkCCS_Label,
 	
 	needsCDecl, isAsmTemp, externallyVisibleCLabel,
@@ -114,6 +128,9 @@ data CLabel
 
   | RtsLabel	    RtsLabelInfo
 
+  | ForeignLabel FAST_STRING Bool  -- a 'C' (or otherwise foreign) label
+				   -- Bool <=> is dynamic
+
   | CC_Label CostCentre
   | CCS_Label CostCentreStack
 
@@ -160,7 +177,13 @@ data RtsLabelInfo
 
   | RtsBlackHoleInfoTbl FAST_STRING  -- black hole with info table name
 
-  | RtsUpdInfo
+  | RtsUpdInfo            	-- upd_frame_info
+  | RtsSeqInfo			-- seq_frame_info
+  | RtsGCEntryLabel String 	-- a heap check fail handler, eg  stg_chk_2
+  | RtsMainRegTable             -- MainRegTable (??? Capabilities wurble ???)
+  | Rts_Closure String		-- misc rts closures, eg CHARLIKE_closure
+  | Rts_Info String		-- misc rts itbls, eg MUT_ARR_PTRS_FROZEN_info
+  | Rts_Code String		-- misc rts code
 
   | RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-}	-- Selector thunks
   | RtsSelectorEntry   Bool{-updatable-} Int{-offset-}
@@ -219,7 +242,19 @@ mkModuleInitLabel		= ModuleInitLabel
 	-- Some fixed runtime system labels
 
 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")
+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")
+
 mkTopTickyCtrLabel		= RtsLabel RtsTopTickyCtr
 mkBlackHoleInfoTableLabel	= RtsLabel (RtsBlackHoleInfoTbl SLIT("BLACKHOLE_info"))
 mkCAFBlackHoleInfoTableLabel	= RtsLabel (RtsBlackHoleInfoTbl SLIT("CAF_BLACKHOLE_info"))
@@ -237,6 +272,11 @@ mkSelectorEntryLabel upd off	= RtsLabel (RtsSelectorEntry   upd off)
 mkApInfoTableLabel  upd off	= RtsLabel (RtsApInfoTbl upd off)
 mkApEntryLabel upd off		= RtsLabel (RtsApEntry   upd off)
 
+	-- Foreign labels
+
+mkForeignLabel :: FAST_STRING -> Bool -> CLabel
+mkForeignLabel str is_dynamic	= ForeignLabel str is_dynamic
+
 	-- Cost centres etc.
 
 mkCC_Label	cc		= CC_Label cc
@@ -271,6 +311,7 @@ needsCDecl (TyConLabel _)		= True
 needsCDecl (AsmTempLabel _)		= False
 needsCDecl (ModuleInitLabel _)		= False
 needsCDecl (RtsLabel _)			= False
+needsCDecl (ForeignLabel _ _)		= False
 needsCDecl (CC_Label _)			= False
 needsCDecl (CCS_Label _)		= False
 \end{code}
@@ -295,6 +336,7 @@ externallyVisibleCLabel (AsmTempLabel _)   = False
 externallyVisibleCLabel (ModuleInitLabel _)= True
 externallyVisibleCLabel (RtsLabel RtsModuleRegd) = False --hack
 externallyVisibleCLabel (RtsLabel _)	   = True
+externallyVisibleCLabel (ForeignLabel _ _) = True
 externallyVisibleCLabel (IdLabel id _)     = isExternallyVisibleName id
 externallyVisibleCLabel (CC_Label _)	   = False -- not strictly true
 externallyVisibleCLabel (CCS_Label _)	   = False -- not strictly true
@@ -341,6 +383,7 @@ labelDynamic lbl =
    IdLabel n k      -> isDllName n
    DataConLabel n k -> isDllName n
    TyConLabel tc    -> isDllName (getName tc)
+   ForeignLabel _ d -> d
    _ 		    -> False
 \end{code}
 
@@ -418,7 +461,13 @@ pprCLbl (CaseLabel u CaseBitmap)
 
 pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("stg_error_entry")
 
-pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("Upd_frame_info")
+pprCLbl (RtsLabel RtsUpdInfo)            = ptext SLIT("upd_frame_info")
+pprCLbl (RtsLabel RtsSeqInfo)            = ptext SLIT("seq_frame_info")
+pprCLbl (RtsLabel RtsMainRegTable)       = ptext SLIT("MainRegTable")
+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")
 
@@ -458,6 +507,9 @@ pprCLbl (RtsLabel (RtsPrimOp primop))
 pprCLbl (RtsLabel RtsModuleRegd)
   = ptext SLIT("module_registered")
 
+pprCLbl (ForeignLabel str _)
+  = ptext str
+
 pprCLbl (TyConLabel tc)
   = hcat [ppr tc, pp_cSEP, ptext SLIT("closure_tbl")]