[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: typo

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Tue Aug 16 09:41:32 UTC 2022



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
42321170 by Eric Lindblad at 2022-08-16T05:41:12-04:00
typo
- - - - -
6cfb6b69 by Ben Gamari at 2022-08-16T05:41:13-04:00
CmmToLlvm: Don't aliasify builtin LLVM variables

Our aliasification logic would previously turn builtin LLVM variables
into aliases, which apparently confuses LLVM. This manifested in
initializers failing to be emitted, resulting in many profiling failures
with the LLVM backend.

Fixes #22019.

- - - - -
a94e470b by Bryan Richter at 2022-08-16T05:41:14-04:00
run_ci: remove monoidal-containers

Fixes #21492

MonoidalMap is inlined and used to implement Variables, as before.

The top-level value "jobs" is reimplemented as a regular Map, since it
doesn't use the monoidal union anyway.

- - - - -
dc62f24e by Cheng Shao at 2022-08-16T05:41:16-04:00
CmmToAsm/AArch64: correct a typo

- - - - -


4 changed files:

- .gitlab/gen_ci.hs
- compiler/GHC/CmmToAsm/AArch64.hs
- compiler/GHC/CmmToLlvm/Base.hs
- rts/Interpreter.c


Changes:

=====================================
.gitlab/gen_ci.hs
=====================================
@@ -2,13 +2,16 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {- cabal:
-build-depends: base, monoidal-containers, aeson >= 1.8.1, containers, bytestring
+build-depends: base, aeson >= 1.8.1, containers, bytestring
 -}
 
+import Data.Coerce
 import Data.String (String)
 import Data.Aeson as A
-import qualified Data.Map.Monoidal as M
+import qualified Data.Map as Map
+import Data.Map (Map)
 import qualified Data.ByteString.Lazy as B hiding (putStrLn)
 import qualified Data.ByteString.Lazy.Char8 as B
 import Data.List (intercalate)
@@ -307,10 +310,22 @@ dockerImage _ _ = Nothing
 -- The "proper" solution would be to use a dependent monoidal map where each key specifies
 -- the combination behaviour of it's values. Ie, whether setting it multiple times is an error
 -- or they should be combined.
-type Variables = M.MonoidalMap String [String]
+newtype MonoidalMap k v = MonoidalMap (Map k v)
+    deriving (Eq, Show, Functor, ToJSON)
+
+instance (Ord k, Semigroup v) => Semigroup (MonoidalMap k v) where
+    (MonoidalMap a) <> (MonoidalMap b) = MonoidalMap (Map.unionWith (<>) a b)
+
+instance (Ord k, Semigroup v) => Monoid (MonoidalMap k v) where
+    mempty = MonoidalMap (Map.empty)
+
+mminsertWith :: Ord k => (a -> a -> a) -> k -> a -> MonoidalMap k a -> MonoidalMap k a
+mminsertWith f k v (MonoidalMap m) = MonoidalMap (Map.insertWith f k v m)
+
+type Variables = MonoidalMap String [String]
 
 (=:) :: String -> String -> Variables
-a =: b = M.singleton a [b]
+a =: b = MonoidalMap (Map.singleton a [b])
 
 opsysVariables :: Arch -> Opsys -> Variables
 opsysVariables _ FreeBSD13 = mconcat
@@ -566,7 +581,7 @@ instance ToJSON Job where
     , "allow_failure" A..= jobAllowFailure
     -- Joining up variables like this may well be the wrong thing to do but
     -- at least it doesn't lose information silently by overriding.
-    , "variables" A..= (M.map (intercalate " ") jobVariables)
+    , "variables" A..= fmap (intercalate " ") jobVariables
     , "artifacts" A..= jobArtifacts
     , "cache" A..= jobCache
     , "after_script" A..= jobAfterScript
@@ -621,9 +636,9 @@ job arch opsys buildConfig = (jobName, Job {..})
       , "BUILD_FLAVOUR" =: flavourString jobFlavour
       , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig)
       , "CONFIGURE_ARGS" =: configureArgsStr buildConfig
-      , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig)
-      , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig)
-      , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty
+      , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig)
+      , maybe mempty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig)
+      , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty
       ]
 
     jobArtifacts = Artifacts
@@ -669,7 +684,7 @@ addJobRule :: Rule -> Job -> Job
 addJobRule r j = j { jobRules = enableRule r (jobRules j) }
 
 addVariable :: String -> String -> Job -> Job
-addVariable k v j = j { jobVariables = M.insertWith (++) k [v] (jobVariables j) }
+addVariable k v j = j { jobVariables = mminsertWith (++) k [v] (jobVariables j) }
 
 -- Building the standard jobs
 --
@@ -765,8 +780,8 @@ flattenJobGroup (ValidateOnly a b) = [a, b]
 
 
 -- | Specification for all the jobs we want to build.
-jobs :: M.MonoidalMap String Job
-jobs = M.fromList $ concatMap flattenJobGroup $
+jobs :: Map String Job
+jobs = Map.fromList $ concatMap flattenJobGroup $
      [ disableValidate (standardBuilds Amd64 (Linux Debian10))
      , (standardBuildsWithConfig Amd64 (Linux Debian10) dwarf)
      , (validateBuilds Amd64 (Linux Debian10) nativeInt)


=====================================
compiler/GHC/CmmToAsm/AArch64.hs
=====================================
@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
--- | Native code generator for x86 and x86-64 architectures
+-- | Native code generator for AArch64 architectures
 module GHC.CmmToAsm.AArch64
    ( ncgAArch64 )
 where


=====================================
compiler/GHC/CmmToLlvm/Base.hs
=====================================
@@ -58,7 +58,7 @@ import GHC.Utils.Logger
 
 import Data.Maybe (fromJust)
 import Control.Monad (ap)
-import Data.List (sortBy, groupBy)
+import Data.List (sortBy, groupBy, isPrefixOf)
 import Data.Ord (comparing)
 
 -- ----------------------------------------------------------------------------
@@ -504,6 +504,12 @@ generateExternDecls = do
   modifyEnv $ \env -> env { envAliases = emptyUniqSet }
   return (concat defss, [])
 
+-- | Is a variable one of the special @$llvm@ globals?
+isBuiltinLlvmVar :: LlvmVar -> Bool
+isBuiltinLlvmVar (LMGlobalVar lbl _ _ _ _ _) =
+    "$llvm" `isPrefixOf` unpackFS lbl
+isBuiltinLlvmVar _ = False
+
 -- | Here we take a global variable definition, rename it with a
 -- @$def@ suffix, and generate the appropriate alias.
 aliasify :: LMGlobal -> LlvmM [LMGlobal]
@@ -511,8 +517,9 @@ aliasify :: LMGlobal -> LlvmM [LMGlobal]
 -- Here we obtain the indirectee's precise type and introduce
 -- fresh aliases to both the precise typed label (lbl$def) and the i8*
 -- typed (regular) label of it with the matching new names.
-aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias)
-                   (Just orig)) = do
+aliasify (LMGlobal var@(LMGlobalVar lbl ty at LMAlias{} link sect align Alias)
+                   (Just orig))
+  | not $ isBuiltinLlvmVar var = do
     let defLbl = llvmDefLabel lbl
         LMStaticPointer (LMGlobalVar origLbl _ oLnk Nothing Nothing Alias) = orig
         defOrigLbl = llvmDefLabel origLbl
@@ -525,7 +532,8 @@ aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias)
     pure [ LMGlobal (LMGlobalVar defLbl ty link sect align Alias) (Just defOrig)
          , LMGlobal (LMGlobalVar lbl i8Ptr link sect align Alias) (Just orig')
          ]
-aliasify (LMGlobal var val) = do
+aliasify (LMGlobal var val)
+  | not $ isBuiltinLlvmVar var = do
     let LMGlobalVar lbl ty link sect align const = var
 
         defLbl = llvmDefLabel lbl
@@ -543,6 +551,7 @@ aliasify (LMGlobal var val) = do
     return [ LMGlobal defVar val
            , LMGlobal aliasVar (Just aliasVal)
            ]
+aliasify global = pure [global]
 
 -- Note [Llvm Forward References]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -601,3 +610,6 @@ aliasify (LMGlobal var val) = do
 -- away with casting the alias to the desired type in @getSymbolPtr@
 -- and instead just emit a reference to the definition symbol directly.
 -- This is the @Just@ case in @getSymbolPtr at .
+--
+-- Note that we must take care not to turn LLVM's builtin variables into
+-- aliases (e.g. $llvm.global_ctors) since this confuses LLVM.


=====================================
rts/Interpreter.c
=====================================
@@ -1875,7 +1875,7 @@ run_BCO:
             int flags                 = BCO_NEXT;
             bool interruptible        = flags & 0x1;
             bool unsafe_call          = flags & 0x2;
-            void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
+            void(*marshal_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
 
             /* the stack looks like this:
 
@@ -1902,7 +1902,7 @@ run_BCO:
 
 #define ROUND_UP_WDS(p)  ((((StgWord)(p)) + sizeof(W_)-1)/sizeof(W_))
 
-            ffi_cif *cif = (ffi_cif *)marshall_fn;
+            ffi_cif *cif = (ffi_cif *)marshal_fn;
             uint32_t nargs = cif->nargs;
             uint32_t ret_size;
             uint32_t i;



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e66c9859f0b189fa270e687dd3c4302c1909b9bb...dc62f24ecd1c2b8f3a127845ffdfb8159257fc8c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e66c9859f0b189fa270e687dd3c4302c1909b9bb...dc62f24ecd1c2b8f3a127845ffdfb8159257fc8c
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/20220816/d1fd38d5/attachment-0001.html>


More information about the ghc-commits mailing list