From 4b87f5b676314f14cfe4581db6f3623423205f14 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 9 Mar 2023 10:51:28 +0100 Subject: [PATCH 01/16] Build system: do not use SHAREDLIB_CFLAGS when computing dependencies This commit contains two changes to the root Makefile: 1. Removal of the following line: $(DEPDIR)/runtime/%.bpic.$(D): OC_CFLAGS += $(SHAREDLIB_CFLAGS) This line is useless because it makes no sense to alter any variable in the CFLAGS category for the computation of dependencies, since only the C preprocessor is involved in this stage and it does not take C flags into account anyway, only C preprocessor flags. 2. When computing the dependencies for $(DEPDIR)/runtime/%.npic.$(D), one should not refer to $(SHAREDLIB_CFLAGS), for a similar reason. It has been verified that SHAREDLIB_CFLAGS is either empty, or contains just -fPIC which is indeed not necessary for computing dependencies (it is indeed a C flag rather than a C preprocessor flag). --- Makefile | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 4ce297cfea..e2f0c1c8a2 100644 --- a/Makefile +++ b/Makefile @@ -912,7 +912,6 @@ runtime/%.bi.$(O): OC_CPPFLAGS += $(ocamlruni_CPPFLAGS) $(DEPDIR)/runtime/%.bi.$(D): OC_CPPFLAGS += $(ocamlruni_CPPFLAGS) runtime/%.bpic.$(O): OC_CFLAGS += $(SHAREDLIB_CFLAGS) -$(DEPDIR)/runtime/%.bpic.$(D): OC_CFLAGS += $(SHAREDLIB_CFLAGS) runtime/%.n.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(DEPDIR)/runtime/%.n.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) @@ -926,8 +925,7 @@ $(DEPDIR)/runtime/%.ni.$(D): \ OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(ocamlruni_CPPFLAGS) runtime/%.npic.$(O): OC_CFLAGS += $(OC_NATIVE_CPPFLAGS) $(SHAREDLIB_CFLAGS) -$(DEPDIR)/runtime/%.npic.$(D): \ - OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(SHAREDLIB_CFLAGS) +$(DEPDIR)/runtime/%.npic.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) ## Compilation of runtime C files From b72b639e2ceade33e2237f73be926ba46897b5bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 9 Mar 2023 11:19:19 +0100 Subject: [PATCH 02/16] Build system: fix flag definitions for native PIC objects In this target-specific definition, C and C preprocessor flags were mixed. This commit distinguishes one form the other. --- Makefile | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index e2f0c1c8a2..c66028733c 100644 --- a/Makefile +++ b/Makefile @@ -924,7 +924,8 @@ runtime/%.ni.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(ocamlruni_CPPFLAGS) $(DEPDIR)/runtime/%.ni.$(D): \ OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(ocamlruni_CPPFLAGS) -runtime/%.npic.$(O): OC_CFLAGS += $(OC_NATIVE_CPPFLAGS) $(SHAREDLIB_CFLAGS) +runtime/%.npic.$(O): OC_CFLAGS += $(SHAREDLIB_CFLAGS) +runtime/%.npic.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(DEPDIR)/runtime/%.npic.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) ## Compilation of runtime C files From 48fa4b79776b57d872aefc0ae547de2773fb0632 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 9 Mar 2023 14:57:02 +0100 Subject: [PATCH 03/16] Make private build variables private Given the convention that the OC_* build varialbes are reserved for the build system, it seems better to make sure all of them are defined in the private Makefile.build_config file, rather than in Makefile.config which gets installed and thus becomes public. This commit moves the definitions of OC_CFLAGS, OC_CPPFLAGS, OC_LDFLAGS, OC_DLL_LDFLAGS and OC_EXE_LDFLAGS from Makefile.config.in to Makefile.build_config.in. It also moves the defintion of MKEXE_VIA_CC, since this variable relies on private build varables and does not seem relevant or useful outside of the context of the build of the compiler itself. --- Makefile.build_config.in | 14 ++++++++++++++ Makefile.config.in | 11 ----------- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/Makefile.build_config.in b/Makefile.build_config.in index 86433f90fa..2a909e2b24 100644 --- a/Makefile.build_config.in +++ b/Makefile.build_config.in @@ -50,6 +50,20 @@ INSTALL_OCAMLNAT = @install_ocamlnat@ DEP_CC=@DEP_CC@ -MM COMPUTE_DEPS=@compute_deps@ +# Build-system flags to use to compile C files +OC_CFLAGS=@oc_cflags@ +OC_CPPFLAGS=-I$(ROOTDIR)/runtime @oc_cppflags@ + +# Additional link-time options +# To support dynamic loading of shared libraries (they need to look at +# our own symbols): +OC_LDFLAGS=@oc_ldflags@ +OC_DLL_LDFLAGS=@oc_dll_ldflags@ +OC_EXE_LDFLAGS=@oc_exe_ldflags@ + +MKEXE_VIA_CC=\ + $(CC) $(OC_EXE_LDFLAGS) $(OC_CFLAGS) $(CFLAGS) @mkexe_via_cc_ldflags@ + # Which tool to use to display differences between files DIFF=@DIFF@ # Which flags to pass to the diff tool diff --git a/Makefile.config.in b/Makefile.config.in index c8d6966c40..d56dc96ecd 100644 --- a/Makefile.config.in +++ b/Makefile.config.in @@ -78,13 +78,6 @@ CC=@CC@ CC_HAS_DEBUG_PREFIX_MAP=@cc_has_debug_prefix_map@ AS_HAS_DEBUG_PREFIX_MAP=@as_has_debug_prefix_map@ -### Additional link-time options -# To support dynamic loading of shared libraries (they need to look at -# our own symbols): -OC_LDFLAGS=@oc_ldflags@ -OC_DLL_LDFLAGS=@oc_dll_ldflags@ -OC_EXE_LDFLAGS=@oc_exe_ldflags@ - LDFLAGS?=@LDFLAGS@ ### How to invoke the C preprocessor through the C compiler @@ -175,9 +168,7 @@ OTHERLIBRARIES=@otherlibraries@ UNIX_OR_WIN32=@unix_or_win32@ INSTALL_SOURCE_ARTIFACTS=@install_source_artifacts@ -OC_CFLAGS=@oc_cflags@ CFLAGS=@CFLAGS@ -OC_CPPFLAGS=-I$(ROOTDIR)/runtime @oc_cppflags@ CPPFLAGS=@CPPFLAGS@ OCAMLC_CFLAGS=@ocamlc_cflags@ @@ -214,8 +205,6 @@ MKEXE=@mkexe@ MKDLL=@mkdll@ MKMAINDLL=@mkmaindll@ MKEXEDEBUGFLAG=@mkexedebugflag@ -MKEXE_VIA_CC=\ - $(CC) $(OC_EXE_LDFLAGS) $(OC_CFLAGS) $(CFLAGS) @mkexe_via_cc_ldflags@ RUNTIMED=@debug_runtime@ INSTRUMENTED_RUNTIME=@instrumented_runtime@ From 0a7cbc8716c29388f6021f65fb25ffa57ca8286f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 9 Mar 2023 17:22:47 +0100 Subject: [PATCH 04/16] Rename a few private build variables The renamings done in this commit are: OC_COMMON_CFLAGS -> OC_COMMON_COMPFLAGS OC_COMMON_LDFLAGS -> OC_COMMON_LINKFLAGS OC_BYTECODE_LDFLAGS -> OC_BYTECODE_LINKFLAGS OC_NATIVE_CFLAGS -> OC_NATIVE_COMPFLAGS OC_NATIVE_LDFLAGS -> OC_NATIVE_LINKFLAGS --- Makefile | 28 +++++++++++++++------------- Makefile.build_config.in | 24 ++++++++++++------------ Makefile.common | 4 ++-- Makefile.menhir | 2 +- configure | 6 +++--- configure.ac | 6 +++--- 6 files changed, 36 insertions(+), 34 deletions(-) diff --git a/Makefile b/Makefile index c66028733c..bd57f60e67 100644 --- a/Makefile +++ b/Makefile @@ -474,9 +474,9 @@ ocamlc_LIBRARIES = $(addprefix compilerlibs/,ocamlcommon ocamlbytecomp) ocamlc_MODULES = driver/main -ocamlc$(EXE): OC_BYTECODE_LDFLAGS += -compat-32 -g +ocamlc$(EXE): OC_BYTECODE_LINKFLAGS += -compat-32 -g -ocamlc.opt$(EXE): OC_NATIVE_LDFLAGS += $(addprefix -cclib ,$(BYTECCLIBS)) +ocamlc.opt$(EXE): OC_NATIVE_LINKFLAGS += $(addprefix -cclib ,$(BYTECCLIBS)) partialclean:: rm -f ocamlc ocamlc.exe ocamlc.opt ocamlc.opt.exe @@ -487,7 +487,7 @@ ocamlopt_LIBRARIES = $(addprefix compilerlibs/,ocamlcommon ocamloptcomp) ocamlopt_MODULES = driver/optmain -ocamlopt$(EXE): OC_BYTECODE_LDFLAGS += -g +ocamlopt$(EXE): OC_BYTECODE_LINKFLAGS += -g partialclean:: rm -f ocamlopt ocamlopt.exe ocamlopt.opt ocamlopt.opt.exe @@ -500,7 +500,7 @@ ocaml_LIBRARIES = \ ocaml_MODULES = toplevel/topstart .INTERMEDIATE: ocaml.tmp -ocaml.tmp: OC_BYTECODE_LDFLAGS += -I toplevel/byte -linkall -g +ocaml.tmp: OC_BYTECODE_LINKFLAGS += -I toplevel/byte -linkall -g ocaml.tmp: $(ocaml_LIBRARIES:=.cma) $(ocaml_MODULES:=.cmo) $(V_LINKC)$(LINK_BYTECODE_PROGRAM) -o $@ $^ @@ -1119,7 +1119,7 @@ ocamllex: ocamlyacc ocamllex.opt: ocamlopt $(MAKE) lex-allopt -lex/ocamllex$(EXE): OC_BYTECODE_LDFLAGS += -compat-32 +lex/ocamllex$(EXE): OC_BYTECODE_LINKFLAGS += -compat-32 partialclean:: rm -f lex/*.cm* lex/*.o lex/*.obj @@ -1364,7 +1364,7 @@ partialclean:: ocamldep_LIBRARIES = $(addprefix compilerlibs/,ocamlcommon ocamlbytecomp) ocamldep_MODULES = tools/ocamldep -tools/ocamldep$(EXE): OC_BYTECODE_LDFLAGS += -compat-32 +tools/ocamldep$(EXE): OC_BYTECODE_LINKFLAGS += -compat-32 # The profiler @@ -1456,10 +1456,10 @@ ocamltex_MODULES = tools/ocamltex # Note: the following definitions apply to all the prerequisites # of ocamltex. $(ocamltex): CAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc$(EXE) $(STDLIBFLAGS) -$(ocamltex): OC_COMMON_LDFLAGS += -linkall +$(ocamltex): OC_COMMON_LINKFLAGS += -linkall $(ocamltex): VPATH += $(addprefix otherlibs/,str unix) -tools/ocamltex.cmo: OC_COMMON_CFLAGS += -no-alias-deps +tools/ocamltex.cmo: OC_COMMON_COMPFLAGS += -no-alias-deps # we need str and unix which depend on the bytecode version of other tools # thus we use the othertools target @@ -1506,13 +1506,15 @@ ocamlnat_LIBRARIES = \ ocamlnat_MODULES = $(ocaml_MODULES) -ocamlnat$(EXE): OC_NATIVE_LDFLAGS += -linkall -I toplevel/native +ocamlnat$(EXE): OC_NATIVE_LINKFLAGS += -linkall -I toplevel/native COMPILE_NATIVE_MODULE = \ - $(CAMLOPT_CMD) $(OC_COMMON_CFLAGS) -I $(@D) $(INCLUDES) $(OC_NATIVE_CFLAGS) + $(CAMLOPT_CMD) $(OC_COMMON_COMPFLAGS) -I $(@D) $(INCLUDES) \ + $(OC_NATIVE_COMPFLAGS) + toplevel/topdirs.cmx toplevel/toploop.cmx $(ocamlnat_MODULES:=.cmx): \ - OC_NATIVE_CFLAGS += -I toplevel/native + OC_NATIVE_COMPFLAGS += -I toplevel/native toplevel/toploop.cmx: toplevel/native/topeval.cmx @@ -1544,10 +1546,10 @@ endif # Default rules %.cmo: %.ml - $(V_OCAMLC)$(CAMLC) $(OC_COMMON_CFLAGS) -I $(@D) $(INCLUDES) -c $< + $(V_OCAMLC)$(CAMLC) $(OC_COMMON_COMPFLAGS) -I $(@D) $(INCLUDES) -c $< %.cmi: %.mli - $(V_OCAMLC)$(CAMLC) $(OC_COMMON_CFLAGS) -I $(@D) $(INCLUDES) -c $< + $(V_OCAMLC)$(CAMLC) $(OC_COMMON_COMPFLAGS) -I $(@D) $(INCLUDES) -c $< %.cmx: %.ml $(V_OCAMLOPT)$(COMPILE_NATIVE_MODULE) -c $< diff --git a/Makefile.build_config.in b/Makefile.build_config.in index 2a909e2b24..d9e947ec32 100644 --- a/Makefile.build_config.in +++ b/Makefile.build_config.in @@ -103,9 +103,9 @@ DEFAULT_BUILD_TARGET = @default_build_target@ # The names of the variables below take the form XXX_YYY_ZZZ where # -# XXX is one of OC, OCAML or the name of a module. The OC prefix +# XXX is one of OC, OCAML or the lower-case name of a module. The OC prefix # is for private variables (i.e. reserved by the compiler's build system), -# the OCAML prefix is used for variables the user can define to add their +# the OCAML prefix is used for variables users can define to add their # own flags and the module-name prefix is for flags that apply only # to one module. # @@ -113,22 +113,22 @@ DEFAULT_BUILD_TARGET = @default_build_target@ # COMMON for the flags shared by all the backends, BYTECODE or NATIVE # (other backends may be added in the future). # -# ZZZ is either CFLAGS (compile-time flags) or LDFLAGS (link-time flags). -# However, contrary to what is done for C compilers, the flags in the -# CFLAGS category are not passed at link time, so if a flag is needed -# at both stages, like e.g. -g, it should be added to both XXX_YYY_CFLAGS and -# XXX_YYY_LDFLAGS. +# ZZZ is either COMPFLAGS (compile-time flags) or LINKFLAGS (link-time flags). +# Countrary to the C convention wrt. CFLAGS and LDFLAGS, the flags in the +# COMPFLAGS category are not passed at link time, so if a flag is needed +# at both stages, like e.g. -g, it should be added to both +# XXX_YYY_COMPFLAGS and XXX_YYY_LINKFLAGS. -OC_COMMON_CFLAGS = -g -strict-sequence -principal -absname \ +OC_COMMON_COMPFLAGS = -g -strict-sequence -principal -absname \ -w +a-4-9-40-41-42-44-45-48 -warn-error +a -bin-annot \ -strict-formats -OC_COMMON_LDFLAGS = $(INCLUDES) +OC_COMMON_LINKFLAGS = $(INCLUDES) -OC_BYTECODE_LDFLAGS = +OC_BYTECODE_LINKFLAGS = -OC_NATIVE_CFLAGS = @oc_native_cflags@ +OC_NATIVE_COMPFLAGS = @oc_native_compflags@ -OC_NATIVE_LDFLAGS = -g +OC_NATIVE_LINKFLAGS = -g # Platform-dependent command to create symbolic links LN = @ln@ diff --git a/Makefile.common b/Makefile.common index 9bdc162c3c..5f2c4531b4 100644 --- a/Makefile.common +++ b/Makefile.common @@ -254,7 +254,7 @@ MERGEMANIFESTEXE = $(call if_file_exists, $(1).manifest, \ .SECONDEXPANSION: LINK_BYTECODE_PROGRAM =\ - $(CAMLC) $(OC_COMMON_LDFLAGS) $(OC_BYTECODE_LDFLAGS) + $(CAMLC) $(OC_COMMON_LINKFLAGS) $(OC_BYTECODE_LINKFLAGS) define OCAML_BYTECODE_PROGRAM $(eval $(call PROGRAM_SYNONYM,$(1))) @@ -265,7 +265,7 @@ $(1)$(EXE): \ endef # OCAML_BYTECODE_PROGRAM LINK_NATIVE_PROGRAM =\ - $(CAMLOPT_CMD) $(OC_COMMON_LDFLAGS) $(OC_NATIVE_LDFLAGS) + $(CAMLOPT_CMD) $(OC_COMMON_LINKFLAGS) $(OC_NATIVE_LINKFLAGS) define OCAML_NATIVE_PROGRAM $(eval $(call PROGRAM_SYNONYM,$(1))) diff --git a/Makefile.menhir b/Makefile.menhir index 1bf961a945..fc13e5e70c 100644 --- a/Makefile.menhir +++ b/Makefile.menhir @@ -76,7 +76,7 @@ MENHIRBASICFLAGS := \ MENHIRFLAGS := \ $(MENHIRBASICFLAGS) \ --infer \ - --ocamlc "$(CAMLC) $(OC_COMMON_CFLAGS) $(INCLUDES)" \ + --ocamlc "$(CAMLC) $(OC_COMMON_COMPFLAGS) $(INCLUDES)" \ --fixed-exception \ --table \ --strategy simplified \ diff --git a/configure b/configure index c491144386..6d392286ec 100755 --- a/configure +++ b/configure @@ -789,7 +789,7 @@ mkdll_ldflags_exp flexdll_chain flexlink_cmd afl -oc_native_cflags +oc_native_compflags function_sections flat_float_array windows_unicode @@ -19429,7 +19429,7 @@ esac fi -oc_native_cflags='' +oc_native_compflags='' if test x"$enable_function_sections" = "xno" then : @@ -19459,7 +19459,7 @@ printf "%s\n" "$as_me: Function sections are not supported in Clang prior to version 3.5." >&6;} ;; #( gcc-*|clang-*) : function_sections=true; - oc_native_cflags='-function-sections' + oc_native_compflags='-function-sections' internal_cflags="$internal_cflags -ffunction-sections"; printf "%s\n" "#define FUNCTION_SECTIONS 1" >>confdefs.h ;; #( diff --git a/configure.ac b/configure.ac index 231d690e12..e4943d23e5 100644 --- a/configure.ac +++ b/configure.ac @@ -201,7 +201,7 @@ AC_SUBST([cmm_invariants]) AC_SUBST([windows_unicode]) AC_SUBST([flat_float_array]) AC_SUBST([function_sections]) -AC_SUBST([oc_native_cflags]) +AC_SUBST([oc_native_compflags]) AC_SUBST([afl]) AC_SUBST([flexlink_cmd]) AC_SUBST([flexdll_chain]) @@ -2143,7 +2143,7 @@ AS_IF([test x"$enable_mmap_map_stack" = "xyes"], [with_mmap_map_stack=false]) ]) -oc_native_cflags='' +oc_native_compflags='' AS_IF([test x"$enable_function_sections" = "xno"], [function_sections=false], @@ -2165,7 +2165,7 @@ AS_IF([test x"$enable_function_sections" = "xno"], in Clang prior to version 3.5.])], [gcc-*|clang-*], [function_sections=true; - oc_native_cflags='-function-sections' + oc_native_compflags='-function-sections' internal_cflags="$internal_cflags -ffunction-sections"; AC_DEFINE([FUNCTION_SECTIONS])], [*], From 6fd3475e124e21d4433556ffd4e19e80a66cfb0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 9 Mar 2023 18:19:18 +0100 Subject: [PATCH 05/16] Make OC_NATIVE_CPPFLAGS configurable This means moving its definition from Makefile.common to Makefile.build_config.in --- Makefile.build_config.in | 12 ++++++++++++ Makefile.common | 7 ------- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/Makefile.build_config.in b/Makefile.build_config.in index d9e947ec32..88883d2cf5 100644 --- a/Makefile.build_config.in +++ b/Makefile.build_config.in @@ -54,6 +54,18 @@ COMPUTE_DEPS=@compute_deps@ OC_CFLAGS=@oc_cflags@ OC_CPPFLAGS=-I$(ROOTDIR)/runtime @oc_cppflags@ +# The following variable defines flags to be passed to the C preprocessor +# when compiling C files to be linked with native code. This includes +# the native runtime itself and can also include the stub code around +# C libraries when it needs to be different from the one used to +# link with bytecode. + +# These flags should be passed *in addition* to those in OC_CPPFLAGS, they +# should not replace them. + +OC_NATIVE_CPPFLAGS=\ + -DNATIVE_CODE -DTARGET_$(ARCH) -DMODEL_$(MODEL) -DSYS_$(SYSTEM) + # Additional link-time options # To support dynamic loading of shared libraries (they need to look at # our own symbols): diff --git a/Makefile.common b/Makefile.common index 5f2c4531b4..76e66a44dc 100644 --- a/Makefile.common +++ b/Makefile.common @@ -142,13 +142,6 @@ endif # ifeq "$(BOOTSTRAPPING_FLEXDLL)" "false" # List of other libraries ALL_OTHERLIBS = dynlink str systhreads unix runtime_events -# The following variable defines flags to be passed to the C preprocessor -# when compiling C files for the native runtime. -# These flags should be passed *in addition* to those in OC_CPPFLAGS, they -# should not replace them. -OC_NATIVE_CPPFLAGS=\ - -DNATIVE_CODE -DTARGET_$(ARCH) -DMODEL_$(MODEL) -DSYS_$(SYSTEM) - # Flags to pass to the C preprocessor when preprocessing assembly files OC_ASPPFLAGS=-I $(ROOTDIR)/runtime $(OC_NATIVE_CPPFLAGS) From 74d164a8fbbec113d951710708dc2ba8114a79d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 9 Mar 2023 18:32:12 +0100 Subject: [PATCH 06/16] Compute OC_NATIVE_CPPFLAGS during configure rather than during build --- Makefile.build_config.in | 3 +-- configure | 4 ++++ configure.ac | 3 +++ 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/Makefile.build_config.in b/Makefile.build_config.in index 88883d2cf5..0429921e2b 100644 --- a/Makefile.build_config.in +++ b/Makefile.build_config.in @@ -63,8 +63,7 @@ OC_CPPFLAGS=-I$(ROOTDIR)/runtime @oc_cppflags@ # These flags should be passed *in addition* to those in OC_CPPFLAGS, they # should not replace them. -OC_NATIVE_CPPFLAGS=\ - -DNATIVE_CODE -DTARGET_$(ARCH) -DMODEL_$(MODEL) -DSYS_$(SYSTEM) +OC_NATIVE_CPPFLAGS=-DNATIVE_CODE @native_cppflags@ # Additional link-time options # To support dynamic loading of shared libraries (they need to look at diff --git a/configure b/configure index 6d392286ec..45c2ba3bb9 100755 --- a/configure +++ b/configure @@ -876,6 +876,7 @@ ln unix_or_win32 ocamlsrcdir systhread_support +native_cppflags system model arch64 @@ -3351,6 +3352,7 @@ OCAML_VERSION_SHORT=5.1 + # TODO: rename this variable @@ -15447,6 +15449,8 @@ fi; system=elf ;; #( ;; esac +native_cppflags="-DTARGET_${arch} -DMODEL_${model} -DSYS_${system}" + case $ccomptype in #( msvc) : runtime_asm_objects=${arch}nt.${OBJEXT} ;; #( diff --git a/configure.ac b/configure.ac index e4943d23e5..44c8c3b9c5 100644 --- a/configure.ac +++ b/configure.ac @@ -115,6 +115,7 @@ AC_SUBST([arch]) AC_SUBST([arch64]) AC_SUBST([model]) AC_SUBST([system]) +AC_SUBST([native_cppflags]) AC_SUBST([systhread_support]) AC_SUBST([ocamlsrcdir]) AC_SUBST([unix_or_win32]) @@ -1273,6 +1274,8 @@ AS_CASE([$host], [has_native_backend=yes; arch=riscv; model=riscv64; system=linux] ) +native_cppflags="-DTARGET_${arch} -DMODEL_${model} -DSYS_${system}" + AS_CASE([$ccomptype], [msvc], [runtime_asm_objects=${arch}nt.${OBJEXT}], From 0ea76bc6b11c53e74cc8ad537004202ad83c6b9a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Thu, 9 Mar 2023 18:44:56 +0100 Subject: [PATCH 07/16] Introduce the OC_NATIVE_CFLAGS build variable This is to let configure specify flags that will be used when compiling C files to be linked with native code. The variable is not used in the build system yet, just defined. --- Makefile.build_config.in | 3 +++ configure | 3 +++ configure.ac | 2 ++ 3 files changed, 8 insertions(+) diff --git a/Makefile.build_config.in b/Makefile.build_config.in index 0429921e2b..08d2841a3f 100644 --- a/Makefile.build_config.in +++ b/Makefile.build_config.in @@ -65,6 +65,9 @@ OC_CPPFLAGS=-I$(ROOTDIR)/runtime @oc_cppflags@ OC_NATIVE_CPPFLAGS=-DNATIVE_CODE @native_cppflags@ +# Same as above, for CFLAGS +OC_NATIVE_CFLAGS=@native_cflags@ + # Additional link-time options # To support dynamic loading of shared libraries (they need to look at # our own symbols): diff --git a/configure b/configure index 45c2ba3bb9..09c88c1c40 100755 --- a/configure +++ b/configure @@ -877,6 +877,7 @@ unix_or_win32 ocamlsrcdir systhread_support native_cppflags +native_cflags system model arch64 @@ -3353,6 +3354,7 @@ OCAML_VERSION_SHORT=5.1 + # TODO: rename this variable @@ -15449,6 +15451,7 @@ fi; system=elf ;; #( ;; esac +native_cflags='' native_cppflags="-DTARGET_${arch} -DMODEL_${model} -DSYS_${system}" case $ccomptype in #( diff --git a/configure.ac b/configure.ac index 44c8c3b9c5..907884293e 100644 --- a/configure.ac +++ b/configure.ac @@ -115,6 +115,7 @@ AC_SUBST([arch]) AC_SUBST([arch64]) AC_SUBST([model]) AC_SUBST([system]) +AC_SUBST([native_cflags]) AC_SUBST([native_cppflags]) AC_SUBST([systhread_support]) AC_SUBST([ocamlsrcdir]) @@ -1274,6 +1275,7 @@ AS_CASE([$host], [has_native_backend=yes; arch=riscv; model=riscv64; system=linux] ) +native_cflags='' native_cppflags="-DTARGET_${arch} -DMODEL_${model} -DSYS_${system}" AS_CASE([$ccomptype], From 0a5de7774c86e5ab7ba2fabd57c7dab7a1186b1b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Fri, 10 Mar 2023 00:12:50 +0100 Subject: [PATCH 08/16] Use OC_NATIVE_CFLAGS where appropriate --- Makefile | 5 ++++- otherlibs/Makefile.otherlibs.common | 8 +++----- otherlibs/systhreads/Makefile | 5 ++--- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/Makefile b/Makefile index bd57f60e67..b73eb129c4 100644 --- a/Makefile +++ b/Makefile @@ -913,18 +913,21 @@ $(DEPDIR)/runtime/%.bi.$(D): OC_CPPFLAGS += $(ocamlruni_CPPFLAGS) runtime/%.bpic.$(O): OC_CFLAGS += $(SHAREDLIB_CFLAGS) +runtime/%.n.$(O): OC_CFLAGS += $(OC_NATIVE_CFLAGS) runtime/%.n.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(DEPDIR)/runtime/%.n.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) +runtime/%.nd.$(O): OC_CFLAGS += $(OC_NATIVE_CFLAGS) runtime/%.nd.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(ocamlrund_CPPFLAGS) $(DEPDIR)/runtime/%.nd.$(D): \ OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(ocamlrund_CPPFLAGS) +runtime/%.ni.$(O): OC_CFLAGS += $(OC_NATIVE_CFLAGS) runtime/%.ni.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(ocamlruni_CPPFLAGS) $(DEPDIR)/runtime/%.ni.$(D): \ OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(ocamlruni_CPPFLAGS) -runtime/%.npic.$(O): OC_CFLAGS += $(SHAREDLIB_CFLAGS) +runtime/%.npic.$(O): OC_CFLAGS += $(OC_NATIVE_CFLAGS) $(SHAREDLIB_CFLAGS) runtime/%.npic.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(DEPDIR)/runtime/%.npic.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) diff --git a/otherlibs/Makefile.otherlibs.common b/otherlibs/Makefile.otherlibs.common index 11b5d3d1f3..294becda06 100644 --- a/otherlibs/Makefile.otherlibs.common +++ b/otherlibs/Makefile.otherlibs.common @@ -36,10 +36,6 @@ OPTCOMPFLAGS += -O3 endif MKLIB=$(OCAMLRUN) $(ROOTDIR)/tools/ocamlmklib -# The C stubs for the native backend may be built with specific flags by -# redefining this variable. -OC_NATIVE_C_FLAGS = - # Variables that must be defined by individual libraries: # LIBNAME # CAMLOBJS @@ -168,8 +164,10 @@ distclean:: clean $(V_CC)$(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \ $(OUTPUTOBJ)$@ $< +%.n.$(O): OC_CFLAGS += $(OC_NATIVE_CFLAGS) + %.n.$(O): %.c $(REQUIRED_HEADERS) - $(V_CC)$(CC) -c $(OC_CFLAGS) $(OC_NATIVE_C_FLAGS) $(CFLAGS) \ + $(V_CC)$(CC) -c $(OC_CFLAGS) $(CFLAGS) \ $(OC_CPPFLAGS) $(CPPFLAGS) $(OUTPUTOBJ)$@ $< ifeq "$(COMPUTE_DEPS)" "true" diff --git a/otherlibs/systhreads/Makefile b/otherlibs/systhreads/Makefile index 51cffb0492..a098f0bafd 100644 --- a/otherlibs/systhreads/Makefile +++ b/otherlibs/systhreads/Makefile @@ -61,6 +61,8 @@ allopt: lib$(LIBNAME)nat.$(A) $(LIBNAME).cmxa $(CMIFILES) lib$(LIBNAME).$(A): $(BYTECODE_C_OBJS) $(V_OCAMLMKLIB)$(MKLIB_CMD) -o $(LIBNAME) $(BYTECODE_C_OBJS) +lib$(LIBNAME)nat.$(A): OC_CFLAGS += $(OC_NATIVE_CFLAGS) + lib$(LIBNAME)nat.$(A): $(NATIVECODE_C_OBJS) $(V_OCAMLMKLIB)$(MKLIB_CMD) -o $(LIBNAME)nat $^ @@ -88,8 +90,6 @@ $(LIBNAME).cmxa: $(THREADS_NCOBJS) # st_stubs.n.$(O) from the same source file st_stubs.c (it is compiled # twice, each time with different options). -st_stubs.n.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) - ifeq "$(COMPUTE_DEPS)" "true" st_stubs.%.$(O): st_stubs.c else @@ -154,7 +154,6 @@ ifeq "$(COMPUTE_DEPS)" "true" include $(addprefix $(DEPDIR)/, $(DEP_FILES)) endif -%.n.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) %.n.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) define GEN_RULE From 8f26653fce5b1a38ba8db8777e0c1785b016f5ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Tue, 14 Mar 2023 16:55:49 +0100 Subject: [PATCH 09/16] OC_ASPPFLAGS should include OC_CPPFLAGS When compiled for linking with native code, C files use both the common preprocessor flags and the native-specific cppflags. The same should happen for assembly files and this commit makes sure this is the case. --- Makefile.common | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.common b/Makefile.common index 76e66a44dc..509382d371 100644 --- a/Makefile.common +++ b/Makefile.common @@ -143,7 +143,7 @@ endif # ifeq "$(BOOTSTRAPPING_FLEXDLL)" "false" ALL_OTHERLIBS = dynlink str systhreads unix runtime_events # Flags to pass to the C preprocessor when preprocessing assembly files -OC_ASPPFLAGS=-I $(ROOTDIR)/runtime $(OC_NATIVE_CPPFLAGS) +OC_ASPPFLAGS=$(OC_CPPFLAGS) $(OC_NATIVE_CPPFLAGS) OPTCOMPFLAGS= ifeq "$(FUNCTION_SECTIONS)" "true" From 848ef0d9ad51fb6918ef8ac3f808f35a6d1f33b0 Mon Sep 17 00:00:00 2001 From: Fabrice Buoro Date: Thu, 9 Mar 2023 14:21:17 +0100 Subject: [PATCH 10/16] Add tsan configure flag This flag is unused for now. Co-authored-by: Olivier Nicole --- Makefile.config.in | 1 + configure | 53 ++++++++++++++++++++++++++++++++++++++++++++++ configure.ac | 36 +++++++++++++++++++++++++++++++ 3 files changed, 90 insertions(+) diff --git a/Makefile.config.in b/Makefile.config.in index d56dc96ecd..f562ddc3b4 100644 --- a/Makefile.config.in +++ b/Makefile.config.in @@ -214,6 +214,7 @@ WITH_OCAMLDOC=@ocamldoc@ WITH_OCAMLTEST=@ocamltest@ ASM_CFI_SUPPORTED=@asm_cfi_supported@ WITH_FRAME_POINTERS=@frame_pointers@ +WITH_TSAN=@tsan@ HEADER_RESERVED_BITS=@reserved_header_bits@ LIBUNWIND_AVAILABLE=@libunwind_available@ LIBUNWIND_INCLUDE_FLAGS=@libunwind_include_flags@ diff --git a/configure b/configure index 09c88c1c40..d3bde446e0 100755 --- a/configure +++ b/configure @@ -859,6 +859,7 @@ oc_exe_ldflags oc_dll_ldflags oc_ldflags oc_cppflags +tsan oc_cflags toolchain ccomptype @@ -952,6 +953,7 @@ enable_dependency_generation enable_instrumented_runtime enable_vmthreads enable_systhreads +enable_tsan enable_graph_lib enable_str_lib enable_unix_lib @@ -1639,6 +1641,7 @@ Optional Features: build the instrumented runtime [default=auto] --disable-systhreads disable the Win32/POSIX threads library + --enable-tsan enable ThreadSanitizer support [default=no] --disable-str-lib do not build the str library --disable-unix-lib do not build the unix library --disable-ocamldoc do not build the ocamldoc documentation system @@ -3230,6 +3233,8 @@ oc_ldflags="" oc_dll_ldflags="" oc_exe_ldflags="" +tsan=false + # The C# compiler and its flags CSC="" CSCFLAGS="" @@ -3355,6 +3360,7 @@ OCAML_VERSION_SHORT=5.1 + # TODO: rename this variable @@ -3676,6 +3682,15 @@ then : fi +# Check whether --enable-tsan was given. +if test ${enable_tsan+y} +then : + enableval=$enable_tsan; +else $as_nop + enable_tsan=no +fi + + # Check whether --enable-graph-lib was given. if test ${enable_graph_lib+y} then : @@ -16380,6 +16395,44 @@ esac fi +# ThreadSanitizer support is only for Linux/FreeBSD/macOS on amd64. +# ThreadSanitizer supports more architectures but the OCaml client side is not +# implemented (yet). +if test "x$enable_tsan" = "xyes" +then : + case "$arch" in #( + amd64) : + case "$system" in #( + linux) : + case "$cc_basename" in #( + gcc*|clang*) : + tsan=true ;; #( + *) : + as_fn_error $? "thread sanitizer not supported with compiler \ +$cc_basename\"" "$LINENO" 5 + ;; +esac ;; #( + macosx) : + case "$cc_basename" in #( + gcc*|clang*) : + tsan=true ;; #( + *) : + as_fn_error $? "thread sanitizer not supported with compiler \ +$cc_basename on system $system\"" "$LINENO" 5 + ;; +esac ;; #( + *) : + as_fn_error $? "thread sanitizer not supported on system $system" "$LINENO" 5 + ;; +esac ;; #( + *) : + as_fn_error $? "thread sanitizer not supported on arch $arch" "$LINENO" 5 + ;; +esac +else $as_nop + tsan=false +fi + ## Sockets ## TODO: check whether the different libraries are really useful diff --git a/configure.ac b/configure.ac index 907884293e..f83ececd50 100644 --- a/configure.ac +++ b/configure.ac @@ -54,6 +54,8 @@ oc_ldflags="" oc_dll_ldflags="" oc_exe_ldflags="" +tsan=false + # The C# compiler and its flags CSC="" CSCFLAGS="" @@ -134,6 +136,7 @@ AC_SUBST([mkexe_via_cc_ldflags]) AC_SUBST([ccomptype]) AC_SUBST([toolchain]) AC_SUBST([oc_cflags]) +AC_SUBST([tsan]) AC_SUBST([oc_cppflags]) AC_SUBST([oc_ldflags]) AC_SUBST([oc_dll_ldflags]) @@ -328,6 +331,12 @@ AC_ARG_ENABLE([systhreads], [AS_HELP_STRING([--disable-systhreads], [disable the Win32/POSIX threads library])]) +AC_ARG_ENABLE([tsan], + [AS_HELP_STRING([--enable-tsan], + [enable ThreadSanitizer support @<:@default=no@:>@])], + [], + [enable_tsan=no]) + AC_ARG_ENABLE([graph-lib], [], [AS_IF([test "x$enableval" != 'xno'], [AC_MSG_ERROR(m4_normalize([The graphics library is no longer distributed @@ -1561,6 +1570,33 @@ but no proper monotonic clock source was found.]) )] ) +# ThreadSanitizer support is only for Linux/FreeBSD/macOS on amd64. +# ThreadSanitizer supports more architectures but the OCaml client side is not +# implemented (yet). +AS_IF([test "x$enable_tsan" = "xyes" ], + [AS_CASE(["$arch"], + [amd64], + [AS_CASE(["$system"], + [linux], + [AS_CASE(["$cc_basename"], + [gcc*|clang*], + [tsan=true], + [AC_MSG_ERROR([thread sanitizer not supported with compiler \ +$cc_basename"])] + )], + [macosx], + [AS_CASE(["$cc_basename"], + [gcc*|clang*], + [tsan=true], + [AC_MSG_ERROR([thread sanitizer not supported with compiler \ +$cc_basename on system $system"])] + )], + [AC_MSG_ERROR([thread sanitizer not supported on system $system])] + )], + [AC_MSG_ERROR([thread sanitizer not supported on arch $arch])] + )], + [tsan=false]) + ## Sockets ## TODO: check whether the different libraries are really useful From 96b9ee311ed65f1c7cbcd88fdb17bdf8dc6bd386 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Mon, 20 May 2019 14:45:36 +0200 Subject: [PATCH 11/16] Restore libunwind detection Restore libunwind detection when TSan is enabled at configure time. This is a cherry-picking of b694e84aff by with some adaptations: - libunwind detection is only attempted when tsan is enabled - if tsan is enabled, libunwind is requested and not optional - libunwind_include_dirs and libunwind_link_dirs become libunwind_cppflags and libunwind_ldflags, respectively Co-authored-by: Olivier Nicole --- Makefile.config.in | 3 -- aclocal.m4 | 8 ++-- configure | 101 ++++++++++++++++++++++++++++++++++++++++++++ configure.ac | 58 +++++++++++++++++++++++++ runtime/caml/s.h.in | 2 + 5 files changed, 165 insertions(+), 7 deletions(-) diff --git a/Makefile.config.in b/Makefile.config.in index f562ddc3b4..6f6c2d6918 100644 --- a/Makefile.config.in +++ b/Makefile.config.in @@ -216,9 +216,6 @@ ASM_CFI_SUPPORTED=@asm_cfi_supported@ WITH_FRAME_POINTERS=@frame_pointers@ WITH_TSAN=@tsan@ HEADER_RESERVED_BITS=@reserved_header_bits@ -LIBUNWIND_AVAILABLE=@libunwind_available@ -LIBUNWIND_INCLUDE_FLAGS=@libunwind_include_flags@ -LIBUNWIND_LINK_FLAGS=@libunwind_link_flags@ WITH_FPIC=@fpic@ TARGET=@target@ HOST=@host@ diff --git a/aclocal.m4 b/aclocal.m4 index 9b6ae4e761..aefc1112db 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -322,16 +322,16 @@ int main (int argc, char *argv[]){ ]) AC_DEFUN([OCAML_CHECK_LIBUNWIND], [ - SAVED_CFLAGS="$CFLAGS" + SAVED_CPPFLAGS="$CPPFLAGS" SAVED_LDFLAGS="$LDFLAGS" - CFLAGS="$CFLAGS $libunwind_include_flags" - LDFLAGS="$LDFLAGS $libunwind_link_flags" + CPPFLAGS="$CPPFLAGS $libunwind_cppflags" + LDFLAGS="$LDFLAGS $libunwind_ldflags" AC_CHECK_HEADER([libunwind.h], [AC_DEFINE([HAS_LIBUNWIND]) libunwind_available=true], [libunwind_available=false]) LDFLAGS="$SAVED_LDFLAGS" - CFLAGS="$SAVED_CFLAGS" + CPPFLAGS="$SAVED_CPPFLAGS" ]) AC_DEFUN([OCAML_TEST_FLEXLINK], [ diff --git a/configure b/configure index d3bde446e0..3ee2e61e9b 100755 --- a/configure +++ b/configure @@ -763,6 +763,8 @@ ac_ct_LD LD DEFAULT_STRING WINDOWS_UNICODE_MODE +LIBUNWIND_LDFLAGS +LIBUNWIND_CPPFLAGS DLLIBS PARTIALLD target_os @@ -1001,6 +1003,8 @@ AS ASPP PARTIALLD DLLIBS +LIBUNWIND_CPPFLAGS +LIBUNWIND_LDFLAGS WINDOWS_UNICODE_MODE DEFAULT_STRING CC @@ -1705,6 +1709,11 @@ Some influential environment variables: PARTIALLD how to build partial (relocatable) object files DLLIBS which libraries to use (in addition to -ldl) to load dynamic libs + LIBUNWIND_CPPFLAGS + cc flags for libunwind (e.g. -I) + LIBUNWIND_LDFLAGS + linker flags for libunwind (e.g. -L WINDOWS_UNICODE_MODE how to handle Unicode under Windows: ansi, compatible DEFAULT_STRING @@ -3234,6 +3243,8 @@ oc_dll_ldflags="" oc_exe_ldflags="" tsan=false +# Passed to the linker by ocamlopt when tsan is enabled +oc_tsan_ldflags="-fsanitize=thread" # The C# compiler and its flags CSC="" @@ -3691,6 +3702,13 @@ else $as_nop fi +# Preprocessor and linker flags for libunwind (currently only used when TSan is +# enabled) + + + + + # Check whether --enable-graph-lib was given. if test ${enable_graph_lib+y} then : @@ -16433,6 +16451,89 @@ else $as_nop tsan=false fi +# libunwind detection when TSan is enabled +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether libunwind is required" >&5 +printf %s "checking whether libunwind is required... " >&6; } +if ! $tsan +then : + libunwind_available=false + libunwind_cppflags= + libunwind_link_flags= + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + if test "$system" = "macosx" +then : + if test x"$LIBUNWIND_CPPFLAGS" != x -o \ + x"$LIBUNWIND_LDFLAGS" != x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: On MacOSX, specifying paths for libunwind headers or libraries is strongly discouraged. It is recommended to rely on the defaults provided by the configure script" >&5 +printf "%s\n" "$as_me: WARNING: On MacOSX, specifying paths for libunwind headers or libraries is strongly discouraged. It is recommended to rely on the defaults provided by the configure script" >&2;} +fi +fi + + if test x"$LIBUNWIND_CPPFLAGS" != x +then : + libunwind_cppflags="$LIBUNWIND_CPPFLAGS" +else $as_nop + libunwind_cppflags="" +fi + + case "$system" in #( + "macosx") : + libunwind_ldflags="-framework System" ;; #( + *) : + libunwind_ldflags="-lunwind -lunwind-x86_64" ;; +esac + + if test x"$LIBUNWIND_LDFLAGS" != x +then : + libunwind_ldflags="$LIBUNWIND_LDFLAGS $libunwind_ldflags" +fi + + native_cppflags="$native_cppflags $libunwind_cppflags" + oc_tsan_ldflags="$oc_tsan_ldflags $libunwind_ldflags" + + + SAVED_CPPFLAGS="$CPPFLAGS" + SAVED_LDFLAGS="$LDFLAGS" + CPPFLAGS="$CPPFLAGS $libunwind_cppflags" + LDFLAGS="$LDFLAGS $libunwind_ldflags" + ac_fn_c_check_header_compile "$LINENO" "libunwind.h" "ac_cv_header_libunwind_h" "$ac_includes_default" +if test "x$ac_cv_header_libunwind_h" = xyes +then : + printf "%s\n" "#define HAS_LIBUNWIND 1" >>confdefs.h + + libunwind_available=true +else $as_nop + libunwind_available=false +fi + + LDFLAGS="$SAVED_LDFLAGS" + CPPFLAGS="$SAVED_CPPFLAGS" + + + if ! $libunwind_available +then : + as_fn_error $? "libunwind was requested by tsan but can not be found" "$LINENO" 5 +fi + + # We need unwinding information at runtime, but since we use + # -no_compact_unwind, we also need -keep_dwarf_unwind otherwise + # the OS X linker will chuck away the DWARF-like (.eh_frame) + # information. (Older versions of OS X don't provide this.) + + if $libunwind_available && test x"$system" = "xmacosx" +then : + extra_flags="-Wl,-keep_dwarf_unwind" + mkexe="$mkexe $extra_flags" + mksharedlib="$mksharedlib $extra_flags" +fi + +fi + ## Sockets ## TODO: check whether the different libraries are really useful diff --git a/configure.ac b/configure.ac index f83ececd50..48980c7df5 100644 --- a/configure.ac +++ b/configure.ac @@ -55,6 +55,8 @@ oc_dll_ldflags="" oc_exe_ldflags="" tsan=false +# Passed to the linker by ocamlopt when tsan is enabled +oc_tsan_ldflags="-fsanitize=thread" # The C# compiler and its flags CSC="" @@ -337,6 +339,15 @@ AC_ARG_ENABLE([tsan], [], [enable_tsan=no]) +# Preprocessor and linker flags for libunwind (currently only used when TSan is +# enabled) + +AC_ARG_VAR([LIBUNWIND_CPPFLAGS], + [cc flags for libunwind (e.g. -I)]) + +AC_ARG_VAR([LIBUNWIND_LDFLAGS], + [linker flags for libunwind (e.g. -L]) + AC_ARG_ENABLE([graph-lib], [], [AS_IF([test "x$enableval" != 'xno'], [AC_MSG_ERROR(m4_normalize([The graphics library is no longer distributed @@ -1597,6 +1608,53 @@ $cc_basename on system $system"])] )], [tsan=false]) +# libunwind detection when TSan is enabled +AC_MSG_CHECKING([whether libunwind is required]) +AS_IF([! $tsan], + [libunwind_available=false + libunwind_cppflags= + libunwind_ldflags= + AC_MSG_RESULT([no])], + [AC_MSG_RESULT([yes]) + AS_IF([test "$system" = "macosx"], + [AS_IF([test x"$LIBUNWIND_CPPFLAGS" != x -o \ + x"$LIBUNWIND_LDFLAGS" != x], + [AC_MSG_WARN(m4_normalize([ + On MacOSX, specifying paths for libunwind headers or libraries is + strongly discouraged. It is recommended to rely on the defaults + provided by the configure script + ]))])]) + + AS_IF([test x"$LIBUNWIND_CPPFLAGS" != x], + [libunwind_cppflags="$LIBUNWIND_CPPFLAGS"], + [libunwind_cppflags=""]) + + AS_CASE(["$system"], + ["macosx"], [libunwind_ldflags="-framework System"], + [libunwind_ldflags="-lunwind -lunwind-x86_64"]) + + AS_IF([test x"$LIBUNWIND_LDFLAGS" != x], + [libunwind_ldflags="$LIBUNWIND_LDFLAGS $libunwind_ldflags"]) + + native_cppflags="$native_cppflags $libunwind_cppflags" + oc_tsan_ldflags="$oc_tsan_ldflags $libunwind_ldflags" + + OCAML_CHECK_LIBUNWIND + + AS_IF([! $libunwind_available], + [AC_MSG_ERROR([libunwind was requested by tsan but can not be found])]) + + # We need unwinding information at runtime, but since we use + # -no_compact_unwind, we also need -keep_dwarf_unwind otherwise + # the OS X linker will chuck away the DWARF-like (.eh_frame) + # information. (Older versions of OS X don't provide this.) + + AS_IF([$libunwind_available && test x"$system" = "xmacosx"], + [extra_flags="-Wl,-keep_dwarf_unwind" + mkexe="$mkexe $extra_flags" + mksharedlib="$mksharedlib $extra_flags"]) + ]) + ## Sockets ## TODO: check whether the different libraries are really useful diff --git a/runtime/caml/s.h.in b/runtime/caml/s.h.in index 4b5b43ba19..250a42120d 100644 --- a/runtime/caml/s.h.in +++ b/runtime/caml/s.h.in @@ -298,6 +298,8 @@ #undef HUGE_PAGE_SIZE +#undef HAS_LIBUNWIND + #undef HAS_BROKEN_PRINTF #undef HAS_STRERROR From 470c17ecee67a04f4df9e8d440d7dab44291c48f Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Thu, 2 Mar 2023 14:39:57 +0100 Subject: [PATCH 12/16] Add ThreadSanitizer support ThreadSanitizer support is in two parts: instrumentation of the generated native code, and runtime support. The Cmm instrumentation pass is in asmcomp/thread_sanitizer.ml[i]. The new C file runtime/tsan.c handles the task of letting TSan know about function entries and exits when raising exceptions or handling effects. Finally, some of the instrumentation calls have to be inserted directly into the assembly routines of runtime/amd64.S. Co-authored-by: Fabrice Buoro Co-authored-by: Anmol Sahoo --- .depend | 20 +++ Makefile | 3 +- Makefile.build_config.in | 4 + asmcomp/CSEgen.ml | 1 + asmcomp/afl_instrument.ml | 2 +- asmcomp/amd64/emit.mlp | 16 +- asmcomp/arm64/emit.mlp | 8 + asmcomp/asmlink.ml | 21 ++- asmcomp/cmm.ml | 6 +- asmcomp/cmm.mli | 1 + asmcomp/cmm_helpers.ml | 19 +- asmcomp/cmm_invariants.ml | 2 +- asmcomp/cmmgen.ml | 21 ++- asmcomp/mach.ml | 1 + asmcomp/mach.mli | 1 + asmcomp/polling.ml | 2 +- asmcomp/power/emit.mlp | 8 + asmcomp/printcmm.ml | 1 + asmcomp/printmach.ml | 1 + asmcomp/riscv/emit.mlp | 4 + asmcomp/s390x/emit.mlp | 4 + asmcomp/selectgen.ml | 7 +- asmcomp/thread_sanitizer.ml | 277 +++++++++++++++++++++++++++++ asmcomp/thread_sanitizer.mli | 39 ++++ compilerlibs/Makefile.compilerlibs | 3 +- configure | 36 +++- configure.ac | 25 ++- dune | 2 +- runtime/amd64.S | 163 ++++++++++++++++- runtime/caml/misc.h | 15 -- runtime/caml/mlvalues.h | 40 +++++ runtime/caml/tsan.h | 27 +++ runtime/fail_nat.c | 5 + runtime/memory.c | 13 ++ runtime/misc.c | 14 ++ runtime/tsan.c | 176 ++++++++++++++++++ tools/check-symbol-names | 2 + utils/config.common.ml | 2 + utils/config.fixed.ml | 2 + utils/config.generated.ml.in | 3 + utils/config.mli | 7 + 41 files changed, 957 insertions(+), 47 deletions(-) create mode 100644 asmcomp/thread_sanitizer.ml create mode 100644 asmcomp/thread_sanitizer.mli create mode 100644 runtime/caml/tsan.h create mode 100644 runtime/tsan.c diff --git a/.depend b/.depend index 5439e23dae..f4ae97ac41 100644 --- a/.depend +++ b/.depend @@ -2381,6 +2381,7 @@ asmcomp/asmlibrarian.cmx : \ asmcomp/asmlibrarian.cmi asmcomp/asmlibrarian.cmi : asmcomp/asmlink.cmo : \ + asmcomp/thread_sanitizer.cmi \ lambda/runtimedef.cmi \ utils/profile.cmi \ utils/misc.cmi \ @@ -2399,6 +2400,7 @@ asmcomp/asmlink.cmo : \ asmcomp/asmgen.cmi \ asmcomp/asmlink.cmi asmcomp/asmlink.cmx : \ + asmcomp/thread_sanitizer.cmx \ lambda/runtimedef.cmx \ utils/profile.cmx \ utils/misc.cmx \ @@ -2583,6 +2585,7 @@ asmcomp/cmm_invariants.cmi : \ asmcomp/cmm.cmi asmcomp/cmmgen.cmo : \ typing/types.cmi \ + asmcomp/thread_sanitizer.cmi \ middle_end/printclambda_primitives.cmi \ typing/primitive.cmi \ utils/misc.cmi \ @@ -2602,6 +2605,7 @@ asmcomp/cmmgen.cmo : \ asmcomp/cmmgen.cmi asmcomp/cmmgen.cmx : \ typing/types.cmx \ + asmcomp/thread_sanitizer.cmx \ middle_end/printclambda_primitives.cmx \ typing/primitive.cmx \ utils/misc.cmx \ @@ -3170,6 +3174,22 @@ asmcomp/strmatch.cmx : \ asmcomp/strmatch.cmi : \ lambda/debuginfo.cmi \ asmcomp/cmm.cmi +asmcomp/thread_sanitizer.cmo : \ + lambda/debuginfo.cmi \ + asmcomp/cmm_helpers.cmi \ + asmcomp/cmm.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + asmcomp/thread_sanitizer.cmi +asmcomp/thread_sanitizer.cmx : \ + lambda/debuginfo.cmx \ + asmcomp/cmm_helpers.cmx \ + asmcomp/cmm.cmx \ + middle_end/backend_var.cmx \ + parsing/asttypes.cmi \ + asmcomp/thread_sanitizer.cmi +asmcomp/thread_sanitizer.cmi : \ + asmcomp/cmm.cmi asmcomp/x86_ast.cmi : asmcomp/x86_dsl.cmo : \ asmcomp/x86_proc.cmi \ diff --git a/Makefile b/Makefile index b73eb129c4..7bf8beb1b5 100644 --- a/Makefile +++ b/Makefile @@ -680,7 +680,8 @@ runtime_NATIVE_ONLY_C_SOURCES = \ fail_nat \ frame_descriptors \ startup_nat \ - signals_nat + signals_nat \ + $(TSAN_NATIVE_RUNTIME_C_SOURCES) runtime_NATIVE_C_SOURCES = \ $(runtime_COMMON_C_SOURCES:%=runtime/%.c) \ $(runtime_NATIVE_ONLY_C_SOURCES:%=runtime/%.c) diff --git a/Makefile.build_config.in b/Makefile.build_config.in index 08d2841a3f..12a60ac96e 100644 --- a/Makefile.build_config.in +++ b/Makefile.build_config.in @@ -152,3 +152,7 @@ runtime_ASM_OBJECTS = $(addprefix runtime/,@runtime_asm_objects@) # Platform-dependent module for ocamlyacc ocamlyacc_WSTR_MODULE = @ocamlyacc_wstr_module@ + +# Contains TSan-specific runtime files, or nothing if TSan support is +# disabled +TSAN_NATIVE_RUNTIME_C_SOURCES = @tsan_native_runtime_c_sources@ diff --git a/asmcomp/CSEgen.ml b/asmcomp/CSEgen.ml index 687bfe04c8..bb47047ffc 100644 --- a/asmcomp/CSEgen.ml +++ b/asmcomp/CSEgen.ml @@ -237,6 +237,7 @@ method class_of_operation op = | Ifloatofint | Iintoffloat -> Op_pure | Ispecific _ -> Op_other | Idls_get -> Op_load Mutable + | Ireturn_addr -> Op_load Immutable (* Operations that are so cheap that it isn't worth factoring them. *) method is_cheap_operation op = diff --git a/asmcomp/afl_instrument.ml b/asmcomp/afl_instrument.ml index 3cd716fa64..6771cd864e 100644 --- a/asmcomp/afl_instrument.ml +++ b/asmcomp/afl_instrument.ml @@ -97,7 +97,7 @@ and instrument = function (* these are base cases and have no logging *) | Cconst_int _ | Cconst_natint _ | Cconst_float _ - | Cconst_symbol _ + | Cconst_symbol _ | Creturn_addr | Cvar _ as c -> c let instrument_function c dbg = diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index e2da778605..8300ae6e6a 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -747,6 +747,9 @@ let emit_instr env fallthrough i = I.mov (arg32 i 0) (res32 i 0) | Lop (Idls_get) -> I.mov (domain_field Domainstate.Domain_dls_root) (res i 0) + | Lop (Ireturn_addr) -> + let offset = frame_size env - 8 in + I.mov (mem64 QWORD offset RSP) (res i 0) | Lreloadretaddr -> () | Lreturn -> @@ -869,10 +872,15 @@ let emit_instr env fallthrough i = emit_call "caml_reraise_exn"; record_frame env Reg.Set.empty (Dbg_raise i.dbg) | Lambda.Raise_notrace -> - I.mov (domain_field Domainstate.Domain_exn_handler) rsp; - I.pop (domain_field Domainstate.Domain_exn_handler); - I.pop r11; - I.jmp r11 + if Config.tsan then begin + emit_call "caml_tsan_raise_notrace_exn"; + record_frame env Reg.Set.empty (Dbg_raise i.dbg) + end else begin + I.mov (domain_field Domainstate.Domain_exn_handler) rsp; + I.pop (domain_field Domainstate.Domain_exn_handler); + I.pop r11; + I.jmp r11 + end end let rec emit_all env fallthrough i = diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index a0c9f62442..148c995847 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -513,6 +513,10 @@ module BR = Branch_relaxation.Make (struct | Lop (Ispecific Imove32) -> 1 | Lop (Ispecific (Isignext _)) -> 1 | Lop (Idls_get) -> 1 + | Lop (Ireturn_addr) -> + invalid_arg ( + "Support for Ireturn_addr is not implemented on architecture " + ^ Config.architecture) | Lreloadretaddr -> 0 | Lreturn -> epilogue_size f | Llabel _ -> 0 @@ -958,6 +962,10 @@ let emit_instr env i = | Lop(Idls_get) -> let offset = Domainstate.(idx_of_field Domain_dls_root) * 8 in ` ldr {emit_reg i.res.(0)}, [{emit_reg reg_domain_state_ptr}, {emit_int offset}]\n` + | Lop(Ireturn_addr) -> + invalid_arg ( + "Support for Ireturn_addr is not implemented on architecture " + ^ Config.architecture) | Lreloadretaddr -> () | Lreturn -> diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index 7021f8c3d1..72f3e1440a 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -233,7 +233,18 @@ let make_startup_file ~ppf_dump units_list ~crc_interfaces = Emit.begin_assembly (); let name_list = List.flatten (List.map (fun (info,_,_) -> info.ui_defines) units_list) in - compile_phrase (Cmm_helpers.entry_point name_list); + let entry = Cmm_helpers.entry_point name_list in + let entry = + if Config.tsan then + match entry with + | Cfunction ({ fun_body; _ } as cf) -> + Cmm.Cfunction + { cf with fun_body = Thread_sanitizer.wrap_entry_exit fun_body } + | _ -> assert false + else + entry + in + compile_phrase entry; let units = List.map (fun (info,_,_) -> info) units_list in List.iter compile_phrase (Cmm_helpers.emit_preallocated_blocks [] (* add gc_roots (for dynlink) *) @@ -313,9 +324,15 @@ let call_linker file_list startup_file output_name = and main_obj_runtime = !Clflags.output_complete_object in let files = startup_file :: (List.rev file_list) in + let tsan_ld_flags = + if Config.tsan && String.length Config.tsan_ld_flags <> 0 then + String.split_on_char ' ' Config.tsan_ld_flags + else + [] + in let files, c_lib = if (not !Clflags.output_c_object) || main_dll || main_obj_runtime then - files @ (List.rev !Clflags.ccobjs) @ runtime_lib (), + files @ (List.rev !Clflags.ccobjs) @ runtime_lib () @ tsan_ld_flags, (if !Clflags.nopervasives || (main_obj_runtime && not main_dll) then "" else Config.native_c_libraries) else diff --git a/asmcomp/cmm.ml b/asmcomp/cmm.ml index 15c732788b..b2783b595b 100644 --- a/asmcomp/cmm.ml +++ b/asmcomp/cmm.ml @@ -197,6 +197,7 @@ type expression = | Cexit of int * expression list | Ctrywith of expression * Backend_var.With_provenance.t * expression * Debuginfo.t + | Creturn_addr type codegen_option = | Reduce_code_size @@ -266,7 +267,8 @@ let iter_shallow_tail f = function | Cvar _ | Cassign _ | Ctuple _ - | Cop _ -> + | Cop _ + | Creturn_addr -> false let rec map_tail f = function @@ -302,6 +304,7 @@ let rec map_tail f = function | Cvar _ | Cassign _ | Ctuple _ + | Creturn_addr | Cop _ as c -> f c @@ -336,5 +339,6 @@ let map_shallow f = function | Cconst_float _ | Cconst_symbol _ | Cvar _ + | Creturn_addr as c -> c diff --git a/asmcomp/cmm.mli b/asmcomp/cmm.mli index 4a68ae5c61..ed4efc8239 100644 --- a/asmcomp/cmm.mli +++ b/asmcomp/cmm.mli @@ -199,6 +199,7 @@ and expression = | Cexit of int * expression list | Ctrywith of expression * Backend_var.With_provenance.t * expression * Debuginfo.t + | Creturn_addr (** Return address saved in the current call frame *) type codegen_option = | Reduce_code_size diff --git a/asmcomp/cmm_helpers.ml b/asmcomp/cmm_helpers.ml index ca57632f4a..7605cd33e7 100644 --- a/asmcomp/cmm_helpers.ml +++ b/asmcomp/cmm_helpers.ml @@ -646,8 +646,13 @@ let set_field ptr n newval init dbg = Cop(Cstore (Word_val, init), [field_address ptr n dbg; newval], dbg) let get_header ptr dbg = - (* header loads are mutable because laziness changes tags. *) - Cop(mk_load_mut Word_int, + (* Headers can be mutated when forcing a lazy value. However, for all + purposes that the mutability tag currently serves in the compiler, header + loads can be marked as [Immutable], since the runtime should ensure that + there is no data race on headers. This saves performance with + ThreadSanitizer instrumentation by avoiding to instrument header loads. *) + Cop( + Cload {memory_chunk = Word_int; mutability = Immutable; is_atomic = false}, [Cop(Cadda, [ptr; Cconst_int(-size_int, dbg)], dbg)], dbg) let get_header_masked ptr dbg = @@ -664,9 +669,13 @@ let get_tag ptr dbg = if Proc.word_addressed then (* If byte loads are slow *) Cop(Cand, [get_header ptr dbg; Cconst_int (255, dbg)], dbg) else (* If byte loads are efficient *) - (* header loads are mutable because laziness changes tags. *) - Cop(mk_load_mut Byte_unsigned, - [Cop(Cadda, [ptr; Cconst_int(tag_offset, dbg)], dbg)], dbg) + (* Same comment as [get_header] above *) + Cop( + Cload + { memory_chunk = Byte_unsigned; + mutability = Immutable; + is_atomic = false }, + [Cop(Cadda, [ptr; Cconst_int(tag_offset, dbg)], dbg)], dbg) let get_size ptr dbg = Cop(Clsr, [get_header_masked ptr dbg; Cconst_int (10, dbg)], dbg) diff --git a/asmcomp/cmm_invariants.ml b/asmcomp/cmm_invariants.ml index df102df718..92b605fecb 100644 --- a/asmcomp/cmm_invariants.ml +++ b/asmcomp/cmm_invariants.ml @@ -125,7 +125,7 @@ end let rec check env (expr : Cmm.expression) = match expr with | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _ - | Cvar _ -> + | Cvar _ | Creturn_addr -> () | Clet (_, expr, body) | Clet_mut (_, _, expr, body) -> diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index d8e3793f9b..d2461ff7b7 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -116,8 +116,14 @@ let mut_from_env env ptr = else Mutable | _ -> Mutable -let get_field env ptr n dbg = - let mut = mut_from_env env ptr in +(* Minimum of two [mutable_flag] values, assuming [Immutable < Mutable]. *) +let min_mut x y = + match x,y with + | Immutable,_ | _,Immutable -> Immutable + | Mutable,Mutable -> Mutable + +let get_field env mut ptr n dbg = + let mut = min_mut mut (mut_from_env env ptr) in get_field_gen mut ptr n dbg type rhs_kind = @@ -794,8 +800,8 @@ and transl_prim_1 env p arg dbg = Popaque -> opaque (transl env arg) dbg (* Heap operations *) - | Pfield(n, _, _) -> - get_field env (transl env arg) n dbg + | Pfield(n, _, mut) -> + get_field env mut (transl env arg) n dbg | Pfloatfield n -> let ptr = transl env arg in box_float dbg (floatfield n ptr dbg) @@ -1418,6 +1424,9 @@ let transl_function f = Afl_instrument.instrument_function (transl env body) f.dbg else transl env body in + let cmm_body = + if Config.tsan then Thread_sanitizer.instrument cmm_body else cmm_body + in let fun_codegen_options = if !Clflags.optimize_for_speed then [] @@ -1518,6 +1527,10 @@ let compunit (ulam, preallocated_blocks, constants) = (fun () -> dbg) else transl empty_env ulam in + let init_code = + if Config.tsan then Thread_sanitizer.instrument init_code + else init_code + in let c1 = [Cfunction {fun_name = Compilenv.make_symbol (Some "entry"); fun_args = []; fun_body = init_code; diff --git a/asmcomp/mach.ml b/asmcomp/mach.ml index 85b3ce9a57..8b3a297202 100644 --- a/asmcomp/mach.ml +++ b/asmcomp/mach.ml @@ -67,6 +67,7 @@ type operation = | Ispecific of Arch.specific_operation | Ipoll of { return_label: Cmm.label option } | Idls_get + | Ireturn_addr type instruction = { desc: instruction_desc; diff --git a/asmcomp/mach.mli b/asmcomp/mach.mli index e3e9b06513..f72eb1dcbe 100644 --- a/asmcomp/mach.mli +++ b/asmcomp/mach.mli @@ -68,6 +68,7 @@ type operation = | Ispecific of Arch.specific_operation | Ipoll of { return_label: Cmm.label option } | Idls_get + | Ireturn_addr (** Retrieve the return address from the stack frame *) type instruction = { desc: instruction_desc; diff --git a/asmcomp/polling.ml b/asmcomp/polling.ml index 6959660f1e..c7753e1334 100644 --- a/asmcomp/polling.ml +++ b/asmcomp/polling.ml @@ -259,7 +259,7 @@ let find_poll_alloc_or_calls instr = Iconst_symbol _ | Iextcall { alloc = false } | Istackoffset _ | Iload _ | Istore _ | Iintop _ | Iintop_imm _ | Ifloatofint | Iintoffloat | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf | - Iopaque | Ispecific _ | Idls_get | Icompf _) -> None + Iopaque | Ispecific _ | Idls_get | Icompf _ | Ireturn_addr) -> None | Iend | Ireturn | Iifthenelse _ | Iswitch _ | Icatch _ | Iexit _ | Itrywith _ | Iraise _ -> None in diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index ed96111671..23f1ef11a3 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -513,6 +513,10 @@ module BR = Branch_relaxation.Make (struct | Lop (Idls_get) -> (* Here to maintain build *) assert false + | Lop (Ireturn_addr) -> + invalid_arg ( + "Support for Ireturn_addr is not implemented on architecture " + ^ Config.architecture) | Lreloadretaddr -> 2 | Lreturn -> 2 | Llabel _ -> 0 @@ -930,6 +934,10 @@ let emit_instr env i = | Lop (Idls_get) -> (* Here to maintain build *) assert false + | Lop (Ireturn_addr) -> + invalid_arg ( + "Support for Ireturn_addr is not implemented on architecture " + ^ Config.architecture) | Lreloadretaddr -> ` {emit_string lg} 11, {emit_int(retaddr_offset env)}(1)\n`; ` mtlr 11\n` diff --git a/asmcomp/printcmm.ml b/asmcomp/printcmm.ml index 078f92e5e9..400044f051 100644 --- a/asmcomp/printcmm.ml +++ b/asmcomp/printcmm.ml @@ -167,6 +167,7 @@ let rec expr ppf = function | Cconst_float (n, _dbg) -> fprintf ppf "%F" n | Cconst_symbol (s, _dbg) -> fprintf ppf "\"%s\"" s | Cvar id -> V.print ppf id + | Creturn_addr -> fprintf ppf "return_addr" | Clet(id, def, (Clet(_, _, _) as body)) -> let print_binding id ppf def = fprintf ppf "@[<2>%a@ %a@]" diff --git a/asmcomp/printmach.ml b/asmcomp/printmach.ml index 5180ab9d20..89b900c9ce 100644 --- a/asmcomp/printmach.ml +++ b/asmcomp/printmach.ml @@ -156,6 +156,7 @@ let operation op arg ppf res = | Ispecific op -> Arch.print_specific_operation reg op ppf arg | Idls_get -> fprintf ppf "dls_get" + | Ireturn_addr -> fprintf ppf "return_addr" | Ipoll { return_label } -> fprintf ppf "poll call"; match return_label with diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp index bcc9d12947..4aaae10213 100644 --- a/asmcomp/riscv/emit.mlp +++ b/asmcomp/riscv/emit.mlp @@ -502,6 +502,10 @@ let emit_instr env i = | Lop (Idls_get) -> let ofs = Domainstate.(idx_of_field Domain_dls_root) * 8 in ` ld {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg reg_domain_state_ptr})\n` + | Lop (Ireturn_addr) -> + invalid_arg ( + "Support for Ireturn_addr is not implemented on architecture " + ^ Config.architecture) | Lreloadretaddr -> let n = frame_size env in reload_ra n diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp index 49494965ee..f98757fa62 100644 --- a/asmcomp/s390x/emit.mlp +++ b/asmcomp/s390x/emit.mlp @@ -546,6 +546,10 @@ let emit_instr env i = | Lop (Idls_get) -> (* Here to maintain build *) assert false + | Lop (Ireturn_addr) -> + invalid_arg ( + "Support for Ireturn_addr is not implemented on architecture " + ^ Config.architecture) | Lreloadretaddr -> let n = frame_size env in ` lg %r14, {emit_int(n - size_addr)}(%r15)\n` diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index 0758696f88..5573f9d3f7 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -316,6 +316,7 @@ method is_simple_expr = function | Cconst_float _ -> true | Cconst_symbol _ -> true | Cvar _ -> true + | Creturn_addr -> true | Ctuple el -> List.for_all self#is_simple_expr el | Clet(_id, arg, body) | Clet_mut(_id, _, arg, body) -> self#is_simple_expr arg && self#is_simple_expr body @@ -351,7 +352,7 @@ method effects_of exp = let module EC = Effect_and_coeffect in match exp with | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _ - | Cvar _ -> EC.none + | Cvar _ | Creturn_addr -> EC.none | Ctuple el -> EC.join_list_map el self#effects_of | Clet (_id, arg, body) | Clet_mut (_id, _, arg, body) -> EC.join (self#effects_of arg) (self#effects_of body) @@ -632,6 +633,9 @@ method emit_expr (env:environment) exp = adding this register to the frame table would be redundant *) let r = self#regs_for typ_int in Some(self#insert_op env (Iconst_symbol n) [||] r) + | Creturn_addr -> + let r = self#regs_for typ_int in + Some(self#insert_op env Ireturn_addr [||] r) | Cvar v -> begin try Some(env_find v env) @@ -1150,6 +1154,7 @@ method emit_tail (env:environment) exp = | Cop _ | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _ | Cvar _ + | Creturn_addr | Cassign _ | Ctuple _ | Cexit _ -> diff --git a/asmcomp/thread_sanitizer.ml b/asmcomp/thread_sanitizer.ml new file mode 100644 index 0000000000..1c5296f7c5 --- /dev/null +++ b/asmcomp/thread_sanitizer.ml @@ -0,0 +1,277 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Anmol Sahoo, Purdue University *) +(* Olivier Nicole, Tarides *) +(* Fabrice Buoro, Tarides *) +(* *) +(* Copyright 2022 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. *) +(* *) +(**************************************************************************) + +open Asttypes +open Cmm +module V = Backend_var +module VP = Backend_var.With_provenance + +type read_or_write = Read | Write + +let init_code () = + Cmm_helpers.return_unit Debuginfo.none @@ + Cop (Cextcall ("__tsan_init", typ_void, [], false), [], Debuginfo.none) + +let bit_size memory_chunk = + match memory_chunk with + | Byte_unsigned + | Byte_signed -> 8 + | Sixteen_unsigned + | Sixteen_signed -> 16 + | Thirtytwo_unsigned + | Thirtytwo_signed -> 32 + | Word_int + | Word_val -> Sys.word_size + | Single -> 32 + | Double -> 64 + +let select_function read_or_write memory_chunk = + let bit_size = bit_size memory_chunk in + let acc_string = + match read_or_write with Read -> "read" | Write -> "write" + in + Printf.sprintf "__tsan_%s%d" acc_string (bit_size / 8) + +module TSan_memory_order = struct + (* Constants defined in the LLVM ABI *) + (*let relaxed = Cconst_int (0, Debuginfo.none)*) + (*let consume = Cconst_int (1, Debuginfo.none)*) + (*let acquire = Cconst_int (2, Debuginfo.none)*) + (*let release = Cconst_int (3, Debuginfo.none)*) + (*let acq_rel = Cconst_int (4, Debuginfo.none)*) + let seq_cst = Cconst_int (5, Debuginfo.none) +end + +let machtype_of_memory_chunk = function + | Byte_unsigned + | Byte_signed + | Sixteen_unsigned + | Sixteen_signed + | Thirtytwo_unsigned + | Thirtytwo_signed + | Word_int -> typ_int + | Word_val -> typ_val + | Single + | Double -> typ_float + +let dbg_none = Debuginfo.none + +(* Decides whether an expression {i probably} evaluates to a value of type + [Addr]. This is not intended to be foolproof, but only aims to catch the + cases that should happen in practice. *) +let rec has_type_addr = function + | Cconst_int (_, _) | Cconst_natint (_, _) | Cconst_float (_, _) + | Cconst_symbol (_, _) | Cassign (_, _) | Ctuple _ | Cswitch (_, _, _, _) + | Ccatch (_, _, _) | Cexit (_, _) | Ctrywith (_, _, _, _) | Creturn_addr + | Cvar _ -> false + | Clet (_, _, body) + | Clet_mut (_, _, _, body) + | Cphantom_let (_, _, body) -> has_type_addr body + | Csequence (_, e) -> has_type_addr e + | Cifthenelse (_, _, e1, _, e2, _) -> has_type_addr e1 || has_type_addr e2 + | Cop (op, _, _) -> + begin match op with + | Capply [|Addr|] | Cextcall (_, [|Addr|], _, _) | Cadda -> true + | Capply _ | Cextcall _ | Cload _ | Calloc | Cstore (_, _) | Caddi | Csubi + | Cmuli | Cmulhi | Cdivi | Cmodi | Cand | Cor | Cxor | Clsl | Clsr | Casr + | Ccmpi _ | Caddv | Ccmpa _ | Cnegf | Cabsf | Caddf | Csubf | Cmulf + | Cdivf | Cfloatofint | Cintoffloat | Ccmpf _ | Craise _ | Ccheckbound + | Copaque | Cdls_get -> false + end + +type replace_or_not = Keep of Cmm.expression | Replace of VP.t * Cmm.expression + +let wrap_entry_exit expr = + let call_entry = + Cmm_helpers.return_unit dbg_none @@ + Cop + (Cextcall ("__tsan_func_entry", typ_void, [], false), + [Creturn_addr], + dbg_none) + in + let call_exit = Cmm_helpers.return_unit dbg_none @@ Cop ( + Cextcall ("__tsan_func_exit", typ_void, [], false), [], dbg_none) + in + (* [is_tail] is true when the expression is in tail position *) + let rec insert_call_exit is_tail = function + | Clet (v, e, body) -> Clet (v, e, insert_call_exit is_tail body) + | Clet_mut (v, typ, e, body) -> + Clet_mut (v, typ, e, insert_call_exit is_tail body) + | Cphantom_let (v, e, body) -> + Cphantom_let (v, e, insert_call_exit is_tail body) + | Cassign (v, body) -> Cassign (v, insert_call_exit is_tail body) + | Csequence (op1, op2) -> Csequence (op1, insert_call_exit is_tail op2) + | Cifthenelse (cond, t_dbg, t, f_dbg, f, dbg_none) -> + Cifthenelse (cond, t_dbg, insert_call_exit is_tail t, f_dbg, + insert_call_exit is_tail f, dbg_none) + | Cswitch (e, cases, handlers, dbg_none) -> + let handlers = Array.map + (fun (handler, handler_dbg) -> + (insert_call_exit is_tail handler, handler_dbg)) + handlers + in + Cswitch (e, cases, handlers, dbg_none) + | Ccatch (isrec, handlers, next) -> + let handlers = List.map + (fun (id, args, e, dbg_none) -> + (id, args, insert_call_exit is_tail e, dbg_none)) + handlers + in + Ccatch (isrec, handlers, insert_call_exit is_tail next) + | Cexit (ex, args) -> + (* A [Cexit] is like a goto to the beginning of a handler. Therefore, + it is never the last thing evaluated in a function; there is no need + to insert a call to [__tsan_func_exit] here. *) + Cexit (ex, args) + | Ctrywith (e, v, handler, dbg_none) -> + (* We need to insert a call to [__tsan_func_exit] at the tail of both + the body and the handler. If this is a [try ... with] in tail + position, then the body expression is not in tail position (as code + is inserted at the end of it to pop the exception handler), the + handler expression is. *) + Ctrywith + (insert_call_exit false e, + v, + insert_call_exit is_tail handler, + dbg_none) + | Cop (Capply fn, args, dbg_none) when is_tail -> + (* This is a tail call. We insert the call to [__tsan_func_exit] right + before the call, but after evaluating the arguments. We make an + exception for arguments which evaluate to a value of type [Addr], as + such values should never be live across a function call or + allocation point. *) + let fun_ = List.hd args in + let replace_args = + List.map + (fun e -> + if has_type_addr e + then Keep e + else Replace (VP.create (V.create_local "arg"), e)) + (List.tl args) + in + let tail = + Csequence + (call_exit, + (Cop + (Capply fn, + fun_ + :: List.map + (function + | Replace (id,_) -> Cvar (VP.var id) + | Keep e -> e) + replace_args, + dbg_none))) + in + List.fold_right + (fun keep_or_replace acc -> + match keep_or_replace with + | Keep _ -> acc + | Replace (id,arg) -> Clet (id, arg, acc)) + replace_args + tail + | Cconst_int (_, _) | Cconst_natint (_, _) | Cconst_float (_, _) + | Cconst_symbol (_, _) | Cvar _ | Ctuple _ | Cop (_, _, _) + | Creturn_addr as expr -> + let id = VP.create (V.create_local "res") in + Clet (id, expr, Csequence (call_exit, Cvar (VP.var id))) + in + Csequence (call_entry, insert_call_exit true expr) + +let instrument body = + let rec aux = function + | Cop (Cload {memory_chunk; mutability=Mutable; is_atomic=false} as load_op, + [loc], dbginfo) -> + (* Emit a call to [__tsan_readN] before the load *) + let loc_id = VP.create (V.create_local "loc") in + let loc_exp = Cvar (VP.var loc_id) in + Clet (loc_id, loc, + Csequence + (Cmm_helpers.return_unit dbg_none (Cop + (Cextcall (select_function Read memory_chunk, typ_void, + [], false), + [loc_exp], dbg_none)), + Cop (load_op, [loc_exp], dbginfo))) + | Cop (Cload {memory_chunk; mutability=Mutable; is_atomic=true}, + [loc], dbginfo) -> + (* Replace the atomic load with a call to [__tsan_atomicN_load] *) + let ret_typ = machtype_of_memory_chunk memory_chunk in + Cop (Cextcall + (Printf.sprintf "__tsan_atomic%d_load" (bit_size memory_chunk), + ret_typ, [], false), + [loc; TSan_memory_order.seq_cst], dbginfo) + | Cop (Cload {memory_chunk=_; mutability=Mutable; is_atomic=_}, _, _) -> + invalid_arg "instrument: wrong number of arguments for operation Cload" + | Cop (Cstore(memory_chunk, init_or_assn), [loc;v], dbginfo) as c -> + (* Emit a call to [__tsan_writeN] before the store *) + begin match init_or_assn with + | Assignment -> + (* We make sure that 1. the location and value expressions are + evaluated before the call to TSan, and 2. the location + expression is evaluated right before that call, as it might not + be a valid OCaml value (e.g. a pointer into an array), in which + case it must not be live across a function call or allocation + point. *) + let loc_id = VP.create (V.create_local "loc") in + let loc_exp = Cvar (VP.var loc_id) in + let v_id = VP.create (V.create_local "newval") in + let v_exp = Cvar (VP.var v_id) in + let args = [loc_exp; v_exp] in + Clet (v_id, v, + Clet (loc_id, loc, + Csequence + (Cmm_helpers.return_unit dbg_none (Cop (Cextcall + (select_function Write memory_chunk, typ_void, [], + false), + [loc_exp], dbg_none)), + Cop (Cstore (memory_chunk, init_or_assn), args, dbginfo)))) + | Heap_initialization | Root_initialization -> + (* Initializing writes need not be instrumented as they are always + domain-safe *) + c + end + | Cop (Cstore _, _, _) -> + invalid_arg "instrument: wrong number of arguments for operation Cstore" + | Cop (op, es, dbg_none) -> Cop (op, List.map aux es, dbg_none) + | Clet (v, e, body) -> Clet (v, aux e, aux body) + | Clet_mut (v, k, e, body) -> Clet_mut (v, k, aux e, aux body) + | Cphantom_let (v, e, body) -> Cphantom_let (v, e, aux body) + | Cassign (v, e) -> Cassign (v, aux e) + | Ctuple es -> Ctuple (List.map aux es) + | Csequence(c1,c2) -> Csequence(aux c1, aux c2) + | Ccatch (isrec, cases, body) -> + let cases = + List.map (fun (nfail, ids, e, dbg_none) -> + (nfail, ids, aux e, dbg_none)) + cases + in + Ccatch (isrec, cases, aux body) + | Cexit (ex, args) -> Cexit (ex, List.map aux args) + | Cifthenelse (cond, t_dbg, t, f_dbg, f, dbg_none) -> + Cifthenelse (aux cond, t_dbg, aux t, f_dbg, aux f, dbg_none) + | Ctrywith (e, ex, handler, dbg_none) -> + Ctrywith (aux e, ex, aux handler, dbg_none) + | Cswitch (e, cases, handlers, dbg_none) -> + let handlers = + handlers |> Array.map (fun (handler, handler_dbg) -> + (aux handler, handler_dbg)) + in + Cswitch(aux e, cases, handlers, dbg_none) + (* no instrumentation *) + | Cconst_int _ | Cconst_natint _ | Cconst_float _ + | Cconst_symbol _ | Cvar _ | Creturn_addr as c -> c + in + body |> aux |> wrap_entry_exit diff --git a/asmcomp/thread_sanitizer.mli b/asmcomp/thread_sanitizer.mli new file mode 100644 index 0000000000..e76789bc12 --- /dev/null +++ b/asmcomp/thread_sanitizer.mli @@ -0,0 +1,39 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Anmol Sahoo, Purdue University *) +(* Olivier Nicole, Tarides *) +(* Fabrice Buoro, Tarides *) +(* *) +(* Copyright 2022 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. *) +(* *) +(**************************************************************************) + +(** Instrumentation of memory accesses using ThreadSanitizer for data race + detection. This module contains an instrumentation pass on Cmm, where most + of the instrumentation happens. + Only, the function prologues and epilogues are instrumented at the assembly + level (architecture-specific, due to the need to pass the return address) + where calls are emitted to [__tsan_func_entry] and [__tsan_func_exit]. *) + +(** Instrumentation of a {!Cmm.expression}: instrument memory accesses, and + surround the expression by external calls to [__tsan_func_entry] and + [__tsan_func_exit]. If the expression tail is a function call, then + [__tsan_func_exit] is inserted before that call. *) +val instrument : Cmm.expression -> Cmm.expression + +(** Surround an expression by external calls to [__tsan_func_entry] and + [__tsan_func_exit]. If the expression tail is a function call, then + [__tsan_func_exit] is inserted before that call. *) +val wrap_entry_exit : Cmm.expression -> Cmm.expression + +(** Call to [__tsan_init], which should be called at least once in the compiled + program, before other [__tsan_*] API functions. Idempotent, i.e. can be + called more than once without consequences. *) +val init_code : unit -> Cmm.expression diff --git a/compilerlibs/Makefile.compilerlibs b/compilerlibs/Makefile.compilerlibs index 9d0052a258..9604ad50df 100644 --- a/compilerlibs/Makefile.compilerlibs +++ b/compilerlibs/Makefile.compilerlibs @@ -203,10 +203,11 @@ ASMCOMP = \ asmcomp/reg.cmo \ asmcomp/mach.cmo \ asmcomp/proc.cmo \ - asmcomp/afl_instrument.cmo \ asmcomp/strmatch.cmo \ asmcomp/cmmgen_state.cmo \ asmcomp/cmm_helpers.cmo \ + asmcomp/afl_instrument.cmo \ + asmcomp/thread_sanitizer.cmo \ asmcomp/cmmgen.cmo \ asmcomp/cmm_invariants.cmo \ asmcomp/interval.cmo \ diff --git a/configure b/configure index 3ee2e61e9b..471f80b083 100755 --- a/configure +++ b/configure @@ -861,6 +861,8 @@ oc_exe_ldflags oc_dll_ldflags oc_ldflags oc_cppflags +tsan_native_runtime_c_sources +oc_tsan_ldflags tsan oc_cflags toolchain @@ -3243,9 +3245,13 @@ oc_dll_ldflags="" oc_exe_ldflags="" tsan=false +oc_tsan_c_flags="-O1 -fno-omit-frame-pointer -fsanitize=thread" + # Passed to the linker by ocamlopt when tsan is enabled oc_tsan_ldflags="-fsanitize=thread" +oc_tsan_cppflags="-DWITH_THREAD_SANITIZER" + # The C# compiler and its flags CSC="" CSCFLAGS="" @@ -3371,6 +3377,8 @@ OCAML_VERSION_SHORT=5.1 + + @@ -16451,6 +16459,27 @@ else $as_nop tsan=false fi +if $tsan +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: using thread sanitizer with vendor=$ocaml_cv_cc_vendor" >&5 +printf "%s\n" "$as_me: using thread sanitizer with vendor=$ocaml_cv_cc_vendor" >&6;} + case $ocaml_cv_cc_vendor in #( + gcc-[0123456789]-*|gcc-10-*|clang-*) : + ;; #( + *) : + oc_tsan_c_flags="$oc_tsan_c_flags -Wno-tsan" ;; +esac + common_cppflags="$common_cppflags $oc_tsan_cppflags" + native_cflags="$native_cflags $oc_tsan_c_flags" + ocamlc_cflags="$ocamlc_cflags $oc_tsan_c_flags" + tsan_native_runtime_c_sources="tsan" +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not using thread sanitizer" >&5 +printf "%s\n" "$as_me: not using thread sanitizer" >&6;} + tsan_native_runtime_c_sources="" + +fi + # libunwind detection when TSan is enabled { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether libunwind is required" >&5 printf %s "checking whether libunwind is required... " >&6; } @@ -19668,7 +19697,7 @@ fi oc_cflags="$common_cflags $internal_cflags" oc_cppflags="$common_cppflags $internal_cppflags" -ocamlc_cflags="$common_cflags $sharedlib_cflags $CFLAGS" +ocamlc_cflags="$ocamlc_cflags $common_cflags $sharedlib_cflags $CFLAGS" ocamlc_cppflags="$common_cppflags $CPPFLAGS" cclibs="$cclibs $mathlib" @@ -19725,6 +19754,11 @@ case $host in #( nativecclibs="$cclibs $DLLIBS $PTHREAD_LIBS" ;; esac +if $tsan +then : + bytecclibs="$bytecclibs -fsanitize=thread" +fi + if test x"$libdir" = x'${exec_prefix}/lib' then : libdir="$libdir"/ocaml diff --git a/configure.ac b/configure.ac index 48980c7df5..39f631964d 100644 --- a/configure.ac +++ b/configure.ac @@ -55,9 +55,13 @@ oc_dll_ldflags="" oc_exe_ldflags="" tsan=false +oc_tsan_c_flags="-O1 -fno-omit-frame-pointer -fsanitize=thread" + # Passed to the linker by ocamlopt when tsan is enabled oc_tsan_ldflags="-fsanitize=thread" +oc_tsan_cppflags="-DWITH_THREAD_SANITIZER" + # The C# compiler and its flags CSC="" CSCFLAGS="" @@ -139,6 +143,8 @@ AC_SUBST([ccomptype]) AC_SUBST([toolchain]) AC_SUBST([oc_cflags]) AC_SUBST([tsan]) +AC_SUBST([oc_tsan_ldflags]) +AC_SUBST([tsan_native_runtime_c_sources]) AC_SUBST([oc_cppflags]) AC_SUBST([oc_ldflags]) AC_SUBST([oc_dll_ldflags]) @@ -1608,6 +1614,20 @@ $cc_basename on system $system"])] )], [tsan=false]) +AS_IF([$tsan], + [AC_MSG_NOTICE([using thread sanitizer with vendor=$ocaml_cv_cc_vendor]) + AS_CASE([$ocaml_cv_cc_vendor], + [gcc-[[0123456789]]-*|gcc-10-*|clang-*], + [], + [oc_tsan_c_flags="$oc_tsan_c_flags -Wno-tsan"]) + common_cppflags="$common_cppflags $oc_tsan_cppflags" + native_cflags="$native_cflags $oc_tsan_c_flags" + ocamlc_cflags="$ocamlc_cflags $oc_tsan_c_flags" + tsan_native_runtime_c_sources="tsan"], + [AC_MSG_NOTICE([not using thread sanitizer]) + tsan_native_runtime_c_sources=""] +) + # libunwind detection when TSan is enabled AC_MSG_CHECKING([whether libunwind is required]) AS_IF([! $tsan], @@ -2290,7 +2310,7 @@ AS_IF([test "$ccomptype" != "msvc"], oc_cflags="$common_cflags $internal_cflags" oc_cppflags="$common_cppflags $internal_cppflags" -ocamlc_cflags="$common_cflags $sharedlib_cflags $CFLAGS" +ocamlc_cflags="$ocamlc_cflags $common_cflags $sharedlib_cflags $CFLAGS" ocamlc_cppflags="$common_cppflags $CPPFLAGS" cclibs="$cclibs $mathlib" @@ -2306,6 +2326,9 @@ AS_CASE([$host], [bytecclibs="$cclibs $DLLIBS $PTHREAD_LIBS" nativecclibs="$cclibs $DLLIBS $PTHREAD_LIBS"]) +AS_IF([$tsan], + [bytecclibs="$bytecclibs -fsanitize=thread"]) + AS_IF([test x"$libdir" = x'${exec_prefix}/lib'], [libdir="$libdir"/ocaml]) diff --git a/dune b/dune index 42987ddc0b..74b9910060 100644 --- a/dune +++ b/dune @@ -160,7 +160,7 @@ polling printcmm printlinear printmach proc reg reload reloadgen schedgen scheduling selectgen selection spill split - strmatch x86_ast x86_dsl x86_gas x86_masm x86_proc + strmatch thread_sanitizer x86_ast x86_dsl x86_gas x86_masm x86_proc ;; file_formats/ linear_format diff --git a/runtime/amd64.S b/runtime/amd64.S index e9bb38b423..475ecf81e1 100644 --- a/runtime/amd64.S +++ b/runtime/amd64.S @@ -122,6 +122,16 @@ #define LEAVE_FUNCTION #endif +#ifdef WITH_FRAME_POINTERS +#define STACK_RETADDR(reg) (1 * 8)(reg) +#define STACK_ARG_1(reg) (2 * 8 + 0 * 8)(reg) +#define STACK_ARG_2(reg) (2 * 8 + 1 * 8)(reg) +#else +#define STACK_RETADDR(reg) (0 * 8)(reg) +#define STACK_ARG_1(reg) (1 * 8 + 0 * 8)(reg) +#define STACK_ARG_2(reg) (1 * 8 + 1 * 8)(reg) +#endif + #ifdef DEBUG #define CHECK_STACK_ALIGNMENT \ @@ -253,6 +263,27 @@ CFI_DEF_CFA_OFFSET(16); \ POP_EXN_HANDLER +#if defined(WITH_THREAD_SANITIZER) +#define TSAN_ENTER_FUNCTION \ + SAVE_ALL_REGS; \ + /* arg 1: pc of raise */ \ + movq STACK_RETADDR(%rsp), C_ARG_1; \ + SWITCH_OCAML_TO_C; \ + C_call (GCALL(__tsan_func_entry)); \ + SWITCH_C_TO_OCAML; \ + RESTORE_ALL_REGS; +#define TSAN_EXIT_FUNCTION \ + SAVE_ALL_REGS; \ + SWITCH_OCAML_TO_C; \ + movq $0, C_ARG_1; \ + C_call (GCALL(__tsan_func_exit)); \ + SWITCH_C_TO_OCAML; \ + RESTORE_ALL_REGS; +#else +#define TSAN_ENTER_FUNCTION +#define TSAN_EXIT_FUNCTION +#endif + /* Switch between OCaml stacks. Clobbers %r12. Expects old stack in %rsi and target stack in %r10. Leaves old stack in %rsi and target stack in %r10. */ @@ -594,6 +625,7 @@ FUNCTION(G(caml_c_call)) CFI_STARTPROC CFI_SIGNAL_FRAME ENTER_FUNCTION + TSAN_ENTER_FUNCTION LBL(caml_c_call): /* Arguments: C arguments : %rdi, %rsi, %rdx, %rcx, %r8, and %r9 @@ -608,6 +640,7 @@ LBL(caml_c_call): movq Caml_state(young_ptr), %r15 /* Load ocaml stack and restore global variables */ SWITCH_C_TO_OCAML + TSAN_EXIT_FUNCTION LEAVE_FUNCTION /* Return to OCaml caller */ ret @@ -665,6 +698,13 @@ CFI_STARTPROC CFI_SIGNAL_FRAME /* Save callee-save registers */ PUSH_CALLEE_SAVE_REGS +#if defined(WITH_THREAD_SANITIZER) + /* TSan enter function from C */ + pushq C_ARG_1 + movq 56(%rsp), C_ARG_1 + C_call (GCALL(__tsan_func_entry)) + popq C_ARG_1 +#endif /* Load Caml_state into r14 (was passed as an argument from C) */ movq C_ARG_1, %r14 /* Initial entry point is G(caml_program) */ @@ -738,6 +778,13 @@ LBL(108): movq Cstack_prev(%rsp), %r10 movq %r10, Caml_state(c_stack) addq $24, %rsp; CFI_ADJUST(-24) +#if defined(WITH_THREAD_SANITIZER) + /* TSan exit function from C */ + pushq %rax + movq $0, C_ARG_1 + C_call (GCALL(__tsan_func_exit)) + popq %rax +#endif /* Restore callee-save registers. */ POP_CALLEE_SAVE_REGS /* Return to caller. */ @@ -762,40 +809,69 @@ FUNCTION(G(caml_raise_exn)) CFI_STARTPROC ENTER_FUNCTION LBL(caml_raise_exn): +#if !defined(WITH_THREAD_SANITIZER) testq $1, Caml_state(backtrace_active) jne LBL(116) RESTORE_EXN_HANDLER_OCAML ret +#endif LBL(116): movq $0, Caml_state(backtrace_pos) LBL(117): - movq %rsp, %r10 /* Save OCaml stack pointer */ + movq %rsp, %r13 /* Save OCaml stack pointer */ movq %rax, %r12 /* Save exception bucket */ movq Caml_state(c_stack), %rsp +#if defined(WITH_THREAD_SANITIZER) + testq $1, Caml_state(backtrace_active) + je LBL(118) +#endif movq %rax, C_ARG_1 /* arg 1: exception bucket */ #ifdef WITH_FRAME_POINTERS - movq 8(%r10), C_ARG_2 /* arg 2: pc of raise */ - leaq 16(%r10), C_ARG_3 /* arg 3: sp at raise */ + movq 8(%r13), C_ARG_2 /* arg 2: pc of raise */ + leaq 16(%r13), C_ARG_3 /* arg 3: sp at raise */ #else - movq (%r10), C_ARG_2 /* arg 2: pc of raise */ - leaq 8(%r10), C_ARG_3 /* arg 3: sp at raise */ + movq (%r13), C_ARG_2 /* arg 2: pc of raise */ + leaq 8(%r13), C_ARG_3 /* arg 3: sp at raise */ #endif movq Caml_state(exn_handler), C_ARG_4 /* arg 4: sp of handler */ C_call (GCALL(caml_stash_backtrace)) +#if defined(WITH_THREAD_SANITIZER) +LBL(118): + movq STACK_RETADDR(%r13), C_ARG_1 /* arg 1: pc of raise */ + leaq STACK_ARG_1(%r13), C_ARG_2 /* arg 2: sp at raise */ + movq Caml_state(exn_handler), C_ARG_3 /* arg 3: sp of handler */ + C_call (GCALL(caml_tsan_exn_func_exit)) +#endif movq %r12, %rax /* Recover exception bucket */ RESTORE_EXN_HANDLER_OCAML ret CFI_ENDPROC ENDFUNCTION(G(caml_raise_exn)) +#if defined(WITH_THREAD_SANITIZER) +FUNCTION(G(caml_tsan_raise_notrace_exn)) +CFI_STARTPROC + ENTER_FUNCTION + movq %rsp, %r13 /* Save OCaml stack pointer */ + movq %rax, %r12 /* Save exception bucket */ + movq Caml_state(c_stack), %rsp + jmp LBL(118) +CFI_ENDPROC +ENDFUNCTION(G(caml_tsan_raise_notrace_exn)) +#endif + FUNCTION(G(caml_reraise_exn)) CFI_STARTPROC ENTER_FUNCTION +#if defined(WITH_THREAD_SANITIZER) + jmp LBL(117) +#else testq $1, Caml_state(backtrace_active) jne LBL(117) RESTORE_EXN_HANDLER_OCAML ret +#endif CFI_ENDPROC ENDFUNCTION(G(caml_reraise_exn)) @@ -821,6 +897,17 @@ ENDFUNCTION(G(caml_raise_exception)) FUNCTION(G(caml_callback_asm)) CFI_STARTPROC +#if defined(WITH_THREAD_SANITIZER) + /* TSan enter function from C */ + pushq C_ARG_1 + pushq C_ARG_2 + pushq C_ARG_3 + movq 24(%rsp), C_ARG_1 + C_call (GCALL(__tsan_func_entry)) + popq C_ARG_3 + popq C_ARG_2 + popq C_ARG_1 +#endif /* Save callee-save registers */ PUSH_CALLEE_SAVE_REGS /* Initial loading of arguments */ @@ -836,6 +923,17 @@ ENDFUNCTION(G(caml_callback_asm)) FUNCTION(G(caml_callback2_asm)) CFI_STARTPROC +#if defined(WITH_THREAD_SANITIZER) + /* TSan enter function from C */ + pushq C_ARG_1 + pushq C_ARG_2 + pushq C_ARG_3 + movq 24(%rsp), C_ARG_1 + C_call (GCALL(__tsan_func_entry)) + popq C_ARG_3 + popq C_ARG_2 + popq C_ARG_1 +#endif /* Save callee-save registers */ PUSH_CALLEE_SAVE_REGS /* Initial loading of arguments */ @@ -851,6 +949,17 @@ ENDFUNCTION(G(caml_callback2_asm)) FUNCTION(G(caml_callback3_asm)) CFI_STARTPROC +#if defined(WITH_THREAD_SANITIZER) + /* TSan enter function from C */ + pushq C_ARG_1 + pushq C_ARG_2 + pushq C_ARG_3 + movq 24(%rsp), C_ARG_1 + C_call (GCALL(__tsan_func_entry)) + popq C_ARG_3 + popq C_ARG_2 + popq C_ARG_1 +#endif /* Save callee-save registers */ PUSH_CALLEE_SAVE_REGS /* Initial loading of arguments */ @@ -887,6 +996,15 @@ LBL(do_perform): movq Handler_parent(%r11), %r10 /* %r10 := parent stack */ cmpq $0, %r10 /* parent is NULL? */ je LBL(112) +#if defined(WITH_THREAD_SANITIZER) + SAVE_ALL_REGS + movq (%rsp), C_ARG_1 /* arg 1: pc of perform */ + leaq 8(%rsp), C_ARG_2 /* arg 2: sp at perform */ + SWITCH_OCAML_TO_C + C_call (GCALL(caml_tsan_func_exit_on_perform)) + SWITCH_C_TO_OCAML + RESTORE_ALL_REGS +#endif SWITCH_OCAML_STACKS /* preserves r11 and rsi */ /* We have to null the Handler_parent after the switch because the Handler_parent is needed to unwind the stack for backtraces */ @@ -899,10 +1017,25 @@ LBL(112): movq 0(%rbx), %r10 /* load performer stack from continuation */ subq $1, %r10 /* r10 := Ptr_val(r10) */ movq Caml_state(current_stack), %rsi - SWITCH_OCAML_STACKS /* No parent stack. Raise Effect.Unhandled. */ + SWITCH_OCAML_STACKS +#if defined(WITH_THREAD_SANITIZER) + /* We must let the TSan runtime know that switched back to the + original performer stack. For that, we perform the necessary calls + to __tsan_func_entry via caml_tsan_func_entry_on_resume. */ + SAVE_ALL_REGS + movq Stack_sp(%r10), %r11 + movq (%r11), C_ARG_1 /* arg 1: pc of perform */ + leaq 8(%r11), C_ARG_2 /* arg 2: sp at perform */ + movq %r10, C_ARG_3 /* arg 3: fiber */ + SWITCH_OCAML_TO_C + C_call (GCALL(caml_tsan_func_entry_on_resume)) + SWITCH_C_TO_OCAML + RESTORE_ALL_REGS +#endif movq %rax, C_ARG_1 LEA_VAR(caml_raise_unhandled_effect, %rax) + TSAN_ENTER_FUNCTION jmp LBL(caml_c_call) CFI_ENDPROC ENDFUNCTION(G(caml_perform)) @@ -931,6 +1064,18 @@ CFI_STARTPROC /* check if stack null, then already used */ testq %r10, %r10 jz 2f + TSAN_ENTER_FUNCTION +#if defined(WITH_THREAD_SANITIZER) + SAVE_ALL_REGS + movq Stack_sp(%r10), %r11 + movq (%r11), C_ARG_1 /* arg 1: pc of perform */ + leaq 8(%r11), C_ARG_2 /* arg 2: sp at perform */ + movq %r10, C_ARG_3 /* arg 3: fiber */ + SWITCH_OCAML_TO_C + C_call (GCALL(caml_tsan_func_entry_on_resume)) + SWITCH_C_TO_OCAML + RESTORE_ALL_REGS +#endif /* Find end of list of stacks and add current */ movq %r10, %rsi 1: movq Stack_handler(%rsi), %rcx @@ -945,7 +1090,8 @@ CFI_STARTPROC UPDATE_BASE_POINTER(%rcx) SWITCH_OCAML_STACKS jmp *(%rbx) -2: LEA_VAR(caml_raise_continuation_already_resumed, %rax) +2: TSAN_ENTER_FUNCTION + LEA_VAR(caml_raise_continuation_already_resumed, %rax) jmp LBL(caml_c_call) CFI_ENDPROC ENDFUNCTION(G(caml_resume)) @@ -956,6 +1102,7 @@ FUNCTION(G(caml_runstack)) CFI_STARTPROC CFI_SIGNAL_FRAME ENTER_FUNCTION + TSAN_ENTER_FUNCTION /* %rax -> fiber, %rbx -> fun, %rdi -> arg */ andq $-2, %rax /* %rax = Ptr_val(%rax) */ /* save old stack pointer and exception handler */ @@ -1013,6 +1160,7 @@ LBL(frame_runstack): movq %r13, %rsp CFI_RESTORE_STATE movq %r12, %rax + TSAN_EXIT_FUNCTION /* Invoke handle_value (or handle_exn) */ LEAVE_FUNCTION jmp *(%rbx) @@ -1026,6 +1174,7 @@ ENDFUNCTION(G(caml_runstack)) FUNCTION(G(caml_ml_array_bound_error)) CFI_STARTPROC ENTER_FUNCTION + TSAN_ENTER_FUNCTION LEA_VAR(caml_array_bound_error_asm, %rax) jmp LBL(caml_c_call) CFI_ENDPROC diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index a9790d8a77..1e374ebe87 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -558,21 +558,6 @@ CAMLextern int caml_snwprintf(wchar_t * buf, #define snprintf_os snprintf #endif -/* Macro used to deactivate thread and address sanitizers on some - functions. */ -#define CAMLno_tsan -#define CAMLno_asan -#if defined(__has_feature) -# if __has_feature(thread_sanitizer) -# undef CAMLno_tsan -# define CAMLno_tsan __attribute__((no_sanitize("thread"))) -# endif -# if __has_feature(address_sanitizer) -# undef CAMLno_asan -# define CAMLno_asan __attribute__((no_sanitize("address"))) -# endif -#endif - #endif /* CAML_INTERNALS */ /* The [backtrace_slot] type represents values stored in diff --git a/runtime/caml/mlvalues.h b/runtime/caml/mlvalues.h index e359ae3094..8332d1fe7f 100644 --- a/runtime/caml/mlvalues.h +++ b/runtime/caml/mlvalues.h @@ -152,6 +152,46 @@ where 0 <= R <= 31 is HEADER_RESERVED_BITS, set with the #define Color_hd(hd) ((hd) & HEADER_COLOR_MASK) #define Hd_with_color(hd, color) (((hd) &~ HEADER_COLOR_MASK) | (color)) +/* Macro used to deactivate thread and address sanitizers on some + functions. */ +#define CAMLno_tsan +#define CAMLno_asan +/* __has_feature is Clang-specific, but GCC defines __SANITIZE_ADDRESS__ and + * __SANITIZE_THREAD__. */ +#if defined(__has_feature) +# if __has_feature(thread_sanitizer) +# undef CAMLno_tsan +# define CAMLno_tsan __attribute__((disable_sanitizer_instrumentation)) +# endif +# if __has_feature(address_sanitizer) +# undef CAMLno_asan +# define CAMLno_asan __attribute__((disable_sanitizer_instrumentation)) +# endif +#else +# if __SANITIZE_THREAD__ +# undef CAMLno_tsan +# define CAMLno_tsan __attribute__((no_sanitize_thread)) +# endif +# if __SANITIZE_ADDRESS__ +# undef CAMLno_asan +# define CAMLno_asan __attribute__((no_sanitize_address)) +# endif +#endif + +/* Macro used to deactivate ThreadSanitizer on some functions, but only in + ThreadSanitizer-enabled installations of OCaml. This has two functions: + removing some ThreadSanitizer warnings from the runtime in user programs on + a switch configured with --enable-tsan, and manually instrumenting some + functions, which requires disabling built-in instrumentation (see + [caml_modify]). This macro has no effect when OCaml is configured without + --enable-tsan, so that compiler developers can still detect bugs in these + functions using ThreadSanitizer. */ +#define CAMLno_user_tsan +#if defined(WITH_THREAD_SANITIZER) +# undef CAMLno_user_tsan +# define CAMLno_user_tsan CAMLno_tsan +#endif + #define Hp_atomic_val(val) ((atomic_uintnat *)(val) - 1) #define Hd_val(val) ((header_t) \ (atomic_load_explicit(Hp_atomic_val(val), memory_order_relaxed))) diff --git a/runtime/caml/tsan.h b/runtime/caml/tsan.h new file mode 100644 index 0000000000..23f316d158 --- /dev/null +++ b/runtime/caml/tsan.h @@ -0,0 +1,27 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Fabrice Buoro and Olivier Nicole, Tarides */ +/* */ +/* Copyright 2022 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_TSAN_H +#define CAML_TSAN_H + +#ifdef CAML_INTERNALS + +CAMLextern void caml_tsan_exn_func_exit_c(char* limit); + +CAMLextern void caml_tsan_func_exit_on_perform(uintnat pc, char* sp); +CAMLextern void caml_tsan_func_entry_on_resume(uintnat pc, char* sp); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_TSAN_H */ diff --git a/runtime/fail_nat.c b/runtime/fail_nat.c index 2245f933b3..daa2e62ff9 100644 --- a/runtime/fail_nat.c +++ b/runtime/fail_nat.c @@ -31,6 +31,7 @@ #include "caml/roots.h" #include "caml/callback.h" #include "caml/signals.h" +#include "caml/tsan.h" /* The globals holding predefined exceptions */ @@ -82,6 +83,10 @@ void caml_raise(value v) Caml_state->local_roots = Caml_state->local_roots->next; } +#if defined(WITH_THREAD_SANITIZER) + caml_tsan_exn_func_exit_c(exception_pointer); +#endif + caml_raise_exception(Caml_state, v); } diff --git a/runtime/memory.c b/runtime/memory.c index 3af3a6f72b..fed45c8df6 100644 --- a/runtime/memory.c +++ b/runtime/memory.c @@ -124,6 +124,8 @@ generated. */ +void __tsan_write8(void *location); + Caml_inline void write_barrier( value obj, intnat field, value old_val, value new_val) { @@ -146,12 +148,23 @@ Caml_inline void write_barrier( } } +CAMLno_user_tsan /* We remove the ThreadSanitizer instrumentation of memory + accesses by the compiler and instrument manually, because + we want ThreadSanitizer to see a plain store here (this is + necessary to detect data races). */ CAMLexport CAMLweakdef void caml_modify (volatile value *fp, value val) { write_barrier((value)fp, 0, *fp, val); /* See Note [MM] above */ atomic_thread_fence(memory_order_acquire); +#if defined(WITH_THREAD_SANITIZER) && defined(NATIVE_CODE) + /* The release store below is not instrumented because of the + * CAMLno_user_tsan. We signal it to ThreadSanitizer as a plain store (see + * ocaml-multicore/ocaml-tsan/pull/22#issuecomment-1377439074 on Github). + */ + __tsan_write8((void *)fp); +#endif atomic_store_explicit(&Op_atomic_val((value)fp)[0], val, memory_order_release); } diff --git a/runtime/misc.c b/runtime/misc.c index 43fc5d600a..7ffab4cb85 100644 --- a/runtime/misc.c +++ b/runtime/misc.c @@ -250,3 +250,17 @@ void caml_bad_caml_state(void) { caml_fatal_error("no domain lock held"); } + +#ifdef WITH_THREAD_SANITIZER +/* This hardcodes a number of suppressions of TSan reports about runtime + functions (see #11040). Unlike the CAMLno_user_tsan qualifier which + un-instruments function, this simply silences reports when the call stack + contains a frame matching one of the lines starting with "race:". */ +const char * __tsan_default_suppressions(void) { + return "deadlock:caml_plat_lock\n" /* Avoids deadlock inversion messages */ + "race:create_domain\n" + "race:mark_slice_darken\n" + "race:caml_darken_cont\n" + "race:caml_shared_try_alloc\n"; +} +#endif /* WITH_THREAD_SANITIZER */ diff --git a/runtime/tsan.c b/runtime/tsan.c new file mode 100644 index 0000000000..3fd4ac0285 --- /dev/null +++ b/runtime/tsan.c @@ -0,0 +1,176 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Fabrice Buoro and Olivier Nicole, Tarides */ +/* */ +/* Copyright 2022 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 + +#define UNW_LOCAL_ONLY +#include + +#include "caml/mlvalues.h" +#include "caml/misc.h" +#include "caml/frame_descriptors.h" +#include "caml/fiber.h" +#include "caml/domain_state.h" +#include "caml/stack.h" +#include "caml/config.h" +#ifdef TSAN_DEBUG +#include /* For backtrace_symbols */ +#endif + +extern void __tsan_func_exit(void*); +#if defined(__GNUC__) && !defined(__clang__) +/* GCC already has __tsan_func_entry declared for some reason */ +#else +extern void __tsan_func_entry(void*); +#endif + +Caml_inline void caml_tsan_debug_log_pc(const char* msg, uintnat pc) +{ +#ifdef TSAN_DEBUG + char **sym_names = backtrace_symbols((void **)&pc, 1); + fprintf(stderr, "%s %s\n", msg, sym_names[0]); + free(sym_names); +#else + (void)msg; (void)pc; +#endif +} + +void caml_tsan_exn_func_exit(uintnat pc, char* sp, char* trapsp) +{ + caml_domain_state* domain_state = Caml_state; + caml_frame_descrs fds = caml_get_frame_descrs(); + uintnat next_pc = pc; + + /* iterate on each frame */ + while (1) { + frame_descr* descr = caml_next_frame_descriptor(fds, &next_pc, &sp, + domain_state->current_stack); + + if (descr == NULL) { + return; + } + + /* Stop when we reach the current exception handler */ + if (sp > trapsp) { + break; + } + + caml_tsan_debug_log_pc("forced__tsan_func_exit for", pc); + __tsan_func_exit(NULL); + pc = next_pc; + } +} + +void caml_tsan_exn_func_exit_c(char* limit) +{ + unw_context_t uc; + unw_cursor_t cursor; + unw_word_t sp; +#ifdef TSAN_DEBUG + unw_word_t prev_pc; +#endif + int ret; + + ret = unw_getcontext(&uc); + if (ret != 0) + caml_fatal_error("unw_getcontextfailed failed with code %d", ret); + ret = unw_init_local(&cursor, &uc); + if (ret != 0) + caml_fatal_error("unw_init_local failed with code %d", ret); + + while (1) { +#ifdef TSAN_DEBUG + if (unw_get_reg(&cursor, UNW_REG_IP, &prev_pc) < 0) { + caml_fatal_error("unw_get_reg failed with code %d", ret); + } +#endif + + ret = unw_step(&cursor); + if (ret < 0) { + caml_fatal_error("unw_step failed with code %d", ret); + } else if (ret == 0) { + /* No more frames */ + break; + } + + ret = unw_get_reg(&cursor, UNW_REG_SP, &sp); + if (ret != 0) + caml_fatal_error("unw_get_reg failed with code %d", ret); +#ifdef TSAN_DEBUG + caml_tsan_debug_log_pc("forced__tsan_func_exit for", prev_pc); +#endif + __tsan_func_exit(NULL); + + if ((char*)sp >= limit) { + break; + } + } +} + +/* This function iterates on each stack frame of the current fiber. This is + sufficient, since when the top of the stack is reached, the runtime switches + to the parent fiber, and re-performs; as a consequence, this function will + be called again. */ +void caml_tsan_func_exit_on_perform(uintnat pc, char* sp) +{ + struct stack_info* stack = Caml_state->current_stack; + caml_frame_descrs fds = caml_get_frame_descrs(); + uintnat next_pc = pc; + + /* iterate on each frame */ + while (1) { + frame_descr* descr = caml_next_frame_descriptor(fds, &next_pc, &sp, stack); + + caml_tsan_debug_log_pc("forced__tsan_func_exit for", pc); + __tsan_func_exit(NULL); + + if (descr == NULL) { + break; + } + pc = next_pc; + } +} + +/* This function is executed after switching to the deeper fiber, but before + the linked list of fibers from the current one to the handler's has been + restored by restoring the parent link to the handler's stack. As a + consequence, this function simply iterates on each stack frame, following + links to parent fibers, until that link is NULL. This way, it performs a + [__tsan_func_entry] for each stack frame between the current and the + handler's stack. + We use non-tail recursion to call [__tsan_func_entry] in the reverse order + of iteration. */ +CAMLno_tsan void caml_tsan_func_entry_on_resume(uintnat pc, char* sp, + struct stack_info const* stack) +{ + caml_frame_descrs fds = caml_get_frame_descrs(); + uintnat next_pc = pc; + + caml_next_frame_descriptor(fds, &next_pc, &sp, (struct stack_info*)stack); + if (next_pc == 0) { + stack = stack->handler->parent; + if (!stack) { + return; + } + + char* p = (char*)stack->sp; + Pop_frame_pointer(p); + next_pc = *(uintnat*)p; + sp = p + sizeof(value); + } + + caml_tsan_func_entry_on_resume(next_pc, sp, stack); + caml_tsan_debug_log_pc("forced__tsan_func_entry for", pc); + __tsan_func_entry((void*)next_pc); +} diff --git a/tools/check-symbol-names b/tools/check-symbol-names index 0e1c829de4..7ea13310f2 100755 --- a/tools/check-symbol-names +++ b/tools/check-symbol-names @@ -32,6 +32,8 @@ $2 ~ /^_?wmain$/ { next } $2 ~ /^__x86.get_pc_thunk./ { next } # for mingw32 $2 ~ /^.debug_/ { next } +# ignore "__tsan_default_suppressions" +$2 ~ /^___?tsan_default_suppressions$/ { next } # print the rest { found=1; print $1 " " $2 " " $3 } # fail if there were any results diff --git a/utils/config.common.ml b/utils/config.common.ml index 9707cd0fc3..45a5e2d30b 100644 --- a/utils/config.common.ml +++ b/utils/config.common.ml @@ -118,6 +118,8 @@ let configuration_variables () = p_bool "flat_float_array" flat_float_array; p_bool "function_sections" function_sections; p_bool "afl_instrument" afl_instrument; + p_bool "tsan" tsan; + p "tsan_ld_flags" tsan_ld_flags; p_bool "windows_unicode" windows_unicode; p_bool "supports_shared_libraries" supports_shared_libraries; p_bool "native_dynlink" native_dynlink; diff --git a/utils/config.fixed.ml b/utils/config.fixed.ml index e0ca8d4aca..15d4fd0839 100644 --- a/utils/config.fixed.ml +++ b/utils/config.fixed.ml @@ -52,6 +52,8 @@ let flat_float_array = true let function_sections = false let afl_instrument = false let native_compiler = false +let tsan = false +let tsan_ld_flags = "" let architecture = "none" let model = "default" let system = "unknown" diff --git a/utils/config.generated.ml.in b/utils/config.generated.ml.in index 6aaf2a1f06..11e63a9452 100644 --- a/utils/config.generated.ml.in +++ b/utils/config.generated.ml.in @@ -110,3 +110,6 @@ let systhread_supported = @systhread_support@ let flexdll_dirs = [@flexdll_dir@] let ar_supports_response_files = @ar_supports_response_files@ + +let tsan = @tsan@ +let tsan_ld_flags = {@QS@|@oc_tsan_ldflags@|@QS@} diff --git a/utils/config.mli b/utils/config.mli index 800d23c477..5e2f9b2149 100644 --- a/utils/config.mli +++ b/utils/config.mli @@ -251,6 +251,13 @@ val afl_instrument : bool val ar_supports_response_files: bool (** Whether ar supports @FILE arguments. *) +val tsan : bool +(** Whether ThreadSanitizer instrumentation is enabled *) + +val tsan_ld_flags : string +(* Flags to pass to the system linker when build ThreadSanitizer-instrumented + programs *) + (** Access to configuration values *) val print_config : out_channel -> unit From 48ab3ecceed03742bc90b06174479ed10024dda8 Mon Sep 17 00:00:00 2001 From: Fabrice Buoro Date: Thu, 2 Mar 2023 12:07:13 +0100 Subject: [PATCH 13/16] Add testing for ThreadSanitizer support - Add a new set of tests in testsuite/tsan/ - A small number of tests have to be disabled when --enable-tsan is set, due to the fact that a call tree of depth >64k causes the ThreadSanitizer runtime to crash. (This is a limitation on the ThreadSanitizer side.) - Add the no-tsan action to ocamltest, in order to test whether --enable-tsan is set. Co-authored-by: Olivier Nicole --- ocamltest/builtin_actions.ml | 16 ++ ocamltest/ocamltest_config.ml.in | 2 + ocamltest/ocamltest_config.mli | 3 + testsuite/tests/asmgen/soli.cmm | 3 +- .../backtrace/pr2195-locs.byte.reference | 4 +- testsuite/tests/backtrace/pr2195.ml | 9 +- .../tests/backtrace/pr2195.opt.reference | 4 +- testsuite/tests/callback/test3.ml | 7 +- testsuite/tests/lf_skiplist/test_parallel.ml | 1 + testsuite/tests/lib-marshal/intext_par.ml | 2 + testsuite/tests/lib-systhreads/boundscheck.ml | 7 +- testsuite/tests/lib-systhreads/testfork.ml | 11 +- testsuite/tests/lib-threads/mutex_errors.ml | 5 +- testsuite/tests/memory-model/forbidden.ml | 5 +- testsuite/tests/memory-model/publish.ml | 7 +- testsuite/tests/misc/pr7168.ml | 2 + testsuite/tests/output-complete-obj/test.ml | 18 +- testsuite/tests/parallel/pingpong.ml | 1 + .../tests/runtime-errors/stackoverflow.ml | 1 + testsuite/tests/tsan/array_elt.ml | 15 ++ testsuite/tests/tsan/array_elt.reference | 71 ++++++ testsuite/tests/tsan/array_elt.run | 4 + testsuite/tests/tsan/callbacks.c | 23 ++ testsuite/tests/tsan/exn_from_c.ml | 51 ++++ testsuite/tests/tsan/exn_from_c.reference | 85 +++++++ testsuite/tests/tsan/exn_from_c.run | 4 + testsuite/tests/tsan/exn_in_callback.ml | 61 +++++ .../tests/tsan/exn_in_callback.reference | 84 ++++++ testsuite/tests/tsan/exn_in_callback.run | 4 + testsuite/tests/tsan/exn_reraise.ml | 50 ++++ testsuite/tests/tsan/exn_reraise.reference | 84 ++++++ testsuite/tests/tsan/exn_reraise.run | 4 + testsuite/tests/tsan/filter-locations.sh | 36 +++ testsuite/tests/tsan/handlers_at_tail.ml | 26 ++ testsuite/tests/tsan/norace_atomics.ml | 18 ++ testsuite/tests/tsan/perform.ml | 86 +++++++ testsuite/tests/tsan/perform.reference | 240 ++++++++++++++++++ testsuite/tests/tsan/perform.run | 4 + testsuite/tests/tsan/raise_through_handler.ml | 59 +++++ .../tsan/raise_through_handler.reference | 79 ++++++ .../tests/tsan/raise_through_handler.run | 4 + testsuite/tests/tsan/record_field.ml | 18 ++ testsuite/tests/tsan/record_field.reference | 71 ++++++ testsuite/tests/tsan/record_field.run | 4 + testsuite/tests/tsan/reperform.ml | 101 ++++++++ testsuite/tests/tsan/reperform.reference | 239 +++++++++++++++++ testsuite/tests/tsan/reperform.run | 4 + .../weak-ephe-final/weaktest_par_load.ml | 4 +- 48 files changed, 1605 insertions(+), 36 deletions(-) create mode 100644 testsuite/tests/tsan/array_elt.ml create mode 100644 testsuite/tests/tsan/array_elt.reference create mode 100644 testsuite/tests/tsan/array_elt.run create mode 100644 testsuite/tests/tsan/callbacks.c create mode 100644 testsuite/tests/tsan/exn_from_c.ml create mode 100644 testsuite/tests/tsan/exn_from_c.reference create mode 100644 testsuite/tests/tsan/exn_from_c.run create mode 100644 testsuite/tests/tsan/exn_in_callback.ml create mode 100644 testsuite/tests/tsan/exn_in_callback.reference create mode 100644 testsuite/tests/tsan/exn_in_callback.run create mode 100644 testsuite/tests/tsan/exn_reraise.ml create mode 100644 testsuite/tests/tsan/exn_reraise.reference create mode 100644 testsuite/tests/tsan/exn_reraise.run create mode 100755 testsuite/tests/tsan/filter-locations.sh create mode 100644 testsuite/tests/tsan/handlers_at_tail.ml create mode 100644 testsuite/tests/tsan/norace_atomics.ml create mode 100644 testsuite/tests/tsan/perform.ml create mode 100644 testsuite/tests/tsan/perform.reference create mode 100644 testsuite/tests/tsan/perform.run create mode 100644 testsuite/tests/tsan/raise_through_handler.ml create mode 100644 testsuite/tests/tsan/raise_through_handler.reference create mode 100644 testsuite/tests/tsan/raise_through_handler.run create mode 100644 testsuite/tests/tsan/record_field.ml create mode 100644 testsuite/tests/tsan/record_field.reference create mode 100644 testsuite/tests/tsan/record_field.run create mode 100644 testsuite/tests/tsan/reperform.ml create mode 100644 testsuite/tests/tsan/reperform.reference create mode 100644 testsuite/tests/tsan/reperform.run diff --git a/ocamltest/builtin_actions.ml b/ocamltest/builtin_actions.ml index 0bc17bc281..1af3b08559 100644 --- a/ocamltest/builtin_actions.ml +++ b/ocamltest/builtin_actions.ml @@ -211,6 +211,20 @@ let frame_pointers = make "frame-pointers available" "frame-pointers not available") +let tsan = make + ~name:"tsan" + ~description:"Pass if thread sanitizer is supported" + (Actions_helpers.pass_or_skip (Ocamltest_config.tsan) + "tsan available" + "tsan not available") + +let no_tsan = make + ~name:"no-tsan" + ~description:"Pass if thread sanitizer is not supported" + (Actions_helpers.pass_or_skip (not Ocamltest_config.tsan) + "tsan not available" + "tsan available") + let has_symlink = make ~name:"has_symlink" ~description:"Pass if symbolic links are available" @@ -346,4 +360,6 @@ let _ = frame_pointers; file_exists; copy; + tsan; + no_tsan; ] diff --git a/ocamltest/ocamltest_config.ml.in b/ocamltest/ocamltest_config.ml.in index 282090b4c3..276c40d864 100644 --- a/ocamltest/ocamltest_config.ml.in +++ b/ocamltest/ocamltest_config.ml.in @@ -91,3 +91,5 @@ let function_sections = @function_sections@ let instrumented_runtime = @instrumented_runtime@ let frame_pointers = @frame_pointers@ + +let tsan = @tsan@ diff --git a/ocamltest/ocamltest_config.mli b/ocamltest/ocamltest_config.mli index cbe1432466..0abe7f1406 100644 --- a/ocamltest/ocamltest_config.mli +++ b/ocamltest/ocamltest_config.mli @@ -127,3 +127,6 @@ val instrumented_runtime : bool val frame_pointers : bool (** Whether frame-pointers have been enabled at configure time *) + +val tsan : bool +(** Whether ThreadSanitizer support has been enabled at configure time *) diff --git a/testsuite/tests/asmgen/soli.cmm b/testsuite/tests/asmgen/soli.cmm index 568765116b..80e31a9b0e 100644 --- a/testsuite/tests/asmgen/soli.cmm +++ b/testsuite/tests/asmgen/soli.cmm @@ -1,7 +1,8 @@ (* TEST readonly_files = "main.c" arguments = "-DUNIT_INT -DFUN=solitaire main.c" -* asmgen +* no-tsan +** asmgen *) (**************************************************************************) diff --git a/testsuite/tests/backtrace/pr2195-locs.byte.reference b/testsuite/tests/backtrace/pr2195-locs.byte.reference index 05fe30cee4..646ffe7876 100644 --- a/testsuite/tests/backtrace/pr2195-locs.byte.reference +++ b/testsuite/tests/backtrace/pr2195-locs.byte.reference @@ -1,4 +1,4 @@ Fatal error: exception Stdlib.Exit Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 405, characters 28-54 -Called from Pr2195 in file "pr2195.ml", line 24, characters 6-19 -Re-raised at Pr2195 in file "pr2195.ml", line 29, characters 4-41 +Called from Pr2195 in file "pr2195.ml", line 25, characters 6-19 +Re-raised at Pr2195 in file "pr2195.ml", line 30, characters 4-41 diff --git a/testsuite/tests/backtrace/pr2195.ml b/testsuite/tests/backtrace/pr2195.ml index e0442a3405..2c44efc58f 100644 --- a/testsuite/tests/backtrace/pr2195.ml +++ b/testsuite/tests/backtrace/pr2195.ml @@ -1,16 +1,17 @@ (* TEST + * no-tsan flags += "-g" exit_status = "2" - * bytecode + ** bytecode ocamlrunparam += ",b=0" reference = "${test_source_directory}/pr2195-nolocs.byte.reference" - * bytecode + ** bytecode ocamlrunparam += ",b=1" reference = "${test_source_directory}/pr2195-nolocs.byte.reference" - * bytecode + ** bytecode ocamlrunparam += ",b=2" reference = "${test_source_directory}/pr2195-locs.byte.reference" - * native + ** native reference = "${test_source_directory}/pr2195.opt.reference" compare_programs = "false" *) diff --git a/testsuite/tests/backtrace/pr2195.opt.reference b/testsuite/tests/backtrace/pr2195.opt.reference index 890fc83eef..92618a6cb3 100644 --- a/testsuite/tests/backtrace/pr2195.opt.reference +++ b/testsuite/tests/backtrace/pr2195.opt.reference @@ -1,5 +1,5 @@ Fatal error: exception Stdlib.Exit Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 405, characters 28-54 Called from Stdlib.open_in in file "stdlib.ml" (inlined), line 410, characters 2-45 -Called from Pr2195 in file "pr2195.ml", line 24, characters 6-19 -Re-raised at Pr2195 in file "pr2195.ml", line 29, characters 4-41 +Called from Pr2195 in file "pr2195.ml", line 25, characters 6-19 +Re-raised at Pr2195 in file "pr2195.ml", line 30, characters 4-41 diff --git a/testsuite/tests/callback/test3.ml b/testsuite/tests/callback/test3.ml index 6b4f64b739..1ab42a8b03 100644 --- a/testsuite/tests/callback/test3.ml +++ b/testsuite/tests/callback/test3.ml @@ -1,9 +1,10 @@ (* TEST include unix modules = "test3_.c" - * libunix - ** bytecode - ** native + * no-tsan + ** libunix + *** bytecode + *** native *) (* Tests nested calls from C (main C) to OCaml (main OCaml) to C (caml_to_c) to diff --git a/testsuite/tests/lf_skiplist/test_parallel.ml b/testsuite/tests/lf_skiplist/test_parallel.ml index ac02717889..e451bd7c45 100644 --- a/testsuite/tests/lf_skiplist/test_parallel.ml +++ b/testsuite/tests/lf_skiplist/test_parallel.ml @@ -1,4 +1,5 @@ (* TEST + * no-tsan modules = "stubs.c" *) diff --git a/testsuite/tests/lib-marshal/intext_par.ml b/testsuite/tests/lib-marshal/intext_par.ml index 8db6e91a5a..29b047a953 100644 --- a/testsuite/tests/lib-marshal/intext_par.ml +++ b/testsuite/tests/lib-marshal/intext_par.ml @@ -1,5 +1,7 @@ (* TEST + * no-tsan modules = "intextaux_par.c" + ocamlopt_flags = "-g" *) (* Test for output_value / input_value *) diff --git a/testsuite/tests/lib-systhreads/boundscheck.ml b/testsuite/tests/lib-systhreads/boundscheck.ml index 216dcebae7..6f56b615b6 100644 --- a/testsuite/tests/lib-systhreads/boundscheck.ml +++ b/testsuite/tests/lib-systhreads/boundscheck.ml @@ -1,9 +1,10 @@ (* TEST include systhreads -* hassysthreads -** bytecode -** native +* no-tsan +** hassysthreads +*** bytecode +*** native *) diff --git a/testsuite/tests/lib-systhreads/testfork.ml b/testsuite/tests/lib-systhreads/testfork.ml index 3fdf386086..37a477d2a9 100644 --- a/testsuite/tests/lib-systhreads/testfork.ml +++ b/testsuite/tests/lib-systhreads/testfork.ml @@ -1,10 +1,11 @@ (* TEST - * hassysthreads + * no-tsan + ** hassysthreads include systhreads - ** not-bsd - *** libunix - **** bytecode - **** native + *** not-bsd + **** libunix + ***** bytecode + ***** native *) (* POSIX threads and fork() *) diff --git a/testsuite/tests/lib-threads/mutex_errors.ml b/testsuite/tests/lib-threads/mutex_errors.ml index 25d3330955..fcd56b7eaa 100644 --- a/testsuite/tests/lib-threads/mutex_errors.ml +++ b/testsuite/tests/lib-threads/mutex_errors.ml @@ -1,9 +1,10 @@ (* TEST * hassysthreads +** no-tsan include systhreads -** bytecode -** native +*** bytecode +*** native *) diff --git a/testsuite/tests/memory-model/forbidden.ml b/testsuite/tests/memory-model/forbidden.ml index 5504d94f04..1b32b7a98a 100644 --- a/testsuite/tests/memory-model/forbidden.ml +++ b/testsuite/tests/memory-model/forbidden.ml @@ -1,8 +1,9 @@ (* TEST modules="opt.ml barrier.ml hist.ml shared.ml run.ml outcome.ml" * not-bsd - ** bytecode - ** native + ** no-tsan + *** bytecode + *** native *) (* Memory model test: diff --git a/testsuite/tests/memory-model/publish.ml b/testsuite/tests/memory-model/publish.ml index 7f778307a1..afb5ab4cb2 100644 --- a/testsuite/tests/memory-model/publish.ml +++ b/testsuite/tests/memory-model/publish.ml @@ -1,9 +1,10 @@ (* TEST modules="opt.ml barrier.ml hist.ml shared.ml run.ml outcome.ml" * not-bsd - ** not-windows - *** bytecode - ** native + ** no-tsan + *** not-windows + **** bytecode + *** native *) (* Memory model: test the _publish idiom *) diff --git a/testsuite/tests/misc/pr7168.ml b/testsuite/tests/misc/pr7168.ml index dcd56eed13..a432f03e39 100644 --- a/testsuite/tests/misc/pr7168.ml +++ b/testsuite/tests/misc/pr7168.ml @@ -1,5 +1,7 @@ (* TEST +* no-tsan + ocamlrunparam += "l=100000" *) diff --git a/testsuite/tests/output-complete-obj/test.ml b/testsuite/tests/output-complete-obj/test.ml index 1b655a6d46..e75e7d9e06 100644 --- a/testsuite/tests/output-complete-obj/test.ml +++ b/testsuite/tests/output-complete-obj/test.ml @@ -1,28 +1,30 @@ (* TEST +* no-tsan + readonly_files = "test.ml_stub.c" -* setup-ocamlc.byte-build-env -** ocamlc.byte +** setup-ocamlc.byte-build-env +*** ocamlc.byte flags = "-w -a -output-complete-obj" program = "test.ml.bc.${objext}" -*** script +**** script script = "${mkexe} -I${ocamlsrcdir}/runtime -o test.ml_bc_stub.exe \ test.ml.bc.${objext} ${nativecc_libs} test.ml_stub.c" output = "${compiler_output}" -**** run +***** run program = "./test.ml_bc_stub.exe" stdout = "program-output" stderr = "program-output" -* setup-ocamlopt.byte-build-env -** ocamlopt.byte +** setup-ocamlopt.byte-build-env +*** ocamlopt.byte flags = "-w -a -output-complete-obj" program = "test.ml.exe.${objext}" -*** script +**** script script = "${mkexe} -I${ocamlsrcdir}/runtime -o test.ml_stub.exe \ test.ml.exe.${objext} ${bytecc_libs} test.ml_stub.c" output = "${compiler_output}" -**** run +***** run program = "./test.ml_stub.exe" stdout = "program-output" stderr = "program-output" diff --git a/testsuite/tests/parallel/pingpong.ml b/testsuite/tests/parallel/pingpong.ml index 1f29cb6b8b..c354b7d711 100644 --- a/testsuite/tests/parallel/pingpong.ml +++ b/testsuite/tests/parallel/pingpong.ml @@ -1,4 +1,5 @@ (* TEST +* no-tsan *) let r = ref (Some 0) diff --git a/testsuite/tests/runtime-errors/stackoverflow.ml b/testsuite/tests/runtime-errors/stackoverflow.ml index b617e64cdc..db70b7aa6d 100644 --- a/testsuite/tests/runtime-errors/stackoverflow.ml +++ b/testsuite/tests/runtime-errors/stackoverflow.ml @@ -1,4 +1,5 @@ (* TEST +* no-tsan flags = "-w -a" ocamlrunparam += "l=100000" *) diff --git a/testsuite/tests/tsan/array_elt.ml b/testsuite/tests/tsan/array_elt.ml new file mode 100644 index 0000000000..d6efc7b375 --- /dev/null +++ b/testsuite/tests/tsan/array_elt.ml @@ -0,0 +1,15 @@ +(* TEST + +* tsan +** native + +include unix +set TSAN_OPTIONS="detect_deadlocks=0" + +*) +let () = + let v = Array.make 4 0 in + let t1 = Domain.spawn (fun () -> Array.set v 3 0; Unix.sleepf 0.1) in + let t2 = Domain.spawn (fun () -> ignore (Sys.opaque_identity (Array.get v 3)); Unix.sleepf 0.1) in + Domain.join t1; + Domain.join t2; diff --git a/testsuite/tests/tsan/array_elt.reference b/testsuite/tests/tsan/array_elt.reference new file mode 100644 index 0000000000..7395105414 --- /dev/null +++ b/testsuite/tests/tsan/array_elt.reference @@ -0,0 +1,71 @@ +================== +WARNING: ThreadSanitizer: data race (pid=) + Read of size 8 at by thread T4 (mutexes: write M): + #0 camlArray_elt.fun_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + Previous write of size 8 at by thread T1 (mutexes: write M): + #0 camlArray_elt.fun_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Thread T4 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlArray_elt.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlArray_elt.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + +SUMMARY: ThreadSanitizer: data race (:) in camlArray_elt.fun_ +================== +ThreadSanitizer: reported 1 warnings diff --git a/testsuite/tests/tsan/array_elt.run b/testsuite/tests/tsan/array_elt.run new file mode 100644 index 0000000000..e96b5ea13a --- /dev/null +++ b/testsuite/tests/tsan/array_elt.run @@ -0,0 +1,4 @@ +#!/bin/sh + +${program} 2>&1 \ + | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/tsan/callbacks.c b/testsuite/tests/tsan/callbacks.c new file mode 100644 index 0000000000..17f6ea003b --- /dev/null +++ b/testsuite/tests/tsan/callbacks.c @@ -0,0 +1,23 @@ +#include +#include + +#define CAML_NAME_SPACE +#include "caml/mlvalues.h" +#include "caml/fail.h" +#include "caml/memory.h" +#include "caml/callback.h" + +value print_and_call_ocaml_h(value /* unit */) +{ + fprintf(stderr, "Hello from print_and_call_ocaml_h\n"); + caml_callback(*caml_named_value("ocaml_h"), Val_unit); + fprintf(stderr, "Leaving print_and_call_ocaml_h\n"); + return Val_unit; +} + +value print_and_raise(value /* unit */) +{ + fprintf(stderr, "Hello from print_and_raise\n"); + caml_failwith("test"); + return Val_unit; /* Unreachable */ +} diff --git a/testsuite/tests/tsan/exn_from_c.ml b/testsuite/tests/tsan/exn_from_c.ml new file mode 100644 index 0000000000..b487e494f9 --- /dev/null +++ b/testsuite/tests/tsan/exn_from_c.ml @@ -0,0 +1,51 @@ +(* TEST + +modules = "callbacks.c" + +* tsan +** native + +ocamlopt_flags = "-g -ccopt -fsanitize=thread -ccopt -O1 -ccopt -fno-omit-frame-pointer -ccopt -g" +include unix +set TSAN_OPTIONS="detect_deadlocks=0" + +*) + +external print_and_raise : unit -> unit = "print_and_raise" + +open Printf + +let r = ref 0 + +let [@inline never] race () = ignore @@ !r + +let [@inline never] i () = + printf "entering i\n%!"; + printf "calling print_and_raise...\n%!"; + print_and_raise (); + printf "leaving i\n%!" + +let [@inline never] h () = + printf "entering h\n%!"; + i (); + printf "leaving h\n%!" + +let [@inline never] g () = + printf "entering g\n%!"; + h (); + printf "leaving g\n%!" + +let [@inline never] f () = + printf "entering f\n%!"; + (try g () + with Failure msg -> + printf "caught Failure \"%s\"\n%!" msg; + Printexc.print_backtrace stdout; + race ()); + printf "leaving f\n%!" + +let () = + Printexc.record_backtrace true; + let d = Domain.spawn (fun () -> Unix.sleep 1; r := 1) in + f (); Unix.sleep 1; + Domain.join d diff --git a/testsuite/tests/tsan/exn_from_c.reference b/testsuite/tests/tsan/exn_from_c.reference new file mode 100644 index 0000000000..465463a2f3 --- /dev/null +++ b/testsuite/tests/tsan/exn_from_c.reference @@ -0,0 +1,85 @@ +entering f +entering g +entering h +entering i +calling print_and_raise... +Hello from print_and_raise +caught Failure "test" +Raised by primitive operation at Exn_from_c.i in file "exn_from_c.ml", line 25, characters 2-20 +Called from Exn_from_c.h in file "exn_from_c.ml", line 30, characters 2-6 +Called from Exn_from_c.g in file "exn_from_c.ml", line 35, characters 2-6 +Called from Exn_from_c.f in file "exn_from_c.ml", line 40, characters 7-11 +leaving f +================== +WARNING: ThreadSanitizer: data race (pid=) + Write of size 8 at by thread T1 (mutexes: write M): + #0 camlExn_from_c.fun_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + Previous read of size 8 at by main thread (mutexes: write M): + #0 camlExn_from_c.race_ () + #1 camlExn_from_c.f_ () + #2 camlExn_from_c.entry () + #3 caml_program () + #4 caml_start_program () + #5 caml_startup_common () + #6 caml_startup_exn () + #7 caml_startup () + #8 caml_main () + #9 main () + + As if synchronized via sleep: + #0 nanosleep () + #1 caml_unix_sleep () + #2 caml_c_call () + #3 camlUnix.sleep_ () + #4 camlExn_from_c.fun_ () + #5 camlStdlib__Domain.body_ () + #6 caml_start_program () + #7 caml_callback_exn () + #8 caml_callback () + #9 domain_thread_func () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlExn_from_c.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + +SUMMARY: ThreadSanitizer: data race (:) in camlExn_from_c.fun_ +================== +ThreadSanitizer: reported 1 warnings diff --git a/testsuite/tests/tsan/exn_from_c.run b/testsuite/tests/tsan/exn_from_c.run new file mode 100644 index 0000000000..e96b5ea13a --- /dev/null +++ b/testsuite/tests/tsan/exn_from_c.run @@ -0,0 +1,4 @@ +#!/bin/sh + +${program} 2>&1 \ + | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/tsan/exn_in_callback.ml b/testsuite/tests/tsan/exn_in_callback.ml new file mode 100644 index 0000000000..3cbcce4c71 --- /dev/null +++ b/testsuite/tests/tsan/exn_in_callback.ml @@ -0,0 +1,61 @@ +(* TEST + +modules = "callbacks.c" + +* tsan +** native + +ocamlopt_flags = "-g -ccopt -fsanitize=thread -ccopt -O1 -ccopt -fno-omit-frame-pointer -ccopt -g" +include unix +set TSAN_OPTIONS="detect_deadlocks=0" + +*) +exception ExnA +exception ExnB + +external print_and_call_ocaml_h : unit -> unit = "print_and_call_ocaml_h" + +open Printf + +let r = ref 0 + +let [@inline never] race () = ignore @@ !r + +let [@inline never] i () = + printf "entering i\n%!"; + printf "throwing Exn...\n%!"; + (*race ();*) + ignore (raise ExnB); + printf "leaving i\n%!" + +let [@inline never] h () = + printf "entering h\n%!"; + i (); + (* try i () with + | ExnA -> printf "caught an ExnA\n%!"; + *) + printf "leaving h\n%!" + +let _ = Callback.register "ocaml_h" h + +let [@inline never] g () = + printf "entering g\n%!"; + printf "calling C code\n%!"; + print_and_call_ocaml_h (); + printf "back from C code\n%!"; + printf "leaving g\n%!" + +let [@inline never] f () = + printf "entering f\n%!"; + (try g () with + | ExnB -> + printf "caught an ExnB\n%!"; + Printexc.print_backtrace stdout; + race ()); + printf "leaving f\n%!" + +let () = + Printexc.record_backtrace true; + let d = Domain.spawn (fun () -> Unix.sleep 1; r := 1) in + f (); Unix.sleep 1; + Domain.join d diff --git a/testsuite/tests/tsan/exn_in_callback.reference b/testsuite/tests/tsan/exn_in_callback.reference new file mode 100644 index 0000000000..5588337de1 --- /dev/null +++ b/testsuite/tests/tsan/exn_in_callback.reference @@ -0,0 +1,84 @@ +entering f +entering g +calling C code +Hello from print_and_call_ocaml_h +entering h +entering i +throwing Exn... +caught an ExnB +Raised by primitive operation at Exn_in_callback.g in file "exn_in_callback.ml", line 44, characters 2-27 +Called from Exn_in_callback.f in file "exn_in_callback.ml", line 50, characters 7-11 +leaving f +================== +WARNING: ThreadSanitizer: data race (pid=) + Write of size 8 at by thread T1 (mutexes: write M): + #0 camlExn_in_callback.fun_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + Previous read of size 8 at by main thread (mutexes: write M): + #0 camlExn_in_callback.race_ () + #1 camlExn_in_callback.f_ () + #2 camlExn_in_callback.entry () + #3 caml_program () + #4 caml_start_program () + #5 caml_startup_common () + #6 caml_startup_exn () + #7 caml_startup () + #8 caml_main () + #9 main () + + As if synchronized via sleep: + #0 nanosleep () + #1 caml_unix_sleep () + #2 caml_c_call () + #3 camlUnix.sleep_ () + #4 camlExn_in_callback.fun_ () + #5 camlStdlib__Domain.body_ () + #6 caml_start_program () + #7 caml_callback_exn () + #8 caml_callback () + #9 domain_thread_func () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlExn_in_callback.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + +SUMMARY: ThreadSanitizer: data race (:) in camlExn_in_callback.fun_ +================== +ThreadSanitizer: reported 1 warnings diff --git a/testsuite/tests/tsan/exn_in_callback.run b/testsuite/tests/tsan/exn_in_callback.run new file mode 100644 index 0000000000..e96b5ea13a --- /dev/null +++ b/testsuite/tests/tsan/exn_in_callback.run @@ -0,0 +1,4 @@ +#!/bin/sh + +${program} 2>&1 \ + | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/tsan/exn_reraise.ml b/testsuite/tests/tsan/exn_reraise.ml new file mode 100644 index 0000000000..c5cd04a259 --- /dev/null +++ b/testsuite/tests/tsan/exn_reraise.ml @@ -0,0 +1,50 @@ +(* TEST + +* tsan +** native + +ocamlopt_flags = "-g -ccopt -fsanitize=thread -ccopt -O1 -ccopt -fno-omit-frame-pointer -ccopt -g" +include unix +set TSAN_OPTIONS="detect_deadlocks=0" + +*) +exception ExnA +exception ExnB + +open Printf + +let r = ref 0 + +let [@inline never] race () = ignore @@ !r + +let [@inline never] i () = + printf "entering i\n%!"; + printf "throwing Exn...\n%!"; + ignore (raise ExnA); + printf "leaving i\n%!" + +let [@inline never] h () = + printf "entering h\n%!"; + try i () with + | ExnB -> printf "caught an ExnB\n%!"; + printf "leaving h\n%!" + +let [@inline never] g () = + printf "entering g\n%!"; + h (); + printf "leaving g\n%!" + +let [@inline never] f () = + printf "entering f\n%!"; + (try g () with + | ExnA -> + printf "caught an ExnA\n%!"; + Printexc.print_backtrace stdout; + race ()); + printf "leaving f\n%!" + +let () = + Printexc.record_backtrace true; + let d = Domain.spawn (fun () -> Unix.sleep 1; r := 1) in + f (); Unix.sleep 1; + Domain.join d diff --git a/testsuite/tests/tsan/exn_reraise.reference b/testsuite/tests/tsan/exn_reraise.reference new file mode 100644 index 0000000000..fe91f8da3f --- /dev/null +++ b/testsuite/tests/tsan/exn_reraise.reference @@ -0,0 +1,84 @@ +entering f +entering g +entering h +entering i +throwing Exn... +caught an ExnA +Raised at Exn_reraise.i in file "exn_reraise.ml", line 23, characters 9-21 +Called from Exn_reraise.h in file "exn_reraise.ml", line 28, characters 6-10 +Called from Exn_reraise.g in file "exn_reraise.ml", line 34, characters 2-6 +Called from Exn_reraise.f in file "exn_reraise.ml", line 39, characters 7-11 +leaving f +================== +WARNING: ThreadSanitizer: data race (pid=) + Write of size 8 at by thread T1 (mutexes: write M): + #0 camlExn_reraise.fun_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + Previous read of size 8 at by main thread (mutexes: write M): + #0 camlExn_reraise.race_ () + #1 camlExn_reraise.f_ () + #2 camlExn_reraise.entry () + #3 caml_program () + #4 caml_start_program () + #5 caml_startup_common () + #6 caml_startup_exn () + #7 caml_startup () + #8 caml_main () + #9 main () + + As if synchronized via sleep: + #0 nanosleep () + #1 caml_unix_sleep () + #2 caml_c_call () + #3 camlUnix.sleep_ () + #4 camlExn_reraise.fun_ () + #5 camlStdlib__Domain.body_ () + #6 caml_start_program () + #7 caml_callback_exn () + #8 caml_callback () + #9 domain_thread_func () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlExn_reraise.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + +SUMMARY: ThreadSanitizer: data race (:) in camlExn_reraise.fun_ +================== +ThreadSanitizer: reported 1 warnings diff --git a/testsuite/tests/tsan/exn_reraise.run b/testsuite/tests/tsan/exn_reraise.run new file mode 100644 index 0000000000..e96b5ea13a --- /dev/null +++ b/testsuite/tests/tsan/exn_reraise.run @@ -0,0 +1,4 @@ +#!/bin/sh + +${program} 2>&1 \ + | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/tsan/filter-locations.sh b/testsuite/tests/tsan/filter-locations.sh new file mode 100755 index 0000000000..c1368c523d --- /dev/null +++ b/testsuite/tests/tsan/filter-locations.sh @@ -0,0 +1,36 @@ +#!/bin/sh +set -eu + +# - Remove mangling of functions (NOTE: functions of the same name, or +# anonymous functions, become indistinguishable) and replace it with +# '' +# - Replace file+hexadecimal locations with '' +# - Replace mutex IDs like 'M87' with 'M' +# - Replace the complete path of the program by '/' followed by +# the program filename. +script='s/pid=[0-9]\+/pid=/ +s/tid=[0-9]\+/tid=/ + +/\([Rr]ead\|[Ww]rite\) of size/ { + s/of size \([0-9]\+\) at 0x[0-9a-f]\+/of size \1 at / +} + +/Mutex M.* created at:/ { + s/M\([0-9]\+\) (0x[0-9a-f]\+)/M\1 ()/ +} + +/#[0-9]\+/ { + s/\(#[0-9]\+\) \([^ ]*\) [^ ]*\( (discriminator [0-9]\+)\)\? (\([^ ]*\))/\1 \2 (\4)/ + s/\(caml[a-zA-Z_0-9]\+\.[a-zA-Z_0-9]\+\)_[[:digit:]]\+/\1_/ + s/(\(.\+\)+0x[0-9a-f]\+)/()/ +} + +s/ M[0-9]\+/ M/ + +/SUMMARY/ { + s/data race (.*\/\(.\+\)+0x[0-9a-f]\+) in /data race (:) in / + s/data race .\+:[[:digit:]?]\+ in /data race (:) in / + s/\(caml[a-zA-Z_0-9]\+\.[a-zA-Z_0-9]\+\)_[[:digit:]]\+/\1_/ +}' + +sed -e "${script}" diff --git a/testsuite/tests/tsan/handlers_at_tail.ml b/testsuite/tests/tsan/handlers_at_tail.ml new file mode 100644 index 0000000000..4b06700802 --- /dev/null +++ b/testsuite/tests/tsan/handlers_at_tail.ml @@ -0,0 +1,26 @@ +(* TEST + +* tsan +** native + +ocamlopt_flags = "-g" +set TSAN_OPTIONS="detect_deadlocks=0" + +*) + +(* This is a regression test for a bug that incorrectly instrumented two nested + try...with expressions, by treating the innermost exception handler as being + in tail position, and thus inserting a redundant call to [__tsan_func_exit] + before the call to [g], causing TSan's shadow stack to underflow after a few + iterations. *) + +let g () = raise Exit [@@inline never] + +let rec f n = + try + try + if n >= 1000 then () else g () + with Exit -> g () (* Innermost handler *) + with Exit -> f (n+1) + +let () = f 1 diff --git a/testsuite/tests/tsan/norace_atomics.ml b/testsuite/tests/tsan/norace_atomics.ml new file mode 100644 index 0000000000..9c6356cb7f --- /dev/null +++ b/testsuite/tests/tsan/norace_atomics.ml @@ -0,0 +1,18 @@ +(* TEST + +* tsan +** native + +include unix +set TSAN_OPTIONS="detect_deadlocks=0" + +*) + +let v = Atomic.make 0 + +let () = + let t1 = Domain.spawn (fun () -> Atomic.set v 10; Unix.sleep 1) in + let t2 = Domain.spawn (fun () -> + ignore (Sys.opaque_identity (Atomic.get v)); Unix.sleep 1) in + Domain.join t1; + Domain.join t2 diff --git a/testsuite/tests/tsan/perform.ml b/testsuite/tests/tsan/perform.ml new file mode 100644 index 0000000000..ff6e8a2484 --- /dev/null +++ b/testsuite/tests/tsan/perform.ml @@ -0,0 +1,86 @@ +(* TEST + +* tsan +** native + +ocamlopt_flags = "-g" +include unix +set TSAN_OPTIONS="detect_deadlocks=0" + +*) + +(* This performs two effects. We trigger race reports in order to check + correctness of the backtrace in three places: + - In the effect handler after performing once; + - After resuming; + - In the value handler when the computation returned. *) +open Printf +open Effect +open Effect.Deep + +type _ Effect.t += E : int -> int t + +let g_ref1 = ref 0 +let g_ref2 = ref 0 +let g_ref3 = ref 0 + +let [@inline never] race = + function + | 0 -> g_ref1 := 42 + | 1 -> g_ref2 := 42 + | _ -> g_ref3 := 42 + +let [@inline never] h () = + print_endline "entering h and perform-ing"; + let v = perform (E 0) in + print_endline "resuming h"; + race 0; + print_endline "leaving h"; + v + +let [@inline never] g () = + print_endline "entering g"; + let v = h () in + print_endline "leaving g"; + v + +let [@inline never] f () = + print_endline "computation, entering f"; + let v = g () in + print_endline "computation, leaving f"; + v + 1 + +let effh : type a. a t -> ((a, 'b) continuation -> 'b) option = function + | E v -> Some (fun k -> + print_endline "in the effect handler"; + race 1; + let v = continue k (v + 1) in + print_endline "handler after continue"; + v + 1 + ) + | e -> None + +let[@inline never] main () = + print_endline "Let's work!"; + ignore ( + match_with f () + { retc = (fun v -> + print_endline "value handler"; + race 2; + v + 1 + ); + exnc = (fun e -> raise e); + effc = effh } + ); + 44 + +let[@inline never] other_domain () = + ignore (Sys.opaque_identity (!g_ref1, !g_ref2, !g_ref3)); + Unix.sleepf 0.66 + +let () = + let d = Domain.spawn other_domain in + Unix.sleepf 0.33; + let v = main () in + printf "result = %d\n" v; + Domain.join d diff --git a/testsuite/tests/tsan/perform.reference b/testsuite/tests/tsan/perform.reference new file mode 100644 index 0000000000..3fd49c9427 --- /dev/null +++ b/testsuite/tests/tsan/perform.reference @@ -0,0 +1,240 @@ +Let's work! +computation, entering f +entering g +entering h and perform-ing +in the effect handler +================== +WARNING: ThreadSanitizer: data race (pid=) + Write of size 8 at by main thread (mutexes: write M): + #0 camlPerform.race_ () + #1 camlPerform.fun_ () + #2 camlPerform.main_ () + #3 camlPerform.entry () + #4 caml_program () + #5 caml_start_program () + #6 caml_startup_common () + #7 caml_startup_exn () + #8 caml_startup () + #9 caml_main () + #10 main () + + Previous read of size 8 at by thread T1 (mutexes: write M): + #0 camlPerform.other_domain_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + As if synchronized via sleep: + #0 nanosleep () + #1 caml_unix_sleep () + #2 caml_c_call () + #3 camlPerform.entry () + #4 caml_program () + #5 caml_start_program () + #6 caml_startup_common () + #7 caml_startup_exn () + #8 caml_startup () + #9 caml_main () + #10 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlPerform.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + +SUMMARY: ThreadSanitizer: data race (:) in camlPerform.race_ +================== +resuming h +================== +WARNING: ThreadSanitizer: data race (pid=) + Write of size 8 at by main thread (mutexes: write M): + #0 camlPerform.race_ () + #1 camlPerform.h_ () + #2 camlPerform.g_ () + #3 camlPerform.f_ () + #4 caml_runstack () + #5 camlPerform.fun_ () + #6 camlPerform.main_ () + #7 camlPerform.entry () + #8 caml_program () + #9 caml_start_program () + #10 caml_startup_common () + #11 caml_startup_exn () + #12 caml_startup () + #13 caml_main () + #14 main () + + Previous read of size 8 at by thread T1 (mutexes: write M): + #0 camlPerform.other_domain_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + As if synchronized via sleep: + #0 nanosleep () + #1 caml_unix_sleep () + #2 caml_c_call () + #3 camlPerform.entry () + #4 caml_program () + #5 caml_start_program () + #6 caml_startup_common () + #7 caml_startup_exn () + #8 caml_startup () + #9 caml_main () + #10 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlPerform.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + +SUMMARY: ThreadSanitizer: data race (:) in camlPerform.race_ +================== +leaving h +leaving g +computation, leaving f +value handler +================== +WARNING: ThreadSanitizer: data race (pid=) + Write of size 8 at by main thread (mutexes: write M): + #0 camlPerform.race_ () + #1 camlPerform.fun_ () + #2 camlPerform.fun_ () + #3 camlPerform.main_ () + #4 camlPerform.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + + Previous read of size 8 at by thread T1 (mutexes: write M): + #0 camlPerform.other_domain_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + As if synchronized via sleep: + #0 nanosleep () + #1 caml_unix_sleep () + #2 caml_c_call () + #3 camlPerform.entry () + #4 caml_program () + #5 caml_start_program () + #6 caml_startup_common () + #7 caml_startup_exn () + #8 caml_startup () + #9 caml_main () + #10 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlPerform.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + +SUMMARY: ThreadSanitizer: data race (:) in camlPerform.race_ +================== +handler after continue +result = 44 +ThreadSanitizer: reported 3 warnings diff --git a/testsuite/tests/tsan/perform.run b/testsuite/tests/tsan/perform.run new file mode 100644 index 0000000000..e96b5ea13a --- /dev/null +++ b/testsuite/tests/tsan/perform.run @@ -0,0 +1,4 @@ +#!/bin/sh + +${program} 2>&1 \ + | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/tsan/raise_through_handler.ml b/testsuite/tests/tsan/raise_through_handler.ml new file mode 100644 index 0000000000..798a2f11c0 --- /dev/null +++ b/testsuite/tests/tsan/raise_through_handler.ml @@ -0,0 +1,59 @@ +(* TEST + +* tsan +** native + +ocamlopt_flags = "-g" +include unix +set TSAN_OPTIONS="detect_deadlocks=0" + +*) + +open Printf +open Effect +open Effect.Deep + +let g_ref = ref 0 + +let [@inline never] race () = + g_ref := 42 + +let [@inline never] g () = + print_endline "entering g"; + ignore @@ raise Exit; + print_endline "leaving g"; + 12 + +let [@inline never] f () = + print_endline "computation, entering f"; + let v = g () in + print_endline "computation, leaving f"; + v + 1 + +let effh : type a. a t -> ((a, 'b) continuation -> 'b) option = fun _ -> None + +let[@inline never] main () = + print_endline "Let's work!"; + (try + ignore ( + match_with f () + { retc = (fun v -> v + 1); + exnc = (fun e -> raise e); + effc = effh } + ) + with Exit -> + print_endline "In exception handler"; + race (); + ); + 44 + +let[@inline never] other_domain () = + ignore (Sys.opaque_identity !g_ref); + Unix.sleepf 0.66 + +let () = + let d = Domain.spawn other_domain in + Unix.sleepf 0.33; + let v = main () in + printf "result = %d\n" v; + Domain.join d diff --git a/testsuite/tests/tsan/raise_through_handler.reference b/testsuite/tests/tsan/raise_through_handler.reference new file mode 100644 index 0000000000..cc8bd49a3e --- /dev/null +++ b/testsuite/tests/tsan/raise_through_handler.reference @@ -0,0 +1,79 @@ +Let's work! +computation, entering f +entering g +In exception handler +================== +WARNING: ThreadSanitizer: data race (pid=) + Write of size 8 at by main thread (mutexes: write M): + #0 camlRaise_through_handler.race_ () + #1 camlRaise_through_handler.main_ () + #2 camlRaise_through_handler.entry () + #3 caml_program () + #4 caml_start_program () + #5 caml_startup_common () + #6 caml_startup_exn () + #7 caml_startup () + #8 caml_main () + #9 main () + + Previous read of size 8 at by thread T1 (mutexes: write M): + #0 camlRaise_through_handler.other_domain_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + As if synchronized via sleep: + #0 nanosleep () + #1 caml_unix_sleep () + #2 caml_c_call () + #3 camlRaise_through_handler.entry () + #4 caml_program () + #5 caml_start_program () + #6 caml_startup_common () + #7 caml_startup_exn () + #8 caml_startup () + #9 caml_main () + #10 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlRaise_through_handler.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + +SUMMARY: ThreadSanitizer: data race (:) in camlRaise_through_handler.race_ +================== +result = 44 +ThreadSanitizer: reported 1 warnings diff --git a/testsuite/tests/tsan/raise_through_handler.run b/testsuite/tests/tsan/raise_through_handler.run new file mode 100644 index 0000000000..e96b5ea13a --- /dev/null +++ b/testsuite/tests/tsan/raise_through_handler.run @@ -0,0 +1,4 @@ +#!/bin/sh + +${program} 2>&1 \ + | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/tsan/record_field.ml b/testsuite/tests/tsan/record_field.ml new file mode 100644 index 0000000000..04a54485b9 --- /dev/null +++ b/testsuite/tests/tsan/record_field.ml @@ -0,0 +1,18 @@ +(* TEST + +* tsan +** native + +include unix +set TSAN_OPTIONS="detect_deadlocks=0" + +*) +type t = { mutable x : int } + +let v = { x = 0 } + +let () = + let t1 = Domain.spawn (fun () -> v.x <- 10; Unix.sleepf 0.1) in + let t2 = Domain.spawn (fun () -> ignore (Sys.opaque_identity v.x); Unix.sleepf 0.1) in + Domain.join t1; + Domain.join t2 diff --git a/testsuite/tests/tsan/record_field.reference b/testsuite/tests/tsan/record_field.reference new file mode 100644 index 0000000000..13892fa24a --- /dev/null +++ b/testsuite/tests/tsan/record_field.reference @@ -0,0 +1,71 @@ +================== +WARNING: ThreadSanitizer: data race (pid=) + Read of size 8 at by thread T4 (mutexes: write M): + #0 camlRecord_field.fun_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + Previous write of size 8 at by thread T1 (mutexes: write M): + #0 camlRecord_field.fun_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Thread T4 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlRecord_field.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlRecord_field.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + +SUMMARY: ThreadSanitizer: data race (:) in camlRecord_field.fun_ +================== +ThreadSanitizer: reported 1 warnings diff --git a/testsuite/tests/tsan/record_field.run b/testsuite/tests/tsan/record_field.run new file mode 100644 index 0000000000..e96b5ea13a --- /dev/null +++ b/testsuite/tests/tsan/record_field.run @@ -0,0 +1,4 @@ +#!/bin/sh + +${program} 2>&1 \ + | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/tsan/reperform.ml b/testsuite/tests/tsan/reperform.ml new file mode 100644 index 0000000000..59cdd913a3 --- /dev/null +++ b/testsuite/tests/tsan/reperform.ml @@ -0,0 +1,101 @@ +(* TEST + +* tsan +** native + +ocamlopt_flags = "-g" +include unix +set TSAN_OPTIONS="detect_deadlocks=0" + +*) + +(* This performs two effects. We trigger race reports in order to check + correctness of the backtrace in three places: + - In the outer effect handler after a perform and a reperform; + - After resuming, back in the deepest computation; + - After the outermost Effect.match_with has completed. *) +open Printf +open Effect +open Effect.Deep + +let print_endline s = Stdlib.print_endline s; flush stdout + +type _ t += E1 : int -> int t +type _ t += E2 : int -> int t + +let g_ref1 = ref 0 +let g_ref2 = ref 0 +let g_ref3 = ref 0 + +let [@inline never] race = + function + | 0 -> g_ref1 := 1 + | 1 -> g_ref2 := 1 + | _ -> g_ref3 := 1 + +let [@inline never] h () = + print_endline "entering h"; + let v = perform (E1 0) in + race 1; + print_endline "leaving h"; + v + +let [@inline never] g () = + print_endline "entering g"; + let v = h () in + print_endline "leaving g"; + v + +let f () = + print_endline "entering f"; + let v = g () in + print_endline "leaving f"; + v + 1 + +let [@inline never] fiber2 () = + ignore @@ match_with f () + { retc = Fun.id; + exnc = raise; + effc = (fun (type a) (e : a t) -> + match e with + | E2 v -> Some (fun (k : (a, _) continuation) -> + print_endline "E2 handler before continue"; + let v = continue k v in + print_endline "E2 handler after continue"; + v) + | e -> None) }; + 42 + +let effh : type a. a t -> ((a, 'b) continuation -> 'b) option = function + | E1 v -> Some (fun k -> + print_endline "E1 handler before continue"; + race 0; + let v = continue k (v + 1) in + print_endline "E1 handler after continue"; + v + 1 + ) + | e -> None + +let [@inline never] fiber1 () = + ignore @@ match_with fiber2 () + { retc = (fun v -> + print_endline "value handler"; v + 1); + exnc = (fun e -> raise e); + effc = effh }; + 1338 + +let[@inline never] main () = + let v = fiber1 () in + v + 1 + +let[@inline never] other_domain () = + ignore @@ (!g_ref1, !g_ref2, !g_ref3); + Unix.sleepf 0.66 + +let () = + let d = Domain.spawn other_domain in + Unix.sleepf 0.33; + let v = main () in + printf "result=%d\n%!" v; + race 2; + Domain.join d diff --git a/testsuite/tests/tsan/reperform.reference b/testsuite/tests/tsan/reperform.reference new file mode 100644 index 0000000000..f2f7c0ba83 --- /dev/null +++ b/testsuite/tests/tsan/reperform.reference @@ -0,0 +1,239 @@ +entering f +entering g +entering h +E1 handler before continue +================== +WARNING: ThreadSanitizer: data race (pid=) + Write of size 8 at by main thread (mutexes: write M): + #0 camlReperform.race_ () + #1 camlReperform.fun_ () + #2 camlReperform.fiber1_ () + #3 camlReperform.main_ () + #4 camlReperform.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + + Previous read of size 8 at by thread T1 (mutexes: write M): + #0 camlReperform.other_domain_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + As if synchronized via sleep: + #0 nanosleep () + #1 caml_unix_sleep () + #2 caml_c_call () + #3 camlReperform.entry () + #4 caml_program () + #5 caml_start_program () + #6 caml_startup_common () + #7 caml_startup_exn () + #8 caml_startup () + #9 caml_main () + #10 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlReperform.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + +SUMMARY: ThreadSanitizer: data race (:) in camlReperform.race_ +================== +================== +WARNING: ThreadSanitizer: data race (pid=) + Write of size 8 at by main thread (mutexes: write M): + #0 camlReperform.race_ () + #1 camlReperform.h_ () + #2 camlReperform.g_ () + #3 camlReperform.f_ () + #4 caml_runstack () + #5 camlReperform.fiber2_ () + #6 caml_runstack () + #7 camlReperform.fun_ () + #8 camlReperform.fiber1_ () + #9 camlReperform.main_ () + #10 camlReperform.entry () + #11 caml_program () + #12 caml_start_program () + #13 caml_startup_common () + #14 caml_startup_exn () + #15 caml_startup () + #16 caml_main () + #17 main () + + Previous read of size 8 at by thread T1 (mutexes: write M): + #0 camlReperform.other_domain_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + As if synchronized via sleep: + #0 nanosleep () + #1 caml_unix_sleep () + #2 caml_c_call () + #3 camlReperform.entry () + #4 caml_program () + #5 caml_start_program () + #6 caml_startup_common () + #7 caml_startup_exn () + #8 caml_startup () + #9 caml_main () + #10 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlReperform.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + +SUMMARY: ThreadSanitizer: data race (:) in camlReperform.race_ +================== +leaving h +leaving g +leaving f +value handler +E1 handler after continue +result=1339 +================== +WARNING: ThreadSanitizer: data race (pid=) + Write of size 8 at by main thread (mutexes: write M): + #0 camlReperform.race_ () + #1 camlReperform.entry () + #2 caml_program () + #3 caml_start_program () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Previous read of size 8 at by thread T1 (mutexes: write M): + #0 camlReperform.other_domain_ () + #1 camlStdlib__Domain.body_ () + #2 caml_start_program () + #3 caml_callback_exn () + #4 caml_callback () + #5 domain_thread_func () + + As if synchronized via sleep: + #0 nanosleep () + #1 caml_unix_sleep () + #2 caml_c_call () + #3 camlReperform.entry () + #4 caml_program () + #5 caml_start_program () + #6 caml_startup_common () + #7 caml_startup_exn () + #8 caml_startup () + #9 caml_main () + #10 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Mutex M () created at: + #0 pthread_mutex_init () + #1 caml_plat_mutex_init () + #2 caml_init_domains () + #3 caml_init_gc () + #4 caml_startup_common () + #5 caml_startup_exn () + #6 caml_startup () + #7 caml_main () + #8 main () + + Thread T1 (tid=, running) created by main thread at: + #0 pthread_create () + #1 caml_domain_spawn () + #2 caml_c_call () + #3 camlStdlib__Domain.spawn_ () + #4 camlReperform.entry () + #5 caml_program () + #6 caml_start_program () + #7 caml_startup_common () + #8 caml_startup_exn () + #9 caml_startup () + #10 caml_main () + #11 main () + +SUMMARY: ThreadSanitizer: data race (:) in camlReperform.race_ +================== +ThreadSanitizer: reported 3 warnings diff --git a/testsuite/tests/tsan/reperform.run b/testsuite/tests/tsan/reperform.run new file mode 100644 index 0000000000..e96b5ea13a --- /dev/null +++ b/testsuite/tests/tsan/reperform.run @@ -0,0 +1,4 @@ +#!/bin/sh + +${program} 2>&1 \ + | ${test_source_directory}/filter-locations.sh ${program} >${output} diff --git a/testsuite/tests/weak-ephe-final/weaktest_par_load.ml b/testsuite/tests/weak-ephe-final/weaktest_par_load.ml index f5e0711b79..3da6b7695c 100644 --- a/testsuite/tests/weak-ephe-final/weaktest_par_load.ml +++ b/testsuite/tests/weak-ephe-final/weaktest_par_load.ml @@ -1,4 +1,6 @@ -(* TEST *) +(* TEST + * no-tsan + *) (* Testing unsynchronized, parallel Weak usage *) From 0ad33b59f2110b4c82a886f84a8b9670cd3a9c2c Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Thu, 2 Mar 2023 14:55:29 +0100 Subject: [PATCH 14/16] Disable TSan reporting on parts of the runtime TSan warns about data races on these functions. We reported those warnings in #11040, and silence them to avoid facing users of TSan with data race reports that are not related to their code. This is done in two ways: either un-instrumenting those functions, or adding their name in __tsan_default_suppressions in tsan.c. Co-authored-by: Fabrice Buoro --- runtime/fiber.c | 2 ++ runtime/gc_stats.c | 3 +++ runtime/major_gc.c | 7 +++++++ runtime/minor_gc.c | 2 ++ runtime/shared_heap.c | 2 ++ 5 files changed, 16 insertions(+) diff --git a/runtime/fiber.c b/runtime/fiber.c index 52d68fbbff..e35c33e520 100644 --- a/runtime/fiber.c +++ b/runtime/fiber.c @@ -61,6 +61,8 @@ uintnat caml_get_init_stack_wsize (void) return stack_wsize; } + +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ void caml_change_max_stack_size (uintnat new_max_wsize) { struct stack_info *current_stack = Caml_state->current_stack; diff --git a/runtime/gc_stats.c b/runtime/gc_stats.c index 4435521b68..6b062d2937 100644 --- a/runtime/gc_stats.c +++ b/runtime/gc_stats.c @@ -23,6 +23,7 @@ Caml_inline intnat intnat_max(intnat a, intnat b) { return (a > b ? a : b); } +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ void caml_accum_heap_stats(struct heap_stats* acc, const struct heap_stats* h) { acc->pool_words += h->pool_words; @@ -47,6 +48,7 @@ void caml_remove_heap_stats(struct heap_stats* acc, const struct heap_stats* h) acc->large_blocks -= h->large_blocks; } +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ void caml_accum_alloc_stats( struct alloc_stats* acc, const struct alloc_stats* s) @@ -122,6 +124,7 @@ void caml_clear_gc_stats_sample(caml_domain_state *domain) { memset(stats, 0, sizeof(*stats)); } +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ /* Compute global stats for the whole runtime. */ void caml_compute_gc_stats(struct gc_stats* buf) { diff --git a/runtime/major_gc.c b/runtime/major_gc.c index 3ed9bba0a8..d9335c21a6 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -276,6 +276,7 @@ void caml_final_domain_terminate (caml_domain_state *domain_state) } } +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ static int no_orphaned_work (void) { return @@ -323,6 +324,7 @@ static void orph_ephe_list_verify_status (int status) static intnat ephe_mark (intnat budget, uintnat for_cycle, int force_alive); +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ void caml_add_to_orphaned_ephe_list(struct caml_ephe_info* ephe_info) { caml_plat_lock(&orphaned_lock); @@ -352,6 +354,7 @@ void caml_add_to_orphaned_ephe_list(struct caml_ephe_info* ephe_info) } } +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ void caml_adopt_orphaned_work (void) { caml_domain_state* domain_state = Caml_state; @@ -689,6 +692,7 @@ static void realloc_mark_stack (struct mark_stack* stk) mark_stack_prune(stk); } +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ Caml_inline void mark_stack_push_range(struct mark_stack* stk, value* start, value* end) { @@ -702,6 +706,7 @@ Caml_inline void mark_stack_push_range(struct mark_stack* stk, me->end = end; } +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ /* returns the work done by skipping unmarkable objects */ static intnat mark_stack_push_block(struct mark_stack* stk, value block) { @@ -772,6 +777,7 @@ void caml_shrink_mark_stack (void) void caml_darken_cont(value cont); +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ static void mark_slice_darken(struct mark_stack* stk, value child, intnat* work) { @@ -816,6 +822,7 @@ static void mark_slice_darken(struct mark_stack* stk, value child, } } +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ Caml_noinline static intnat do_some_marking(struct mark_stack* stk, intnat budget) { prefetch_buffer_t pb = { .enqueued = 0, .dequeued = 0, diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index 55476b9026..d063f9f518 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -185,6 +185,7 @@ header_t caml_get_header_val(value v) { } +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ static int try_update_object_header(value v, volatile value *p, value result, mlsize_t infix_offset) { int success = 0; @@ -232,6 +233,7 @@ static int try_update_object_header(value v, volatile value *p, value result, static scanning_action_flags oldify_scanning_flags = SCANNING_ONLY_YOUNG_VALUES; +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ /* Note that the tests on the tag depend on the fact that Infix_tag, Forward_tag, and No_scan_tag are contiguous. */ static void oldify_one (void* st_v, value v, volatile value *p) diff --git a/runtime/shared_heap.c b/runtime/shared_heap.c index 0859801a01..5e6568dc55 100644 --- a/runtime/shared_heap.c +++ b/runtime/shared_heap.c @@ -263,6 +263,7 @@ static intnat pool_sweep(struct caml_heap_state* local, /* Adopt pool from the pool_freelist avail and full pools to satisfy an allocation */ +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ static pool* pool_global_adopt(struct caml_heap_state* local, sizeclass sz) { pool* r = NULL; @@ -512,6 +513,7 @@ static intnat pool_sweep(struct caml_heap_state* local, pool** plist, return work; } +CAMLno_user_tsan /* Disable TSan reports from this function (see #11040) */ static intnat large_alloc_sweep(struct caml_heap_state* local) { value* p; header_t hd; From 985d6b4a639e5db739a88886b8c2568c5494164f Mon Sep 17 00:00:00 2001 From: Fabrice Buoro Date: Thu, 2 Mar 2023 14:22:59 +0100 Subject: [PATCH 15/16] Disable some TSan instrumentation for performance The functions that we un-instrumentation are called often but should not contain data races with user code. Co-authored-by: Olivier Nicole --- runtime/caml/mlvalues.h | 7 +++++-- runtime/interp.c | 2 ++ runtime/minor_gc.c | 2 ++ runtime/shared_heap.c | 1 + runtime/str.c | 1 + 5 files changed, 11 insertions(+), 2 deletions(-) diff --git a/runtime/caml/mlvalues.h b/runtime/caml/mlvalues.h index 8332d1fe7f..448232680f 100644 --- a/runtime/caml/mlvalues.h +++ b/runtime/caml/mlvalues.h @@ -193,8 +193,11 @@ where 0 <= R <= 31 is HEADER_RESERVED_BITS, set with the #endif #define Hp_atomic_val(val) ((atomic_uintnat *)(val) - 1) -#define Hd_val(val) ((header_t) \ - (atomic_load_explicit(Hp_atomic_val(val), memory_order_relaxed))) +CAMLno_user_tsan /* Disable TSan instrumentation for performance. */ +Caml_inline header_t Hd_val(value val) +{ + return atomic_load_explicit(Hp_atomic_val(val), memory_order_relaxed); +} #define Color_val(val) (Color_hd (Hd_val (val))) diff --git a/runtime/interp.c b/runtime/interp.c index d206d87822..5f47101d3c 100644 --- a/runtime/interp.c +++ b/runtime/interp.c @@ -244,6 +244,8 @@ static value raise_unhandled_effect; /* The interpreter itself */ +CAMLno_user_tsan /* No need to TSan-instrument this (and pay a slowdown) + function as TSan is not supported for bytecode. */ value caml_interprete(code_t prog, asize_t prog_size) { #ifdef PC_REG diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index d063f9f518..8bfe6dd70e 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -171,6 +171,7 @@ static void spin_on_header(value v) { } } +CAMLno_user_tsan /* Disable TSan instrumentation for performance. */ Caml_inline header_t get_header_val(value v) { header_t hd = atomic_load_explicit(Hp_atomic_val(v), memory_order_acquire); if (!Is_update_in_progress(hd)) @@ -381,6 +382,7 @@ static void oldify_one (void* st_v, value v, volatile value *p) Note that [oldify_one] itself is called by oldify_mopup, so we have to be careful to remove the first entry from the list before oldifying its fields. */ +CAMLno_user_tsan /* Disable TSan instrumentation for performance. */ static void oldify_mopup (struct oldify_state* st, int do_ephemerons) { value v, new_v, f; diff --git a/runtime/shared_heap.c b/runtime/shared_heap.c index 5e6568dc55..b7ae0b66d3 100644 --- a/runtime/shared_heap.c +++ b/runtime/shared_heap.c @@ -256,6 +256,7 @@ Caml_inline void pool_initialize(pool* r, } /* Allocating an object from a pool */ +CAMLno_user_tsan /* Disable TSan instrumentation for performance. */ static intnat pool_sweep(struct caml_heap_state* local, pool**, sizeclass sz , diff --git a/runtime/str.c b/runtime/str.c index 32ca54c7a5..fc9cee585e 100644 --- a/runtime/str.c +++ b/runtime/str.c @@ -268,6 +268,7 @@ CAMLprim value caml_bytes_set64(value str, value index, value newval) return Val_unit; } +CAMLno_user_tsan /* Disable TSan instrumentation for performance. */ CAMLprim value caml_string_equal(value s1, value s2) { mlsize_t sz1, sz2; From 0760b24e47e2a98b2cbf8a5508b0b126cb07d8fd Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Thu, 16 Mar 2023 14:23:26 +0100 Subject: [PATCH 16/16] Add Changes entry --- Changes | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Changes b/Changes index e3c7d0e368..cb7a324a5e 100644 --- a/Changes +++ b/Changes @@ -27,6 +27,10 @@ Working version functor leads to new warning 73. (Frederic Bour and Richard Eisenberg, review by Florian Angeletti) +- #12114: Add ThreadSanitizer support + (Fabrice Buoro and Olivier Nicole, based on an initial work by Anmol Sahoo, + review by ???) + ### Runtime system: - #12001: Fix book keeping for last finalisers during the minor cycle