[Git][ghc/ghc][wip/con-info] 5 commits: Description of primop
Matthew Pickering
gitlab at gitlab.haskell.org
Wed Nov 18 11:04:11 UTC 2020
Matthew Pickering pushed to branch wip/con-info at Glasgow Haskell Compiler / GHC
Commits:
b4252889 by Matthew Pickering at 2020-11-18T10:43:48+00:00
Description of primop
- - - - -
f40529dd by Matthew Pickering at 2020-11-18T10:53:07+00:00
clean
- - - - -
652a274b by Matthew Pickering at 2020-11-18T10:59:06+00:00
Return
- - - - -
15e73efa by Matthew Pickering at 2020-11-18T11:00:46+00:00
clean
- - - - -
d9332454 by Matthew Pickering at 2020-11-18T11:03:58+00:00
clean
- - - - -
6 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/StgToCmm/Prof.hs
- compiler/GHC/StgToCmm/Utils.hs
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -3009,7 +3009,9 @@ section "Info Table Origin"
------------------------------------------------------------------------
primop WhereFromOp "whereFrom#" GenPrimOp
a -> State# s -> (# State# s, Addr# #)
- { TODO }
+ { Returns the {\tt InfoProvEnt } for the info table of the given object
+ (value is {\tt NULL} if the table does not exist or there is no information
+ about the closure).}
with
out_of_line = True
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -80,16 +80,10 @@ module GHC.Cmm.CLabel (
mkRtsApFastLabel,
mkPrimCallLabel,
mkForeignLabel,
- addLabelSize,
-
- foreignLabelStdcallInfo,
- isBytesLabel,
- isForeignLabel,
- isSomeRODataLabel,
- isStaticClosureLabel,
- mkCCLabel, mkCCSLabel,
-
- mkIPELabel, InfoTableEnt(..),
+ mkCCLabel,
+ mkCCSLabel,
+ mkIPELabel,
+ InfoProvEnt(..),
mkDynamicLinkerLabel,
mkPicBaseLabel,
@@ -112,6 +106,10 @@ module GHC.Cmm.CLabel (
isIdLabel,
isTickyLabel,
hasHaskellName,
+ isBytesLabel,
+ isForeignLabel,
+ isSomeRODataLabel,
+ isStaticClosureLabel,
-- * Conversions
toClosureLbl,
@@ -125,7 +123,9 @@ module GHC.Cmm.CLabel (
pprCLabel,
-- * Others
- dynamicLinkerLabelInfo
+ dynamicLinkerLabelInfo,
+ addLabelSize,
+ foreignLabelStdcallInfo
) where
#include "HsVersions.h"
@@ -253,7 +253,7 @@ data CLabel
| CC_Label CostCentre
| CCS_Label CostCentreStack
- | IPE_Label InfoTableEnt
+ | IPE_Label InfoProvEnt
-- | These labels are generated and used inside the NCG only.
@@ -735,19 +735,16 @@ mkBitmapLabel :: Unique -> CLabel
mkBitmapLabel uniq = LargeBitmapLabel uniq
-data InfoTableEnt = InfoTableEnt { infoTablePtr :: !CLabel
- , infoTableEntClosureType :: !Int
- , infoTableType :: !String
- , infoTableProv :: !(Module, RealSrcSpan, String) }
- deriving (Eq, Ord)
-
---instance Outputable InfoTableEnt where
--- ppr (InfoTableEnt l ct p) = pdoc (undefined :: Platform) l <> colon <> ppr ct <> colon <> ppr p
+data InfoProvEnt = InfoProvEnt { infoTablePtr :: !CLabel
+ , infoProvEntClosureType :: !Int
+ , infoTableType :: !String
+ , infoTableProv :: !(Module, RealSrcSpan, String) }
+ deriving (Eq, Ord)
-- Constructing Cost Center Labels
mkCCLabel :: CostCentre -> CLabel
mkCCSLabel :: CostCentreStack -> CLabel
-mkIPELabel :: InfoTableEnt -> CLabel
+mkIPELabel :: InfoProvEnt -> CLabel
mkCCLabel cc = CC_Label cc
mkCCSLabel ccs = CCS_Label ccs
mkIPELabel ipe = IPE_Label ipe
@@ -1393,7 +1390,7 @@ pprCLabel platform sty lbl =
CC_Label cc -> maybe_underscore $ ppr cc
CCS_Label ccs -> maybe_underscore $ ppr ccs
- (IPE_Label (InfoTableEnt l _ _ (m, _, _))) -> pprCode CStyle (pdoc platform l) <> text "_" <> ppr m <> text "_ipe"
+ (IPE_Label (InfoProvEnt l _ _ (m, _, _))) -> pprCode CStyle (pdoc platform l) <> text "_" <> ppr m <> text "_ipe"
CmmLabel _ _ fs CmmCode -> maybe_underscore $ ftext fs
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -1,4 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
{-
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -163,6 +163,19 @@ import GHC.Cmm.Info.Build
import GHC.Cmm.Pipeline
import GHC.Cmm.Info
+import GHC.Unit
+import GHC.Unit.External
+import GHC.Unit.State
+import GHC.Unit.Module.ModDetails
+import GHC.Unit.Module.ModGuts
+import GHC.Unit.Module.ModIface
+import GHC.Unit.Module.ModSummary
+import GHC.Unit.Module.Graph
+import GHC.Unit.Module.Imported
+import GHC.Unit.Module.Deps
+import GHC.Unit.Module.Status
+import GHC.Unit.Home.ModInfo
+
import GHC.Utils.Error
import Data.IORef
@@ -210,19 +223,6 @@ import Data.Set (Set)
import Data.Functor
import Control.DeepSeq (force)
import Data.Bifunctor (first, bimap)
-import GHC.Unit.Module.ModGuts
-import GHC.Unit.Module.ModSummary
-import GHC.Unit.Module
-import GHC.Unit.Module.ModIface
-import GHC.Unit.Module.ModDetails
-import GHC.Unit.Module.Status
-import GHC.Unit.Module.Imported
-import GHC.Unit.Module.Graph
-import GHC.Unit.Home.ModInfo
-import GHC.Unit.Home
-import GHC.Unit.State
-import GHC.Unit.Module.Deps
-import GHC.Unit.External
#include "HsVersions.h"
=====================================
compiler/GHC/StgToCmm/Prof.hs
=====================================
@@ -286,7 +286,7 @@ initInfoTableProv (InfoTableProvMap dcmap clmap) this_mod
mapM_ emitInfoTableProv ents
--- Info Table Prov stuff
-emitInfoTableProv :: InfoTableEnt -> FCode ()
+emitInfoTableProv :: InfoProvEnt -> FCode ()
emitInfoTableProv ip = do
{ dflags <- getDynFlags
; let (mod, src, label) = infoTableProv ip
@@ -305,7 +305,7 @@ emitInfoTableProv ip = do
showPpr dflags (pprCLabel platform CStyle (infoTablePtr ip))
; closure_type <- newByteStringCLit $ bytesFS $ mkFastString $
- showPpr dflags (text $ show $ infoTableEntClosureType ip)
+ showPpr dflags (text $ show $ infoProvEntClosureType ip)
; let
lits = [ CmmLabel (infoTablePtr ip), -- Info table pointer
table_name, -- char *table_name
=====================================
compiler/GHC/StgToCmm/Utils.hs
=====================================
@@ -633,20 +633,20 @@ emitUpdRemSetPushThunk ptr =
False
-convertClosureMap :: [CmmInfoTable] -> Module -> ClosureMap -> [InfoTableEnt]
+convertClosureMap :: [CmmInfoTable] -> Module -> ClosureMap -> [InfoProvEnt]
convertClosureMap defns this_mod denv =
mapMaybe (\cmit -> do
let cl = cit_lbl cmit
cn = rtsClosureType (cit_rep cmit)
n <- hasHaskellName cl
(ty, ss, l) <- lookupUniqMap denv n
- return (InfoTableEnt cl cn ty (this_mod, ss, l))) defns
+ return (InfoProvEnt cl cn ty (this_mod, ss, l))) defns
-convertDCMap :: Module -> DCMap -> [InfoTableEnt]
+convertDCMap :: Module -> DCMap -> [InfoProvEnt]
convertDCMap this_mod (UniqMap denv) =
concatMap (\(dc, ns) -> mapMaybe (\(k, mss) ->
case mss of
Nothing -> Nothing
Just (ss, l) -> Just $
- InfoTableEnt (mkConInfoTableLabel (dataConName dc) (Just (this_mod, k)))
+ InfoProvEnt (mkConInfoTableLabel (dataConName dc) (Just (this_mod, k)))
0 "" (this_mod, ss, l)) ns) (nonDetEltsUFM denv)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/129de9a0aa783114fbeabf557d3591d75f0aec0c...d9332454f4c3a7615c6a94f70bcf67f05fd9d7b6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/129de9a0aa783114fbeabf557d3591d75f0aec0c...d9332454f4c3a7615c6a94f70bcf67f05fd9d7b6
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201118/548f8539/attachment-0001.html>
More information about the ghc-commits
mailing list