[Git][ghc/ghc][wip/T24504] IPE: Eliminate dependency on Read
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Sat May 4 00:54:34 UTC 2024
Ben Gamari pushed to branch wip/T24504 at Glasgow Haskell Compiler / GHC
Commits:
80c85fe5 by Ben Gamari at 2024-05-03T20:53:07-04:00
IPE: Eliminate dependency on Read
Instead of encoding the closure type as decimal string we now simply
represent it as an integer, eliminating the need for `Read` in
`GHC.Internal.InfoProv.Types.peekInfoProv`.
Closes #24504.
- - - - -
5 changed files:
- compiler/GHC/StgToCmm/InfoTableProv.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
- rts/IPE.c
- rts/Trace.c
- rts/include/rts/IPE.h
Changes:
=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -178,7 +178,7 @@ toIpeBufferEntries byte_order cg_ipes =
to_ipe_buf_ent :: CgInfoProvEnt -> [Word32]
to_ipe_buf_ent cg_ipe =
[ ipeTableName cg_ipe
- , ipeClosureDesc cg_ipe
+ , fromIntegral $ ipeClosureDesc cg_ipe
, ipeTypeDesc cg_ipe
, ipeLabel cg_ipe
, ipeSrcFile cg_ipe
@@ -193,7 +193,6 @@ toIpeBufferEntries byte_order cg_ipes =
toCgIPE :: Platform -> SDocContext -> InfoProvEnt -> State StringTable CgInfoProvEnt
toCgIPE platform ctx ipe = do
table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform (infoTablePtr ipe))
- closure_desc <- lookupStringTable $ ST.pack $ show (infoProvEntClosureType ipe)
type_desc <- lookupStringTable $ ST.pack $ infoTableType ipe
let label_str = maybe "" ((\(LexicalFastString s) -> unpackFS s) . snd) (infoTableProv ipe)
let (src_loc_file, src_loc_span) =
@@ -208,7 +207,7 @@ toCgIPE platform ctx ipe = do
src_span <- lookupStringTable $ ST.pack src_loc_span
return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe
, ipeTableName = table_name
- , ipeClosureDesc = closure_desc
+ , ipeClosureDesc = fromIntegral (infoProvEntClosureType ipe)
, ipeTypeDesc = type_desc
, ipeLabel = label
, ipeSrcFile = src_file
@@ -218,7 +217,7 @@ toCgIPE platform ctx ipe = do
data CgInfoProvEnt = CgInfoProvEnt
{ ipeInfoTablePtr :: !CLabel
, ipeTableName :: !StrTabOffset
- , ipeClosureDesc :: !StrTabOffset
+ , ipeClosureDesc :: !Word32
, ipeTypeDesc :: !StrTabOffset
, ipeLabel :: !StrTabOffset
, ipeSrcFile :: !StrTabOffset
=====================================
libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
=====================================
@@ -18,8 +18,9 @@ module GHC.Internal.InfoProv.Types
) where
import GHC.Internal.Base
-import GHC.Internal.Data.Maybe
import GHC.Internal.Enum
+import GHC.Internal.Real (fromIntegral)
+import GHC.Internal.Word (Word32)
import GHC.Internal.Show (Show)
import GHC.Internal.Ptr (Ptr(..), plusPtr)
import GHC.Internal.Foreign.C.String.Encoding (CString, peekCString)
@@ -28,7 +29,6 @@ import GHC.Internal.Foreign.Marshal.Alloc (allocaBytes)
import GHC.Internal.IO.Encoding (utf8)
import GHC.Internal.Foreign.Storable (peekByteOff)
import GHC.Internal.ClosureTypes
-import GHC.Internal.Text.Read
import GHC.Prim (whereFrom##)
data InfoProv = InfoProv {
@@ -70,9 +70,11 @@ getIPE obj fail k = allocaBytes (#size InfoProvEnt) $ \p -> IO $ \s ->
ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv
ipeProv p = (#ptr InfoProvEnt, prov) p
-peekIpName, peekIpDesc, peekIpLabel, peekIpUnitId, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString
-peekIpName p = (# peek InfoProv, table_name) p
+peekIpDesc :: Ptr InfoProv -> IO Word32
peekIpDesc p = (# peek InfoProv, closure_desc) p
+
+peekIpName, peekIpLabel, peekIpUnitId, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString
+peekIpName p = (# peek InfoProv, table_name) p
peekIpLabel p = (# peek InfoProv, label) p
peekIpUnitId p = (# peek InfoProv, unit_id) p
peekIpModule p = (# peek InfoProv, module) p
@@ -83,7 +85,7 @@ peekIpTyDesc p = (# peek InfoProv, ty_desc) p
peekInfoProv :: Ptr InfoProv -> IO InfoProv
peekInfoProv infop = do
name <- peekCString utf8 =<< peekIpName infop
- desc <- peekCString utf8 =<< peekIpDesc infop
+ desc <- peekIpDesc infop
tyDesc <- peekCString utf8 =<< peekIpTyDesc infop
label <- peekCString utf8 =<< peekIpLabel infop
unit_id <- peekCString utf8 =<< peekIpUnitId infop
@@ -94,7 +96,7 @@ peekInfoProv infop = do
ipName = name,
-- The INVALID_OBJECT case should be impossible as we
-- control the C code generating these values.
- ipDesc = maybe INVALID_OBJECT toEnum . readMaybe @Int $ desc,
+ ipDesc = toEnum $ fromIntegral desc,
ipTyDesc = tyDesc,
ipLabel = label,
ipUnitId = unit_id,
=====================================
rts/IPE.c
=====================================
@@ -105,7 +105,7 @@ static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, uint32_t i
.info = node->tables[idx],
.prov = {
.table_name = &strings[ent->table_name],
- .closure_desc = &strings[ent->closure_desc],
+ .closure_desc = ent->closure_desc,
.ty_desc = &strings[ent->ty_desc],
.label = &strings[ent->label],
.unit_id = &strings[node->unit_id],
=====================================
rts/Trace.c
=====================================
@@ -689,7 +689,7 @@ void traceIPE(const InfoProvEnt *ipe)
ACQUIRE_LOCK(&trace_utx);
tracePreface();
- debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, unit %s, module %s, srcloc %s:%s\n",
+ debugBelch("IPE: table_name %s, closure_desc %d, ty_desc %s, label %s, unit %s, module %s, srcloc %s:%s\n",
ipe->prov.table_name, ipe->prov.closure_desc, ipe->prov.ty_desc,
ipe->prov.label, ipe->prov.unit_id, ipe->prov.module,
ipe->prov.src_file, ipe->prov.src_span);
=====================================
rts/include/rts/IPE.h
=====================================
@@ -15,7 +15,7 @@
typedef struct InfoProv_ {
const char *table_name;
- const char *closure_desc;
+ uint32_t closure_desc; // closure type
const char *ty_desc;
const char *label;
const char *unit_id;
@@ -54,7 +54,7 @@ typedef uint32_t StringIdx;
// to ensure correct packing.
typedef struct {
StringIdx table_name;
- StringIdx closure_desc;
+ uint32_t closure_desc; // closure type
StringIdx ty_desc;
StringIdx label;
StringIdx src_file;
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80c85fe57531a20dc8ea17d79d4b72ef51abd842
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80c85fe57531a20dc8ea17d79d4b72ef51abd842
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/20240503/da409d26/attachment-0001.html>
More information about the ghc-commits
mailing list