[Git][ghc/ghc][wip/t21766] Fix byte order of IPE data, fix IPE tests
Finley McIlwaine (@FinleyMcIlwaine)
gitlab at gitlab.haskell.org
Mon Feb 6 18:58:09 UTC 2023
Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC
Commits:
56b0d3ac by Finley McIlwaine at 2023-02-06T11:55:12-07:00
Fix byte order of IPE data, fix IPE tests
Make sure byte order of written IPE buffer entries matches target.
Make sure the IPE-related tests properly access the fields of IPE buffer
entry nodes with the new IPE layout.
This commit also introduces checks to avoid importing modules if IPE
compression is not enabled.
See ticket #21766.
- - - - -
6 changed files:
- compiler/GHC/StgToCmm/InfoTableProv.hs
- rts/include/rts/IPE.h
- testsuite/tests/rts/ipe/ipeEventLog_fromMap.c
- testsuite/tests/rts/ipe/ipeMap.c
- testsuite/tests/rts/ipe/ipe_lib.c
- testsuite/tests/rts/ipe/ipe_lib.h
Changes:
=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -3,10 +3,14 @@
module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where
import Foreign
+
+#if defined(HAVE_LIBZSTD)
import Foreign.C.Types
+import qualified Data.ByteString.Internal as BSI
+import GHC.IO (unsafePerformIO)
+#endif
import GHC.Data.FastString (fastStringToShortText)
-import GHC.IO (unsafePerformIO)
import GHC.Prelude
import GHC.Platform
import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile)
@@ -26,7 +30,6 @@ import Control.Monad.Trans.State.Strict
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
-import qualified Data.ByteString.Internal as BSI
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Map.Strict as M
@@ -90,17 +93,16 @@ emitIpeBufferListNode this_mod ents = do
uncompressed_strings = getStringTableStrings strtab
strings_bytes :: BS.ByteString
- strings_bytes =
- if do_compress == 1 then
- compress defaultCompressionLevel uncompressed_strings
- else
- uncompressed_strings
+ strings_bytes = compress defaultCompressionLevel uncompressed_strings
strings :: [CmmStatic]
strings = [CmmString strings_bytes]
+ entries_bytes :: BS.ByteString
+ entries_bytes = toIpeBufferEntries (platformByteOrder platform) cg_ipes
+
entries :: [CmmStatic]
- entries = toIpeBufferEntries cg_ipes
+ entries = [CmmString entries_bytes]
ipe_buffer_lbl :: CLabel
ipe_buffer_lbl = mkIPELabel this_mod
@@ -111,7 +113,7 @@ emitIpeBufferListNode this_mod ents = do
zeroCLit platform
-- 'compressed' field
- , int $ do_compress
+ , int do_compress
-- 'count' field
, int $ length cg_ipes
@@ -123,13 +125,13 @@ emitIpeBufferListNode this_mod ents = do
, CmmLabel entries_lbl
-- 'entries_size' field
- , int (length cg_ipes * 8 * 32)
+ , int $ BS.length entries_bytes
-- 'string_table' field
, CmmLabel strings_lbl
-- 'string_table_size' field
- , int (BS.length strings_bytes)
+ , int $ BS.length strings_bytes
]
-- Emit the list of info table pointers
@@ -153,21 +155,17 @@ emitIpeBufferListNode this_mod ents = do
(CmmStaticsRaw ipe_buffer_lbl ipe_buffer_node)
-- | Emit the fields of an IpeBufferEntry struct for each entry in a given list.
--- The fields are converted to a bytestring, compressed, and then emitted as a
--- string. If compression is not enabled, the compression step is simply
--- @id at .
+-- The fields are converted to a bytestring and compressed. If compression is
+-- not enabled, the compression step is simply @id at .
toIpeBufferEntries ::
- [CgInfoProvEnt] -- ^ List of IPE buffer entries
- -> [CmmStatic]
-toIpeBufferEntries cg_ipes =
- [ CmmString
- . compress defaultCompressionLevel
+ ByteOrder -- ^ Byte order to write the data in
+ -> [CgInfoProvEnt] -- ^ List of IPE buffer entries
+ -> BS.ByteString
+toIpeBufferEntries byte_order cg_ipes =
+ compress defaultCompressionLevel
. BSL.toStrict . BSB.toLazyByteString . mconcat
- $ map (mconcat . map (BSB.word32BE) . to_ipe_buf_ent) cg_ipes
- ]
+ $ map (mconcat . map word32Builder . to_ipe_buf_ent) cg_ipes
where
- int32 n = CmmStaticLit $ CmmInt (fromIntegral n) W32
-
to_ipe_buf_ent :: CgInfoProvEnt -> [Word32]
to_ipe_buf_ent cg_ipe =
[ ipeTableName cg_ipe
@@ -180,6 +178,11 @@ toIpeBufferEntries cg_ipes =
, 0 -- padding
]
+ word32Builder :: Word32 -> BSB.Builder
+ word32Builder = case byte_order of
+ BigEndian -> BSB.word32BE
+ LittleEndian -> BSB.word32LE
+
toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt
toCgIPE platform ctx module_name ipe = do
table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform (infoTablePtr ipe))
@@ -194,7 +197,7 @@ toCgIPE platform ctx module_name ipe = do
coords = renderWithContext ctx (pprUserRealSpan False span)
in (file, coords)
label <- lookupStringTable $ ST.pack label_str
- src_file <- lookupStringTable $ src_loc_file
+ src_file <- lookupStringTable src_loc_file
src_span <- lookupStringTable $ ST.pack src_loc_span
return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe
, ipeTableName = table_name
=====================================
rts/include/rts/IPE.h
=====================================
@@ -70,18 +70,18 @@ typedef struct IpeBufferListNode_ {
// Everything below is read-only and generated by the codegen
// This flag should be treated as a boolean
- const StgWord compressed;
+ StgWord compressed;
StgWord count;
// When TNTC is enabled, these will point to the entry code
// not the info table itself.
- const StgInfoTable **tables;
+ StgInfoTable **tables;
- const IpeBufferEntry *entries;
+ IpeBufferEntry *entries;
StgWord entries_size;
- const char *string_table;
+ char *string_table;
StgWord string_table_size;
} IpeBufferListNode;
=====================================
testsuite/tests/rts/ipe/ipeEventLog_fromMap.c
=====================================
@@ -19,7 +19,7 @@ int main(int argc, char *argv[]) {
registerInfoProvList(list2);
// Query an IPE to initialize the underlying hash map.
- lookupIPE(list1->entries[0].info);
+ lookupIPE(list1->tables[0]);
// Trace all IPE events.
dumpIPEToEventLog();
=====================================
testsuite/tests/rts/ipe/ipeMap.c
=====================================
@@ -40,15 +40,23 @@ void shouldFindNothingInAnEmptyIPEMap(Capability *cap) {
}
HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) {
- IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry));
+ // Allocate buffers for IPE buffer list node
+ IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode));
+ node->tables = malloc(sizeof(StgInfoTable *));
+ node->entries = malloc(sizeof(IpeBufferEntry));
+
StringTable st;
init_string_table(&st);
HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42));
- node->entries[0] = makeAnyProvEntry(cap, &st, fortyTwo, 42);
- node->count = 1;
node->next = NULL;
+ node->compressed = 0;
+ node->count = 1;
+ node->tables[0] = get_itbl(fortyTwo);
+ node->entries[0] = makeAnyProvEntry(cap, &st, 42);
+ node->entries_size = sizeof(IpeBufferEntry);
node->string_table = st.buffer;
+ node->string_table_size = st.size;
registerInfoProvList(node);
@@ -72,15 +80,23 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) {
void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap,
HaskellObj fortyTwo) {
- IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry));
+ // Allocate buffers for IPE buffer list node
+ IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode));
+ node->tables = malloc(sizeof(StgInfoTable *));
+ node->entries = malloc(sizeof(IpeBufferEntry));
+
StringTable st;
init_string_table(&st);
HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23));
- node->entries[0] = makeAnyProvEntry(cap, &st, twentyThree, 23);
- node->count = 1;
node->next = NULL;
+ node->compressed = 0;
+ node->count = 1;
+ node->tables[0] = get_itbl(twentyThree);
+ node->entries[0] = makeAnyProvEntry(cap, &st, 23);
+ node->entries_size = sizeof(IpeBufferEntry);
node->string_table = st.buffer;
+ node->string_table_size = st.size;
registerInfoProvList(node);
@@ -103,17 +119,26 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap,
}
void shouldFindTwoFromTheSameList(Capability *cap) {
- IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + 2 * sizeof(IpeBufferEntry));
+ // Allocate buffers for IPE buffer list node
+ IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode));
+ node->tables = malloc(sizeof(StgInfoTable *) * 2);
+ node->entries = malloc(sizeof(IpeBufferEntry) * 2);
+
StringTable st;
init_string_table(&st);
HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1));
HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2));
- node->entries[0] = makeAnyProvEntry(cap, &st, one, 1);
- node->entries[1] = makeAnyProvEntry(cap, &st, two, 2);
- node->count = 2;
node->next = NULL;
+ node->compressed = 0;
+ node->count = 2;
+ node->tables[0] = get_itbl(one);
+ node->tables[1] = get_itbl(two);
+ node->entries[0] = makeAnyProvEntry(cap, &st, 1);
+ node->entries[1] = makeAnyProvEntry(cap, &st, 2);
+ node->entries_size = sizeof(IpeBufferEntry) * 2;
node->string_table = st.buffer;
+ node->string_table_size = st.size;
registerInfoProvList(node);
=====================================
testsuite/tests/rts/ipe/ipe_lib.c
=====================================
@@ -25,9 +25,8 @@ uint32_t add_string(StringTable *st, const char *s) {
return n;
}
-IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i) {
+IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) {
IpeBufferEntry provEnt;
- provEnt.info = get_itbl(closure);
unsigned int tableNameLength = strlen("table_name_") + 3 /* digits */ + 1 /* null character */;
char *tableName = malloc(sizeof(char) * tableNameLength);
@@ -69,15 +68,27 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj clo
IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) {
const int n = end - start;
- IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + n * sizeof(IpeBufferEntry));
+
+ // Allocate buffers for IpeBufferListNode
+ IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode));
+ node->tables = malloc(sizeof(StgInfoTable *) * n);
+ node->entries = malloc(sizeof(IpeBufferEntry) * n);
+
StringTable st;
init_string_table(&st);
+
+ // Make the entries and fill the buffers
for (int i=start; i < end; i++) {
HaskellObj closure = rts_mkInt(cap, 42);
- node->entries[i] = makeAnyProvEntry(cap, &st, closure, i);
+ node->tables[i] = get_itbl(closure);
+ node->entries[i] = makeAnyProvEntry(cap, &st, i);
}
+
+ // Set the rest of the fields
node->next = NULL;
+ node->compressed = 0;
node->count = n;
node->string_table = st.buffer;
+
return node;
}
=====================================
testsuite/tests/rts/ipe/ipe_lib.h
=====================================
@@ -12,6 +12,6 @@ void init_string_table(StringTable *st);
uint32_t add_string(StringTable *st, const char *s);
IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end);
-IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i);
+IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i);
void dumpIPEToEventLog(void);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56b0d3ac6118f0bfac654ec85c2dcc3dbb27bc4e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56b0d3ac6118f0bfac654ec85c2dcc3dbb27bc4e
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/20230206/6f3e4cbc/attachment-0001.html>
More information about the ghc-commits
mailing list