[Git][ghc/ghc][wip/dtrace] 3 commits: hadrian: support building dtrace probes
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Dec 8 14:56:11 UTC 2023
Ben Gamari pushed to branch wip/dtrace at Glasgow Haskell Compiler / GHC
Commits:
c6f16ce1 by Ben Gamari at 2023-12-08T09:39:25-05:00
hadrian: support building dtrace probes
This fixes DTrace support in the RTS, implements support in Hadrian, and
introduces support on Linux platforms via SystemTap.
Fixes #18133.
Co-Authored-By: Doug Wilson
Co-Authored-By: @adamse
- - - - -
3755f841 by Ben Gamari at 2023-12-08T09:41:20-05:00
configure: check for ld.gold bug 27775 and disable DTrace probes for linux in CI
- - - - -
cb6aa2f9 by Douglas Wilson at 2023-12-08T09:41:20-05:00
tests: Add a test for dtrace probe points
- - - - -
16 changed files:
- configure.ac
- hadrian/cfg/system.config.in
- hadrian/src/Builder.hs
- hadrian/src/Expression.hs
- hadrian/src/Oracles/Flag.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Rts.hs
- hadrian/src/Settings/Packages.hs
- + m4/check_for_gold_t27775.m4
- rts/RtsProbes.d
- + testsuite/tests/rts/Dtrace.hs
- testsuite/tests/rts/Makefile
- testsuite/tests/rts/all.T
- + testsuite/tests/rts/dtrace.sh
- + testsuite/tests/rts/dtrace.stdout
Changes:
=====================================
configure.ac
=====================================
@@ -752,7 +752,7 @@ AC_PATH_PROGS(PatchCmd,gpatch patch, patch)
dnl ** check for autoreconf
AC_PATH_PROG(AutoreconfCmd, autoreconf, autoreconf)
-dnl ** check for dtrace (currently only implemented for Mac OS X)
+dnl ** check for dtrace
AC_ARG_ENABLE(dtrace,
[AS_HELP_STRING([--enable-dtrace],
[Enable DTrace])],
@@ -763,17 +763,51 @@ AC_ARG_ENABLE(dtrace,
HaveDtrace=NO
AC_PATH_PROG(DtraceCmd,dtrace)
+
if test "x$EnableDtrace" = "xyes"; then
if test -n "$DtraceCmd"; then
if test "x$TargetOS_CPP-$TargetVendor_CPP" = "xdarwin-apple" \
-o "x$TargetOS_CPP-$TargetVendor_CPP" = "xfreebsd-portbld" \
+ -o "x$TargetOS_CPP-$TargetVendor_CPP" = "xlinux-unknown" \
-o "x$TargetOS_CPP-$TargetVendor_CPP" = "xsolaris2-unknown"; then
HaveDtrace=YES
fi
fi
fi
+
+if test "x$EnableDtrace" = "xyes" \
+ -a "x$HaveDtrace" = "xYES" \
+ -a "x$TargetOS_CPP-$TargetVendor_CPP" = "xlinux-unknown"; then
+ CHECK_FOR_GOLD_T27775([$LD])
+ if test "$result" = "1"; then
+ AC_MSG_WARN([ld.gold is affected by binutils bug 27775. The RTS dtrace probes will not work with statically linked executables. Use a different linker if you need this.])
+ fi
+fi
+
AC_SUBST(HaveDtrace)
+dnl ** check for libsystemtap
+
+AC_ARG_WITH([libsystemtap-includes],
+ [AC_HELP_STRING([--with-libsystemtap-includes=ARG],
+ [Find includes for libsystemtap in ARG (for DTrace probes on linux) [default=system default]])],
+ [LibsystemtapIncludeDir="$withval"; LIBSYSTEMTAP_CFLAGS="-I$withval"])
+
+AC_SUBST(LibsystemtapIncludeDir)
+
+if test "x$HaveDtrace" = "xYES" \
+ -a "x$TargetOS_CPP-$TargetVendor_CPP" = "xlinux-unknown"; then
+ CFLAGS2="$CFLAGS"
+ CFLAGS="$LIBSYSTEMTAP_CFLAGS $CFLAGS"
+
+ AC_CHECK_HEADER([sys/sdt.h],
+ [],
+ [AC_MSG_ERROR([DTrace support on Linux needs sys/sdt.h header])])
+
+ CFLAGS="$CFLAGS2"
+fi
+
+
AC_PATH_PROG(HSCOLOUR,HsColour)
# HsColour is passed to Cabal, so we need a native path
if test "$HostOS" = "mingw32" && \
=====================================
hadrian/cfg/system.config.in
=====================================
@@ -24,6 +24,7 @@ makeinfo = @MAKEINFO@
bourne-shell = @SH@
git = @GIT@
cabal = @CABAL@
+dtrace = @DtraceCmd@
# Python 3 is required to run test driver.
# See: https://github.com/ghc/ghc/blob/master/testsuite/mk/boilerplate.mk#L220
@@ -116,6 +117,8 @@ libnuma-lib-dir = @LibNumaLibDir@
libzstd-include-dir = @LibZstdIncludeDir@
libzstd-lib-dir = @LibZstdLibDir@
+libsystemtap-include-dir = @LibsystemtapIncludeDir@
+
# Optional Dependencies:
#=======================
@@ -129,3 +132,4 @@ use-lib-dl = @UseLibdl@
use-lib-bfd = @UseLibbfd@
use-lib-pthread = @UseLibpthread@
need-libatomic = @NeedLibatomic@
+use-dtrace = @HaveDtrace@
=====================================
hadrian/src/Builder.hs
=====================================
@@ -4,6 +4,7 @@ module Builder (
ArMode (..), CcMode (..), ConfigurationInfo (..), DependencyType (..),
GhcMode (..), GhcPkgMode (..), HaddockMode (..), TestMode(..), SphinxMode (..),
TarMode (..), GitMode (..), Builder (..), Win32TarballsMode(..),
+ DtraceMode (..),
-- * Builder properties
builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilders,
@@ -149,7 +150,23 @@ instance Binary Win32TarballsMode
instance Hashable Win32TarballsMode
instance NFData Win32TarballsMode
+-- | Note [Dtrace probes]
+-- ~~~~~~~~~~~~~~~~~~~~~~
+--
+-- We use Dtrace to define "User statically defined tracepoints" (USDTs) for
+-- the RTS. (See @rts/RtsProbes.d@ for the probe declarations.)
+--
+-- The Dtrace compiler reads the probe declaration and produces:
+--
+-- * A header file. Contains function like C-macros that you use to place the tracepoints.
+-- * A stub object. An object file containing implementation details
+-- for the probes, must be linked with the final executable or object. Not needed for the
+-- Macos implementation of dtrace.
+data DtraceMode = DtraceHeader | DtraceStub deriving (Eq, Generic, Show)
+instance Binary DtraceMode
+instance Hashable DtraceMode
+instance NFData DtraceMode
-- | A 'Builder' is a (usually external) command invoked in a separate process
-- via 'cmd'. Here are some examples:
@@ -166,6 +183,7 @@ data Builder = Alex
| Cc CcMode Stage
| Configure FilePath
| DeriveConstants
+ | Dtrace DtraceMode
| GenApply
| GenPrimopCode
| Ghc GhcMode Stage
@@ -385,6 +403,12 @@ instance H.Builder Builder where
when (code /= ExitSuccess) $ do
fail "tests failed"
+ Dtrace mode -> do
+ let modeFlag = case mode of
+ DtraceHeader -> "-h"
+ DtraceStub -> "-G"
+ cmd' [path] buildArgs modeFlag [ "-o", output ] [ "-s", input ]
+
_ -> cmd' [path] buildArgs buildOptions
-- | Invoke @haddock@ given a path to it and a list of arguments. The arguments
@@ -425,6 +449,7 @@ systemBuilderPath builder = case builder of
Configure _ -> return "configure"
Ghc _ (Stage0 {}) -> fromKey "system-ghc"
GhcPkg _ (Stage0 {}) -> fromKey "system-ghc-pkg"
+ Dtrace _ -> fromKey "dtrace"
Happy -> fromKey "happy"
HsCpp -> fromTargetTC "hs-cpp" (Toolchain.hsCppProgram . tgtHsCPreprocessor)
Ld _ -> fromTargetTC "ld" (Toolchain.ccLinkProgram . tgtCCompilerLink)
=====================================
hadrian/src/Expression.hs
=====================================
@@ -94,6 +94,13 @@ instance BuilderPredicate a => BuilderPredicate (TestMode -> a) where
Testsuite mode -> builder (f mode)
_ -> return False
+instance BuilderPredicate a => BuilderPredicate (DtraceMode -> a) where
+ builder f = do
+ b <- getBuilder
+ case b of
+ Dtrace mode -> builder (f mode)
+ _ -> return False
+
-- | Is the current build 'Way' equal to a certain value?
way :: Way -> Predicate
way w = (w ==) <$> getWay
=====================================
hadrian/src/Oracles/Flag.hs
=====================================
@@ -28,6 +28,7 @@ data Flag = CrossCompiling
| UseSystemFfi
| BootstrapThreadedRts
| BootstrapEventLoggingRts
+ | UseDtrace
| UseLibdw
| UseLibnuma
| UseLibzstd
@@ -52,6 +53,7 @@ flag f = do
UseSystemFfi -> "use-system-ffi"
BootstrapThreadedRts -> "bootstrap-threaded-rts"
BootstrapEventLoggingRts -> "bootstrap-event-logging-rts"
+ UseDtrace -> "use-dtrace"
UseLibdw -> "use-lib-dw"
UseLibnuma -> "use-lib-numa"
UseLibzstd -> "use-lib-zstd"
=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -55,6 +55,7 @@ data Setting = CursesIncludeDir
| GmpLibDir
| IconvIncludeDir
| IconvLibDir
+ | LibsystemtapIncludeDir
| LibdwIncludeDir
| LibdwLibDir
| LibnumaIncludeDir
@@ -111,6 +112,7 @@ setting key = lookupSystemConfig $ case key of
GmpLibDir -> "gmp-lib-dir"
IconvIncludeDir -> "iconv-include-dir"
IconvLibDir -> "iconv-lib-dir"
+ LibsystemtapIncludeDir -> "libsystemtap-include-dir"
LibdwIncludeDir -> "libdw-include-dir"
LibdwLibDir -> "libdw-lib-dir"
LibnumaIncludeDir -> "libnuma-include-dir"
=====================================
hadrian/src/Rules/Library.hs
=====================================
@@ -11,6 +11,7 @@ import Expression hiding (way, package, stage)
import Oracles.ModuleFiles
import Packages
import Rules.Gmp
+import Rules.Rts (rtsDtraceProbes)
import Rules.Register
import Settings
import Target
@@ -209,6 +210,8 @@ extraObjects context
"gmp" -> gmpObjects (stage context)
_ -> return []
+ | package context == rts = rtsDtraceProbes (stage context)
+
| otherwise = return []
-- | Return all the object files to be put into the library we're building for
=====================================
hadrian/src/Rules/Rts.hs
=====================================
@@ -1,13 +1,16 @@
{-# LANGUAGE MultiWayIf #-}
-module Rules.Rts (rtsRules, needRtsLibffiTargets, needRtsSymLinks) where
+module Rules.Rts (rtsRules, needRtsLibffiTargets, needRtsSymLinks, rtsDtraceProbes) where
import qualified Data.Set as Set
+import GHC.Platform.ArchOS
import Packages (rts, rtsBuildPath, libffiBuildPath, rtsContext)
import Rules.Libffi
import Hadrian.Utilities
import Settings.Builders.Common
+import Utilities
+import Target
-- | This rule has priority 3 to override the general rule for generating shared
-- library files (see Rules.Library.libraryRules).
@@ -25,10 +28,14 @@ rtsRules = priority 3 $ do
(addRtsDummyVersion $ takeFileName rtsLibFilePath')
rtsLibFilePath'
- -- Libffi
forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do
let buildPath = root -/- buildDir (rtsContext stage)
+ -- Dtrace
+ buildPath -/- "include" -/- "RtsProbes.h" %> buildRtsDtraceProbes stage DtraceHeader
+ buildPath -/- "RtsProbes.o" %> buildRtsDtraceProbes stage DtraceStub
+
+ -- Libffi
-- Header files
-- See Note [Packaging libffi headers] in GHC.Driver.CodeOutput.
forM_ libffiHeaderFiles $ \header ->
@@ -42,6 +49,40 @@ rtsRules = priority 3 $ do
buildPath -/- "libffi*.so*" %> copyLibffiDynamicUnix stage ".so"
buildPath -/- "libffi*.dll*" %> copyLibffiDynamicWin stage
+buildRtsDtraceProbes :: Stage -> DtraceMode -> FilePath -> Action ()
+buildRtsDtraceProbes stage what out =
+ build (target (rtsContext stage) (Dtrace what) ["rts/RtsProbes.d"] [out])
+
+-- | see Note [Dtrace probes] in @src/Builder.hs at .
+rtsDtraceProbes :: Stage -> Action [FilePath]
+rtsDtraceProbes stage = do
+ withDtrace <- flag UseDtrace
+ osRequiresStub <- anyTargetOs [OSLinux, OSSolaris2, OSFreeBSD]
+ buildPath <- rtsBuildPath stage
+
+ need (map
+ (buildPath -/-)
+ ["include/ghcautoconf.h", "include/ghcplatform.h"])
+
+ header <-
+ if withDtrace
+ then do
+ let out = buildPath -/- "include/RtsProbes.h"
+ return [out]
+ else return []
+
+ obj <-
+ if withDtrace && osRequiresStub
+ then do
+ let obj = buildPath -/- "RtsProbes.o"
+ return [obj]
+ else return []
+
+ -- we build both the header and the obj, but we only link the obj into the
+ -- rts library
+ need (header ++ obj)
+ return obj
+
withLibffi :: Stage -> (FilePath -> FilePath -> Action a) -> Action a
withLibffi stage action = needLibffi stage
>> (join $ action <$> libffiBuildPath stage
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -298,12 +298,13 @@ rtsPackageArgs = package rts ? do
libnumaLibraryDir <- getSetting LibnumaLibDir
libzstdIncludeDir <- getSetting LibZstdIncludeDir
libzstdLibraryDir <- getSetting LibZstdLibDir
-
+ libsystemtapIncludeDir <- getSetting LibsystemtapIncludeDir
-- Arguments passed to GHC when compiling C and .cmm sources.
let ghcArgs = mconcat
[ arg "-Irts"
, arg $ "-I" ++ path
+ , flag UseDtrace ? arg "-DDTRACE"
, way `elem` [debug, debugDynamic] ? pure [ "-DTICKY_TICKY"
, "-optc-DTICKY_TICKY"]
, Profiling `wayUnit` way ? arg "-DPROFILING"
@@ -311,9 +312,25 @@ rtsPackageArgs = package rts ? do
, notM targetSupportsSMP ? arg "-optc-DNOSMP"
]
+ let includes = fmap (fmap ("-I" ++)) $ mconcat
+ [ flag UseSystemFfi ? arg ffiIncludeDir
+ , flag UseLibdw ? arg libdwIncludeDir
+ , arg "rts"
+ , arg path
+ , if not (null libsystemtapIncludeDir) then arg libsystemtapIncludeDir else mempty
+ ]
+
+ let dtraceArgs = mconcat
+ [ arg "-C" -- runs the preprocessor
+ , arg "-Irts"
+ , arg ("-I" <> (path </> "include"))
+ , arg "-Irts/include"
+ ]
+
let cArgs = mconcat
[ rtsWarnings
, wayCcArgs
+ , flag UseDtrace ? arg "-DDTRACE"
, arg "-fomit-frame-pointer"
-- RTS *must* be compiled with optimisations. The INLINE_HEADER macro
-- requires that functions are inlined to work as expected. Inlining
@@ -362,7 +379,7 @@ rtsPackageArgs = package rts ? do
, "-DRtsWay=\"rts_" ++ show way ++ "\""
]
- -- We're after pur performance here. So make sure fast math and
+ -- We're after pure performance here. So make sure fast math and
-- vectorization is enabled.
, input "**/Hash.c" ? pure [ "-O3" ]
@@ -431,6 +448,7 @@ rtsPackageArgs = package rts ? do
, builder (Ghc CompileCWithGhc) ? map ("-optc" ++) <$> cArgs
, builder (Ghc CompileCppWithGhc) ? map ("-optcxx" ++) <$> cArgs
, builder Ghc ? ghcArgs
+ , builder Dtrace ? dtraceArgs
, builder HsCpp ? pure
[ "-DTOP=" ++ show top ]
=====================================
m4/check_for_gold_t27775.m4
=====================================
@@ -0,0 +1,55 @@
+# CHECK_FOR_GOLD_T27775
+# ----------------------
+#
+# Test for binutils #27775.
+#
+# Uses test from
+# https://sourceware.org/bugzilla/show_bug.cgi?id=27775
+#
+# $1 = linker to test
+# Sets $result to 0 if not affected, 1 otherwise
+AC_DEFUN([CHECK_FOR_GOLD_T27775],[
+ AC_REQUIRE([FIND_LD])
+ AC_MSG_CHECKING([for ld.gold gc-sections with note section bug (binutils 27775)])
+ if ! $1 --version | grep -q "GNU gold"; then
+ # Not gold
+ result=0
+ else
+ FPTOOLS_WRITE_FILE([conftest.a.s], [
+ .section .note.stapsdt,"?","note"
+ .dc.a _.stapsdt.base
+ .section .stapsdt.base,"aG","progbits",.stapsdt.base,comdat
+ _.stapsdt.base: .space 1
+ .size _.stapsdt.base,1
+ ])
+
+ FPTOOLS_WRITE_FILE([conftest.b.s], [
+ .text
+ .global start /* Used by SH targets. */
+ start:
+ .global _start
+ _start:
+ .global __start
+ __start:
+ .global main /* Used by HPPA targets. */
+ main:
+ .dc.a 0
+ ])
+
+ $CC -c -o conftest.a.o conftest.a.s || AC_MSG_ERROR([Failed to compile test])
+ $CC -c -o conftest.b.o conftest.b.s || AC_MSG_ERROR([Failed to compile test])
+ if $1 --gc-sections -o conftest conftest.a.o conftest.b.o; then
+ AC_MSG_RESULT([not affected])
+ result=0
+ else
+ AC_MSG_RESULT([affected])
+ result=1
+ fi
+
+ rm -f conftest.a.o conftest.a.s conttest.b.o conftest.b.c conftest
+
+ if test "$result" = "1"; then
+ AC_MSG_ERROR([ld.gold suffers from bugs with dtrace probes, turn off dtrace or use another linker])
+ fi
+ fi
+])
=====================================
rts/RtsProbes.d
=====================================
@@ -58,7 +58,7 @@ provider HaskellEvent {
probe migrate__thread (EventCapNo, EventThreadID, EventCapNo);
probe thread_wakeup (EventCapNo, EventThreadID, EventCapNo);
probe create__spark__thread (EventCapNo, EventThreadID);
- probe thread__label (EventCapNo, EventThreadID, char *);
+ probe thread__label (EventCapNo, EventThreadID, char *, int);
/* GC and heap events */
probe gc__start (EventCapNo);
=====================================
testsuite/tests/rts/Dtrace.hs
=====================================
@@ -0,0 +1,10 @@
+{-# language NumericUnderscores #-}
+
+import Debug.Trace
+import Control.Concurrent
+
+main :: IO ()
+main = do
+ -- Pause for 500ms so we don't finish before bpftrace attaches
+ threadDelay 500_000
+ traceEventIO "dtrace works"
=====================================
testsuite/tests/rts/Makefile
=====================================
@@ -162,3 +162,7 @@ HSC2HS_OPTS = --cc="$(TEST_CC)" $(addprefix --cflag=,$(TEST_CC_OPTS)) --ld=$(TES
IOManager.hs: IOManager.hsc
'$(HSC2HS)' $(HSC2HS_OPTS) $<
+
+.PHONY: dtrace
+dtrace:
+ ./dtrace.sh
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -608,3 +608,5 @@ test('T23400', [], compile_and_run, ['-with-rtsopts -A8k'])
test('IOManager', [js_skip, when(arch('wasm32'), skip), when(opsys('mingw32'), skip),
pre_cmd('$MAKE -s --no-print-directory IOManager.hs')],
compile_and_run, [''])
+
+test('dtrace', [extra_files(['Dtrace.hs', 'dtrace.sh'])], makefile_test, ['dtrace'])
=====================================
testsuite/tests/rts/dtrace.sh
=====================================
@@ -0,0 +1,4 @@
+#!/usr/bin/env bash
+set -euo pipefail
+"$TEST_HC" $TEST_HC_OPTS -eventlog Dtrace.hs -v0
+./Dtrace & sudo bpftrace -q -e "usdt::HaskellEvent:user__msg { printf(\"%s\n\", str(arg1)); }" -p $!
=====================================
testsuite/tests/rts/dtrace.stdout
=====================================
@@ -0,0 +1,3 @@
+dtrace works
+
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5281d38d0f56a712adf1f0310e94abdce8c4fad...cb6aa2f9a2c5346cca431766d912aa4c9a1d68fa
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5281d38d0f56a712adf1f0310e94abdce8c4fad...cb6aa2f9a2c5346cca431766d912aa4c9a1d68fa
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231208/071b3672/attachment-0001.html>
More information about the ghc-commits
mailing list