--
-----------------------------------------------------------------------------
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- for details
+
module CLabel (
CLabel, -- abstract type
mkClosureLabel,
mkSRTLabel,
- mkSRTDescLabel,
mkInfoTableLabel,
mkEntryLabel,
mkSlowEntryLabel,
mkRednCountsLabel,
mkConInfoTableLabel,
mkStaticInfoTableLabel,
+ mkLargeSRTLabel,
mkApEntryLabel,
mkApInfoTableLabel,
mkClosureTableLabel,
mkSplitMarkerLabel,
mkDirty_MUT_VAR_Label,
mkUpdInfoLabel,
- mkSeqInfoLabel,
mkIndStaticInfoLabel,
mkMainCapabilityLabel,
mkMAP_FROZEN_infoLabel,
mkHpcTicksLabel,
mkHpcModuleNameLabel,
- mkHpcModuleOffsetLabel,
infoLblToEntryLbl, entryLblToInfoLbl,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
import CostCentre
import Outputable
import FastString
+import DynFlags
-- -----------------------------------------------------------------------------
-- The CLabel type
Name -- definition of a particular Id or Con
IdLabelInfo
- | DynIdLabel -- like IdLabel, but in a separate package,
- Name -- and might therefore need a dynamic
- IdLabelInfo -- reference.
-
| CaseLabel -- A family of labels related to a particular
-- case expression.
{-# UNPACK #-} !Unique -- Unique says which case expression
| ModuleInitLabel
Module -- the module name
String -- its "way"
- Bool -- True <=> is in a different package
-- at some point we might want some kind of version number in
-- the module init label, to guard against compiling modules in
-- the wrong order. We can't use the interface file version however,
| PlainModuleInitLabel -- without the vesrion & way info
Module
- Bool -- True <=> is in a different package
| ModuleRegdLabel
| HpcTicksLabel Module -- Per-module table of tick locations
| HpcModuleNameLabel -- Per-module name of the module for Hpc
- | HpcModuleOffsetLabel Module-- Per-module offset of the module for Hpc (dynamically generated)
+
+ | LargeSRTLabel -- Label of an StgLargeSRT
+ {-# UNPACK #-} !Unique
+
+ | LargeBitmapLabel -- A bitmap (function or case return)
+ {-# UNPACK #-} !Unique
deriving (Eq, Ord)
data IdLabelInfo
= Closure -- Label for closure
| SRT -- Static reference table
- | SRTDesc -- Static reference table descriptor
| InfoTable -- Info tables for closures; always read-only
| Entry -- entry point
| Slow -- slow entry point
| RednCounts -- Label of place to keep Ticky-ticky info for
-- this Id
- | Bitmap -- A bitmap (function or case return)
-
| ConEntry -- constructor entry point
| ConInfoTable -- corresponding info table
| StaticConEntry -- static constructor entry point
-- These are always local:
mkSRTLabel name = IdLabel name SRT
-mkSRTDescLabel name = IdLabel name SRTDesc
mkSlowEntryLabel name = IdLabel name Slow
-mkBitmapLabel name = IdLabel name Bitmap
mkRednCountsLabel name = IdLabel name RednCounts
-- These have local & (possibly) external variants:
mkLocalEntryLabel name = IdLabel name Entry
mkLocalClosureTableLabel name = IdLabel name ClosureTable
-mkClosureLabel this_pkg name
- | isDllName this_pkg name = DynIdLabel name Closure
- | otherwise = IdLabel name Closure
-
-mkInfoTableLabel this_pkg name
- | isDllName this_pkg name = DynIdLabel name InfoTable
- | otherwise = IdLabel name InfoTable
-
-mkEntryLabel this_pkg name
- | isDllName this_pkg name = DynIdLabel name Entry
- | otherwise = IdLabel name Entry
-
-mkClosureTableLabel this_pkg name
- | isDllName this_pkg name = DynIdLabel name ClosureTable
- | otherwise = IdLabel name ClosureTable
-
-mkLocalConInfoTableLabel con = IdLabel con ConInfoTable
-mkLocalConEntryLabel con = IdLabel con ConEntry
-mkLocalStaticInfoTableLabel con = IdLabel con StaticInfoTable
-mkLocalStaticConEntryLabel con = IdLabel con StaticConEntry
-
-mkConInfoTableLabel name False = IdLabel name ConInfoTable
-mkConInfoTableLabel name True = DynIdLabel name ConInfoTable
+mkClosureLabel name = IdLabel name Closure
+mkInfoTableLabel name = IdLabel name InfoTable
+mkEntryLabel name = IdLabel name Entry
+mkClosureTableLabel name = IdLabel name ClosureTable
+mkLocalConInfoTableLabel con = IdLabel con ConInfoTable
+mkLocalConEntryLabel con = IdLabel con ConEntry
+mkLocalStaticInfoTableLabel con = IdLabel con StaticInfoTable
+mkLocalStaticConEntryLabel con = IdLabel con StaticConEntry
+mkConInfoTableLabel name = IdLabel name ConInfoTable
+mkStaticInfoTableLabel name = IdLabel name StaticInfoTable
-mkStaticInfoTableLabel name False = IdLabel name StaticInfoTable
-mkStaticInfoTableLabel name True = DynIdLabel name StaticInfoTable
-
-mkConEntryLabel this_pkg name
- | isDllName this_pkg name = DynIdLabel name ConEntry
- | otherwise = IdLabel name ConEntry
-
-mkStaticConEntryLabel this_pkg name
- | isDllName this_pkg name = DynIdLabel name StaticConEntry
- | otherwise = IdLabel name StaticConEntry
+mkConEntryLabel name = IdLabel name ConEntry
+mkStaticConEntryLabel name = IdLabel name StaticConEntry
+mkLargeSRTLabel uniq = LargeSRTLabel uniq
+mkBitmapLabel uniq = LargeBitmapLabel uniq
mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
mkStringLitLabel = StringLitLabel
mkAsmTempLabel = AsmTempLabel
-mkModuleInitLabel :: PackageId -> Module -> String -> CLabel
-mkModuleInitLabel this_pkg mod way
- = ModuleInitLabel mod way $! modulePackageId mod /= this_pkg
+mkModuleInitLabel :: Module -> String -> CLabel
+mkModuleInitLabel mod way = ModuleInitLabel mod way
-mkPlainModuleInitLabel :: PackageId -> Module -> CLabel
-mkPlainModuleInitLabel this_pkg mod
- = PlainModuleInitLabel mod $! modulePackageId mod /= this_pkg
+mkPlainModuleInitLabel :: Module -> CLabel
+mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
-- Some fixed runtime system labels
mkSplitMarkerLabel = RtsLabel (RtsCode SLIT("__stg_split_marker"))
mkDirty_MUT_VAR_Label = RtsLabel (RtsCode SLIT("dirty_MUT_VAR"))
mkUpdInfoLabel = RtsLabel (RtsInfo SLIT("stg_upd_frame"))
-mkSeqInfoLabel = RtsLabel (RtsInfo SLIT("stg_seq_frame"))
mkIndStaticInfoLabel = RtsLabel (RtsInfo SLIT("stg_IND_STATIC"))
mkMainCapabilityLabel = RtsLabel (RtsData SLIT("MainCapability"))
mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN0"))
mkHpcTicksLabel = HpcTicksLabel
mkHpcModuleNameLabel = HpcModuleNameLabel
-mkHpcModuleOffsetLabel = HpcModuleOffsetLabel
-- Dynamic linking
mkDeadStripPreventer lbl = DeadStripPreventer lbl
-- -----------------------------------------------------------------------------
--- Converting info labels to entry labels.
+-- Converting between info labels and entry/ret labels.
infoLblToEntryLbl :: CLabel -> CLabel
infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
-infoLblToEntryLbl (DynIdLabel n InfoTable) = DynIdLabel n Entry
-infoLblToEntryLbl (DynIdLabel n ConInfoTable) = DynIdLabel n ConEntry
-infoLblToEntryLbl (DynIdLabel n StaticInfoTable) = DynIdLabel n StaticConEntry
infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
-entryLblToInfoLbl (DynIdLabel n Entry) = DynIdLabel n InfoTable
-entryLblToInfoLbl (DynIdLabel n ConEntry) = DynIdLabel n ConInfoTable
-entryLblToInfoLbl (DynIdLabel n StaticConEntry) = DynIdLabel n StaticInfoTable
entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
-- don't bother declaring SRT & Bitmap labels, we always make sure
-- they are defined before use.
needsCDecl (IdLabel _ SRT) = False
-needsCDecl (IdLabel _ SRTDesc) = False
-needsCDecl (IdLabel _ Bitmap) = False
+needsCDecl (LargeSRTLabel _) = False
+needsCDecl (LargeBitmapLabel _) = False
needsCDecl (IdLabel _ _) = True
-needsCDecl (DynIdLabel _ _) = True
needsCDecl (CaseLabel _ _) = True
-needsCDecl (ModuleInitLabel _ _ _) = True
-needsCDecl (PlainModuleInitLabel _ _) = True
+needsCDecl (ModuleInitLabel _ _) = True
+needsCDecl (PlainModuleInitLabel _) = True
needsCDecl ModuleRegdLabel = False
needsCDecl (StringLitLabel _) = False
needsCDecl (CC_Label _) = True
needsCDecl (CCS_Label _) = True
needsCDecl (HpcTicksLabel _) = True
-needsCDecl (HpcModuleOffsetLabel _) = True
needsCDecl HpcModuleNameLabel = False
-- Whether the label is an assembler temporary:
externallyVisibleCLabel (CaseLabel _ _) = False
externallyVisibleCLabel (StringLitLabel _) = False
externallyVisibleCLabel (AsmTempLabel _) = False
-externallyVisibleCLabel (ModuleInitLabel _ _ _)= True
-externallyVisibleCLabel (PlainModuleInitLabel _ _)= True
+externallyVisibleCLabel (ModuleInitLabel _ _) = True
+externallyVisibleCLabel (PlainModuleInitLabel _)= True
externallyVisibleCLabel ModuleRegdLabel = False
externallyVisibleCLabel (RtsLabel _) = True
externallyVisibleCLabel (ForeignLabel _ _ _) = True
externallyVisibleCLabel (IdLabel name _) = isExternalName name
-externallyVisibleCLabel (DynIdLabel name _) = isExternalName name
externallyVisibleCLabel (CC_Label _) = True
externallyVisibleCLabel (CCS_Label _) = True
externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
externallyVisibleCLabel (HpcTicksLabel _) = True
-externallyVisibleCLabel (HpcModuleOffsetLabel _) = True
externallyVisibleCLabel HpcModuleNameLabel = False
+externallyVisibleCLabel (LargeBitmapLabel _) = False
+externallyVisibleCLabel (LargeSRTLabel _) = False
-- -----------------------------------------------------------------------------
-- Finding the "type" of a CLabel
labelType (RtsLabel (RtsApFast _)) = CodeLabel
labelType (CaseLabel _ CaseReturnInfo) = DataLabel
labelType (CaseLabel _ _) = CodeLabel
-labelType (ModuleInitLabel _ _ _) = CodeLabel
-labelType (PlainModuleInitLabel _ _) = CodeLabel
+labelType (ModuleInitLabel _ _) = CodeLabel
+labelType (PlainModuleInitLabel _) = CodeLabel
+labelType (LargeSRTLabel _) = DataLabel
+labelType (LargeBitmapLabel _) = DataLabel
labelType (IdLabel _ info) = idInfoLabelType info
-labelType (DynIdLabel _ info) = idInfoLabelType info
labelType _ = DataLabel
idInfoLabelType info =
case info of
InfoTable -> DataLabel
Closure -> DataLabel
- Bitmap -> DataLabel
ConInfoTable -> DataLabel
StaticInfoTable -> DataLabel
ClosureTable -> DataLabel
+-- krc: aie! a ticky counter label is data
+ RednCounts -> DataLabel
_ -> CodeLabel
-- @labelDynamic@ returns @True@ if the label is located
-- in a DLL, be it a data reference or not.
-labelDynamic :: CLabel -> Bool
-labelDynamic lbl =
+labelDynamic :: PackageId -> CLabel -> Bool
+labelDynamic this_pkg lbl =
case lbl of
- RtsLabel _ -> not opt_Static -- i.e., is the RTS in a DLL or not?
- IdLabel n k -> False
- DynIdLabel n k -> True
+ RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
+ IdLabel n k -> isDllName this_pkg n
#if mingw32_TARGET_OS
ForeignLabel _ _ d -> d
#else
-- so we claim that all foreign imports come from dynamic libraries
ForeignLabel _ _ _ -> True
#endif
- ModuleInitLabel m _ dyn -> not opt_Static && dyn
- PlainModuleInitLabel m dyn -> not opt_Static && dyn
+ ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
+ PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
-- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
_ -> False
pprCLbl (CaseLabel u CaseDefault)
= hcat [pprUnique u, ptext SLIT("_dflt")]
+pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext SLIT("srtd")
+pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext SLIT("btm")
+-- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
+-- until that gets resolved we'll just force them to start
+-- with a letter so the label will be legal assmbly code.
+
+
pprCLbl (RtsLabel (RtsCode str)) = ptext str
pprCLbl (RtsLabel (RtsData str)) = ptext str
pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
= ftext str
pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor
-pprCLbl (DynIdLabel name flavor) = ppr name <> ppIdFlavor flavor
pprCLbl (CC_Label cc) = ppr cc
pprCLbl (CCS_Label ccs) = ppr ccs
-pprCLbl (ModuleInitLabel mod way _)
+pprCLbl (ModuleInitLabel mod way)
= ptext SLIT("__stginit_") <> ppr mod
<> char '_' <> text way
-pprCLbl (PlainModuleInitLabel mod _)
+pprCLbl (PlainModuleInitLabel mod)
= ptext SLIT("__stginit_") <> ppr mod
pprCLbl (HpcTicksLabel mod)
= ptext SLIT("_hpc_tickboxes_") <> ppr mod <> ptext SLIT("_hpc")
-pprCLbl (HpcModuleOffsetLabel mod)
- = ptext SLIT("_hpc_module_offset_") <> ppr mod <> ptext SLIT("_hpc")
-
pprCLbl HpcModuleNameLabel
= ptext SLIT("_hpc_module_name_str")
(case x of
Closure -> ptext SLIT("closure")
SRT -> ptext SLIT("srt")
- SRTDesc -> ptext SLIT("srtd")
InfoTable -> ptext SLIT("info")
Entry -> ptext SLIT("entry")
Slow -> ptext SLIT("slow")
RednCounts -> ptext SLIT("ct")
- Bitmap -> ptext SLIT("btm")
ConEntry -> ptext SLIT("con_entry")
ConInfoTable -> ptext SLIT("con_info")
StaticConEntry -> ptext SLIT("static_entry")
= pprCLabel lbl <> text "@gotpcrel"
pprDynamicLinkerAsmLabel GotSymbolOffset lbl
= pprCLabel lbl
-pprDynamicLinkerAsmLabel _ _
- = panic "pprDynamicLinkerAsmLabel"
+pprDynamicLinkerAsmLabel SymbolPtr lbl
+ = text ".LC_" <> pprCLabel lbl
#elif linux_TARGET_OS
pprDynamicLinkerAsmLabel CodeStub lbl
= pprCLabel lbl <> text "@plt"
projects / ghc-hetmet.git / blobdiff