[Git][ghc/ghc][wip/t21766] Make IPE tests compatible with new layout
Finley McIlwaine (@FinleyMcIlwaine)
gitlab at gitlab.haskell.org
Fri Feb 3 21:56:58 UTC 2023
Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC
Commits:
df06f7ef by Finley McIlwaine at 2023-02-03T14:55:38-07:00
Make IPE tests compatible with new layout
IPE data compression requires a new layout for the IPE buffer list
entries. This commit makes sure the IPE test field names are consistent
with the actual fields of IpeBufferEntry and IpeBufferListNode. See
ticket #21766.
This commit also introduces checks to avoid importing modules if IPE
compression is not enabled.
- - - - -
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 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,16 @@ 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]
+ -> BS.ByteString
toIpeBufferEntries cg_ipes =
- [ CmmString
- . compress defaultCompressionLevel
+ compress defaultCompressionLevel
. BSL.toStrict . BSB.toLazyByteString . mconcat
- $ map (mconcat . map (BSB.word32BE) . to_ipe_buf_ent) cg_ipes
- ]
+ $ map (mconcat . map BSB.word32BE . 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
@@ -194,7 +191,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
=====================================
@@ -45,10 +45,14 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) {
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);
@@ -77,10 +81,14 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap,
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);
@@ -109,11 +117,16 @@ void shouldFindTwoFromTheSameList(Capability *cap) {
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);
@@ -74,9 +73,11 @@ IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) {
init_string_table(&st);
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);
}
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/df06f7efc703e7349c7218cfda8c595ef60182e2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df06f7efc703e7349c7218cfda8c595ef60182e2
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/20230203/fa74c146/attachment-0001.html>
More information about the ghc-commits
mailing list