Commit 21f0f561 authored by Mitsutoshi Aoe's avatar Mitsutoshi Aoe Committed by Ben Gamari

Add traceBinaryEvent# primop

This adds a new primop called traceBinaryEvent# that takes the length
of binary data and a pointer to the data, then emits it to the eventlog.

There is some example code that uses this primop and the new event:

* [traceBinaryEventIO][1] that calls `traceBinaryEvent#`

* [A patch to ghc-events][2] that parses the new `EVENT_USER_BINARY_MSG`

There's no corresponding issue on Trac but it was discussed at
ghc-devs [3].

[1] https://github.com/maoe/ghc-trace-events/blob
    /fb226011ef1f85a97b4da7cc9d5f98f9fe6316ae/src/Debug/Trace/Binary.hs#L29)
[2] https://github.com/maoe/ghc-events/commit
    /239ca77c24d18cdd10d6d85a0aef98e4a7c56ae6)
[3] https://mail.haskell.org/pipermail/ghc-devs/2018-May/015791.html

Reviewers: bgamari, erikd, simonmar

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D5007
parent 8546afc5
...@@ -3154,17 +3154,27 @@ primop TraceEventOp "traceEvent#" GenPrimOp ...@@ -3154,17 +3154,27 @@ primop TraceEventOp "traceEvent#" GenPrimOp
Addr# -> State# s -> State# s Addr# -> State# s -> State# s
{ Emits an event via the RTS tracing framework. The contents { Emits an event via the RTS tracing framework. The contents
of the event is the zero-terminated byte string passed as the first of the event is the zero-terminated byte string passed as the first
argument. The event will be emitted either to the .eventlog file, argument. The event will be emitted either to the {\tt .eventlog} file,
or to stderr, depending on the runtime RTS flags. } or to stderr, depending on the runtime RTS flags. }
with with
has_side_effects = True has_side_effects = True
out_of_line = True out_of_line = True
primop TraceEventBinaryOp "traceBinaryEvent#" GenPrimOp
Addr# -> Int# -> State# s -> State# s
{ Emits an event via the RTS tracing framework. The contents
of the event is the binary object passed as the first argument with
the the given length passed as the second argument. The event will be
emitted to the {\tt .eventlog} file. }
with
has_side_effects = True
out_of_line = True
primop TraceMarkerOp "traceMarker#" GenPrimOp primop TraceMarkerOp "traceMarker#" GenPrimOp
Addr# -> State# s -> State# s Addr# -> State# s -> State# s
{ Emits a marker event via the RTS tracing framework. The contents { Emits a marker event via the RTS tracing framework. The contents
of the event is the zero-terminated byte string passed as the first of the event is the zero-terminated byte string passed as the first
argument. The event will be emitted either to the .eventlog file, argument. The event will be emitted either to the {\tt .eventlog} file,
or to stderr, depending on the runtime RTS flags. } or to stderr, depending on the runtime RTS flags. }
with with
has_side_effects = True has_side_effects = True
......
...@@ -178,12 +178,15 @@ ...@@ -178,12 +178,15 @@
#define EVENT_HEAP_PROF_SAMPLE_BEGIN 162 #define EVENT_HEAP_PROF_SAMPLE_BEGIN 162
#define EVENT_HEAP_PROF_SAMPLE_COST_CENTRE 163 #define EVENT_HEAP_PROF_SAMPLE_COST_CENTRE 163
#define EVENT_HEAP_PROF_SAMPLE_STRING 164 #define EVENT_HEAP_PROF_SAMPLE_STRING 164
#define EVENT_USER_BINARY_MSG 181
/* /*
* The highest event code +1 that ghc itself emits. Note that some event * The highest event code +1 that ghc itself emits. Note that some event
* ranges higher than this are reserved but not currently emitted by ghc. * ranges higher than this are reserved but not currently emitted by ghc.
* This must match the size of the EventDesc[] array in EventLog.c * This must match the size of the EventDesc[] array in EventLog.c
*/ */
#define NUM_GHC_EVENT_TAGS 165 #define NUM_GHC_EVENT_TAGS 182
#if 0 /* DEPRECATED EVENTS: */ #if 0 /* DEPRECATED EVENTS: */
/* we don't actually need to record the thread, it's implicit */ /* we don't actually need to record the thread, it's implicit */
...@@ -257,4 +260,5 @@ typedef StgWord16 EventCapsetType; /* types for EVENT_CAPSET_CREATE */ ...@@ -257,4 +260,5 @@ typedef StgWord16 EventCapsetType; /* types for EVENT_CAPSET_CREATE */
typedef StgWord64 EventTaskId; /* for EVENT_TASK_* */ typedef StgWord64 EventTaskId; /* for EVENT_TASK_* */
typedef StgWord64 EventKernelThreadId; /* for EVENT_TASK_CREATE */ typedef StgWord64 EventKernelThreadId; /* for EVENT_TASK_CREATE */
#define EVENT_PAYLOAD_SIZE_MAX STG_WORD16_MAX
#endif #endif
...@@ -479,6 +479,7 @@ RTS_FUN_DECL(stg_noDuplicatezh); ...@@ -479,6 +479,7 @@ RTS_FUN_DECL(stg_noDuplicatezh);
RTS_FUN_DECL(stg_traceCcszh); RTS_FUN_DECL(stg_traceCcszh);
RTS_FUN_DECL(stg_clearCCSzh); RTS_FUN_DECL(stg_clearCCSzh);
RTS_FUN_DECL(stg_traceEventzh); RTS_FUN_DECL(stg_traceEventzh);
RTS_FUN_DECL(stg_traceBinaryEventzh);
RTS_FUN_DECL(stg_traceMarkerzh); RTS_FUN_DECL(stg_traceMarkerzh);
RTS_FUN_DECL(stg_getThreadAllocationCounterzh); RTS_FUN_DECL(stg_getThreadAllocationCounterzh);
RTS_FUN_DECL(stg_setThreadAllocationCounterzh); RTS_FUN_DECL(stg_setThreadAllocationCounterzh);
......
...@@ -2405,6 +2405,14 @@ stg_traceEventzh ( W_ msg ) ...@@ -2405,6 +2405,14 @@ stg_traceEventzh ( W_ msg )
return (); return ();
} }
stg_traceBinaryEventzh ( W_ msg, W_ len )
{
#if defined(TRACING) || defined(DEBUG)
ccall traceUserBinaryMsg(MyCapability() "ptr", msg "ptr", len);
#endif
return ();
}
// Same code as stg_traceEventzh above but a different kind of event // Same code as stg_traceEventzh above but a different kind of event
// Before changing this code, read the comments in the impl above // Before changing this code, read the comments in the impl above
stg_traceMarkerzh ( W_ msg ) stg_traceMarkerzh ( W_ msg )
......
...@@ -910,6 +910,7 @@ ...@@ -910,6 +910,7 @@
SymI_HasProto(stg_traceCcszh) \ SymI_HasProto(stg_traceCcszh) \
SymI_HasProto(stg_traceEventzh) \ SymI_HasProto(stg_traceEventzh) \
SymI_HasProto(stg_traceMarkerzh) \ SymI_HasProto(stg_traceMarkerzh) \
SymI_HasProto(stg_traceBinaryEventzh) \
SymI_HasProto(stg_getThreadAllocationCounterzh) \ SymI_HasProto(stg_getThreadAllocationCounterzh) \
SymI_HasProto(stg_setThreadAllocationCounterzh) \ SymI_HasProto(stg_setThreadAllocationCounterzh) \
SymI_HasProto(getMonotonicNSec) \ SymI_HasProto(getMonotonicNSec) \
......
...@@ -746,6 +746,17 @@ void traceUserMsg(Capability *cap, char *msg) ...@@ -746,6 +746,17 @@ void traceUserMsg(Capability *cap, char *msg)
dtraceUserMsg(cap->no, msg); dtraceUserMsg(cap->no, msg);
} }
void traceUserBinaryMsg(Capability *cap, uint8_t *msg, size_t size)
{
/* Note: normally we don't check the TRACE_* flags here as they're checked
by the wrappers in Trace.h. But traceUserMsg is special since it has no
wrapper (it's called from cmm code), so we check TRACE_user here
*/
if (eventlog_enabled && TRACE_user) {
postUserBinaryEvent(cap, EVENT_USER_BINARY_MSG, msg, size);
}
}
void traceUserMarker(Capability *cap, char *markername) void traceUserMarker(Capability *cap, char *markername)
{ {
/* Note: traceUserMarker is special since it has no wrapper (it's called /* Note: traceUserMarker is special since it has no wrapper (it's called
......
...@@ -205,6 +205,11 @@ void traceUserMsg(Capability *cap, char *msg); ...@@ -205,6 +205,11 @@ void traceUserMsg(Capability *cap, char *msg);
*/ */
void traceUserMarker(Capability *cap, char *msg); void traceUserMarker(Capability *cap, char *msg);
/*
* A binary message or event emitted by the program
*/
void traceUserBinaryMsg(Capability *cap, uint8_t *msg, size_t size);
/* /*
* An event to record a Haskell thread's label/name * An event to record a Haskell thread's label/name
* Used by GHC.Conc.labelThread * Used by GHC.Conc.labelThread
......
...@@ -105,6 +105,7 @@ char *EventDesc[] = { ...@@ -105,6 +105,7 @@ char *EventDesc[] = {
[EVENT_HEAP_PROF_SAMPLE_BEGIN] = "Start of heap profile sample", [EVENT_HEAP_PROF_SAMPLE_BEGIN] = "Start of heap profile sample",
[EVENT_HEAP_PROF_SAMPLE_STRING] = "Heap profile string sample", [EVENT_HEAP_PROF_SAMPLE_STRING] = "Heap profile string sample",
[EVENT_HEAP_PROF_SAMPLE_COST_CENTRE] = "Heap profile cost-centre sample", [EVENT_HEAP_PROF_SAMPLE_COST_CENTRE] = "Heap profile cost-centre sample",
[EVENT_USER_BINARY_MSG] = "User binary message"
}; };
// Event type. // Event type.
...@@ -466,6 +467,10 @@ initEventLogging(const EventLogWriter *ev_writer) ...@@ -466,6 +467,10 @@ initEventLogging(const EventLogWriter *ev_writer)
eventTypes[t].size = EVENT_SIZE_DYNAMIC; eventTypes[t].size = EVENT_SIZE_DYNAMIC;
break; break;
case EVENT_USER_BINARY_MSG:
eventTypes[t].size = EVENT_SIZE_DYNAMIC;
break;
default: default:
continue; /* ignore deprecated events */ continue; /* ignore deprecated events */
} }
...@@ -745,6 +750,10 @@ void postCapsetStrEvent (EventTypeNum tag, ...@@ -745,6 +750,10 @@ void postCapsetStrEvent (EventTypeNum tag,
{ {
int strsize = strlen(msg); int strsize = strlen(msg);
int size = strsize + sizeof(EventCapsetID); int size = strsize + sizeof(EventCapsetID);
if (size > EVENT_PAYLOAD_SIZE_MAX) {
errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, bail out");
return;
}
ACQUIRE_LOCK(&eventBufMutex); ACQUIRE_LOCK(&eventBufMutex);
...@@ -752,7 +761,7 @@ void postCapsetStrEvent (EventTypeNum tag, ...@@ -752,7 +761,7 @@ void postCapsetStrEvent (EventTypeNum tag,
printAndClearEventBuf(&eventBuf); printAndClearEventBuf(&eventBuf);
if (!hasRoomForVariableEvent(&eventBuf, size)){ if (!hasRoomForVariableEvent(&eventBuf, size)){
// Event size exceeds buffer size, bail out: errorBelch("Event size exceeds buffer size, bail out");
RELEASE_LOCK(&eventBufMutex); RELEASE_LOCK(&eventBufMutex);
return; return;
} }
...@@ -785,7 +794,7 @@ void postCapsetVecEvent (EventTypeNum tag, ...@@ -785,7 +794,7 @@ void postCapsetVecEvent (EventTypeNum tag,
printAndClearEventBuf(&eventBuf); printAndClearEventBuf(&eventBuf);
if(!hasRoomForVariableEvent(&eventBuf, size)){ if(!hasRoomForVariableEvent(&eventBuf, size)){
// Event size exceeds buffer size, bail out: errorBelch("Event size exceeds buffer size, bail out");
RELEASE_LOCK(&eventBufMutex); RELEASE_LOCK(&eventBufMutex);
return; return;
} }
...@@ -1024,14 +1033,43 @@ void postCapMsg(Capability *cap, char *msg, va_list ap) ...@@ -1024,14 +1033,43 @@ void postCapMsg(Capability *cap, char *msg, va_list ap)
void postUserEvent(Capability *cap, EventTypeNum type, char *msg) void postUserEvent(Capability *cap, EventTypeNum type, char *msg)
{ {
const int size = strlen(msg); const size_t size = strlen(msg);
if (size > EVENT_PAYLOAD_SIZE_MAX) {
errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, bail out");
return;
}
EventsBuf *eb = &capEventBuf[cap->no]; EventsBuf *eb = &capEventBuf[cap->no];
if (!hasRoomForVariableEvent(eb, size)){
printAndClearEventBuf(eb);
if (!hasRoomForVariableEvent(eb, size)){
errorBelch("Event size exceeds buffer size, bail out");
return;
}
}
postEventHeader(eb, type);
postPayloadSize(eb, size);
postBuf(eb, (StgWord8*) msg, size);
}
void postUserBinaryEvent(Capability *cap,
EventTypeNum type,
uint8_t *msg,
size_t size)
{
if (size > EVENT_PAYLOAD_SIZE_MAX) {
errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, bail out");
return;
}
EventsBuf *eb = &capEventBuf[cap->no];
if (!hasRoomForVariableEvent(eb, size)){ if (!hasRoomForVariableEvent(eb, size)){
printAndClearEventBuf(eb); printAndClearEventBuf(eb);
if (!hasRoomForVariableEvent(eb, size)){ if (!hasRoomForVariableEvent(eb, size)){
// Event size exceeds buffer size, bail out: errorBelch("Event size exceeds buffer size, bail out");
return; return;
} }
} }
...@@ -1047,13 +1085,17 @@ void postThreadLabel(Capability *cap, ...@@ -1047,13 +1085,17 @@ void postThreadLabel(Capability *cap,
{ {
const int strsize = strlen(label); const int strsize = strlen(label);
const int size = strsize + sizeof(EventThreadID); const int size = strsize + sizeof(EventThreadID);
EventsBuf *eb = &capEventBuf[cap->no]; if (size > EVENT_PAYLOAD_SIZE_MAX) {
errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, bail out");
return;
}
EventsBuf *eb = &capEventBuf[cap->no];
if (!hasRoomForVariableEvent(eb, size)){ if (!hasRoomForVariableEvent(eb, size)){
printAndClearEventBuf(eb); printAndClearEventBuf(eb);
if (!hasRoomForVariableEvent(eb, size)){ if (!hasRoomForVariableEvent(eb, size)){
// Event size exceeds buffer size, bail out: errorBelch("Event size exceeds buffer size, bail out");
return; return;
} }
} }
......
...@@ -47,6 +47,9 @@ void postMsg(char *msg, va_list ap); ...@@ -47,6 +47,9 @@ void postMsg(char *msg, va_list ap);
void postUserEvent(Capability *cap, EventTypeNum type, char *msg); void postUserEvent(Capability *cap, EventTypeNum type, char *msg);
void postUserBinaryEvent(Capability *cap, EventTypeNum type,
uint8_t *msg, size_t size);
void postCapMsg(Capability *cap, char *msg, va_list ap); void postCapMsg(Capability *cap, char *msg, va_list ap);
/* /*
......
...@@ -139,6 +139,10 @@ test('traceEvent', [ omit_ways(['dyn'] + prof_ways), ...@@ -139,6 +139,10 @@ test('traceEvent', [ omit_ways(['dyn'] + prof_ways),
extra_run_opts('+RTS -ls -RTS') ], extra_run_opts('+RTS -ls -RTS') ],
compile_and_run, ['-eventlog']) compile_and_run, ['-eventlog'])
test('traceBinaryEvent', [ omit_ways(['dyn'] + prof_ways),
extra_run_opts('+RTS -ls -RTS') ],
compile_and_run, ['-eventlog'])
test('T4059', [], run_command, ['$MAKE -s --no-print-directory T4059']) test('T4059', [], run_command, ['$MAKE -s --no-print-directory T4059'])
# Test for #4274 # Test for #4274
......
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
import Data.Word
import GHC.Base
import GHC.Ptr
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as BU
main :: IO ()
main = do
traceBinaryEventIO "0123456789"
traceBinaryEventIO $ B.replicate 10 0
traceBinaryEventIO $ B.replicate (maxSize + 1) 0
maxSize :: Int
maxSize = fromIntegral (maxBound :: Word16)
traceBinaryEventIO :: B.ByteString -> IO ()
traceBinaryEventIO bytes =
BU.unsafeUseAsCStringLen bytes $ \(Ptr p, I# n) -> IO $ \s -> do
case traceBinaryEvent# p n s of
s' -> (# s', () #)
traceBinaryEvent: Event size exceeds EVENT_PAYLOAD_SIZE_MAX, bail out
import Data.Word
import Debug.Trace import Debug.Trace
main = do main = do
traceEventIO "testing" traceEventIO "testing"
traceEventIO "%s" -- see #3874 traceEventIO "%s" -- see #3874
traceEventIO $ replicate (maxSize + 1) 'A'
maxSize :: Int
maxSize = fromIntegral (maxBound :: Word16)
traceEvent: Event size exceeds EVENT_PAYLOAD_SIZE_MAX, bail out
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment