[project @ 1999-09-06 14:36:03 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 f0641fa..ac0c3d2 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.22 1998/12/18 17:40:34 simonpj Exp $
+% $Id: CLabel.lhs,v 1.27 1999/05/13 17:30:52 simonm Exp $
 %
 \section[CLabel]{@CLabel@: Information to make C Labels}
 
@@ -35,8 +35,9 @@ module CLabel (
        mkAsmTempLabel,
 
        mkErrorStdEntryLabel,
-       mkUpdEntryLabel,
-       mkBlackHoleInfoTableLabel,
+       mkUpdInfoLabel,
+        mkCAFBlackHoleInfoTableLabel,
+        mkSECAFBlackHoleInfoTableLabel,
        mkRtsPrimOpLabel,
 
        mkSelectorInfoLabel,
@@ -44,9 +45,9 @@ module CLabel (
 
        mkCC_Label, mkCCS_Label,
        
-       needsCDecl, isReadOnly, isAsmTemp, externallyVisibleCLabel,
+       needsCDecl, isAsmTemp, externallyVisibleCLabel,
 
-       CLabelType(..), labelType,
+       CLabelType(..), labelType, labelDynamic,
 
        pprCLabel
 #if ! OMIT_NATIVE_CODEGEN
@@ -61,9 +62,11 @@ module CLabel (
 import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl )
 #endif
 
+import CmdLineOpts      ( opt_Static, opt_DoTickyProfiling )
 import CStrings                ( pp_cSEP )
 import DataCon         ( ConTag, DataCon )
-import Name            ( Name, isExternallyVisibleName )
+import Module          ( isDynamicModule )
+import Name            ( Name, getName, isExternallyVisibleName, nameModule, isLocallyDefinedName )
 import TyCon           ( TyCon )
 import Unique          ( pprUnique, Unique )
 import PrimOp          ( PrimOp, pprPrimOp )
@@ -151,9 +154,9 @@ data CaseLabelInfo
 data RtsLabelInfo
   = RtsShouldNeverHappenCode
 
-  | RtsBlackHoleInfoTbl
+  | RtsBlackHoleInfoTbl FAST_STRING  -- black hole with info table name
 
-  | RtsUpdEntry
+  | RtsUpdInfo
 
   | RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-} -- Selector thunks
   | RtsSelectorEntry   Bool{-updatable-} Int{-offset-}
@@ -171,6 +174,7 @@ data CLabelType
   = InfoTblType
   | ClosureType
   | VecTblType
+  | ClosureTblType
   | CodeType
   | DataType
 \end{code}
@@ -206,8 +210,12 @@ mkAsmTempLabel                     = AsmTempLabel
        -- Some fixed runtime system labels
 
 mkErrorStdEntryLabel           = RtsLabel RtsShouldNeverHappenCode
-mkUpdEntryLabel                        = RtsLabel RtsUpdEntry
-mkBlackHoleInfoTableLabel      = RtsLabel RtsBlackHoleInfoTbl
+mkUpdInfoLabel                 = RtsLabel RtsUpdInfo
+mkCAFBlackHoleInfoTableLabel   = RtsLabel (RtsBlackHoleInfoTbl SLIT("CAF_BLACKHOLE_info"))
+mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
+                                    RtsLabel (RtsBlackHoleInfoTbl SLIT("SE_CAF_BLACKHOLE_info"))
+                                  else  -- RTS won't have info table unless -ticky is on
+                                    panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
 mkRtsPrimOpLabel primop                = RtsLabel (RtsPrimOp primop)
 
 mkSelectorInfoLabel  upd off   = RtsLabel (RtsSelectorInfoTbl upd off)
@@ -224,7 +232,6 @@ mkCCS_Label ccs             = CCS_Label ccs
 
 \begin{code}
 needsCDecl :: CLabel -> Bool   -- False <=> it's pre-declared; don't bother
-isReadOnly :: CLabel -> Bool   -- lives in C "text space"
 isAsmTemp  :: CLabel -> Bool    -- is a local temporary for native code generation
 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 \end{code}
@@ -246,29 +253,14 @@ needsCDecl (IdLabel _ _)          = True
 needsCDecl (CaseLabel _ CaseReturnPt)  = True
 needsCDecl (DataConLabel _ _)          = True
 needsCDecl (CaseLabel _ _)             = False
+needsCDecl (TyConLabel _)              = True
 
 needsCDecl (AsmTempLabel _)            = False
-needsCDecl (TyConLabel _)              = False
 needsCDecl (RtsLabel _)                        = False
 needsCDecl (CC_Label _)                        = False
 needsCDecl (CCS_Label _)               = False
 \end{code}
 
-Whether the labelled thing can be put in C "text space":
-
-\begin{code}
-isReadOnly (IdLabel _ InfoTbl) = True  -- info-tables: yes
-isReadOnly (IdLabel _ other)   = False -- others: pessimistically, no
-
-isReadOnly (DataConLabel _ _)  = True -- and so on, for other
-isReadOnly (TyConLabel _)      = True
-isReadOnly (CaseLabel _ _)     = True
-isReadOnly (AsmTempLabel _)    = True
-isReadOnly (RtsLabel _)                = True
-isReadOnly (CC_Label _)                = True
-isReadOnly (CCS_Label _)       = True
-\end{code}
-
 Whether the label is an assembler temporary:
 
 \begin{code}
@@ -296,12 +288,14 @@ For generating correct types in label declarations...
 
 \begin{code}
 labelType :: CLabel -> CLabelType
-labelType (RtsLabel RtsBlackHoleInfoTbl)      = InfoTblType
+labelType (RtsLabel (RtsBlackHoleInfoTbl _))  = InfoTblType
 labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = InfoTblType
 labelType (RtsLabel (RtsApInfoTbl _ _))       = InfoTblType
+labelType (RtsLabel RtsUpdInfo)              = InfoTblType
 labelType (CaseLabel _ CaseReturnInfo)        = InfoTblType
 labelType (CaseLabel _ CaseReturnPt)         = CodeType
 labelType (CaseLabel _ CaseVecTbl)            = VecTblType
+labelType (TyConLabel _)                     = ClosureTblType
 
 labelType (IdLabel _ info) = 
   case info of
@@ -319,6 +313,24 @@ labelType (DataConLabel _ info) =
 labelType _        = DataType
 \end{code}
 
+When referring to data in code, we need to know whether
+that data resides in a DLL or not. [Win32 only.]
+@labelDynamic@ returns @True@ if the label is located
+in a DLL, be it a data reference or not.
+
+\begin{code}
+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
+
+\end{code}
+
+
 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 right places. It is used to detect when the abstractC statement of an
 CCodeBlock actually contains the code for a slow entry point.  -- HWL
@@ -391,9 +403,9 @@ pprCLbl (CaseLabel u CaseBitmap)
 
 pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("stg_error_entry")
 
-pprCLbl (RtsLabel RtsUpdEntry) = ptext SLIT("Upd_frame_entry")
+pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("Upd_frame_info")
 
-pprCLbl (RtsLabel RtsBlackHoleInfoTbl) = ptext SLIT("BLACKHOLE_info")
+pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ptext info
 
 pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
   = hcat [ptext SLIT("__sel_"), text (show offset),