diff --git a/.github/workflows/test-gibbon-examples.yml b/.github/workflows/test-gibbon-examples.yml index 0459afc44..3a3495fe4 100644 --- a/.github/workflows/test-gibbon-examples.yml +++ b/.github/workflows/test-gibbon-examples.yml @@ -2,8 +2,11 @@ name: Test Gibbon examples on: [ push, pull_request ] jobs: linux: - name: test-gibbon + name: test-gibbon (${{ matrix.cc }}) runs-on: ubuntu-22.04 + strategy: + matrix: + cc: [gcc, clang] steps: - name: dependencies run: | @@ -12,7 +15,7 @@ jobs: sudo apt-get update sudo add-apt-repository -y ppa:ubuntu-toolchain-r/test sudo apt update - sudo apt-get install -y libgc-dev libgmp-dev uthash-dev gcc-11 racket + sudo apt-get install -y libgc-dev libgmp-dev uthash-dev gcc-11 clang llvm racket sudo unlink /usr/bin/gcc && sudo ln -s /usr/bin/gcc-11 /usr/bin/gcc - name: ghc and cabal env: @@ -70,4 +73,4 @@ jobs: run: | export GIBBONDIR=`pwd` cd gibbon-compiler/ - cabal v2-exec -w $HC test-gibbon-examples -- -v2 + cabal v2-exec -w $HC test-gibbon-examples -- -v2 --cc=${{ matrix.cc }} diff --git a/gibbon-compiler/src/Gibbon/Compiler.hs b/gibbon-compiler/src/Gibbon/Compiler.hs index ffe89af4c..63a1ec6c5 100644 --- a/gibbon-compiler/src/Gibbon/Compiler.hs +++ b/gibbon-compiler/src/Gibbon/Compiler.hs @@ -35,10 +35,12 @@ import System.Environment import System.Exit import System.FilePath import System.IO -import System.IO.Error (isDoesNotExistError) +import System.IO.Error (isDoesNotExistError, catchIOError) import System.Process import Text.PrettyPrint.GenericPretty +import Data.List (isInfixOf, stripPrefix) +import Data.Char (isDigit, isSpace) import Gibbon.Common import Gibbon.DynFlags import Gibbon.Language @@ -369,10 +371,30 @@ withPrintInterpProg l0 = return Nothing compileRTS :: Config -> IO () -compileRTS Config{verbosity,optc,dynflags} = do +compileRTS Config{verbosity,optc,dynflags,cc=ccCmd} = do gibbon_dir <- getGibbonDir + archiver <- chooseArchiver ccCmd + when (isClangCompiler ccCmd && not ("llvm-ar" `isInfixOf` takeFileName archiver)) $ + hPutStrLn stderr $ + "[compiler] clang detected but llvm-ar not found; using '" ++ archiver ++ "' instead." + when (isClangCompiler ccCmd && "llvm-ar" `isInfixOf` takeFileName archiver) $ do + clangVer <- toolVersionMajor ccCmd + arVer <- toolVersionMajor archiver + case (clangVer, arVer) of + (Just clangMajor, Just arMajor) + | clangMajor /= arMajor -> + die $ unlines + [ "[compiler] clang/llvm-ar version mismatch detected." + , " requested compiler : " ++ ccCmd + , " selected archiver : " ++ archiver + , " clang major version: " ++ show clangMajor + , " archiver major ver : " ++ show arMajor + , "Please adjust PATH so clang and llvm-ar versions align." + ] + _ -> pure () let rtsmk = gibbon_dir "gibbon-rts/Makefile" - let rtsmkcmd = "make -f " ++ rtsmk ++ " " + userCFlags = optc + rtsmkcmd = "make -f " ++ rtsmk ++ " " ++ (if rts_debug then " MODE=debug " else " MODE=release ") ++ (if rts_debug && pointer then " -DGC_DEBUG " else "") ++ (if not genGC then " GC=nongen " else " GC=gen ") @@ -380,8 +402,10 @@ compileRTS Config{verbosity,optc,dynflags} = do ++ (if pointer then " POINTER=1 " else "") ++ (if parallel then " PARALLEL=1 " else "") ++ (if bumpAlloc then " BUMPALLOC=1 " else "") - ++ (" USER_CFLAGS=\"" ++ optc ++ "\"") + ++ (" USER_CFLAGS=\"" ++ userCFlags ++ "\"") ++ (" VERBOSITY=" ++ show verbosity) + ++ (" CC=\"" ++ ccCmd ++ "\"") + ++ (" AR=\"" ++ archiver ++ "\"") execCmd Nothing rtsmkcmd @@ -433,7 +457,7 @@ compileAndRunExe cfg@Config{backend,arrayInput,benchInput,mode,cfile,exefile} fp compileRTS cfg lib_dir <- getRTSBuildDir let rts_o_path = lib_dir "gibbon_rts.o" - let compile_prog_cmd = compilationCmd backend cfg + compile_prog_cmd = compilationCmd backend cfg ++ " -o " ++ exe ++" -I" ++ lib_dir ++" -L" ++ lib_dir @@ -464,6 +488,52 @@ getRTSBuildDir = unless exists (error "RTS build not found.") pure build_dir +chooseArchiver :: String -> IO String +chooseArchiver ccCmd = pick candidates + where + candidates + | isClangCompiler ccCmd = ["llvm-ar", "ar"] + | otherwise = ["gcc-ar", "ar"] + pick [] = pure "ar" + pick (tool:rest) = do + found <- findExecutable tool + case found of + Just path -> pure path + Nothing -> pick rest + +isClangCompiler :: String -> Bool +isClangCompiler = ("clang" `isInfixOf`) . takeFileName + +toolVersionMajor :: String -> IO (Maybe Int) +toolVersionMajor toolString = do + let exe = takeWhile (not . isSpace) (dropWhile isSpace toolString) + base = takeFileName exe + marker + | "llvm-ar" `isInfixOf` base = Just "LLVM version " + | "clang" `isInfixOf` base = Just "clang version " + | otherwise = Nothing + case marker of + Nothing -> pure Nothing + Just mk -> do + outcome <- catchIOError (Just <$> readProcessWithExitCode exe ["--version"] "") (const (pure Nothing)) + case outcome of + Just (ExitSuccess, stdoutText, _) -> pure (parseMajorAfter mk stdoutText) + _ -> pure Nothing + +parseMajorAfter :: String -> String -> Maybe Int +parseMajorAfter marker txt = do + rest <- findMarker marker txt + let digits = takeWhile isDigit rest + if null digits + then Nothing + else Just (read digits) + +findMarker :: String -> String -> Maybe String +findMarker _ [] = Nothing +findMarker marker str = + case stripPrefix marker str of + Just rest -> Just rest + Nothing -> findMarker marker (tail str) execCmd :: Maybe FilePath -> String -> String -> String -> IO () execCmd dir cmd msg errmsg = do diff --git a/gibbon-compiler/src/Gibbon/HaskellFrontend.hs b/gibbon-compiler/src/Gibbon/HaskellFrontend.hs index e6e3618dd..af1659b80 100644 --- a/gibbon-compiler/src/Gibbon/HaskellFrontend.hs +++ b/gibbon-compiler/src/Gibbon/HaskellFrontend.hs @@ -8,8 +8,6 @@ module Gibbon.HaskellFrontend import Control.Monad import Data.Foldable ( foldrM ) -#if !MIN_VERSION_base(4,21,0) -#endif import Data.Maybe (catMaybes, isJust) import qualified Data.Map as M import qualified Data.Set as S diff --git a/gibbon-compiler/tests/TestRunner.hs b/gibbon-compiler/tests/TestRunner.hs index c44e34978..778f92151 100644 --- a/gibbon-compiler/tests/TestRunner.hs +++ b/gibbon-compiler/tests/TestRunner.hs @@ -206,6 +206,9 @@ modeExeFlags Interp1 = error "Cannot compile in Interp1 mode." modeExeFlags Gibbon1 = ["--to-exe", "--packed", "--gibbon1"] modeExeFlags MPL = ["--mpl-exe"] +ccFlags :: TestConfig -> [String] +ccFlags tc = maybe [] (\cc -> ["--cc=" ++ cc]) (ccOverride tc) + modeFileSuffix :: Mode -> String modeFileSuffix GibbonNoCopies = "_gibbonNoCopies" modeFileSuffix GibbonNoRan = "_gibbonNoRan" @@ -339,6 +342,7 @@ data TestConfig = TestConfig -- It's a global parameter i.e it affects ALL tests. -- However, if a corresponding parameter is specified -- for a particular test, that has higher precedence. + , ccOverride :: Maybe String -- ^ If set, pass --cc= to all gibbon invocations. , checkPerf :: Bool -- ^ Should we also run the performance tests ? , onlyPerf :: Bool -- ^ If true, only run the benchmarks. , recordBenchmarks :: Bool -- ^ If true, record the results of running fresh benchmarks. Used via BenchRunner. @@ -353,6 +357,7 @@ defaultTestConfig = TestConfig , testSummaryFile = "gibbon-test-summary.txt" , tempdir = "examples/build_tmp" , gRunModes = [] + , ccOverride = Nothing , checkPerf = False , onlyPerf = False , recordBenchmarks = False @@ -366,6 +371,7 @@ instance FromJSON TestConfig where o .:? "test-summary-file" .!= (testSummaryFile defaultTestConfig) <*> o .:? "tempdir" .!= (tempdir defaultTestConfig) <*> o .:? "run-modes" .!= (gRunModes defaultTestConfig) <*> + o .:? "cc" .!= (ccOverride defaultTestConfig) <*> o .:? "check-perf" .!= (checkPerf defaultTestConfig) <*> o .:? "only-perf" .!= (onlyPerf defaultTestConfig) <*> o .:? "run-benchmarks" .!= (recordBenchmarks defaultTestConfig) <*> @@ -394,6 +400,9 @@ configParser dtc = TestConfig <*> option readM_modes (long "run-modes" <> help "Only run the tests in these modes" <> value (gRunModes dtc)) + <*> fmap (\mb -> maybe (ccOverride dtc) Just mb) + (OA.optional (strOption (long "cc" <> + help "C compiler to use for all tests"))) <*> switch (long "check-perf" <> help "Run performance tests." <> showDefault) @@ -521,7 +530,7 @@ runTest tc Test{name,dir,expectedResults,runModes,mb_anspath,test_flags} = do exepath = replaceExtension basename ".exe" cmd = "gibbon" -- The order of (++) is important. The PATH to the test file must always be at the end. - cmd_flags = modeRunFlags mode ++ test_flags ++ + cmd_flags = modeRunFlags mode ++ ccFlags tc ++ test_flags ++ [ "--cfile=" ++ cpath , "--exefile=" ++ exepath , compiler_dir dir name ] @@ -594,7 +603,7 @@ doNTrials tc mode t@Test{name,dir,numTrials,sizeParam,moreIters,isMegaBench,benc -- The order of (++) is important. The PATH to the test file must always be at the end. - cmd_flags = modeExeFlags mode ++ test_flags ++ + cmd_flags = modeExeFlags mode ++ ccFlags tc ++ test_flags ++ [ "--cfile=" ++ cpath , "--exefile=" ++ exepath , compiler_dir dir name ] diff --git a/gibbon-rts/Makefile b/gibbon-rts/Makefile index 7c5e6c456..64789789a 100644 --- a/gibbon-rts/Makefile +++ b/gibbon-rts/Makefile @@ -28,7 +28,7 @@ CC := gcc AR := gcc-ar -CFLAGS := -Wall -Wextra -Wpedantic -Wshadow -std=gnu11 -flto +CFLAGS := -Wall -Wextra -Wpedantic -Wshadow -Werror -std=gnu11 -flto RSC := cargo RSFLAGS := -v VERBOSITY := 1 @@ -107,6 +107,11 @@ RUST_RTS_SO := libgibbon_rts_ng.so RUST_RTS_PATH := $(RUST_RTS_DIR)/target/$(MODE)/$(RUST_RTS_SO) RUST_SOURCES := $(shell find $(RUST_RTS_DIR) -type f -name *.rs) +UTHASH_INCLUDE ?= $(GIBBONDIR)/deps/uthash +ifneq ($(strip $(UTHASH_INCLUDE)),) + CFLAGS += -I$(UTHASH_INCLUDE) +endif + all: rts diff --git a/gibbon-rts/rts-c/gibbon_rts.c b/gibbon-rts/rts-c/gibbon_rts.c index 2e614d1e0..3783e56eb 100644 --- a/gibbon-rts/rts-c/gibbon_rts.c +++ b/gibbon-rts/rts-c/gibbon_rts.c @@ -145,7 +145,7 @@ GibSym gib_read_gensym_counter(void) #ifdef _GIBBON_POINTER #ifdef _GIBBON_BUMPALLOC_HEAP -#pragma message "Using bump allocator." +GIB_PRAGMA_MESSAGE("Using bump allocator.") static __thread char *gib_global_ptr_bumpalloc_heap_ptr = (char *) NULL; static __thread char *gib_global_ptr_bumpalloc_heap_ptr_end = (char *) NULL; @@ -512,7 +512,7 @@ GibCursor *gib_array_alloc(GibCursor *arr, size_t size) exit(1); } - #pragma GCC unroll 2 + GIB_PRAGMA_UNROLL(2) for (size_t i = 0; i < size; i++){ arr_on_heap[i] = arr[i]; } @@ -724,7 +724,7 @@ double gib_sum_timing_array(GibVector *times) #ifdef _GIBBON_BUMPALLOC_LISTS // #define _GIBBON_DEBUG -#pragma message "Using bump allocator." +GIB_PRAGMA_MESSAGE("Using bump allocator.") static __thread char *gib_global_list_bumpalloc_heap_ptr = (char *) NULL; static __thread char *gib_global_list_bumpalloc_heap_ptr_end = (char *) NULL; @@ -1054,26 +1054,26 @@ void gib_print_gc_config(void) { printf("C config\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n"); #if defined _GIBBON_GENGC && _GIBBON_GENGC == 0 - #pragma message "Generational GC is disabled." + GIB_PRAGMA_MESSAGE("Generational GC is disabled.") printf("Generational GC is disabled.\n"); #else - #pragma message "Generational GC is enabled." + GIB_PRAGMA_MESSAGE("Generational GC is enabled.") printf("Generational GC is enabled.\n"); #endif #if defined _GIBBON_EAGER_PROMOTION && _GIBBON_EAGER_PROMOTION == 0 - #pragma message "Eager promotion is disabled." + GIB_PRAGMA_MESSAGE("Eager promotion is disabled.") printf("Eager promotion is disabled.\n"); #else - #pragma message "Eager promotion is enabled." + GIB_PRAGMA_MESSAGE("Eager promotion is enabled.") printf("Eager promotion is enabled.\n"); #endif #if defined _GIBBON_SIMPLE_WRITE_BARRIER && _GIBBON_SIMPLE_WRITE_BARRIER == 0 - #pragma message "Simple write barrier is disabled." + GIB_PRAGMA_MESSAGE("Simple write barrier is disabled.") printf("Simple write barrier is disabled.\n"); #else - #pragma message "Simple write barrier is enabled." + GIB_PRAGMA_MESSAGE("Simple write barrier is enabled.") printf("Simple write barrier is enabled.\n"); #endif diff --git a/gibbon-rts/rts-c/gibbon_rts.h b/gibbon-rts/rts-c/gibbon_rts.h index 7e2eee61d..8855dc35e 100644 --- a/gibbon-rts/rts-c/gibbon_rts.h +++ b/gibbon-rts/rts-c/gibbon_rts.h @@ -15,6 +15,25 @@ #include #endif +#define GIB_PRAGMA(x) _Pragma(#x) + +#if defined(__clang__) +#define GIB_PRAGMA_MESSAGE(msg) \ + GIB_PRAGMA(clang diagnostic push) \ + GIB_PRAGMA(clang diagnostic ignored "-W#pragma-messages") \ + GIB_PRAGMA(message msg) \ + GIB_PRAGMA(clang diagnostic pop) +#else +#define GIB_PRAGMA_MESSAGE(msg) GIB_PRAGMA(message msg) +#endif + +#if defined(__clang__) +#define GIB_PRAGMA_UNROLL(n) GIB_PRAGMA(unroll n) +#elif defined(__GNUC__) && (__GNUC__ >= 8) +#define GIB_PRAGMA_UNROLL(n) GIB_PRAGMA(GCC unroll n) +#else +#define GIB_PRAGMA_UNROLL(n) +#endif /* * CPP macros used in the RTS: * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -358,7 +377,7 @@ extern bool gib_global_thread_requested_gc; extern uint64_t gib_global_num_threads; -INLINE_HEADER GibThreadId gib_get_thread_id() +INLINE_HEADER GibThreadId gib_get_thread_id(void) { #ifdef _GIBBON_PARALLEL return __cilkrts_get_worker_number(); @@ -1006,7 +1025,7 @@ INLINE_HEADER void gib_shadowstack_print_all(GibShadowstack *stack) while (run_ptr < end_ptr) { frame = (GibShadowstackFrame *) run_ptr; printf("ptr=%p, endptr=%p, datatype=%d\n", - frame->ptr, frame->endptr, frame->datatype); + (void *)frame->ptr, (void *)frame->endptr, frame->datatype); run_ptr += sizeof(GibShadowstackFrame); } return; @@ -1083,9 +1102,9 @@ INLINE_HEADER void gib_indirection_barrier( { #if defined _GIBBON_SIMPLE_WRITE_BARRIER && _GIBBON_SIMPLE_WRITE_BARRIER == 1 - #pragma message "Simple write barrier is enabled." + GIB_PRAGMA_MESSAGE("Simple write barrier is enabled.") #else - #pragma message "Simple write barrier is disabled." + GIB_PRAGMA_MESSAGE("Simple write barrier is disabled.") { // Optimization: don't create long chains of indirection pointers. GibPackedTag pointed_to_tag = *(GibPackedTag *) to; @@ -1219,12 +1238,12 @@ INLINE_HEADER uint8_t gib_log2(size_t x) // From Chandler Carruth's CppCon 2015 talk. INLINE_HEADER void escape(void *p) { - asm volatile("" : : "g"(p) : "memory"); + __asm__ __volatile__("" : : "g"(p) : "memory"); } // From Chandler Carruth's CppCon 2015 talk. -INLINE_HEADER void clobber() { - asm volatile("" : : : "memory"); +INLINE_HEADER void clobber(void) { + __asm__ __volatile__("" : : : "memory"); }