diff options
45 files changed, 1279 insertions, 738 deletions
diff --git a/.gitattributes b/.gitattributes index 748f53db2a..200eb49c62 100644 --- a/.gitattributes +++ b/.gitattributes @@ -116,7 +116,8 @@ testsuite/tests/**/*.reference typo.prune # Expect tests with overly long lines of expected output testsuite/tests/parsing/docstrings.ml typo.very-long-line -tools/magic typo.missing-header +tools/magic typo.missing-header +tools/eventlog_metadata.in typo.missing-header # TODO we should fix the long-line errors in yacc/*.c /yacc/*.[ch] typo.very-long-line=may diff --git a/.gitignore b/.gitignore index b8acce8852..ff94e3c788 100644 --- a/.gitignore +++ b/.gitignore @@ -259,6 +259,7 @@ _build /tools/make_opcodes /tools/make_opcodes.ml /tools/caml-tex +/tools/eventlog_metadata /utils/config.ml /utils/domainstate.ml @@ -144,6 +144,17 @@ OCaml 4.11 avoiding overflow. (Jeremy Yallop, Stephen Dolan, review by Xavier Leroy) +- #9082: The instrumented runtime now records logs in the CTF format. + A new API is available in the runtime to collect runtime statistics, + replacing the previous instrumented runtime macros. + Gc.eventlog_pause and Gc.eventlog_resume were added to allow user to control + instrumentation in a running program. + (Enguerrand Decorne and Stephen Dolan, with help and review from + David Allsopp, Sébastien Hinderer, review by Anil Madhavapeddy, + Nicolás Ojeda Bär, Shakthi Kannan, KC Sivaramakrishnan, Gabriel Scherer, + Guillaume Munch-Maccagnoni, Damien Doligez, Leo White, Daniel Bünzli + and Xavier Leroy) + ### Code generation and optimizations: - #8637, #8805, #9247, #9296: Record debug info for each allocation. @@ -1081,6 +1081,7 @@ distclean: clean rm -f Makefile.config Makefile.common runtime/caml/m.h runtime/caml/s.h rm -rf autom4te.cache rm -f config.log config.status libtool + rm -f tools/eventlog_metadata rm -f tools/*.bak rm -f ocaml ocamlc rm -f testsuite/_log* diff --git a/Makefile.config.in b/Makefile.config.in index 040b72b2a4..fe9b23316c 100644 --- a/Makefile.config.in +++ b/Makefile.config.in @@ -129,6 +129,9 @@ ARCH=@arch@ # Whether the architecture has 64 bits ARCH64=@arch64@ +# Endianess for this architecture +ENDIANNESS=@endianness@ + ### Name of architecture model for the native-code compiler. ### Some architectures come in several slightly different flavors ### that share a common code generator. This variable tailors the @@ -777,6 +777,7 @@ rpath sharedlib_cflags asm_cfi_supported AS +endianness ASPP bfd_ldlibs bfd_ldflags @@ -791,6 +792,7 @@ with_debugger as_has_debug_prefix_map cc_has_debug_prefix_map otherlibraries +has_monotonic_clock instrumented_runtime debug_runtime cmxs @@ -2755,6 +2757,8 @@ toolchain="cc" profinfo=false profinfo_width=0 extralibs= +instrumented_runtime=false +instrumented_runtime_ldlibs="" # Information about the package @@ -2850,6 +2854,7 @@ VERSION=4.12.0+dev0-2020-04-22 + # TODO: rename this variable @@ -2892,12 +2897,15 @@ VERSION=4.12.0+dev0-2020-04-22 + ## Generated files ac_config_files="$ac_config_files Makefile.common" ac_config_files="$ac_config_files Makefile.config" +ac_config_files="$ac_config_files tools/eventlog_metadata" + ac_config_headers="$ac_config_headers runtime/caml/m.h" ac_config_headers="$ac_config_headers runtime/caml/s.h" @@ -13315,10 +13323,13 @@ fi $as_echo "$ac_cv_c_bigendian" >&6; } case $ac_cv_c_bigendian in #( yes) - $as_echo "#define ARCH_BIG_ENDIAN 1" >>confdefs.h -;; #( + + $as_echo "#define ARCH_BIG_ENDIAN 1" >>confdefs.h +, + endianness="be" + ;; #( no) - ;; #( + endianness="le" ;; #( universal) as_fn_error $? "unable to handle universal endianness" "$LINENO" 5 @@ -14118,21 +14129,93 @@ if test "x$ac_cv_func_issetugid" = xyes; then : fi -## clock_gettime, for the instrumented runtime +## Checking for monotonic clock source +## On Windows MSVC, QueryPerformanceCounter and QueryPerformanceFrequency +## are always available. +## On Unix platforms, we check for the appropriate POSIX feature-test macros. +## On MacOS clock_gettime's CLOCK_MONOTONIC flag is not actually monotonic. +## mach_timebase_info and mach_absolute_time are used instead. -## Note: on MinGW, configure finds a clock_gettime and thus the build -# system tries to build the instrumented runtime, which causes -# warnings. For the moment we simply disable it on MinGW -# but this would need to be further investigated case $host in #( - *-*-mingw32) : - instrumented_runtime=false ;; #( + *-*-windows) : + has_monotonic_clock=true ;; #( + *-apple-darwin*) : + + for ac_func in mach_timebase_info mach_absolute_time +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + + has_monotonic_clock=true + $as_echo "#define HAS_MACH_ABSOLUTE_TIME 1" >>confdefs.h + + +else + has_monotonic_clock=false +fi +done + ;; #( *) : - if test "x$enable_instrumented_runtime" = "xno" ; then : - instrumented_runtime=false; instrumented_runtime_libs="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include <unistd.h> + #include <time.h> + int main(void) + { + #if !(defined(_POSIX_TIMERS) && defined(_POSIX_MONOTONIC_CLOCK) \ + && _POSIX_MONOTONIC_CLOCK != (-1)) + #error "no monotonic clock source" + #endif + return 0; + } + +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + + has_monotonic_clock=true + $as_echo "#define HAS_POSIX_MONOTONIC_CLOCK 1" >>confdefs.h + + else + has_monotonic_clock=false +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + + ;; +esac + +# The instrumented runtime is built by default +# if the proper clock source is found. +# If asked via --enable-instrumented-runtime, configuration fails if the proper +# clock source is missing. +if test "x$enable_instrumented_runtime" != "xno" ; then : + + case $host in #( + *-*-windows) : + instrumented_runtime=true ;; #( + *-apple-darwin*) : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing clock_gettime" >&5 + case $enable_instrumented_runtime,$has_monotonic_clock in #( + *,true) : + instrumented_runtime=true ;; #( + yes,false) : + + as_fn_error $? "Instrumented runtime support requested \ +but no proper monotonic clock source was found." "$LINENO" 5 + ;; #( + auto,false) : + instrumented_runtime=false + ;; #( + *) : + ;; +esac ;; #( + *) : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing clock_gettime" >&5 $as_echo_n "checking for library containing clock_gettime... " >&6; } if ${ac_cv_search_clock_gettime+:} false; then : $as_echo_n "(cached) " >&6 @@ -14190,24 +14273,40 @@ else has_clock_gettime=false fi - case $enable_instrumented_runtime,$has_clock_gettime in #( - *,true) : - instrumented_runtime=true - if test "x$ac_cv_search_clock_gettime" = "xnone required"; then : - instrumented_runtime_libs="" -else - instrumented_runtime_libs=$ac_cv_search_clock_gettime -fi ;; #( - auto,*) : + case $enable_instrumented_runtime,$has_clock_gettime,$has_monotonic_clock in #( + auto,false,*) : instrumented_runtime=false ;; #( - yes,*) : - as_fn_error $? "the instrumented runtime can not be built" "$LINENO" 5 ;; #( + auto,*,false) : + instrumented_runtime=false ;; #( + *,true,true) : + + instrumented_runtime=true + if test "x$ac_cv_search_clock_gettime" = "xnone required"; then : + instrumented_runtime_ldlibs="" +else + instrumented_runtime_ldlibs=$ac_cv_search_clock_gettime + +fi + ;; #( + yes,false,*) : + + as_fn_error $? "Instrumented runtime support requested \ +but clock_gettime is missing." "$LINENO" 5 + ;; #( + yes,*,false) : + + as_fn_error $? "Instrumented runtime support requested \ +but no proper monotonic clock source was found." "$LINENO" 5 + + ;; #( *) : ;; esac -fi ;; + ;; esac +fi + ## Sockets ## TODO: check whether the different libraries are really useful @@ -16897,7 +16996,7 @@ case $host in #( bytecclibs="advapi32.lib ws2_32.lib version.lib" nativecclibs="advapi32.lib ws2_32.lib version.lib" ;; #( *) : - bytecclibs="$cclibs $DLLIBS $pthread_link $instrumented_runtime_libs" + bytecclibs="$cclibs $DLLIBS $pthread_link $instrumented_runtime_ldlibs" nativecclibs="$cclibs $DLLIBS" ;; esac @@ -17977,6 +18076,7 @@ do case $ac_config_target in "Makefile.common") CONFIG_FILES="$CONFIG_FILES Makefile.common" ;; "Makefile.config") CONFIG_FILES="$CONFIG_FILES Makefile.config" ;; + "tools/eventlog_metadata") CONFIG_FILES="$CONFIG_FILES tools/eventlog_metadata" ;; "runtime/caml/m.h") CONFIG_HEADERS="$CONFIG_HEADERS runtime/caml/m.h" ;; "runtime/caml/s.h") CONFIG_HEADERS="$CONFIG_HEADERS runtime/caml/s.h" ;; "libtool") CONFIG_COMMANDS="$CONFIG_COMMANDS libtool" ;; diff --git a/configure.ac b/configure.ac index f1f3a0f65e..ffa0435659 100644 --- a/configure.ac +++ b/configure.ac @@ -56,6 +56,8 @@ toolchain="cc" profinfo=false profinfo_width=0 extralibs= +instrumented_runtime=false +instrumented_runtime_ldlibs="" # Information about the package @@ -119,6 +121,7 @@ AC_SUBST([natdynlinkopts]) AC_SUBST([cmxs]) AC_SUBST([debug_runtime]) AC_SUBST([instrumented_runtime]) +AC_SUBST([has_monotonic_clock]) AC_SUBST([otherlibraries]) AC_SUBST([cc_has_debug_prefix_map]) AC_SUBST([as_has_debug_prefix_map]) @@ -133,6 +136,7 @@ AC_SUBST([bfd_cppflags]) AC_SUBST([bfd_ldflags]) AC_SUBST([bfd_ldlibs]) AC_SUBST([ASPP]) +AC_SUBST([endianness]) AC_SUBST([AS]) AC_SUBST([asm_cfi_supported]) AC_SUBST([sharedlib_cflags]) @@ -168,6 +172,7 @@ AC_SUBST([stdlib_manpages]) AC_CONFIG_FILES([Makefile.common]) AC_CONFIG_FILES([Makefile.config]) +AC_CONFIG_FILES([tools/eventlog_metadata]) AC_CONFIG_HEADERS([runtime/caml/m.h]) AC_CONFIG_HEADERS([runtime/caml/s.h]) @@ -758,8 +763,11 @@ AC_DEFINE_UNQUOTED([SIZEOF_LONGLONG], [$ac_cv_sizeof_long_long]) AC_MSG_NOTICE([Target is a $bits bits architecture]) AC_C_BIGENDIAN( - [AC_DEFINE([ARCH_BIG_ENDIAN], [1])], - [], + [ + AC_DEFINE([ARCH_BIG_ENDIAN], [1]), + [endianness="be"] + ], + [endianness="le"], [AC_MSG_ERROR([could not determine endianness.])], [AC_MSG_ERROR([unable to handle universal endianness])] ) @@ -1121,30 +1129,91 @@ CPPFLAGS="$saved_CPPFLAGS" AC_CHECK_FUNC([issetugid], [AC_DEFINE([HAS_ISSETUGID])]) -## clock_gettime, for the instrumented runtime +## Checking for monotonic clock source +## On Windows MSVC, QueryPerformanceCounter and QueryPerformanceFrequency +## are always available. +## On Unix platforms, we check for the appropriate POSIX feature-test macros. +## On MacOS clock_gettime's CLOCK_MONOTONIC flag is not actually monotonic. +## mach_timebase_info and mach_absolute_time are used instead. -## Note: on MinGW, configure finds a clock_gettime and thus the build -# system tries to build the instrumented runtime, which causes -# warnings. For the moment we simply disable it on MinGW -# but this would need to be further investigated AS_CASE([$host], - [*-*-mingw32], [instrumented_runtime=false], - [AS_IF([test "x$enable_instrumented_runtime" = "xno" ], - [instrumented_runtime=false; instrumented_runtime_libs=""], + [*-*-windows], + [has_monotonic_clock=true], + [*-apple-darwin*], [ + AC_CHECK_FUNCS([mach_timebase_info mach_absolute_time], + [ + has_monotonic_clock=true + AC_DEFINE([HAS_MACH_ABSOLUTE_TIME]) + ], + [has_monotonic_clock=false])], + [AC_COMPILE_IFELSE([AC_LANG_SOURCE([[ + #include <unistd.h> + #include <time.h> + int main(void) + { + #if !(defined(_POSIX_TIMERS) && defined(_POSIX_MONOTONIC_CLOCK) \ + && _POSIX_MONOTONIC_CLOCK != (-1)) + #error "no monotonic clock source" + #endif + return 0; + } + ]])], [ - AC_SEARCH_LIBS([clock_gettime], [rt], - [has_clock_gettime=true], - [has_clock_gettime=false]) - AS_CASE([$enable_instrumented_runtime,$has_clock_gettime], + has_monotonic_clock=true + AC_DEFINE([HAS_POSIX_MONOTONIC_CLOCK]) + ], + [has_monotonic_clock=false]) + ] +) + +# The instrumented runtime is built by default +# if the proper clock source is found. +# If asked via --enable-instrumented-runtime, configuration fails if the proper +# clock source is missing. +AS_IF([test "x$enable_instrumented_runtime" != "xno" ], + [ + AS_CASE([$host], + [*-*-windows], + [instrumented_runtime=true], + [*-apple-darwin*], [ + AS_CASE([$enable_instrumented_runtime,$has_monotonic_clock], [*,true], - [instrumented_runtime=true - AS_IF([test "x$ac_cv_search_clock_gettime" = "xnone required"], - [instrumented_runtime_libs=""], - [instrumented_runtime_libs=$ac_cv_search_clock_gettime])], - [auto,*], - [instrumented_runtime=false], - [yes,*], - [AC_MSG_ERROR([the instrumented runtime can not be built])])])]) + [instrumented_runtime=true], + [yes,false], [ + AC_MSG_ERROR([Instrumented runtime support requested \ +but no proper monotonic clock source was found.]) + ], + [auto,false], + [instrumented_runtime=false] + )], + [AC_SEARCH_LIBS([clock_gettime], [rt], + [has_clock_gettime=true], + [has_clock_gettime=false]) + AS_CASE( + [$enable_instrumented_runtime,$has_clock_gettime,$has_monotonic_clock], + [auto,false,*], [instrumented_runtime=false], + [auto,*,false], [instrumented_runtime=false], + [*,true,true], + [ + instrumented_runtime=true + AS_IF([test "x$ac_cv_search_clock_gettime" = "xnone required"], + [instrumented_runtime_ldlibs=""], + [instrumented_runtime_ldlibs=$ac_cv_search_clock_gettime] + ) + ], + [yes,false,*], + [ + AC_MSG_ERROR([Instrumented runtime support requested \ +but clock_gettime is missing.]) + ], + [yes,*,false], + [ + AC_MSG_ERROR([Instrumented runtime support requested \ +but no proper monotonic clock source was found.]) + ] + )] + )] +) ## Sockets @@ -1799,7 +1868,7 @@ AS_CASE([$host], [*-pc-windows], [bytecclibs="advapi32.lib ws2_32.lib version.lib" nativecclibs="advapi32.lib ws2_32.lib version.lib"], - [bytecclibs="$cclibs $DLLIBS $pthread_link $instrumented_runtime_libs" + [bytecclibs="$cclibs $DLLIBS $pthread_link $instrumented_runtime_ldlibs" nativecclibs="$cclibs $DLLIBS"]) AS_IF([test x"$libdir" = x'${exec_prefix}/lib'], diff --git a/ocamltest/Makefile b/ocamltest/Makefile index 48c4419ea5..eb7e7587fe 100644 --- a/ocamltest/Makefile +++ b/ocamltest/Makefile @@ -231,6 +231,7 @@ ocamltest.opt$(EXE): $(compdeps_opt) $(native_modules) ocamltest_config.ml: ocamltest_config.ml.in Makefile ../Makefile.config sed \ -e 's|@@AFL_INSTRUMENT@@|$(AFL_INSTRUMENT)|' \ + -e 's|@@RUNTIMEI@@|$(RUNTIMEI)|' \ -e 's|@@ARCH@@|$(ARCH)|' \ -e 's|@@SHARED_LIBRARIES@@|$(SUPPORTS_SHARED_LIBRARIES)|' \ -e 's|@@UNIX@@|$(unix)|' \ diff --git a/ocamltest/builtin_actions.ml b/ocamltest/builtin_actions.ml index 0cb4d925a8..99059c1c99 100644 --- a/ocamltest/builtin_actions.ml +++ b/ocamltest/builtin_actions.ml @@ -62,6 +62,12 @@ let dumpenv = make (fun log env -> Environments.dump log env; (Result.pass, env)) +let hasinstrumentedruntime = make + "hasinstrumentedruntime" + (Actions_helpers.pass_or_skip (Ocamltest_config.has_instrumented_runtime) + "instrumented runtime available" + "instrumented runtime not available") + let hasunix = make "hasunix" (Actions_helpers.pass_or_skip (Ocamltest_config.libunix <> None) @@ -227,6 +233,7 @@ let _ = fail; cd; dumpenv; + hasinstrumentedruntime; hasunix; hassysthreads; hasstr; diff --git a/ocamltest/ocamltest_config.ml.in b/ocamltest/ocamltest_config.ml.in index ed43989536..b42f92309e 100644 --- a/ocamltest/ocamltest_config.ml.in +++ b/ocamltest/ocamltest_config.ml.in @@ -80,3 +80,5 @@ let nativecc_libs = "@@NATIVECCLIBS@@" let windows_unicode = @@WINDOWS_UNICODE@@ != 0 let function_sections = @@FUNCTION_SECTIONS@@ + +let has_instrumented_runtime = @@RUNTIMEI@@ diff --git a/ocamltest/ocamltest_config.mli b/ocamltest/ocamltest_config.mli index 6e0c98a296..a03c6b68d0 100644 --- a/ocamltest/ocamltest_config.mli +++ b/ocamltest/ocamltest_config.mli @@ -112,3 +112,6 @@ val windows_unicode : bool val function_sections : bool (** Whether the compiler was configured to generate each function in a separate section *) + +val has_instrumented_runtime : bool +(** Whether the instrumented runtime is available *) diff --git a/otherlibs/unix/fork.c b/otherlibs/unix/fork.c index c8fef37c0c..a244a5cf83 100644 --- a/otherlibs/unix/fork.c +++ b/otherlibs/unix/fork.c @@ -17,16 +17,27 @@ #include <caml/mlvalues.h> #include <caml/debugger.h> +#include <caml/eventlog.h> #include "unixsupport.h" CAMLprim value unix_fork(value unit) { int ret; + + CAML_EV_FLUSH(); + ret = fork(); if (ret == -1) uerror("fork", Nothing); + + CAML_EVENTLOG_DO({ + if (ret == 0) + caml_eventlog_disable(); + }); + if (caml_debugger_in_use) if ((caml_debugger_fork_mode && ret == 0) || (!caml_debugger_fork_mode && ret != 0)) caml_debugger_cleanup_fork(); + return Val_int(ret); } diff --git a/runtime/Makefile b/runtime/Makefile index 761f47e57b..744955c0d7 100644 --- a/runtime/Makefile +++ b/runtime/Makefile @@ -23,7 +23,7 @@ ROOTDIR = .. BYTECODE_C_SOURCES := $(addsuffix .c, \ interp misc stacks fix_code startup_aux startup_byt freelist major_gc \ minor_gc memory alloc roots_byt globroots fail_byt signals \ - signals_byt printexc backtrace_byt backtrace compare ints \ + signals_byt printexc backtrace_byt backtrace compare ints eventlog \ floats str array io extern intern hash sys meta parsing gc_ctrl md5 obj \ lexing callback debugger weak compact finalise custom dynlink \ spacetime_byt afl $(UNIX_OR_WIN32) bigarray main memprof domain) @@ -31,7 +31,7 @@ BYTECODE_C_SOURCES := $(addsuffix .c, \ NATIVE_C_SOURCES := $(addsuffix .c, \ startup_aux startup_nat main fail_nat roots_nat signals \ signals_nat misc freelist major_gc minor_gc memory alloc compare ints \ - floats str array io extern intern hash sys parsing gc_ctrl md5 obj \ + floats str array io extern intern hash sys parsing gc_ctrl eventlog md5 obj \ lexing $(UNIX_OR_WIN32) printexc callback weak compact finalise custom \ globroots backtrace_nat backtrace dynlink_nat debugger meta \ dynlink clambda_checks spacetime_nat spacetime_snapshot afl bigarray \ diff --git a/runtime/array.c b/runtime/array.c index 64790423b4..37af6b7f60 100644 --- a/runtime/array.c +++ b/runtime/array.c @@ -23,6 +23,7 @@ #include "caml/misc.h" #include "caml/mlvalues.h" #include "caml/signals.h" +#include "caml/eventlog.h" /* Why is caml/spacetime.h included conditionnally sometimes and not here ? */ #include "caml/spacetime.h" @@ -320,7 +321,7 @@ CAMLprim value caml_make_vect(value len, value init) if (Is_block(init) && Is_young(init)) { /* We don't want to create so many major-to-minor references, so [init] is moved to the major heap by doing a minor GC. */ - CAML_INSTR_INT ("force_minor/make_vect@", 1); + CAML_EV_COUNTER (EV_C_FORCE_MINOR_MAKE_VECT, 1); caml_minor_collection (); } CAMLassert(!(Is_block(init) && Is_young(init))); diff --git a/runtime/caml/config.h b/runtime/caml/config.h index 28bf199c78..b119bc3410 100644 --- a/runtime/caml/config.h +++ b/runtime/caml/config.h @@ -122,6 +122,7 @@ typedef unsigned short uint16_t; #else #error "No 16-bit integer type available" #endif +typedef unsigned char uint8_t; #endif #if SIZEOF_PTR == SIZEOF_LONG diff --git a/runtime/caml/domain_state.h b/runtime/caml/domain_state.h index 798a461bbc..4427f21db3 100644 --- a/runtime/caml/domain_state.h +++ b/runtime/caml/domain_state.h @@ -18,6 +18,7 @@ #define CAML_STATE_H #include <stddef.h> +#include <stdio.h> #include "misc.h" #include "mlvalues.h" diff --git a/runtime/caml/domain_state.tbl b/runtime/caml/domain_state.tbl index 80ac7875bd..ef8384336f 100644 --- a/runtime/caml/domain_state.tbl +++ b/runtime/caml/domain_state.tbl @@ -73,3 +73,10 @@ DOMAIN_STATE(intnat, stat_top_heap_wsz) DOMAIN_STATE(intnat, stat_compactions) DOMAIN_STATE(intnat, stat_heap_chunks) /* See gc_ctrl.c */ + +DOMAIN_STATE(uintnat, eventlog_startup_timestamp) +DOMAIN_STATE(uint32_t, eventlog_startup_pid) +DOMAIN_STATE(uintnat, eventlog_paused) +DOMAIN_STATE(uintnat, eventlog_enabled) +DOMAIN_STATE(FILE*, eventlog_out) +/* See eventlog.c */ diff --git a/runtime/caml/eventlog.h b/runtime/caml/eventlog.h new file mode 100644 index 0000000000..3f2a4fca2d --- /dev/null +++ b/runtime/caml/eventlog.h @@ -0,0 +1,130 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Stephen Dolan, University of Cambridge */ +/* Enguerrand Decorne, Tarides */ +/* */ +/* Copyright 2020 University of Cambridge */ +/* Copyright 2020 Tarides */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_EVENTLOG_H +#define CAML_EVENTLOG_H + +typedef enum { + EV_ENTRY, + EV_EXIT, + EV_COUNTER, + EV_ALLOC, + EV_FLUSH +} ev_type; + +typedef enum { + EV_COMPACT_MAIN, + EV_COMPACT_RECOMPACT, + EV_EXPLICIT_GC_SET, + EV_EXPLICIT_GC_STAT, + EV_EXPLICIT_GC_MINOR, + EV_EXPLICIT_GC_MAJOR, + EV_EXPLICIT_GC_FULL_MAJOR, + EV_EXPLICIT_GC_COMPACT, + EV_MAJOR, + EV_MAJOR_ROOTS, + EV_MAJOR_SWEEP, + EV_MAJOR_MARK_ROOTS, + EV_MAJOR_MARK_MAIN, + EV_MAJOR_MARK_FINAL, + EV_MAJOR_MARK, + EV_MAJOR_MARK_GLOBAL_ROOTS_SLICE, + EV_MAJOR_ROOTS_GLOBAL, + EV_MAJOR_ROOTS_DYNAMIC_GLOBAL, + EV_MAJOR_ROOTS_LOCAL, + EV_MAJOR_ROOTS_C, + EV_MAJOR_ROOTS_FINALISED, + EV_MAJOR_ROOTS_MEMPROF, + EV_MAJOR_ROOTS_HOOK, + EV_MAJOR_CHECK_AND_COMPACT, + EV_MINOR, + EV_MINOR_LOCAL_ROOTS, + EV_MINOR_REF_TABLES, + EV_MINOR_COPY, + EV_MINOR_UPDATE_WEAK, + EV_MINOR_FINALIZED, + EV_EXPLICIT_GC_MAJOR_SLICE +} ev_gc_phase; + +typedef enum { + EV_C_ALLOC_JUMP, + EV_C_FORCE_MINOR_ALLOC_SMALL, + EV_C_FORCE_MINOR_MAKE_VECT, + EV_C_FORCE_MINOR_SET_MINOR_HEAP_SIZE, + EV_C_FORCE_MINOR_WEAK, + EV_C_FORCE_MINOR_MEMPROF, + EV_C_MAJOR_MARK_SLICE_REMAIN, + EV_C_MAJOR_MARK_SLICE_FIELDS, + EV_C_MAJOR_MARK_SLICE_POINTERS, + EV_C_MAJOR_WORK_EXTRA, + EV_C_MAJOR_WORK_MARK, + EV_C_MAJOR_WORK_SWEEP, + EV_C_MINOR_PROMOTED, + EV_C_REQUEST_MAJOR_ALLOC_SHR, + EV_C_REQUEST_MAJOR_ADJUST_GC_SPEED, + EV_C_REQUEST_MINOR_REALLOC_REF_TABLE, + EV_C_REQUEST_MINOR_REALLOC_EPHE_REF_TABLE, + EV_C_REQUEST_MINOR_REALLOC_CUSTOM_TABLE +} ev_gc_counter; + +#ifdef CAML_INSTR + +#define CAML_EVENTLOG_DO(f) if (Caml_state->eventlog_enabled &&\ + !Caml_state->eventlog_paused) f + +#define CAML_EVENTLOG_INIT() caml_eventlog_init() +#define CAML_EVENTLOG_DISABLE() caml_eventlog_disable() +#define CAML_EV_BEGIN(p) caml_ev_begin(p) +#define CAML_EV_END(p) caml_ev_end(p) +#define CAML_EV_COUNTER(c, v) caml_ev_counter(c, v) +#define CAML_EV_ALLOC(s) caml_ev_alloc(s) +#define CAML_EV_ALLOC_FLUSH() caml_ev_alloc_flush() +#define CAML_EV_FLUSH() caml_ev_flush() + +/* General note about the public API for the eventlog framework + The caml_ev_* functions are no-op when called with the eventlog framework + paused or disabled. + caml_eventlog_* functions on the other hand may introduce side effects + (such as write buffer flushes, or side effects in the eventlog internals.) + + All these functions should be called while holding the runtime lock. +*/ + +void caml_eventlog_init(void); +void caml_eventlog_disable(void); +void caml_ev_begin(ev_gc_phase phase); +void caml_ev_end(ev_gc_phase phase); +void caml_ev_counter(ev_gc_counter counter, uint64_t val); +void caml_ev_alloc(uint64_t size); +void caml_ev_alloc_flush(void); +void caml_ev_flush(void); + +#else + +#define CAML_EVENTLOG_DO(f) /**/ + +#define CAML_EVENTLOG_INIT() /**/ +#define CAML_EVENTLOG_DISABLE() /**/ +#define CAML_EV_BEGIN(p) /**/ +#define CAML_EV_END(p) /**/ +#define CAML_EV_COUNTER(c, v) /**/ +#define CAML_EV_ALLOC(S) /**/ +#define CAML_EV_ALLOC_FLUSH() /**/ +#define CAML_EV_FLUSH() /**/ + +#endif /*CAML_INSTR*/ + +#endif /*CAML_EVENTLOG_H*/ diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index a140109211..6c3810ded8 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -407,103 +407,6 @@ extern int caml_snprintf(char * buf, size_t size, const char * format, ...); #define snprintf caml_snprintf #endif -#ifdef CAML_INSTR -/* Timers and counters for GC latency profiling (Linux-only) */ - -#include <time.h> -#include <stdio.h> - -extern intnat caml_instr_starttime, caml_instr_stoptime; - -struct caml_instr_block { - struct timespec ts[10]; - char *tag[10]; - int index; - struct caml_instr_block *next; -}; - -extern struct caml_instr_block *caml_instr_log; - -/* Declare a timer/counter name. [t] must be a new variable name. */ -#define CAML_INSTR_DECLARE(t) \ - struct caml_instr_block *t = NULL - -/* Allocate the data block for a given name. - [t] must have been declared with [CAML_INSTR_DECLARE]. */ -#define CAML_INSTR_ALLOC(t) do{ \ - if (Caml_state_field(stat_minor_collections) >= caml_instr_starttime \ - && Caml_state_field(stat_minor_collections) < caml_instr_stoptime){ \ - t = caml_stat_alloc_noexc (sizeof (struct caml_instr_block)); \ - t->index = 0; \ - t->tag[0] = ""; \ - t->next = caml_instr_log; \ - caml_instr_log = t; \ - } \ - }while(0) - -/* Allocate the data block and start the timer. - [t] must have been declared with [CAML_INSTR_DECLARE] - and allocated with [CAML_INSTR_ALLOC]. */ -#define CAML_INSTR_START(t, msg) do{ \ - if (t != NULL){ \ - t->tag[0] = msg; \ - clock_gettime (CLOCK_REALTIME, &(t->ts[0])); \ - } \ - }while(0) - -/* Declare a timer, allocate its data, and start it. - [t] must be a new variable name. */ -#define CAML_INSTR_SETUP(t, msg) \ - CAML_INSTR_DECLARE (t); \ - CAML_INSTR_ALLOC (t); \ - CAML_INSTR_START (t, msg) - -/* Record an intermediate time within a given timer. - [t] must have been declared, allocated, and started. */ -#define CAML_INSTR_TIME(t, msg) do{ \ - if (t != NULL){ \ - ++ t->index; \ - t->tag[t->index] = (msg); \ - clock_gettime (CLOCK_REALTIME, &(t->ts[t->index])); \ - } \ - }while(0) - -/* Record an integer data point. - If [msg] ends with # it will be interpreted as an integer-valued event. - If it ends with @ it will be interpreted as an event counter. -*/ -#define CAML_INSTR_INT(msg, data) do{ \ - CAML_INSTR_SETUP (__caml_tmp, ""); \ - if (__caml_tmp != NULL){ \ - __caml_tmp->index = 1; \ - __caml_tmp->tag[1] = msg; \ - __caml_tmp->ts[1].tv_sec = 0; \ - __caml_tmp->ts[1].tv_nsec = (data); \ - } \ - }while(0) - -/* This function is called at the start of the program to set up - the data for the above macros. -*/ -extern void caml_instr_init (void); - -/* This function is automatically called by the runtime to output - the collected data to the dump file. */ -extern void caml_instr_atexit (void); - -#else /* CAML_INSTR */ - -#define CAML_INSTR_DECLARE(t) /**/ -#define CAML_INSTR_ALLOC(t) /**/ -#define CAML_INSTR_START(t, name) /**/ -#define CAML_INSTR_SETUP(t, name) /**/ -#define CAML_INSTR_TIME(t, msg) /**/ -#define CAML_INSTR_INT(msg, c) /**/ -#define caml_instr_init() /**/ -#define caml_instr_atexit() /**/ - -#endif /* CAML_INSTR */ - extern int caml_snwprintf(wchar_t * buf, size_t size, const wchar_t * format, ...); diff --git a/runtime/caml/s.h.in b/runtime/caml/s.h.in index b618309d62..5aa589ba01 100644 --- a/runtime/caml/s.h.in +++ b/runtime/caml/s.h.in @@ -261,3 +261,7 @@ #undef HAS_BROKEN_PRINTF #undef HAS_STRERROR + +#undef HAS_POSIX_MONOTONIC_CLOCK + +#undef HAS_MACH_ABSOLUTE_TIME diff --git a/runtime/compact.c b/runtime/compact.c index 963d98b5a9..bb17f8d7a4 100644 --- a/runtime/compact.c +++ b/runtime/compact.c @@ -30,6 +30,7 @@ #include "caml/weak.h" #include "caml/compact.h" #include "caml/memprof.h" +#include "caml/eventlog.h" extern uintnat caml_percent_free; /* major_gc.c */ extern void caml_shrink_heap (char *); /* memory.c */ @@ -435,7 +436,6 @@ uintnat caml_percent_max; /* used in gc_ctrl.c and memory.c */ void caml_compact_heap (intnat new_allocation_policy) { uintnat target_wsz, live; - CAML_INSTR_SETUP(tmr, "compact"); CAMLassert (Caml_state->young_ptr == Caml_state->young_alloc_end); CAMLassert (Caml_state->ref_table->ptr == @@ -445,8 +445,9 @@ void caml_compact_heap (intnat new_allocation_policy) CAMLassert (Caml_state->custom_table->ptr == Caml_state->custom_table->base); + CAML_EV_BEGIN(EV_COMPACT_MAIN); do_compaction (new_allocation_policy); - CAML_INSTR_TIME (tmr, "compact/main"); + CAML_EV_END(EV_COMPACT_MAIN); /* Compaction may fail to shrink the heap to a reasonable size because it deals in complete chunks: if a very large chunk is at the beginning of the heap, everything gets moved to @@ -508,11 +509,12 @@ void caml_compact_heap (intnat new_allocation_policy) if (Caml_state->stat_heap_wsz > Caml_state->stat_top_heap_wsz){ Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz; } + CAML_EV_BEGIN(EV_COMPACT_RECOMPACT); do_compaction (-1); CAMLassert (Caml_state->stat_heap_chunks == 1); CAMLassert (Chunk_next (caml_heap_start) == NULL); CAMLassert (Caml_state->stat_heap_wsz == Wsize_bsize (Chunk_size (chunk))); - CAML_INSTR_TIME (tmr, "compact/recompact"); + CAML_EV_END(EV_COMPACT_RECOMPACT); } } diff --git a/runtime/domain.c b/runtime/domain.c index f1bc08e3dc..0850021fa9 100644 --- a/runtime/domain.c +++ b/runtime/domain.c @@ -80,4 +80,10 @@ void caml_init_domain () Caml_state->local_roots = NULL; Caml_state->requested_major_slice = 0; Caml_state->requested_minor_gc = 0; + + Caml_state->eventlog_enabled = 0; + Caml_state->eventlog_paused = 0; + Caml_state->eventlog_startup_pid = 0; + Caml_state->eventlog_startup_timestamp = 0; + Caml_state->eventlog_out = NULL; } diff --git a/runtime/eventlog.c b/runtime/eventlog.c new file mode 100644 index 0000000000..474e22d68b --- /dev/null +++ b/runtime/eventlog.c @@ -0,0 +1,396 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Stephen Dolan, University of Cambridge */ +/* Enguerrand Decorne, Tarides */ +/* */ +/* Copyright 2020 University of Cambridge */ +/* Copyright 2020 Tarides */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +#define CAML_INTERNALS +#include <stdio.h> +#include <string.h> +#include "caml/alloc.h" +#include "caml/eventlog.h" +#include "caml/misc.h" +#include "caml/memory.h" +#include "caml/osdeps.h" + + +#ifdef _WIN32 +#include <wtypes.h> +#include <process.h> +#elif defined(HAS_UNISTD) +#include <unistd.h> +#endif + +#ifdef HAS_MACH_ABSOLUTE_TIME +#include <mach/mach_time.h> +#elif HAS_POSIX_MONOTONIC_CLOCK +#include <time.h> +#endif + +#ifdef CAML_INSTR + +#define CTF_MAGIC 0xc1fc1fc1 +#define CAML_TRACE_VERSION 0x1 + +struct ctf_stream_header { + uint32_t magic; + uint16_t caml_trace_version; + uint16_t stream_id; +}; + +static struct ctf_stream_header header = { + CTF_MAGIC, + CAML_TRACE_VERSION, + 0 +}; + +#pragma pack(1) +struct ctf_event_header { + uint64_t timestamp; + uint32_t pid; + uint32_t id; +}; + +struct event { + struct ctf_event_header header; + uint16_t phase; /* for GC events */ + uint16_t counter_kind; /* misc counter name */ + uint8_t alloc_bucket; /* for alloc counters */ + uint64_t count; /* for misc counters */ +}; + +#define EVENT_BUF_SIZE 4096 +struct event_buffer { + uintnat ev_generated; + struct event events[EVENT_BUF_SIZE]; +}; + +static struct event_buffer* evbuf; + +static int64_t time_counter(void) +{ +#ifdef _WIN32 + static double clock_freq = 0; + static LARGE_INTEGER now; + + if (clock_freq == 0) { + LARGE_INTEGER f; + if (!QueryPerformanceFrequency(&f)) + return 0; + clock_freq = (1000000000.0 / f.QuadPart); + }; + + if (!QueryPerformanceCounter(&now)) + return 0; + return (int64_t)(now.QuadPart * clock_freq); + +#elif defined(HAS_MACH_ABSOLUTE_TIME) + static mach_timebase_info_data_t time_base = {0}; + + if (time_base.denom == 0) { + if (mach_timebase_info (&time_base) != KERN_SUCCESS) + return 0; + + if (time_base.denom == 0) + return 0; + } + + uint64_t now = mach_absolute_time (); + return (int64_t)((now * time_base.numer) / time_base.denom); + +#elif defined(HAS_POSIX_MONOTONIC_CLOCK) + struct timespec t; + clock_gettime(CLOCK_MONOTONIC, &t); + return + (int64_t)t.tv_sec * (int64_t)1000000000 + + (int64_t)t.tv_nsec; + + +#endif +} + +static void setup_evbuf() +{ + CAMLassert(!evbuf); + evbuf = caml_stat_alloc_noexc(sizeof(*evbuf)); + + if (evbuf == NULL) + caml_fatal_error("eventlog: could not allocate event buffer"); + + evbuf->ev_generated = 0; +} + +#define OUTPUT_FILE_LEN 4096 +static void setup_eventlog_file() +{ + char_os output_file[OUTPUT_FILE_LEN]; + char_os *eventlog_filename = NULL; + + eventlog_filename = caml_secure_getenv(T("OCAML_EVENTLOG_FILE")); + + if (eventlog_filename) { + int ret = snprintf_os(output_file, OUTPUT_FILE_LEN, T("%s.%d.eventlog"), + eventlog_filename, Caml_state->eventlog_startup_pid); + if (ret > OUTPUT_FILE_LEN) + caml_fatal_error("eventlog: specified OCAML_EVENTLOG_FILE is too long"); + } else { + snprintf_os(output_file, OUTPUT_FILE_LEN, T("caml-eventlog-%d"), + Caml_state->eventlog_startup_pid); + } + + Caml_state->eventlog_out = fopen_os(output_file, T("wb")); + + if (Caml_state->eventlog_out) { + int ret = fwrite(&header, sizeof(struct ctf_stream_header), + 1, Caml_state->eventlog_out); + if (ret != 1) + caml_eventlog_disable(); + fflush(Caml_state->eventlog_out); + } else { + caml_fatal_error("eventlog: could not open trace for writing"); + } +} +#undef OUTPUT_FILE_LEN + +#define FWRITE_EV(item, size) \ + if (fwrite(item, size, 1, out) != 1) \ + goto fwrite_failure; + +static void flush_events(FILE* out, struct event_buffer* eb) +{ + uintnat i; + uint64_t flush_duration; + uintnat n = eb->ev_generated; + + struct ctf_event_header ev_flush; + ev_flush.id = EV_FLUSH; + ev_flush.timestamp = time_counter() - + Caml_state->eventlog_startup_timestamp; + ev_flush.pid = Caml_state->eventlog_startup_pid; + + for (i = 0; i < n; i++) { + struct event ev = eb->events[i]; + ev.header.pid = Caml_state->eventlog_startup_pid; + + FWRITE_EV(&ev.header, sizeof(struct ctf_event_header)); + + switch (ev.header.id) + { + case EV_ENTRY: + FWRITE_EV(&ev.phase, sizeof(uint16_t)); + break; + case EV_EXIT: + FWRITE_EV(&ev.phase, sizeof(uint16_t)); + break; + case EV_COUNTER: + FWRITE_EV(&ev.count, sizeof(uint64_t)); + FWRITE_EV(&ev.counter_kind, sizeof(uint16_t)); + break; + case EV_ALLOC: + FWRITE_EV(&ev.count, sizeof(uint64_t)); + FWRITE_EV(&ev.alloc_bucket, sizeof(uint8_t)); + break; + default: + break; + } + } + + flush_duration = + (time_counter() - Caml_state->eventlog_startup_timestamp) - + ev_flush.timestamp; + + FWRITE_EV(&ev_flush, sizeof(struct ctf_event_header)); + FWRITE_EV(&flush_duration, sizeof(uint64_t)); + + return; + + fwrite_failure: + /* on event flush failure, shut down eventlog. */ + if (caml_runtime_warnings_active()) + fprintf(stderr, + "[ocaml] error while writing trace file, disabling eventlog\n"); + caml_eventlog_disable(); + return; + +} + +static void teardown_eventlog(void) +{ + if (evbuf) { + if (Caml_state->eventlog_out) + flush_events(Caml_state->eventlog_out, evbuf); + caml_stat_free(evbuf); + evbuf = NULL; + } + if (Caml_state->eventlog_out) { + fclose(Caml_state->eventlog_out); + Caml_state->eventlog_out = NULL; + } +} + +void caml_eventlog_init() +{ + char_os *toggle = caml_secure_getenv(T("OCAML_EVENTLOG_ENABLED")); + + if (toggle != NULL) { + Caml_state->eventlog_enabled = 1; + if (*toggle == 'p') + Caml_state->eventlog_paused = 1; + }; + + if (!Caml_state->eventlog_enabled) return; + + Caml_state->eventlog_startup_timestamp = time_counter(); +#ifdef _WIN32 + Caml_state->eventlog_startup_pid = _getpid(); +#else + Caml_state->eventlog_startup_pid = getpid(); +#endif + + setup_eventlog_file(); + setup_evbuf(); + + atexit(&teardown_eventlog); +} + +static void post_event(ev_gc_phase phase, ev_gc_counter counter_kind, + uint8_t bucket, uint64_t count, ev_type ty) +{ + uintnat i; + struct event* ev; + + if (!Caml_state->eventlog_enabled) return; + if (Caml_state->eventlog_paused) return; + + i = evbuf->ev_generated; + CAMLassert(i <= EVENT_BUF_SIZE); + if (i == EVENT_BUF_SIZE) { + flush_events(Caml_state->eventlog_out, evbuf); + evbuf->ev_generated = 0; + i = 0; + } + ev = &evbuf->events[i]; + ev->header.id = ty; + ev->count = count; + ev->counter_kind = counter_kind; + ev->alloc_bucket = bucket; + ev->phase = phase; + ev->header.timestamp = time_counter() - + Caml_state->eventlog_startup_timestamp; + evbuf->ev_generated = i + 1; +} + +void caml_ev_begin(ev_gc_phase phase) +{ + post_event(phase, 0, 0, 0, EV_ENTRY); +} + +void caml_ev_end(ev_gc_phase phase) +{ + post_event(phase, 0, 0, 0, EV_EXIT); +} + +void caml_ev_counter(ev_gc_counter counter, uint64_t val) +{ + post_event(0, counter, 0, val, EV_COUNTER); +} + +static uint64_t alloc_buckets [20] = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0}; + +/* This function records allocations in caml_alloc_shr_aux in given bucket sizes + These buckets are meant to be flushed explicitly by the caller through the + caml_ev_alloc_flush function. Until then the buckets are just updated until + flushed. +*/ +void caml_ev_alloc(uint64_t sz) +{ + if (!Caml_state->eventlog_enabled) return; + if (Caml_state->eventlog_paused) return; + + if (sz < 10) { + ++alloc_buckets[sz]; + } else if (sz < 100) { + ++alloc_buckets[sz/10 + 9]; + } else { + ++alloc_buckets[19]; + } +} + +/* Note that this function does not trigger an actual disk flush, it just + pushes events in the event buffer. +*/ +void caml_ev_alloc_flush() +{ + int i; + + if (!Caml_state->eventlog_enabled) return; + if (Caml_state->eventlog_paused) return; + + for (i = 1; i < 20; i++) { + if (alloc_buckets[i] != 0) { + post_event(0, 0, i, alloc_buckets[i], EV_ALLOC); + }; + alloc_buckets[i] = 0; + } +} + +void caml_ev_flush() +{ + if (!Caml_state->eventlog_enabled) return; + if (Caml_state->eventlog_paused) return; + + if (Caml_state->eventlog_out) { + if (evbuf) + flush_events(Caml_state->eventlog_out, evbuf); + fflush(Caml_state->eventlog_out); + }; +} + +void caml_eventlog_disable() +{ + Caml_state->eventlog_enabled = 0; + teardown_eventlog(); +} + +CAMLprim value caml_eventlog_resume(value v) +{ + CAMLassert(v == Val_unit); + if (Caml_state->eventlog_enabled) + Caml_state->eventlog_paused = 0; + return Val_unit; +} + +CAMLprim value caml_eventlog_pause(value v) +{ + CAMLassert(v == Val_unit); + if (Caml_state->eventlog_enabled) { + Caml_state->eventlog_paused = 1; + if (evbuf && Caml_state->eventlog_out) + flush_events(Caml_state->eventlog_out, evbuf); + }; + return Val_unit; +} + +#else + +CAMLprim value caml_eventlog_resume(value v) +{ + return Val_unit; +} + +CAMLprim value caml_eventlog_pause(value v) +{ + return Val_unit; +} + +#endif /*CAML_INSTR*/ diff --git a/runtime/freelist.c b/runtime/freelist.c index 517c8c9cd1..80d55ad0ff 100644 --- a/runtime/freelist.c +++ b/runtime/freelist.c @@ -31,6 +31,7 @@ #include "caml/major_gc.h" #include "caml/misc.h" #include "caml/mlvalues.h" +#include "caml/eventlog.h" /*************** declarations common to all policies ******************/ @@ -55,42 +56,16 @@ Caml_inline value Next_in_mem (value v) { } #ifdef CAML_INSTR -static uintnat instr_size [20] = - {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0}; -static char *instr_name [20] = { - NULL, - "alloc01@", - "alloc02@", - "alloc03@", - "alloc04@", - "alloc05@", - "alloc06@", - "alloc07@", - "alloc08@", - "alloc09@", - "alloc10-19@", - "alloc20-29@", - "alloc30-39@", - "alloc40-49@", - "alloc50-59@", - "alloc60-69@", - "alloc70-79@", - "alloc80-89@", - "alloc90-99@", - "alloc_large@", -}; -uintnat caml_instr_alloc_jump = 0; -/* number of pointers followed to allocate from the free set */ - -#define INSTR_alloc_jump(n) (caml_instr_alloc_jump += (n)) -#else +/* number of pointers followed to allocate from the free set */ +uintnat caml_instr_alloc_jump = 0; -#define INSTR_alloc_jump(n) ((void)0) +#define EV_ALLOC_JUMP(n) (caml_instr_alloc_jump += (n)) #endif /*CAML_INSTR*/ + /********************* next-fit allocation policy *********************/ /* The free-list is kept sorted by increasing addresses. @@ -179,15 +154,6 @@ static header_t *nf_allocate (mlsize_t wo_sz) value cur = Val_NULL, prev; CAMLassert (sizeof (char *) == sizeof (value)); CAMLassert (wo_sz >= 1); -#ifdef CAML_INSTR - if (wo_sz < 10){ - ++instr_size[wo_sz]; - }else if (wo_sz < 100){ - ++instr_size[wo_sz/10 + 9]; - }else{ - ++instr_size[19]; - } -#endif /* CAML_INSTR */ CAMLassert (nf_prev != Val_NULL); /* Search from [nf_prev] to the end of the list. */ @@ -200,9 +166,7 @@ static header_t *nf_allocate (mlsize_t wo_sz) } prev = cur; cur = Next_small (prev); -#ifdef CAML_INSTR - ++ caml_instr_alloc_jump; -#endif + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1)); } nf_last = prev; /* Search from the start of the list to [nf_prev]. */ @@ -214,9 +178,7 @@ static header_t *nf_allocate (mlsize_t wo_sz) } prev = cur; cur = Next_small (prev); -#ifdef CAML_INSTR - ++ caml_instr_alloc_jump; -#endif + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1)); } /* No suitable block was found. */ return NULL; @@ -232,13 +194,7 @@ static header_t *nf_last_fragment; static void nf_init_merge (void) { -#ifdef CAML_INSTR - int i; - for (i = 1; i < 20; i++){ - CAML_INSTR_INT (instr_name[i], instr_size[i]); - instr_size[i] = 0; - } -#endif /* CAML_INSTR */ + CAML_EV_ALLOC_FLUSH(); nf_last_fragment = NULL; caml_fl_merge = Nf_head; #ifdef DEBUG @@ -506,15 +462,6 @@ static header_t *ff_allocate (mlsize_t wo_sz) mlsize_t sz, prevsz; CAMLassert (sizeof (char *) == sizeof (value)); CAMLassert (wo_sz >= 1); -#ifdef CAML_INSTR - if (wo_sz < 10){ - ++instr_size[wo_sz]; - }else if (wo_sz < 100){ - ++instr_size[wo_sz/10 + 9]; - }else{ - ++instr_size[19]; - } -#endif /* CAML_INSTR */ /* Search in the flp array. */ for (i = 0; i < flp_size; i++){ @@ -666,13 +613,7 @@ static header_t *ff_last_fragment; static void ff_init_merge (void) { -#ifdef CAML_INSTR - int i; - for (i = 1; i < 20; i++){ - CAML_INSTR_INT (instr_name[i], instr_size[i]); - instr_size[i] = 0; - } -#endif /* CAML_INSTR */ + CAML_EV_ALLOC_FLUSH(); ff_last_fragment = NULL; caml_fl_merge = Ff_head; #ifdef DEBUG @@ -1068,7 +1009,7 @@ static large_free_block **bf_search (mlsize_t wosz) while (1){ cur = *p; - INSTR_alloc_jump (1); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1)); if (cur == NULL) break; cursz = bf_large_wosize (cur); if (cursz == wosz){ @@ -1097,7 +1038,7 @@ static large_free_block **bf_search_best (mlsize_t wosz, mlsize_t *next_lower) while (1){ cur = *p; - INSTR_alloc_jump (1); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1)); if (cur == NULL){ *next_lower = lowsz; break; @@ -1142,7 +1083,7 @@ static void bf_splay (mlsize_t wosz) if (xsz > wosz){ /* zig */ y = x->left; - INSTR_alloc_jump (1); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1)); if (y == NULL) break; if (bf_large_wosize (y) > wosz){ /* zig-zig: rotate right */ @@ -1150,7 +1091,7 @@ static void bf_splay (mlsize_t wosz) y->right = x; x = y; y = x->left; - INSTR_alloc_jump (2); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (2)); if (y == NULL) break; } /* link right */ @@ -1161,7 +1102,7 @@ static void bf_splay (mlsize_t wosz) CAMLassert (xsz < wosz); /* zag */ y = x->right; - INSTR_alloc_jump (1); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1)); if (y == NULL) break; if (bf_large_wosize (y) < wosz){ /* zag-zag : rotate left */ @@ -1169,7 +1110,7 @@ static void bf_splay (mlsize_t wosz) y->left = x; x = y; y = x->right; - INSTR_alloc_jump (2); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (2)); if (y == NULL) break; } /* link left */ @@ -1183,7 +1124,7 @@ static void bf_splay (mlsize_t wosz) *right_bottom = x->right; x->left = left_top; x->right = right_top; - INSTR_alloc_jump (2); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (2)); bf_large_tree = x; } @@ -1199,19 +1140,19 @@ static void bf_splay_least (large_free_block **p) large_free_block **right_bottom = &right_top; x = *p; - INSTR_alloc_jump (1); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1)); CAMLassert (x != NULL); while (1){ /* We are always in the zig case. */ y = x->left; - INSTR_alloc_jump (1); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1)); if (y == NULL) break; /* And in the zig-zig case. rotate right */ x->left = y->right; y->right = x; x = y; y = x->left; - INSTR_alloc_jump (2); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (2)); if (y == NULL) break; /* link right */ *right_bottom = x; @@ -1221,7 +1162,7 @@ static void bf_splay_least (large_free_block **p) /* reassemble the tree */ CAMLassert (x->left == NULL); *right_bottom = x->right; - INSTR_alloc_jump (1); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1)); x->right = right_top; *p = x; } @@ -1233,12 +1174,12 @@ static void bf_remove_node (large_free_block **p) large_free_block *l, *r; x = *p; - INSTR_alloc_jump (1); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1)); if (x == NULL) return; if (x == bf_large_least) bf_large_least = NULL; l = x->left; r = x->right; - INSTR_alloc_jump (2); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (2)); if (l == NULL){ *p = r; }else if (r == NULL){ @@ -1259,7 +1200,7 @@ static void bf_insert_block (large_free_block *n) mlsize_t sz = bf_large_wosize (n); large_free_block **p = bf_search (sz); large_free_block *x = *p; - INSTR_alloc_jump (1); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (1)); if (bf_large_least != NULL){ mlsize_t least_sz = bf_large_wosize (bf_large_least); @@ -1291,7 +1232,7 @@ static void bf_insert_block (large_free_block *n) n->next = x; x->prev->next = n; x->prev = n; - INSTR_alloc_jump (2); + CAML_EVENTLOG_DO(EV_ALLOC_JUMP (2)); bf_splay (sz); } } @@ -1560,16 +1501,6 @@ static header_t *bf_allocate (mlsize_t wosz) CAMLassert (sizeof (char *) == sizeof (value)); CAMLassert (wosz >= 1); -#ifdef CAML_INSTR - if (wosz < 10){ - ++instr_size[wosz]; - }else if (wosz < 100){ - ++instr_size[wosz/10 + 9]; - }else{ - ++instr_size[19]; - } -#endif /* CAML_INSTR */ - if (wosz <= BF_NUM_SMALL){ if (bf_small_fl[wosz].free != Val_NULL){ /* fast path: allocate from the corresponding free list */ @@ -1627,12 +1558,7 @@ static void bf_init_merge (void) { mlsize_t i; -#ifdef CAML_INSTR - for (i = 1; i < 20; i++){ - CAML_INSTR_INT (instr_name[i], instr_size[i]); - instr_size[i] = 0; - } -#endif /* CAML_INSTR */ + CAML_EV_ALLOC_FLUSH(); caml_fl_merge = Val_NULL; diff --git a/runtime/gc_ctrl.c b/runtime/gc_ctrl.c index e444b9c5cd..956cbcbb24 100644 --- a/runtime/gc_ctrl.c +++ b/runtime/gc_ctrl.c @@ -30,6 +30,7 @@ #include "caml/misc.h" #include "caml/mlvalues.h" #include "caml/signals.h" +#include "caml/eventlog.h" #ifdef NATIVE_CODE #include "caml/stack.h" #else @@ -267,10 +268,10 @@ void caml_heap_check (void) CAMLprim value caml_gc_stat(value v) { value result; - CAML_INSTR_SETUP (tmr, ""); + CAML_EV_BEGIN(EV_EXPLICIT_GC_STAT); CAMLassert (v == Val_unit); result = heap_stats (1); - CAML_INSTR_TIME (tmr, "explicit/gc_stat"); + CAML_EV_END(EV_EXPLICIT_GC_STAT); return result; } @@ -422,7 +423,7 @@ CAMLprim value caml_gc_set(value v) asize_t newminwsz; uintnat newpolicy; uintnat new_custom_maj, new_custom_min, new_custom_sz; - CAML_INSTR_SETUP (tmr, ""); + CAML_EV_BEGIN(EV_EXPLICIT_GC_SET); caml_verb_gc = Long_val (Field (v, 3)); @@ -514,7 +515,7 @@ CAMLprim value caml_gc_set(value v) ARCH_SIZET_PRINTF_FORMAT "uk words\n", newminwsz / 1024); caml_set_minor_heap_size (Bsize_wsize (newminwsz)); } - CAML_INSTR_TIME (tmr, "explicit/gc_set"); + CAML_EV_END(EV_EXPLICIT_GC_SET); /* The compaction may have triggered some finalizers that we need to call. */ caml_process_pending_actions(); @@ -524,12 +525,15 @@ CAMLprim value caml_gc_set(value v) CAMLprim value caml_gc_minor(value v) { - CAML_INSTR_SETUP (tmr, ""); + value exn; + + CAML_EV_BEGIN(EV_EXPLICIT_GC_MINOR); CAMLassert (v == Val_unit); caml_request_minor_gc (); // call the gc and call finalisers - caml_process_pending_actions(); - CAML_INSTR_TIME (tmr, "explicit/gc_minor"); + exn = caml_process_pending_actions_exn(); + CAML_EV_END(EV_EXPLICIT_GC_MINOR); + caml_raise_if_exception(exn); return Val_unit; } @@ -550,60 +554,76 @@ static void test_and_compact (void) CAMLprim value caml_gc_major(value v) { - CAML_INSTR_SETUP (tmr, ""); + value exn; + + CAML_EV_BEGIN(EV_EXPLICIT_GC_MAJOR); CAMLassert (v == Val_unit); caml_gc_message (0x1, "Major GC cycle requested\n"); caml_empty_minor_heap (); caml_finish_major_cycle (); test_and_compact (); // call finalisers - caml_process_pending_actions(); - CAML_INSTR_TIME (tmr, "explicit/gc_major"); + exn = caml_process_pending_actions_exn(); + CAML_EV_END(EV_EXPLICIT_GC_MAJOR); + caml_raise_if_exception(exn); return Val_unit; } CAMLprim value caml_gc_full_major(value v) { - CAML_INSTR_SETUP (tmr, ""); + value exn; + + CAML_EV_BEGIN(EV_EXPLICIT_GC_FULL_MAJOR); CAMLassert (v == Val_unit); caml_gc_message (0x1, "Full major GC cycle requested\n"); caml_empty_minor_heap (); caml_finish_major_cycle (); // call finalisers - caml_process_pending_actions(); + exn = caml_process_pending_actions_exn(); + if (Is_exception_result(exn)) goto cleanup; caml_empty_minor_heap (); caml_finish_major_cycle (); test_and_compact (); // call finalisers - caml_process_pending_actions(); - CAML_INSTR_TIME (tmr, "explicit/gc_full_major"); + exn = caml_process_pending_actions_exn(); + +cleanup: + CAML_EV_END(EV_EXPLICIT_GC_FULL_MAJOR); + caml_raise_if_exception(exn); + return Val_unit; } CAMLprim value caml_gc_major_slice (value v) { - CAML_INSTR_SETUP (tmr, ""); + CAML_EV_BEGIN(EV_EXPLICIT_GC_MAJOR_SLICE); CAMLassert (Is_long (v)); caml_major_collection_slice (Long_val (v)); - CAML_INSTR_TIME (tmr, "explicit/gc_major_slice"); + CAML_EV_END(EV_EXPLICIT_GC_MAJOR_SLICE); return Val_long (0); } CAMLprim value caml_gc_compaction(value v) { - CAML_INSTR_SETUP (tmr, ""); + value exn; + + CAML_EV_BEGIN(EV_EXPLICIT_GC_COMPACT); CAMLassert (v == Val_unit); caml_gc_message (0x10, "Heap compaction requested\n"); caml_empty_minor_heap (); caml_finish_major_cycle (); // call finalisers - caml_process_pending_actions(); + exn = caml_process_pending_actions_exn(); + if (Is_exception_result(exn)) goto cleanup; caml_empty_minor_heap (); caml_finish_major_cycle (); caml_compact_heap (-1); // call finalisers - caml_process_pending_actions(); - CAML_INSTR_TIME (tmr, "explicit/gc_compact"); + exn = caml_process_pending_actions_exn(); + + cleanup: + CAML_EV_END(EV_EXPLICIT_GC_COMPACT); + caml_raise_if_exception(exn); return Val_unit; } @@ -645,7 +665,6 @@ void caml_init_gc (uintnat minor_size, uintnat major_size, major_bsize = Bsize_wsize(major_size); major_bsize = ((major_bsize + Page_size - 1) >> Page_log) << Page_log; - caml_instr_init (); if (caml_page_table_initialize(Bsize_wsize(minor_size) + major_bsize)){ caml_fatal_error ("cannot initialize page table"); } diff --git a/runtime/gen_primitives.sh b/runtime/gen_primitives.sh index a157bae40a..8816ccb417 100755 --- a/runtime/gen_primitives.sh +++ b/runtime/gen_primitives.sh @@ -24,7 +24,8 @@ export LC_ALL=C for prim in \ alloc array compare extern floats gc_ctrl hash intern interp ints io \ lexing md5 meta memprof obj parsing signals str sys callback weak \ - finalise stacks dynlink backtrace_byt backtrace spacetime_byt afl bigarray + finalise stacks dynlink backtrace_byt backtrace spacetime_byt afl \ + bigarray eventlog do sed -n -e 's/^CAMLprim value \([a-z0-9_][a-z0-9_]*\).*/\1/p' "$prim.c" done diff --git a/runtime/major_gc.c b/runtime/major_gc.c index 14e87647ab..5e4f06bce8 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -33,6 +33,7 @@ #include "caml/signals.h" #include "caml/weak.h" #include "caml/memprof.h" +#include "caml/eventlog.h" #if defined (NATIVE_CODE) && defined (NO_NAKED_POINTERS) #define NATIVE_CODE_AND_NO_NAKED_POINTERS @@ -211,13 +212,6 @@ static void start_cycle (void) static value current_value = 0; static mlsize_t current_index = 0; -/* For instrumentation */ -#ifdef CAML_INSTR -#define INSTR(x) x -#else -#define INSTR(x) /**/ -#endif - static void init_sweep_phase(void) { /* Phase_clean is done. */ @@ -254,7 +248,7 @@ Caml_inline value* mark_slice_darken(value *gray_vals_ptr, #else if (Is_block (child) && Is_in_heap (child)) { #endif - INSTR (++ *slice_pointers;) + CAML_EVENTLOG_DO (++ *slice_pointers); chd = Hd_val (child); if (Tag_hd (chd) == Forward_tag){ value f = Forward_val (child); @@ -390,9 +384,9 @@ static void mark_slice (intnat work) header_t hd; mlsize_t size, i, start, end; /* [start] is a local copy of [current_index] */ #ifdef CAML_INSTR - int slice_fields = 0; -#endif - int slice_pointers = 0; /** gcc removes it when not in CAML_INSTR */ + int slice_fields = 0; /** eventlog counters */ +#endif /*CAML_INSTR*/ + int slice_pointers = 0; caml_gc_message (0x40, "Marking %"ARCH_INTNAT_PRINTF_FORMAT"d words\n", work); caml_gc_message (0x40, "Subphase = %d\n", caml_gc_subphase); @@ -414,9 +408,11 @@ static void mark_slice (intnat work) start = size < start ? size : start; end = size < end ? size : end; CAMLassert (end >= start); - INSTR (slice_fields += end - start;) - INSTR (if (size > end) - CAML_INSTR_INT ("major/mark/slice/remain#", size - end);) + CAML_EVENTLOG_DO({ + slice_fields += end - start; + if (size > end) + CAML_EV_COUNTER (EV_C_MAJOR_MARK_SLICE_REMAIN, size - end); + }); for (i = start; i < end; i++){ gray_vals_ptr = mark_slice_darken(gray_vals_ptr,v,i, /*in_ephemeron=*/ 0, @@ -464,9 +460,11 @@ static void mark_slice (intnat work) markhp = chunk; limit = chunk + Chunk_size (chunk); } else if (caml_gc_subphase == Subphase_mark_roots) { + CAML_EV_BEGIN(EV_MAJOR_MARK_ROOTS); gray_vals_cur = gray_vals_ptr; work = caml_darken_all_roots_slice (work); gray_vals_ptr = gray_vals_cur; + CAML_EV_END(EV_MAJOR_MARK_ROOTS); if (work > 0){ caml_gc_subphase = Subphase_mark_main; } @@ -482,6 +480,7 @@ static void mark_slice (intnat work) case Subphase_mark_main: { /* Subphase_mark_main is done. Mark finalised values. */ + CAML_EV_BEGIN(EV_MAJOR_MARK_MAIN); gray_vals_cur = gray_vals_ptr; caml_final_update_mark_phase (); gray_vals_ptr = gray_vals_cur; @@ -491,12 +490,14 @@ static void mark_slice (intnat work) } /* Complete the marking */ ephes_to_check = ephes_checked_if_pure; + CAML_EV_END(EV_MAJOR_MARK_MAIN); caml_gc_subphase = Subphase_mark_final; } break; case Subphase_mark_final: { /** The set of unreachable value will not change anymore for this cycle. Start clean phase. */ + CAML_EV_BEGIN(EV_MAJOR_MARK_FINAL); caml_gc_phase = Phase_clean; caml_final_update_clean_phase (); caml_memprof_update_clean_phase (); @@ -507,7 +508,8 @@ static void mark_slice (intnat work) /* Initialise the sweep phase. */ init_sweep_phase(); } - work = 0; + work = 0; + CAML_EV_END(EV_MAJOR_MARK_FINAL); } break; default: CAMLassert (0); @@ -517,8 +519,8 @@ static void mark_slice (intnat work) gray_vals_cur = gray_vals_ptr; current_value = v; current_index = start; - INSTR (CAML_INSTR_INT ("major/mark/slice/fields#", slice_fields);) - INSTR (CAML_INSTR_INT ("major/mark/slice/pointers#", slice_pointers);) + CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_FIELDS, slice_fields); + CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_POINTERS, slice_pointers); } /* Clean ephemerons */ @@ -592,26 +594,6 @@ static void sweep_slice (intnat work) } } -#ifdef CAML_INSTR -static char *mark_slice_name[] = { - /* 0 */ NULL, - /* 1 */ NULL, - /* 2 */ NULL, - /* 3 */ NULL, - /* 4 */ NULL, - /* 5 */ NULL, - /* 6 */ NULL, - /* 7 */ NULL, - /* 8 */ NULL, - /* 9 */ NULL, - /* 10 */ "major/mark_roots", - /* 11 */ "major/mark_main", - /* 12 */ "major/mark_weak1", - /* 13 */ "major/mark_weak2", - /* 14 */ "major/mark_final", -}; -#endif - /* The main entry point for the major GC. Called about once for each minor GC. [howmuch] is the amount of work to do: -1 if the GC is triggered automatically @@ -623,7 +605,6 @@ void caml_major_collection_slice (intnat howmuch) double p, dp, filt_p, spend; intnat computed_work; int i; - CAML_INSTR_DECLARE (tmr); /* Free memory at the start of the GC cycle (garbage + free list) (assumed): FM = Caml_state->stat_heap_wsz * caml_percent_free @@ -683,8 +664,6 @@ void caml_major_collection_slice (intnat howmuch) */ if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) (); - CAML_INSTR_ALLOC (tmr); - CAML_INSTR_START (tmr, "major"); p = (double) caml_allocated_words * 3.0 * (100 + caml_percent_free) / Caml_state->stat_heap_wsz / caml_percent_free / 2.0; @@ -702,7 +681,8 @@ void caml_major_collection_slice (intnat howmuch) p_backlog = p - 0.3; p = 0.3; } - CAML_INSTR_INT ("major/work/extra#", + + CAML_EV_COUNTER (EV_C_MAJOR_WORK_EXTRA, (uintnat) (caml_extra_heap_resources * 1000000)); caml_gc_message (0x40, "ordered work = %" @@ -770,8 +750,9 @@ void caml_major_collection_slice (intnat howmuch) if (Caml_state->young_ptr == Caml_state->young_alloc_end){ /* We can only start a major GC cycle if the minor allocation arena is empty, otherwise we'd have to treat it as a set of roots. */ + CAML_EV_BEGIN(EV_MAJOR_ROOTS); start_cycle (); - CAML_INSTR_TIME (tmr, "major/roots"); + CAML_EV_END(EV_MAJOR_ROOTS); } p = 0; goto finished; @@ -792,24 +773,27 @@ void caml_major_collection_slice (intnat howmuch) caml_gc_message (0x40, "computed work = %" ARCH_INTNAT_PRINTF_FORMAT "d words\n", computed_work); if (caml_gc_phase == Phase_mark){ - CAML_INSTR_INT ("major/work/mark#", computed_work); + CAML_EV_COUNTER (EV_C_MAJOR_WORK_MARK, computed_work); + CAML_EV_BEGIN(EV_MAJOR_MARK); mark_slice (computed_work); - CAML_INSTR_TIME (tmr, mark_slice_name[caml_gc_subphase]); + CAML_EV_END(EV_MAJOR_MARK); caml_gc_message (0x02, "!"); }else if (caml_gc_phase == Phase_clean){ clean_slice (computed_work); caml_gc_message (0x02, "%%"); }else{ CAMLassert (caml_gc_phase == Phase_sweep); - CAML_INSTR_INT ("major/work/sweep#", computed_work); + CAML_EV_COUNTER (EV_C_MAJOR_WORK_SWEEP, computed_work); + CAML_EV_BEGIN(EV_MAJOR_SWEEP); sweep_slice (computed_work); - CAML_INSTR_TIME (tmr, "major/sweep"); + CAML_EV_END(EV_MAJOR_SWEEP); caml_gc_message (0x02, "$"); } if (caml_gc_phase == Phase_idle){ + CAML_EV_BEGIN(EV_MAJOR_CHECK_AND_COMPACT); caml_compact_heap_maybe (); - CAML_INSTR_TIME (tmr, "major/check_and_compact"); + CAML_EV_END(EV_MAJOR_CHECK_AND_COMPACT); } finished: diff --git a/runtime/memory.c b/runtime/memory.c index 44bb783445..6eb454b747 100644 --- a/runtime/memory.c +++ b/runtime/memory.c @@ -33,6 +33,7 @@ #include "caml/mlvalues.h" #include "caml/signals.h" #include "caml/memprof.h" +#include "caml/eventlog.h" int caml_huge_fallback_count = 0; /* Number of times that mmapping big pages fails and we fell back to small @@ -479,6 +480,7 @@ Caml_inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag, int track, else return 0; } + CAML_EV_ALLOC(wosize); hp = caml_fl_allocate (wosize); if (hp == NULL){ new_block = expand_heap (wosize); @@ -511,7 +513,7 @@ Caml_inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag, int track, profinfo)); caml_allocated_words += Whsize_wosize (wosize); if (caml_allocated_words > Caml_state->minor_heap_wsz){ - CAML_INSTR_INT ("request_major/alloc_shr@", 1); + CAML_EV_COUNTER (EV_C_REQUEST_MAJOR_ALLOC_SHR, 1); caml_request_major_slice (); } #ifdef DEBUG @@ -618,7 +620,7 @@ CAMLexport void caml_adjust_gc_speed (mlsize_t res, mlsize_t max) if (res > max) res = max; caml_extra_heap_resources += (double) res / (double) max; if (caml_extra_heap_resources > 1.0){ - CAML_INSTR_INT ("request_major/adjust_gc_speed_1@", 1); + CAML_EV_COUNTER (EV_C_REQUEST_MAJOR_ADJUST_GC_SPEED, 1); caml_extra_heap_resources = 1.0; caml_request_major_slice (); } diff --git a/runtime/memprof.c b/runtime/memprof.c index 2f7413cf78..42e446027a 100644 --- a/runtime/memprof.c +++ b/runtime/memprof.c @@ -30,6 +30,7 @@ #include "caml/misc.h" #include "caml/compact.h" #include "caml/printexc.h" +#include "caml/eventlog.h" #define MT_STATE_SIZE 624 @@ -779,7 +780,7 @@ void caml_memprof_track_young(uintnat wosize, int from_caml, /* We can now restore the minor heap in the state needed by [Alloc_small_aux]. */ if (Caml_state->young_ptr - whsize < Caml_state->young_trigger) { - CAML_INSTR_INT("force_minor/memprof@", 1); + CAML_EV_COUNTER(EV_C_FORCE_MINOR_MEMPROF, 1); caml_gc_dispatch(); } diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index 07f3b7738f..b8661bc7e2 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -34,6 +34,7 @@ #ifdef WITH_SPACETIME #include "caml/spacetime.h" #endif +#include "caml/eventlog.h" /* Pointers into the minor heap. [Caml_state->young_base] @@ -148,7 +149,7 @@ void caml_set_minor_heap_size (asize_t bsz) CAMLassert (bsz % Page_size == 0); CAMLassert (bsz % sizeof (value) == 0); if (Caml_state->young_ptr != Caml_state->young_alloc_end){ - CAML_INSTR_INT ("force_minor/set_minor_heap_size@", 1); + CAML_EV_COUNTER (EV_C_FORCE_MINOR_SET_MINOR_HEAP_SIZE, 1); Caml_state->requested_minor_gc = 0; Caml_state->young_trigger = Caml_state->young_alloc_mid; caml_update_young_limit(); @@ -354,25 +355,25 @@ void caml_empty_minor_heap (void) struct caml_custom_elt *elt; uintnat prev_alloc_words; struct caml_ephe_ref_elt *re; - CAML_INSTR_DECLARE (tmr); if (Caml_state->young_ptr != Caml_state->young_alloc_end){ CAMLassert_young_header(*(header_t*)Caml_state->young_ptr); if (caml_minor_gc_begin_hook != NULL) (*caml_minor_gc_begin_hook) (); - CAML_INSTR_ALLOC (tmr); - CAML_INSTR_START (tmr, "minor"); prev_alloc_words = caml_allocated_words; Caml_state->in_minor_collection = 1; caml_gc_message (0x02, "<"); + CAML_EV_BEGIN(EV_MINOR_LOCAL_ROOTS); caml_oldify_local_roots(); - CAML_INSTR_TIME (tmr, "minor/local_roots"); + CAML_EV_END(EV_MINOR_LOCAL_ROOTS); + CAML_EV_BEGIN(EV_MINOR_REF_TABLES); for (r = Caml_state->ref_table->base; r < Caml_state->ref_table->ptr; r++) { caml_oldify_one (**r, *r); } - CAML_INSTR_TIME (tmr, "minor/ref_table"); + CAML_EV_END(EV_MINOR_REF_TABLES); + CAML_EV_BEGIN(EV_MINOR_COPY); caml_oldify_mopup (); - CAML_INSTR_TIME (tmr, "minor/copy"); + CAML_EV_END(EV_MINOR_COPY); /* Update the ephemerons */ for (re = Caml_state->ephe_ref_table->base; re < Caml_state->ephe_ref_table->ptr; re++){ @@ -391,6 +392,7 @@ void caml_empty_minor_heap (void) } } /* Update the OCaml finalise_last values */ + CAML_EV_BEGIN(EV_MINOR_UPDATE_WEAK); caml_final_update_minor_roots(); /* Trigger memprofs callbacks for blocks in the minor heap. */ caml_memprof_minor_update(); @@ -407,7 +409,8 @@ void caml_empty_minor_heap (void) if (final_fun != NULL) final_fun(v); } } - CAML_INSTR_TIME (tmr, "minor/update_weak"); + CAML_EV_END(EV_MINOR_UPDATE_WEAK); + CAML_EV_BEGIN(EV_MINOR_FINALIZED); Caml_state->stat_minor_words += Caml_state->young_alloc_end - Caml_state->young_ptr; caml_gc_clock += @@ -421,9 +424,10 @@ void caml_empty_minor_heap (void) caml_gc_message (0x02, ">"); Caml_state->in_minor_collection = 0; caml_final_empty_young (); - CAML_INSTR_TIME (tmr, "minor/finalized"); + CAML_EV_END(EV_MINOR_FINALIZED); Caml_state->stat_promoted_words += caml_allocated_words - prev_alloc_words; - CAML_INSTR_INT ("minor/promoted#", caml_allocated_words - prev_alloc_words); + CAML_EV_COUNTER (EV_C_MINOR_PROMOTED, + caml_allocated_words - prev_alloc_words); ++ Caml_state->stat_minor_collections; caml_memprof_renew_minor_sample(); if (caml_minor_gc_end_hook != NULL) (*caml_minor_gc_end_hook) (); @@ -444,7 +448,7 @@ void caml_empty_minor_heap (void) #ifdef CAML_INSTR extern uintnat caml_instr_alloc_jump; -#endif +#endif /*CAML_INSTR*/ /* Do a minor collection or a slice of major collection, call finalisation functions, etc. @@ -454,24 +458,29 @@ extern uintnat caml_instr_alloc_jump; CAMLexport void caml_gc_dispatch (void) { value *trigger = Caml_state->young_trigger; /* save old value of trigger */ -#ifdef CAML_INSTR - CAML_INSTR_SETUP(tmr, "dispatch"); - CAML_INSTR_TIME (tmr, "overhead"); - CAML_INSTR_INT ("alloc/jump#", caml_instr_alloc_jump); - caml_instr_alloc_jump = 0; -#endif + + CAML_EVENTLOG_DO({ + CAML_EV_COUNTER(EV_C_ALLOC_JUMP, caml_instr_alloc_jump); + caml_instr_alloc_jump = 0; + }); if (trigger == Caml_state->young_alloc_start || Caml_state->requested_minor_gc) { /* The minor heap is full, we must do a minor collection. */ /* reset the pointers first because the end hooks might allocate */ + CAML_EV_BEGIN(EV_MINOR); Caml_state->requested_minor_gc = 0; Caml_state->young_trigger = Caml_state->young_alloc_mid; caml_update_young_limit(); caml_empty_minor_heap (); /* The minor heap is empty, we can start a major collection. */ - if (caml_gc_phase == Phase_idle) caml_major_collection_slice (-1); - CAML_INSTR_TIME (tmr, "dispatch/minor"); + CAML_EV_END(EV_MINOR); + if (caml_gc_phase == Phase_idle) + { + CAML_EV_BEGIN(EV_MAJOR); + caml_major_collection_slice (-1); + CAML_EV_END(EV_MAJOR); + } } if (trigger != Caml_state->young_alloc_start || Caml_state->requested_major_slice) { @@ -479,8 +488,9 @@ CAMLexport void caml_gc_dispatch (void) Caml_state->requested_major_slice = 0; Caml_state->young_trigger = Caml_state->young_alloc_start; caml_update_young_limit(); + CAML_EV_BEGIN(EV_MAJOR); caml_major_collection_slice (-1); - CAML_INSTR_TIME (tmr, "dispatch/major"); + CAML_EV_END(EV_MAJOR); } } @@ -517,7 +527,7 @@ void caml_alloc_small_dispatch (intnat wosize, int flags, /* If not, then empty the minor heap, and check again for async callbacks. */ - CAML_INSTR_INT ("force_minor/alloc_small@", 1); + CAML_EV_COUNTER (EV_C_FORCE_MINOR_ALLOC_SMALL, 1); caml_gc_dispatch (); #if defined(NATIVE_CODE) && defined(WITH_SPACETIME) if (caml_young_ptr == caml_young_alloc_end) { @@ -559,7 +569,6 @@ CAMLexport value caml_check_urgent_gc (value extra_root) { if (Caml_state->requested_major_slice || Caml_state->requested_minor_gc){ CAMLparam1 (extra_root); - CAML_INSTR_INT ("force_minor/check_urgent_gc@", 1); caml_gc_dispatch(); CAMLdrop; } @@ -568,7 +577,8 @@ CAMLexport value caml_check_urgent_gc (value extra_root) static void realloc_generic_table (struct generic_table *tbl, asize_t element_size, - char * msg_intr_int, char *msg_threshold, char *msg_growing, char *msg_error) + ev_gc_counter ev_counter_name, + char *msg_threshold, char *msg_growing, char *msg_error) { CAMLassert (tbl->ptr == tbl->limit); CAMLassert (tbl->limit <= tbl->end); @@ -578,7 +588,7 @@ static void realloc_generic_table alloc_generic_table (tbl, Caml_state->minor_heap_wsz / 8, 256, element_size); }else if (tbl->limit == tbl->threshold){ - CAML_INSTR_INT (msg_intr_int, 1); + CAML_EV_COUNTER (ev_counter_name, 1); caml_gc_message (0x08, msg_threshold, 0); tbl->limit = tbl->end; caml_request_minor_gc (); @@ -605,7 +615,7 @@ void caml_realloc_ref_table (struct caml_ref_table *tbl) { realloc_generic_table ((struct generic_table *) tbl, sizeof (value *), - "request_minor/realloc_ref_table@", + EV_C_REQUEST_MINOR_REALLOC_REF_TABLE, "ref_table threshold crossed\n", "Growing ref_table to %" ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n", "ref_table overflow"); @@ -615,7 +625,7 @@ void caml_realloc_ephe_ref_table (struct caml_ephe_ref_table *tbl) { realloc_generic_table ((struct generic_table *) tbl, sizeof (struct caml_ephe_ref_elt), - "request_minor/realloc_ephe_ref_table@", + EV_C_REQUEST_MINOR_REALLOC_EPHE_REF_TABLE, "ephe_ref_table threshold crossed\n", "Growing ephe_ref_table to %" ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n", "ephe_ref_table overflow"); @@ -625,7 +635,7 @@ void caml_realloc_custom_table (struct caml_custom_table *tbl) { realloc_generic_table ((struct generic_table *) tbl, sizeof (struct caml_custom_elt), - "request_minor/realloc_custom_table@", + EV_C_REQUEST_MINOR_REALLOC_CUSTOM_TABLE, "custom_table threshold crossed\n", "Growing custom_table to %" ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n", "custom_table overflow"); diff --git a/runtime/misc.c b/runtime/misc.c index c1534bc5fa..8aa0d09038 100644 --- a/runtime/misc.c +++ b/runtime/misc.c @@ -206,89 +206,6 @@ int caml_runtime_warnings_active(void) return 1; } -#ifdef CAML_INSTR -/* Timers for profiling GC and allocation (experimental, Linux-only) */ - -#include <limits.h> -#include <sys/types.h> -#include <unistd.h> - -struct caml_instr_block *caml_instr_log = NULL; -intnat caml_instr_starttime, caml_instr_stoptime; - -#define Get_time(p,i) ((p)->ts[(i)].tv_nsec + 1000000000 * (p)->ts[(i)].tv_sec) - -void caml_instr_init (void) -{ - char *s; - - caml_instr_starttime = 0; - s = caml_secure_getenv ("OCAML_INSTR_START"); - if (s != NULL) caml_instr_starttime = atol (s); - caml_instr_stoptime = LONG_MAX; - s = caml_secure_getenv ("OCAML_INSTR_STOP"); - if (s != NULL) caml_instr_stoptime = atol (s); -} - -void caml_instr_atexit (void) -{ - int i; - struct caml_instr_block *p, *prev, *next; - FILE *f = NULL; - char *fname; - - fname = caml_secure_getenv ("OCAML_INSTR_FILE"); - if (fname != NULL){ - char *mode = "a"; - char buf [1000]; - char *name = fname; - - if (name[0] == '@'){ - snprintf (buf, sizeof(buf), "%s.%lld", - name + 1, (long long) (getpid ())); - name = buf; - } - if (name[0] == '+'){ - mode = "a"; - name = name + 1; - }else if (name [0] == '>' || name[0] == '-'){ - mode = "w"; - name = name + 1; - } - f = fopen (name, mode); - } - - if (f != NULL){ - /* reverse the list */ - prev = NULL; - p = caml_instr_log; - while (p != NULL){ - next = p->next; - p->next = prev; - prev = p; - p = next; - } - caml_instr_log = prev; - fprintf (f, "==== OCAML INSTRUMENTATION DATA %s\n", OCAML_VERSION_STRING); - for (p = caml_instr_log; p != NULL; p = p->next){ - for (i = 0; i < p->index; i++){ - fprintf (f, "@@ %19ld %19ld %s\n", - (long) Get_time (p, i), - (long) Get_time(p, i+1), - p->tag[i+1]); - } - if (p->tag[0][0] != '\000'){ - fprintf (f, "@@ %19ld %19ld %s\n", - (long) Get_time (p, 0), - (long) Get_time(p, p->index), - p->tag[0]); - } - } - fclose (f); - } -} -#endif /* CAML_INSTR */ - int caml_find_code_fragment(char *pc, int *index, struct code_fragment **cf) { struct code_fragment *cfi; diff --git a/runtime/roots_byt.c b/runtime/roots_byt.c index a3a2dcd8f4..bd549f1467 100644 --- a/runtime/roots_byt.c +++ b/runtime/roots_byt.c @@ -27,6 +27,7 @@ #include "caml/roots.h" #include "caml/stacks.h" #include "caml/memprof.h" +#include "caml/eventlog.h" CAMLexport void (*caml_scan_roots_hook) (scanning_action f) = NULL; @@ -81,26 +82,31 @@ intnat caml_darken_all_roots_slice (intnat work) ignored and [caml_darken_all_roots_slice] does nothing. */ void caml_do_roots (scanning_action f, int do_globals) { - CAML_INSTR_SETUP (tmr, "major_roots"); /* Global variables */ + CAML_EV_BEGIN(EV_MAJOR_ROOTS_GLOBAL); f(caml_global_data, &caml_global_data); - CAML_INSTR_TIME (tmr, "major_roots/global"); + CAML_EV_END(EV_MAJOR_ROOTS_GLOBAL); /* The stack and the local C roots */ + CAML_EV_BEGIN(EV_MAJOR_ROOTS_LOCAL); caml_do_local_roots(f, Caml_state->extern_sp, Caml_state->stack_high, Caml_state->local_roots); - CAML_INSTR_TIME (tmr, "major_roots/local"); + CAML_EV_END(EV_MAJOR_ROOTS_LOCAL); /* Global C roots */ + CAML_EV_BEGIN(EV_MAJOR_ROOTS_C); caml_scan_global_roots(f); - CAML_INSTR_TIME (tmr, "major_roots/C"); + CAML_EV_END(EV_MAJOR_ROOTS_C); /* Finalised values */ + CAML_EV_BEGIN(EV_MAJOR_ROOTS_FINALISED); caml_final_do_roots (f); - CAML_INSTR_TIME (tmr, "major_roots/finalised"); + CAML_EV_END(EV_MAJOR_ROOTS_FINALISED); /* Memprof */ + CAML_EV_BEGIN(EV_MAJOR_ROOTS_MEMPROF); caml_memprof_do_roots (f); - CAML_INSTR_TIME (tmr, "major_roots/memprof"); + CAML_EV_END(EV_MAJOR_ROOTS_MEMPROF); /* Hook */ + CAML_EV_BEGIN(EV_MAJOR_ROOTS_HOOK); if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f); - CAML_INSTR_TIME (tmr, "major_roots/hook"); + CAML_EV_END(EV_MAJOR_ROOTS_HOOK); } CAMLexport void caml_do_local_roots (scanning_action f, value *stack_low, diff --git a/runtime/roots_nat.c b/runtime/roots_nat.c index ee1e48de44..ec66e2dbf5 100644 --- a/runtime/roots_nat.c +++ b/runtime/roots_nat.c @@ -27,6 +27,7 @@ #include "caml/stack.h" #include "caml/roots.h" #include "caml/memprof.h" +#include "caml/eventlog.h" #include <string.h> #include <stdio.h> @@ -361,7 +362,7 @@ intnat caml_darken_all_roots_slice (intnat work) static int do_resume = 0; static mlsize_t roots_count = 0; intnat remaining_work = work; - CAML_INSTR_SETUP (tmr, ""); + CAML_EV_BEGIN(EV_MAJOR_MARK_GLOBAL_ROOTS_SLICE); /* If the loop was started in a previous call, resume it. */ if (do_resume) goto resume; @@ -391,7 +392,7 @@ intnat caml_darken_all_roots_slice (intnat work) suspend: /* Do this in both cases. */ - CAML_INSTR_TIME (tmr, "major/mark/global_roots_slice"); + CAML_EV_END(EV_MAJOR_MARK_GLOBAL_ROOTS_SLICE); return remaining_work; } @@ -400,8 +401,8 @@ void caml_do_roots (scanning_action f, int do_globals) int i, j; value * glob; link *lnk; - CAML_INSTR_SETUP (tmr, "major_roots"); + CAML_EV_BEGIN(EV_MAJOR_ROOTS_DYNAMIC_GLOBAL); if (do_globals){ /* The global roots */ for (i = 0; caml_globals[i] != 0; i++) { @@ -419,24 +420,29 @@ void caml_do_roots (scanning_action f, int do_globals) } } } - CAML_INSTR_TIME (tmr, "major_roots/dynamic_global"); + CAML_EV_END(EV_MAJOR_ROOTS_DYNAMIC_GLOBAL); /* The stack and local roots */ + CAML_EV_BEGIN(EV_MAJOR_ROOTS_LOCAL); caml_do_local_roots(f, Caml_state->bottom_of_stack, Caml_state->last_return_address, Caml_state->gc_regs, Caml_state->local_roots); - CAML_INSTR_TIME (tmr, "major_roots/local"); + CAML_EV_END(EV_MAJOR_ROOTS_LOCAL); /* Global C roots */ + CAML_EV_BEGIN(EV_MAJOR_ROOTS_C); caml_scan_global_roots(f); - CAML_INSTR_TIME (tmr, "major_roots/C"); + CAML_EV_END(EV_MAJOR_ROOTS_C); /* Finalised values */ + CAML_EV_BEGIN(EV_MAJOR_ROOTS_FINALISED); caml_final_do_roots (f); - CAML_INSTR_TIME (tmr, "major_roots/finalised"); + CAML_EV_END(EV_MAJOR_ROOTS_FINALISED); /* Memprof */ + CAML_EV_BEGIN(EV_MAJOR_ROOTS_MEMPROF); caml_memprof_do_roots (f); - CAML_INSTR_TIME (tmr, "major_roots/memprof"); + CAML_EV_END(EV_MAJOR_ROOTS_MEMPROF); /* Hook */ + CAML_EV_BEGIN(EV_MAJOR_ROOTS_HOOK); if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f); - CAML_INSTR_TIME (tmr, "major_roots/hook"); + CAML_EV_END(EV_MAJOR_ROOTS_HOOK); } void caml_do_local_roots(scanning_action f, char * bottom_of_stack, diff --git a/runtime/startup_byt.c b/runtime/startup_byt.c index 9ef2c7def6..1d04a85ad1 100644 --- a/runtime/startup_byt.c +++ b/runtime/startup_byt.c @@ -35,6 +35,7 @@ #include "caml/debugger.h" #include "caml/domain.h" #include "caml/dynlink.h" +#include "caml/eventlog.h" #include "caml/exec.h" #include "caml/fail.h" #include "caml/fix_code.h" @@ -353,6 +354,7 @@ CAMLexport void caml_main(char_os **argv) caml_verb_gc = 0x3F; #endif caml_parse_ocamlrunparam(); + CAML_EVENTLOG_INIT(); #ifdef DEBUG caml_gc_message (-1, "### OCaml runtime: debug mode ###\n"); #endif @@ -488,6 +490,7 @@ CAMLexport value caml_startup_code_exn( caml_verb_gc = 0x3F; #endif caml_parse_ocamlrunparam(); + CAML_EVENTLOG_INIT(); #ifdef DEBUG caml_gc_message (-1, "### OCaml runtime: debug mode ###\n"); #endif diff --git a/runtime/startup_nat.c b/runtime/startup_nat.c index 2a3c550d6a..c9ae1a931e 100644 --- a/runtime/startup_nat.c +++ b/runtime/startup_nat.c @@ -24,6 +24,7 @@ #include "caml/custom.h" #include "caml/debugger.h" #include "caml/domain.h" +#include "caml/eventlog.h" #include "caml/fail.h" #include "caml/freelist.h" #include "caml/gc.h" @@ -115,6 +116,7 @@ value caml_startup_common(char_os **argv, int pooling) caml_verb_gc = 0x3F; #endif caml_parse_ocamlrunparam(); + CAML_EVENTLOG_INIT(); #ifdef DEBUG caml_gc_message (-1, "### OCaml runtime: debug mode ###\n"); #endif diff --git a/runtime/sys.c b/runtime/sys.c index ab4704e509..4da107a98e 100644 --- a/runtime/sys.c +++ b/runtime/sys.c @@ -151,7 +151,6 @@ CAMLprim value caml_sys_exit(value retcode_v) #ifndef NATIVE_CODE caml_debugger(PROGRAM_EXIT, Val_unit); #endif - caml_instr_atexit (); if (caml_cleanup_on_exit) caml_shutdown(); #ifdef _WIN32 diff --git a/runtime/weak.c b/runtime/weak.c index 4dab7f7a84..85315263ed 100644 --- a/runtime/weak.c +++ b/runtime/weak.c @@ -27,6 +27,7 @@ #include "caml/weak.h" #include "caml/minor_gc.h" #include "caml/signals.h" +#include "caml/eventlog.h" value caml_ephe_list_head = 0; @@ -408,7 +409,7 @@ CAMLexport int caml_ephemeron_get_key_copy(value ar, mlsize_t offset, CAMLassert(loop < 10); if(8 == loop){ /** One minor gc must be enough */ elt = Val_unit; - CAML_INSTR_INT ("force_minor/weak@", 1); + CAML_EV_COUNTER (EV_C_FORCE_MINOR_WEAK, 1); caml_minor_collection (); } else { /* cases where loop is between 0 to 7 and where loop is equal to 9 */ @@ -463,7 +464,7 @@ CAMLexport int caml_ephemeron_get_data_copy (value ar, value *data) CAMLassert(loop < 10); if(8 == loop){ /** One minor gc must be enough */ elt = Val_unit; - CAML_INSTR_INT ("force_minor/weak@", 1); + CAML_EV_COUNTER (EV_C_FORCE_MINOR_WEAK, 1); caml_minor_collection (); } else { /* cases where loop is between 0 to 7 and where loop is equal to 9 */ diff --git a/stdlib/gc.ml b/stdlib/gc.ml index 52433ca432..9a5c004e64 100644 --- a/stdlib/gc.ml +++ b/stdlib/gc.ml @@ -63,6 +63,8 @@ external get_minor_free : unit -> int = "caml_get_minor_free" external get_bucket : int -> int = "caml_get_major_bucket" [@@noalloc] external get_credit : unit -> int = "caml_get_major_credit" [@@noalloc] external huge_fallback_count : unit -> int = "caml_gc_huge_fallback_count" +external eventlog_pause : unit -> unit = "caml_eventlog_pause" +external eventlog_resume : unit -> unit = "caml_eventlog_resume" open Printf diff --git a/stdlib/gc.mli b/stdlib/gc.mli index 77682456f7..7fe085ee7f 100644 --- a/stdlib/gc.mli +++ b/stdlib/gc.mli @@ -422,6 +422,24 @@ val delete_alarm : alarm -> unit (** [delete_alarm a] will stop the calls to the function associated to [a]. Calling [delete_alarm a] again has no effect. *) +external eventlog_pause : unit -> unit = "caml_eventlog_pause" +(** [eventlog_pause ()] will pause the collection of traces in the + runtime. + Traces are collected if the program is linked to the instrumented runtime + and started with the environment variable OCAML_EVENTLOG_ENABLED. + Events are flushed to disk after pausing, and no new events will be + recorded until [eventlog_resume] is called. *) + +external eventlog_resume : unit -> unit = "caml_eventlog_resume" +(** [eventlog_resume ()] will resume the collection of traces in the + runtime. + Traces are collected if the program is linked to the instrumented runtime + and started with the environment variable OCAML_EVENTLOG_ENABLED. + This call can be used after calling [eventlog_pause], or if the program + was started with OCAML_EVENTLOG_ENABLED=p. (which pauses the collection of + traces before the first event.) *) + + (** [Memprof] is a sampling engine for allocated memory words. Every allocated word has a probability of being sampled equal to a configurable sampling rate. Once a block is sampled, it becomes diff --git a/testsuite/tests/instrumented-runtime/main.ml b/testsuite/tests/instrumented-runtime/main.ml new file mode 100644 index 0000000000..ebee4a6e42 --- /dev/null +++ b/testsuite/tests/instrumented-runtime/main.ml @@ -0,0 +1,11 @@ +(* TEST + * hasinstrumentedruntime + ** native + flags = "-runtime-variant=i" +*) + +(* Test if the instrumented runtime is in working condition *) + +let _ = + Gc.eventlog_pause (); + Gc.eventlog_resume() diff --git a/testsuite/tests/instrumented-runtime/main.run b/testsuite/tests/instrumented-runtime/main.run new file mode 100644 index 0000000000..0b2e8ce455 --- /dev/null +++ b/testsuite/tests/instrumented-runtime/main.run @@ -0,0 +1,35 @@ +#!/bin/sh + +export OCAML_EVENTLOG_ENABLED=1 +export OCAML_EVENTLOG_FILE=${program} + +if [ "${os_type}" = "Win32" ] ; then + program=$(cygpath "$program") +fi + +rm -f "${program}"*.eventlog* +${program} > ${output} & + +pid=$! +wait $pid + +ls "${program}".*.eventlog | grep "\.[0-9]\+\.eventlog$" | \ +while IFS= read -r file; do + touch ${program}.eventlogs + if [ ! -e "${program}.eventlog" ] ; then + touch ${program}.eventlog + else + rm -f ${program}.eventlog + break + fi +done + +if [ -f "${program}.eventlog" ]; then + exit ${TEST_PASS} +elif [ -f "${program}.eventlogs" ]; then + echo 'too many runtime traces found!' > ${ocamltest_response} + exit ${TEST_FAIL} +else + echo 'instrumented runtime trace not found!' > ${ocamltest_response} + exit ${TEST_FAIL} +fi diff --git a/tools/Makefile b/tools/Makefile index 2c3475cded..96a4244ccf 100644 --- a/tools/Makefile +++ b/tools/Makefile @@ -317,6 +317,12 @@ clean:: rm -f "objinfo_helper" "objinfo_helper.manifest" rm -f "objinfo_helper.exe" "objinfo_helper.exe.manifest" +# Eventlog metadata file + +install:: + $(INSTALL_DATA) \ + eventlog_metadata \ + "$(INSTALL_LIBDIR)" # Copy a bytecode executable, stripping debug info @@ -334,13 +340,6 @@ CMPBYT=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \ $(call byte_and_opt,cmpbyt,$(CMPBYT),) -ifeq "$(RUNTIMEI)" "true" -install:: - $(INSTALL_PROG) \ - ocaml-instr-graph ocaml-instr-report \ - "$(INSTALL_BINDIR)/" -endif - CAMLTEX= $(ROOTDIR)/compilerlibs/ocamlcommon.cma \ $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \ $(ROOTDIR)/compilerlibs/ocamltoplevel.cma \ diff --git a/tools/eventlog_metadata.in b/tools/eventlog_metadata.in new file mode 100644 index 0000000000..f39364ed1e --- /dev/null +++ b/tools/eventlog_metadata.in @@ -0,0 +1,216 @@ +/* CTF 1.8 */ + +typealias integer {size = 8;} := uint8_t; +typealias integer {size = 16;} := uint16_t; +typealias integer {size = 32;} := uint32_t; +typealias integer {size = 64;} := uint64_t; + +clock { + name = tracing_clock; + freq = 1000000000; /* tick = 1 ns */ +}; + +typealias integer { + size = 64; + map = clock.tracing_clock.value; +} := tracing_clock_int_t; + + +/* + +Main trace description, +major and minor refers to the CTF version being used. + +The packet header must contain at the very least +a stream id and the CTF magic number. +We only use one stream for now, and CTF magic number is 0xc1fc1fc1. + +We add an extra field ocaml_trace_version to enable simpler transition if we add +or remove metrics in the future. + +*/ +trace { + major = 1; + minor = 8; + byte_order = @endianness@; + packet.header := struct { + uint32_t magic; /* required: must contain CTF magic number */ + uint16_t ocaml_trace_version; /* our own trace format versioning */ + uint16_t stream_id; /* required, although we have only one. */ + }; +}; + +/* + +We use only one stream at the moment. +Each event payload must contain a header with a timestamp and a pid. +The id field refers to the various event kinds defined further down this file. + +*/ +stream { + id = 0; + event.header := struct { /* for each event */ + tracing_clock_int_t timestamp; + uint32_t pid; + uint32_t id; + }; +}; + +/* + +These enumerations are mostly following the instrumented runtime datapoints. +gc_phase aims to track the entry and exit time of each of the following events +during collection. + +*/ +enum gc_phase : uint16_t { + "compact/main" = 0, + "compact/recompact", + "explicit/gc_set", + "explicit/gc_stat", + "explicit/gc_minor", + "explicit/gc_major", + "explicit/gc_full_major", + "explicit/gc_compact", + "major", + "major/roots", + "major/sweep", + "major/mark/roots", + "major/mark/main", + "major/mark/final", + "major/mark", + "major/mark/global_roots_slice", + "major_roots/global", + "major_roots/dynamic_global", + "major_roots/local", + "major_roots/C", + "major_roots/finalised", + "major_roots/memprof", + "major_roots/hook", + "major/check_and_compact", + "minor", + "minor/local_roots", + "minor/ref_tables", + "minor/copy", + "minor/update_weak", + "minor/finalized", + "explicit/gc_major_slice" +}; + +/* + +Miscellaneous GC counters + +*/ +enum gc_counter : uint16_t { + "alloc_jump", + "force_minor/alloc_small", + "force_minor/make_vect", + "force_minor/set_minor_heap_size", + "force_minor/weak", + "force_minor/memprof", + "major/mark/slice/remain", + "major/mark/slice/fields", + "major/mark/slice/pointers", + "major/work/extra", + "major/work/mark", + "major/work/sweep", + "minor/promoted", + "request_major/alloc_shr", + "request_major/adjust_gc_speed", + "request_minor/realloc_ref_table", + "request_minor/realloc_ephe_ref_table", + "request_minor/realloc_custom_table" +}; + +/* + +Block allocation counters, per size buckets. + +*/ +enum alloc_bucket : uint8_t { + "alloc 01" = 1, + "alloc 02", + "alloc 03", + "alloc 04", + "alloc 05", + "alloc 06", + "alloc 07", + "alloc 08", + "alloc 09", + "alloc 10-19", + "alloc 20-29", + "alloc 30-39", + "alloc 40-49", + "alloc 50-59", + "alloc 60-69", + "alloc 70-79", + "alloc 80-89", + "alloc 90-99", + "alloc large" +}; + +/* + +Each event is comprised of the previously defined event.header +and the fields defined here. + +An entry event marks the start of a gc phase. + +*/ +event { + id = 0; + name = "entry"; + stream_id = 0; + fields := struct { + enum gc_phase phase; + }; +}; + +/* + +exit counterparts to entry events + +*/ +event { + id = 1; + name = "exit"; + stream_id = 0; + fields := struct { + enum gc_phase phase; + }; +}; + +event { + id = 2; + name = "counter"; + stream_id = 0; + fields := struct { + uint64_t count; + enum gc_counter kind; + }; +}; + +event { + id = 3; + name = "alloc"; + stream_id = 0; + fields := struct { + uint64_t count; + enum alloc_bucket bucket; + }; +}; + +/* + Flush events are used to track the time spent by the tracing runtime flushing + data to disk, useful to remove flushing overhead for other runtime mesurements + in the trace. +*/ +event { + id = 4; + name = "flush"; + stream_id = 0; + fields := struct { + tracing_clock_int_t duration; + }; +}; diff --git a/tools/ocaml-instr-graph b/tools/ocaml-instr-graph deleted file mode 100755 index edf2d363cf..0000000000 --- a/tools/ocaml-instr-graph +++ /dev/null @@ -1,116 +0,0 @@ -#!/usr/bin/env bash - -#************************************************************************** -#* * -#* OCaml * -#* * -#* Damien Doligez, Jane Street Group, LLC * -#* * -#* Copyright 2015 Institut National de Recherche en Informatique et * -#* en Automatique. * -#* * -#* All rights reserved. This file is distributed under the terms of * -#* the GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -# Use this script on OCAML_INSTR_FILE files - -default_curves=major,minor,coll,dispatch - -usage () { - echo 'usage: ocaml-instr-graph file [options]' - echo ' options:' - echo " -d names plot the data for names (default: $default_curves)" - echo ' -t title set the graph title' - echo ' -m n clip the values to n (default 1G)' - echo ' -rt n set the range for times to 0..n' - echo ' -rn n set the range for counts to 0..n' - echo ' -from t start at time t' - echo ' -to t stop at time t' - echo ' -help display this help message and exit' -} - -datafile= -curves=, -title= -titleset=false -max=1000000000 -ranget= -rangen= -from=0 -to=1e19 - -while [[ $# > 0 ]]; do - case $1 in - -d) curves=$curves$2,; shift 2;; - -t) title=$2; titleset=true; shift 2;; - -m) max=$2; shift 2;; - -rt) ranget="set yrange [0:$2]"; shift 2;; - -rn) rangen="set y2range [0:$2]"; shift 2;; - -from) from=$2; shift 2;; - -to) to=$2; shift 2;; - -help) usage; exit 0;; - *) datafile=$1; shift 1;; - esac -done - -if [[ "$curves" = , ]]; then - curves=,$default_curves, -fi - -if ! $titleset; then - title=$datafile -fi - -tmpfile=/tmp/ocaml-instr-graph.$$ - -rm -f $tmpfile-* - -awk -v curves="$curves" -v clip=$max -v tmpfile="$tmpfile" -v from=$from \ - -v to=$to ' - function output (filename){ - time = ($2 - starttime) / 1e9; - if (time < from || time >= to) return; - if (index(curves, "," filename ",") != 0){ - gsub (/\//,":",filename); - if (filename ~ /#/){ - point = $3; - }else{ - point = ($3 - $2) / 1000; - } - if (point > clip) point = clip; - printf ("%.6f %.3f\n", time, point) >> tmpfile "-" filename; - } - } - BEGIN {starttime = 9e18;} - $1 != "@@" { next; } - $2 < starttime { starttime = $2 } - { output($4); } -' $datafile - -( echo set title \"$title\" - echo set key left top - echo set ytics nomirror - echo 'set format y "%gus"' - echo "$ranget" - echo "$rangen" - echo set y2tics nomirror - echo 'set format x "%gs"' - printf "plot " - for curve in ${curves//,/ }; do - f=$tmpfile-${curve//\//:} - if [ -f $f ]; then - case $f in - *#) printf "\"%s\" using 1:2 axes x1y2 title '%s', " "$f" \ - "$curve" - ;; - *) printf "\"%s\" using 1:2 title '%s', " "$f" "$curve";; - esac - fi - done - printf "\n" -) | gnuplot -p - -rm -f $tmpfile-* diff --git a/tools/ocaml-instr-report b/tools/ocaml-instr-report deleted file mode 100755 index bac4f6bab8..0000000000 --- a/tools/ocaml-instr-report +++ /dev/null @@ -1,162 +0,0 @@ -#!/bin/awk -f - -#************************************************************************** -#* * -#* OCaml * -#* * -#* Damien Doligez, Jane Street Group, LLC * -#* * -#* Copyright 2014 Institut National de Recherche en Informatique et * -#* en Automatique. * -#* * -#* All rights reserved. This file is distributed under the terms of * -#* the GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -# usage: -# ocaml-instr-report { file ... } -# generate a report from the data files (or stdin if no file is given) - -function short(n, kind, i, r){ - for (i = 0; i < 5; i++){ - if (n < 1000) break; - n /= 1000; - } - r = sprintf ("%f", n); - if (index(r, ".") == 3){ - r = substr(r, 1, 2); - }else{ - r = substr(r, 1, 3); - } - return sprintf("%s%s", r, units[kind,i]); -} - -function add(limit){ - lim[nscales] = limit; - scale["t",nscales] = short(limit, "t"); - scale["n",nscales] = short(limit, "n"); - ++ nscales; -} - -# kind is "t" (for timer) or "n" (for number) -# events are simply a special kind of timer - -BEGIN { - units["t",0] = "ns"; - units["t",1] = "us"; - units["t",2] = "ms"; - units["t",3] = "s"; - units["t",4] = "ks"; - units["t",5] = "Ms"; - - units["n",0] = ""; - units["n",1] = "k"; - units["n",2] = "M"; - units["n",3] = "G"; - units["n",4] = "T"; - units["n",5] = "P"; - - nscales=0; - add(0); - for (mul = 100; mul < 10000000000; mul *= 10){ - add(mul); - add(2.2 * mul); - add(4.7 * mul); - } -} - -function store(value, tag) { - ++ total[tag]; - for (i = 0; i < nscales; i++){ - if (value <= lim[i]){ - ++ bin[tag, lim[i]]; - val[tag, lim[i]] = value; - return; - } - } - ++ bin[tag, "off-scale"]; - val[tag, "off-scale"] = value; -} - -$1 == "@@" && $4 ~ /@/ { total[$4] += $3; } - -$1 == "@@" && $4 ~ /#/ { store($3, $4); } - -$1 == "@@" { store($3 - $2, $4); } - -function display(n, val, kind, i) { - graph_width = 35; - - if (n > 0){ - for (i = 0; i < log (n) / log (2); i++){ - printf("#"); - } - if (n == 1){ - printf(" %-6d", n); - printf ("%-*s", graph_width - 7 - i, - sprintf("(%s)", short(val, kind))); - }else{ - printf(" %-*d", graph_width - 1 - i, n); - } - }else{ - printf("%*s", graph_width, ""); - } -} - -END { - n = asorti(total,tags); - total_alloc = 0; - for (i = 1; i <= n; i++){ - t = tags[i]; - if (t ~ /^alloc/) total_alloc += total[t]; - } - for (i = 1; i <= n; i++){ - t = tags[i]; - if (t ~ /#/){ - kind = "n"; # number - }else if (t ~ /@/){ - kind = "e"; # event - }else{ - kind = "t"; # timer - } - if (kind == "e"){ - printf ("==== %-12s:%9d", t, total[t]); - if (t ~ /^alloc/){ - cumul += total[t] / total_alloc; - printf(" (%6.2f%%)", cumul * 100); - } - printf ("\n"); - continue; - }else{ - printf ("==== %s: %d\n", t, total[t]); - } - num = bin[t,0]; - found = num; - if (num == total[t] && kind == "t"){ - /* nothing */ - }else if (num > 0){ - printf (" 0: "); - display(bin[t,0], val[t, 0], kind); - printf ("%6.2f%%\n", found * 100 / total[t]); - } - for (j = 1; j < nscales; j++){ - if (found == total[t]) break; - num = bin [t, lim[j]]; - found += num; - if (found > 0){ - printf ("%5s..%-5s: ", scale[kind,j-1], scale[kind,j]); - display(num, val[t, lim[j]], kind); - printf ("%6.2f%%\n", found * 100 / total[t]); - } - } - num = bin[t, "off-scale"]; - if (num != 0){ - printf (" off scale : "); - display(bin[t, "off-scale"], val[t, "off-scale"]); - printf ("\n"); - } - printf ("====\n"); - } -} |