Feat: better clang support

.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 }}

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,19 +371,41 @@ 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 ")
                  ++ (if print_gc_stats then " GCSTATS=1 " else "")
                  ++ (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

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

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=<value> 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 ]

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
 

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
 

gibbon-rts/rts-c/gibbon_rts.h

@@ -15,6 +15,25 @@
 #include <cilk/cilk_api.h>
 #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");
 }