[project @ 2000-05-19 09:29:08 by simonmar]

[ghc-hetmet.git] / ghc / compiler / absCSyn / CLabel.lhs

diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index 4215354..94dfc39 100644 (file)
--- 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.32 2000/03/23 17:45:17 simonpj Exp $
+% $Id: CLabel.lhs,v 1.35 2000/05/18 13:55:36 sewardj Exp $
 %
 \section[CLabel]{@CLabel@: Information to make C Labels}
 
@@ -36,7 +36,20 @@ module CLabel (
        mkModuleInitLabel,
 
        mkErrorStdEntryLabel,
+
+       mkStgUpdatePAPLabel,
        mkUpdInfoLabel,
+       mkSeqInfoLabel,
+       mkIndInfoLabel,
+       mkIndStaticInfoLabel,
+       mkRtsGCEntryLabel,
+        mkMainRegTableLabel,
+       mkCharlikeClosureLabel,
+       mkIntlikeClosureLabel,
+       mkTopClosureLabel,
+       mkErrorIO_innardsLabel,
+       mkMAP_FROZEN_infoLabel,
+
        mkTopTickyCtrLabel,
        mkBlackHoleInfoTableLabel,
         mkCAFBlackHoleInfoTableLabel,
@@ -70,8 +83,8 @@ import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl )
 import CmdLineOpts      ( opt_Static, opt_DoTickyProfiling )
 import CStrings                ( pp_cSEP )
 import DataCon         ( ConTag, DataCon )
-import Module          ( isDynamicModule, ModuleName, moduleNameString )
-import Name            ( Name, getName, isExternallyVisibleName, nameModule, isLocallyDefinedName )
+import Module          ( ModuleName )
+import Name            ( Name, getName, isDllName, isExternallyVisibleName )
 import TyCon           ( TyCon )
 import Unique          ( pprUnique, Unique )
 import PrimOp          ( PrimOp, pprPrimOp )
@@ -160,7 +173,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, eg ErrorIO_innards
 
   | RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-} -- Selector thunks
   | RtsSelectorEntry   Bool{-updatable-} Int{-offset-}
@@ -219,7 +238,20 @@ mkModuleInitLabel          = ModuleInitLabel
        -- Some fixed runtime system labels
 
 mkErrorStdEntryLabel           = RtsLabel RtsShouldNeverHappenCode
+
+mkStgUpdatePAPLabel            = RtsLabel (Rts_Code "stg_update_PAP")
 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")
+mkTopClosureLabel              = RtsLabel (Rts_Closure "TopClosure")
+mkErrorIO_innardsLabel         = RtsLabel (Rts_Code "ErrorIO_innards")
+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"))
@@ -337,12 +369,11 @@ 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      | not (isLocallyDefinedName n) -> isDynamicModule (nameModule n)
-   DataConLabel n k | not (isLocallyDefinedName n) -> isDynamicModule (nameModule n)
-   TyConLabel tc    | not (isLocallyDefinedName (getName tc)) -> isDynamicModule (nameModule (getName tc))
-   _ -> 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)
+   _               -> False
 \end{code}
 
 
@@ -419,7 +450,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")