[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: rts: ensure gc_thread/gen_workspace is allocated with proper alignment

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu May 30 19:15:57 UTC 2024



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


Commits:
7a660042 by Cheng Shao at 2024-05-30T14:42:29-04:00
rts: ensure gc_thread/gen_workspace is allocated with proper alignment

gc_thread/gen_workspace are required to be aligned by 64 bytes.
However, this property has not been properly enforced before, and
numerous alignment violations at runtime has been caught by
UndefinedBehaviorSanitizer that look like:

```
rts/sm/GC.c:1167:8: runtime error: member access within misaligned address 0x0000027a3390 for type 'gc_thread' (aka 'struct gc_thread_'), which requires 64 byte alignment
0x0000027a3390: note: pointer points here
 00 00 00 00  00 00 00 00 00 00 00 00  00 00 00 00 00 00 00 00  00 00 00 00 00 00 00 00  00 00 00 00
              ^
SUMMARY: UndefinedBehaviorSanitizer: undefined-behavior rts/sm/GC.c:1167:8

rts/sm/GC.c:1184:13: runtime error: member access within misaligned address 0x0000027a3450 for type 'gen_workspace' (aka 'struct gen_workspace_'), which requires 64 byte alignment
0x0000027a3450: note: pointer points here
 00 00 00 00  00 00 00 00 00 00 00 00  00 00 00 00 00 00 00 00  00 00 00 00 00 00 00 00  00 00 00 00
              ^
SUMMARY: UndefinedBehaviorSanitizer: undefined-behavior rts/sm/GC.c:1184:13
```

This patch fixes the gc_thread/gen_workspace misalignment issue by
explicitly allocating them with alignment constraint.

- - - - -
c77a48af by Cheng Shao at 2024-05-30T14:42:29-04:00
rts: fix an unaligned load in nonmoving gc

This patch fixes an unaligned load in nonmoving gc by ensuring the
closure address is properly untagged first before attempting to
prefetch its header. The unaligned load is reported by
UndefinedBehaviorSanitizer:

```
rts/sm/NonMovingMark.c:921:9: runtime error: member access within misaligned address 0x0042005f3a71 for type 'StgClosure' (aka 'struct StgClosure_'), which requires 8 byte alignment
0x0042005f3a71: note: pointer points here
 00 00 00  98 43 13 8e 12 7f 00 00  50 3c 5f 00 42 00 00 00  58 17 b7 92 12 7f 00 00  89 cb 5e 00 42
              ^
SUMMARY: UndefinedBehaviorSanitizer: undefined-behavior rts/sm/NonMovingMark.c:921:9
```

This issue had previously gone unnoticed since it didn't really harm
runtime correctness, the invalid header address directly loaded from a
tagged pointer is only used as prefetch address and will not cause
segfaults. However, it still should be corrected because the prefetch
would be rendered useless by this issue, and untagging only involves a
single bitwise operation without memory access so it's cheap enough to
add.

- - - - -
05c4fafb by Cheng Shao at 2024-05-30T14:42:29-04:00
rts: use __builtin_offsetof to implement STG_FIELD_OFFSET

This patch fixes the STG_FIELD_OFFSET macro definition by using
__builtin_offsetof, which is what gcc/clang uses to implement offsetof
in standard C. The previous definition that uses NULL pointer involves
subtle undefined behavior in C and thus reported by
UndefinedBehaviorSanitizer as well:

```
rts/Capability.h:243:58: runtime error: member access within null pointer of type 'Capability' (aka 'struct Capability_')
SUMMARY: UndefinedBehaviorSanitizer: undefined-behavior rts/Capability.h:243:58
```

- - - - -
5ff83bfc by Sylvain Henry at 2024-05-30T14:43:10-04:00
JS: remove useless h$CLOCK_REALTIME (#23202)

- - - - -
95ef2d58 by Matthew Pickering at 2024-05-30T14:43:47-04:00
ghcup-metadata: Fix metadata generation

There were some syntax errors in the generation script which were
preventing it from running.

I have tested this with:

```
nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="2024-05-27" --pipeline-id=95534 --version=9.11.20240525
```

which completed successfully.

- - - - -
1bc66ee4 by Jakob Bruenker at 2024-05-30T14:44:22-04:00
Add diagrams to Arrows documentation

This adds diagrams to the documentation of Arrows, similar to the ones found on
https://www.haskell.org/arrows/.

It does not add diagrams for ArrowChoice for the time being, mainly because it's
not clear to me how to visually distinguish them from the ones for Arrow. Ideally,
you might want to do something like highlight the arrows belonging to the same
tuple or same Either in common colors, but that's not really possible with unicode.

- - - - -
5c7f3374 by Matthew Craven at 2024-05-30T15:15:36-04:00
Make UnsafeSNat et al. into pattern synonyms

...so that they do not cause coerce to bypass the nominal
role on the corresponding singleton types when they are imported.
See Note [Preventing unsafe coercions for singleton types] and
the discussion at #23478.

This also introduces unsafeWithSNatCo (and analogues for Char
and Symbol) so that users can still access the dangerous coercions
that importing the real constructors would allow, but only in a
very localized way.

- - - - -
a84dc5c8 by Cheng Shao at 2024-05-30T15:15:37-04:00
hadrian: build C/C++ with split sections when enabled

When split sections is enabled, ensure -fsplit-sections is passed to
GHC as well when invoking GHC to compile C/C++; and pass
-ffunction-sections -fdata-sections to gcc/clang when compiling C/C++
with the hadrian Cc builder. Fixes #23381.

- - - - -
348deb08 by Cheng Shao at 2024-05-30T15:15:37-04:00
driver: build C/C++ with -ffunction-sections -fdata-sections when split sections is enabled

When -fsplit-sections is passed to GHC, pass -ffunction-sections
-fdata-sections to gcc/clang when building C/C++. Previously,
-fsplit-sections was only respected by the NCG/LLVM backends, but not
the unregisterised backend; the GHC driver did not pass
-fdata-sections and -ffunction-sections to the C compiler, which
resulted in excessive executable sizes.

Fixes #23381.

-------------------------
Metric Decrease:
    size_hello_artifact
    size_hello_unicode
-------------------------

- - - - -
579b8cdf by Cheng Shao at 2024-05-30T15:15:38-04:00
testsuite: mark process005 as fragile on JS

- - - - -


12 changed files:

- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC/Driver/Pipeline/Execute.hs
- hadrian/src/Settings/Builders/SplitSections.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- rts/include/Stg.h
- rts/js/time.js
- rts/sm/GC.c
- rts/sm/NonMovingMark.c
- testsuite/tests/ghci/scripts/T9181.stdout
- testsuite/tests/process/all.T


Changes:

=====================================
.gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
=====================================
@@ -199,7 +199,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map):
     windows = mk(windowsArtifact)
     alpine3_12 = mk(alpine("3_12"))
     alpine3_18 = mk(alpine("3_18"))
-    alpine3_18_arm64 = mk(alpine("3_18"), arch='aarch64')
+    alpine3_18_arm64 = mk(alpine("3_18", arch='aarch64'))
     deb9 = mk(debian(9, "x86_64"))
     deb10 = mk(debian(10, "x86_64"))
     deb11 = mk(debian(11, "x86_64"))
@@ -233,8 +233,8 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map):
           , "Linux_UnknownLinux" : { "unknown_versioning": rocky8 }
           , "Darwin" : { "unknown_versioning" : darwin_x86 }
           , "Windows" : { "unknown_versioning" :  windows }
-          , "Linux_Alpine" : { "( >= 3.12 && < 3.18 )": alpine_3_12
-                             , ">= 3.18": alpine_3_18
+          , "Linux_Alpine" : { "( >= 3.12 && < 3.18 )": alpine3_12
+                             , ">= 3.18": alpine3_18
                              , "unknown_versioning": alpine3_12 }
 
           }


=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -487,6 +487,13 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
                     , not $ target32Bit (targetPlatform dflags)
                     ]
 
+                 -- if -fsplit-sections is enabled, we should also
+                 -- build with these flags.
+                 ++ (if gopt Opt_SplitSections dflags &&
+                      platformOS (targetPlatform dflags) /= OSDarwin
+                        then ["-ffunction-sections", "-fdata-sections"]
+                        else [])
+
           -- Stub files generated for foreign exports references the runIO_closure
           -- and runNonIO_closure symbols, which are defined in the base package.
           -- These symbols are imported into the stub.c file via RtsAPI.h, and the


=====================================
hadrian/src/Settings/Builders/SplitSections.hs
=====================================
@@ -29,6 +29,9 @@ splitSectionsArgs = do
     ) then
     ( mconcat
         [ builder (Ghc CompileHs) ? arg "-fsplit-sections"
+        , builder (Ghc CompileCWithGhc) ? arg "-fsplit-sections"
+        , builder (Ghc CompileCppWithGhc) ? arg "-fsplit-sections"
+        , builder (Cc CompileC) ? arg "-ffunction-sections" <> arg "-fdata-sections"
         , builder MergeObjects ? ifM (expr isWinTarget)
             (pure ["-T", "driver/utils/merge_sections_pe.ld"])
             (pure ["-T", "driver/utils/merge_sections.ld"])


=====================================
libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
=====================================
@@ -93,17 +93,35 @@ class Category a => Arrow a where
     {-# MINIMAL arr, (first | (***)) #-}
 
     -- | Lift a function to an arrow.
+    --
+    -- >   b ╭───╮ c
+    -- > >───┤ f ├───>
+    -- >     ╰───╯
     arr :: (b -> c) -> a b c
 
     -- | Send the first component of the input through the argument
     --   arrow, and copy the rest unchanged to the output.
+    --
+    --   The default definition may be overridden with a more efficient
+    --   version if desired.
+    --
+    -- >   b ╭─────╮ c
+    -- > >───┼─ f ─┼───>
+    -- > >───┼─────┼───>
+    -- >   d ╰─────╯ d
     first :: a b c -> a (b,d) (c,d)
     first = (*** id)
 
-    -- | A mirror image of 'first'.
+    -- | Send the second component of the input through the argument
+    --   arrow, and copy the rest unchanged to the output.
     --
     --   The default definition may be overridden with a more efficient
     --   version if desired.
+    --
+    -- >   d ╭─────╮ d
+    -- > >───┼─────┼───>
+    -- > >───┼─ f ─┼───>
+    -- >   b ╰─────╯ c
     second :: a b c -> a (d,b) (d,c)
     second = (id ***)
 
@@ -112,6 +130,11 @@ class Category a => Arrow a where
     --
     --   The default definition may be overridden with a more efficient
     --   version if desired.
+    --
+    -- >   b ╭─────╮ b'
+    -- > >───┼─ f ─┼───>
+    -- > >───┼─ g ─┼───>
+    -- >   c ╰─────╯ c'
     (***) :: a b c -> a b' c' -> a (b,b') (c,c')
     f *** g = first f >>> arr swap >>> first g >>> arr swap
       where swap ~(x,y) = (y,x)
@@ -121,6 +144,12 @@ class Category a => Arrow a where
     --
     --   The default definition may be overridden with a more efficient
     --   version if desired.
+    --
+    -- >     ╭───────╮ c
+    -- >   b │ ┌─ f ─┼───>
+    -- > >───┼─┤     │
+    -- >     │ └─ g ─┼───>
+    -- >     ╰───────╯ c'
     (&&&) :: a b c -> a b c' -> a b (c,c')
     f &&& g = arr (\b -> (b,b)) >>> f *** g
 
@@ -204,6 +233,9 @@ instance Monad m => Arrow (Kleisli m) where
     second (Kleisli f) = Kleisli (\ ~(d,b) -> f b >>= \c -> return (d,c))
 
 -- | The identity arrow, which plays the role of 'return' in arrow notation.
+--
+-- >   b
+-- > >───>
 returnA :: Arrow a => a b b
 returnA = id
 
@@ -416,6 +448,15 @@ leftApp f = arr ((\b -> (arr (\() -> b) >>> f >>> arr Left, ())) |||
 -- > unassoc (a,(b,c)) = ((a,b),c)
 --
 class Arrow a => ArrowLoop a where
+    -- |
+    --
+    -- >     ╭──────────────╮
+    -- >   b │     ╭───╮    │ c
+    -- > >───┼─────┤   ├────┼───>
+    -- >     │   ┌─┤   ├─┐  │
+    -- >     │ d │ ╰───╯ │  │
+    -- >     │   └───<───┘  │
+    -- >     ╰──────────────╯
     loop :: a (b,d) (c,d) -> a b c
 
 -- | @since base-2.01


=====================================
libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
=====================================
@@ -16,6 +16,7 @@
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE QuantifiedConstraints #-}
 
 {-|
 GHC's @DataKinds@ language extension lifts data constructors, natural
@@ -49,11 +50,18 @@ module GHC.Internal.TypeLits
   , OrderingI(..)
   , N.cmpNat, cmpSymbol, cmpChar
     -- ** Singleton values
-  , N.SNat (..), SSymbol (..), SChar (..)
+  , N.SNat (..)
+  , SSymbol (UnsafeSSymbol)
+      -- We export a pattern synonym instead of the real constructor:
+      -- See Note [Preventing unsafe coercions for singleton types].
+  , SChar (UnsafeSChar)
+      -- We export a pattern synonym instead of the real constructor:
+      -- See Note [Preventing unsafe coercions for singleton types].
   , pattern N.SNat, pattern SSymbol, pattern SChar
   , fromSNat, fromSSymbol, fromSChar
   , withSomeSNat, withSomeSSymbol, withSomeSChar
   , N.withKnownNat, withKnownSymbol, withKnownChar
+  , N.unsafeWithSNatCo, unsafeWithSSymbolCo, unsafeWithSCharCo
 
     -- * Functions on type literals
   , type (N.<=), type (N.<=?), type (N.+), type (N.*), type (N.^), type (N.-)
@@ -72,7 +80,7 @@ module GHC.Internal.TypeLits
 import GHC.Internal.Base ( Bool(..), Eq(..), Functor(..), Ord(..), Ordering(..), String
                 , (.), otherwise, withDict, Void, (++)
                 , errorWithoutStackTrace)
-import GHC.Types(Symbol, Char, TYPE)
+import GHC.Types(Symbol, Char, TYPE, Coercible)
 import GHC.Internal.TypeError(ErrorMessage(..), TypeError)
 import GHC.Internal.Num(Integer, fromInteger)
 import GHC.Internal.Show(Show(..), appPrec, appPrec1, showParen, showString)
@@ -340,7 +348,9 @@ withSomeSNat n k
 --    'String'.
 --
 -- @since base-4.18.0.0
-newtype SSymbol (s :: Symbol) = UnsafeSSymbol String
+newtype SSymbol (s :: Symbol) = UnsafeSSymbol_ String
+-- nominal role: See Note [Preventing unsafe coercions for singleton types]
+-- in GHC.Internal.TypeNats
 type role SSymbol nominal
 
 -- | A explicitly bidirectional pattern synonym relating an 'SSymbol' to a
@@ -377,6 +387,26 @@ data KnownSymbolInstance (s :: Symbol) where
 knownSymbolInstance :: SSymbol s -> KnownSymbolInstance s
 knownSymbolInstance ss = withKnownSymbol ss KnownSymbolInstance
 
+-- | A pattern that can be used to manipulate the
+-- 'String' that an @SSymbol s@ contains under the hood.
+--
+-- When using this pattern to construct an @SSymbol s@, the actual
+-- @String@ being stored in the @SSymbol@ /must/ be equal to (the
+-- contents of) @s at .  The compiler will not help you verify this,
+-- hence the \'unsafe\' name.
+pattern UnsafeSSymbol :: forall s. String -> SSymbol s
+pattern UnsafeSSymbol guts = UnsafeSSymbol_ guts
+{-# COMPLETE UnsafeSSymbol #-}
+
+-- | 'unsafeWithSSymbolCo' allows uses of @coerce@ in its argument to see the
+-- real representation of @SSymbol s@, without undermining the type-safety of
+-- @coerce@ elsewhere in the module.
+--
+-- See also the documentation for 'UnsafeSSymbol'.
+unsafeWithSSymbolCo
+  :: forall r. ((forall s. Coercible (SSymbol s) String) => r) -> r
+unsafeWithSSymbolCo v = v
+
 -- | @since base-4.19.0.0
 instance Eq (SSymbol s) where
   _ == _ = True
@@ -443,7 +473,9 @@ withSomeSSymbol s k = k (UnsafeSSymbol s)
 -- 3. The 'withSomeSChar' function, which creates an 'SChar' from a 'Char'.
 --
 -- @since base-4.18.0.0
-newtype SChar (s :: Char) = UnsafeSChar Char
+newtype SChar (s :: Char) = UnsafeSChar_ Char
+-- nominal role: See Note [Preventing unsafe coercions for singleton types]
+-- in GHC.Internal.TypeNats
 type role SChar nominal
 
 -- | A explicitly bidirectional pattern synonym relating an 'SChar' to a
@@ -480,6 +512,25 @@ data KnownCharInstance (n :: Char) where
 knownCharInstance :: SChar c -> KnownCharInstance c
 knownCharInstance sc = withKnownChar sc KnownCharInstance
 
+-- | A pattern that can be used to manipulate the
+-- 'Char' that an @SChar c@ contains under the hood.
+--
+-- When using this pattern to construct an @SChar c@, the actual
+-- @Char@ being stored in the @SChar c@ /must/ be equal to @c at .
+-- The compiler will not help you verify this, hence the \'unsafe\' name.
+pattern UnsafeSChar :: forall c. Char -> SChar c
+pattern UnsafeSChar guts = UnsafeSChar_ guts
+{-# COMPLETE UnsafeSChar #-}
+
+-- | 'unsafeWithSCharCo' allows uses of @coerce@ in its argument to see the
+-- real representation of @SChar c@, without undermining the type-safety of
+-- @coerce@ elsewhere in the module.
+--
+-- See also the documentation for 'UnsafeSChar'.
+unsafeWithSCharCo
+  :: forall r. ((forall c. Coercible (SChar c) Char) => r) -> r
+unsafeWithSCharCo v = v
+
 -- | @since base-4.19.0.0
 instance Eq (SChar c) where
   _ == _ = True


=====================================
libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
=====================================
@@ -17,6 +17,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE QuantifiedConstraints #-}
 
 {-| This module is an internal GHC module.  It declares the constants used
 in the implementation of type-level natural numbers.  The programmer interface
@@ -36,11 +37,14 @@ module GHC.Internal.TypeNats
   , sameNat
   , decideNat
     -- ** Singleton values
-  , SNat (..)
+  , SNat (UnsafeSNat)
+      -- We export a pattern synonym instead of the real constructor:
+      -- See Note [Preventing unsafe coercions for singleton types].
   , pattern SNat
   , fromSNat
   , withSomeSNat
   , withKnownNat
+  , unsafeWithSNatCo
 
     -- * Functions on type literals
   , type (<=), type (<=?), type (+), type (*), type (^), type (-)
@@ -344,9 +348,60 @@ cmpNat x y = case compare (natVal x) (natVal y) of
 --    number.
 --
 -- @since base-4.18.0.0
-newtype SNat (n :: Nat) = UnsafeSNat Natural
+newtype SNat (n :: Nat) = UnsafeSNat_ Natural
+-- nominal role: See Note [Preventing unsafe coercions for singleton types]
 type role SNat nominal
 
+{-
+Note [Preventing unsafe coercions for singleton types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider a singleton type like this one:
+
+  newtype SNat (n :: Nat) = UnsafeSNat_ Natural
+
+We operate under the fiction that a (non-bottom) value
+``UnsafeSNat_ v :: SNat n`` also contains evidence that the value
+``v :: Natural`` is the same as the type ``n :: Natural``.
+Such evidence can only be safely ``coerce``d to evidence that the
+value ``v`` is the same as some other type ``n2`` if we know that
+``n ~ n2``, at nominal role. (This is #23454.)
+
+So, to preserve that fiction, we:
+
+ 1. Provide a role annotation indicating that ``SNat``'s type argument has
+    nominal role rather than the phantom role that would be inferred.
+ 2. Ensure that the real newtype constructor ``UnsafeSNat_`` is not
+    exported even from ghc-internal.  Whenever that constructor is in
+    scope, typechecking of ``coerce`` will ignore the role annotation
+    and just unwrap the newtype.
+
+But users may wish to write functions like this one (#23478):
+
+  plusSNat :: SNat a -> SNat b -> SNat (a + b)
+
+We could ask them to use ``unsafeCoerce``, but it seems a bit more polite
+to provide a pattern synonym ``UnsafeSNat :: forall n. Natural -> SNat n``
+as an escape hatch (exported from ghc-internal only), so that such a function
+can be written as follows:
+
+  plusSNat (UnsafeSNat x) (UnsafeSNat y) = UnsafeSNat (x + y)
+
+Crucially, these pattern synonyms (unlike real newtype constructors) do not
+cause ``coerce`` to bypass our role annotation when they are in scope.
+
+To allow casting data structures containing SNats, we provide a
+further escape hatch in ``unsafeWithSNatCo``, which enables ``coerce`` to
+bypass our role annotation on ``SNat``, but /only within its argument/:
+
+  unsafeWithSNatCo
+    :: forall r. ((forall n. Coercible (SNat n) Natural) => r) -> r
+
+
+The above reasoning applies identically for the other singleton types
+'SChar' and 'SSymbol' as well.
+-}
+
+
 -- | A explicitly bidirectional pattern synonym relating an 'SNat' to a
 -- 'KnownNat' constraint.
 --
@@ -381,6 +436,25 @@ data KnownNatInstance (n :: Nat) where
 knownNatInstance :: SNat n -> KnownNatInstance n
 knownNatInstance sn = withKnownNat sn KnownNatInstance
 
+-- | A pattern that can be used to manipulate the
+-- 'Natural' that an @SNat n@ contains under the hood.
+--
+-- When using this pattern to construct an @SNat n@, the actual
+-- @Natural@ being stored in the @SNat n@ /must/ be equal to @n at .
+-- The compiler will not help you verify this, hence the \'unsafe\' name.
+pattern UnsafeSNat :: forall n. Natural -> SNat n
+pattern UnsafeSNat guts = UnsafeSNat_ guts
+{-# COMPLETE UnsafeSNat #-}
+
+-- | 'unsafeWithSNatCo' allows uses of @coerce@ in its argument to see the
+-- real representation of @SNat n@, without undermining the type-safety of
+-- @coerce@ elsewhere in the module.
+--
+-- See also the documentation for 'UnsafeSNat'.
+unsafeWithSNatCo
+  :: forall r. ((forall n. Coercible (SNat n) Natural) => r) -> r
+unsafeWithSNatCo v = v
+
 -- | @since base-4.19.0.0
 instance Eq (SNat n) where
   _ == _ = True


=====================================
rts/include/Stg.h
=====================================
@@ -108,7 +108,7 @@
 
 /* Compute offsets of struct fields
  */
-#define STG_FIELD_OFFSET(s_type, field) ((StgWord)&(((s_type*)0)->field))
+#define STG_FIELD_OFFSET(s_type, field) __builtin_offsetof(s_type, field)
 
 /*
  * 'Portable' inlining:


=====================================
rts/js/time.js
=====================================
@@ -16,5 +16,3 @@ function h$clock_gettime(when, p_d, p_o) {
   }
   return 0;
 }
-
-function h$CLOCK_REALTIME() { return 0; }


=====================================
rts/sm/GC.c
=====================================
@@ -55,6 +55,7 @@
 #include "NonMoving.h"
 #include "Ticky.h"
 
+#include <stdalign.h>
 #include <string.h> // for memset()
 #include <unistd.h>
 
@@ -1242,8 +1243,9 @@ initGcThreads (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS)
 
     for (i = from; i < to; i++) {
         gc_threads[i] =
-            stgMallocBytes(sizeof(gc_thread) +
+            stgMallocAlignedBytes(sizeof(gc_thread) +
                            RtsFlags.GcFlags.generations * sizeof(gen_workspace),
+                           alignof(gc_thread),
                            "alloc_gc_threads");
 
         new_gc_thread(i, gc_threads[i]);
@@ -1268,7 +1270,7 @@ freeGcThreads (void)
             {
                 freeWSDeque(gc_threads[i]->gens[g].todo_q);
             }
-            stgFree (gc_threads[i]);
+            stgFreeAligned (gc_threads[i]);
         }
         closeCondition(&gc_running_cv);
         closeMutex(&gc_running_mutex);


=====================================
rts/sm/NonMovingMark.c
=====================================
@@ -918,7 +918,7 @@ static MarkQueueEnt markQueuePop (MarkQueue *q)
         // The entry may not be a MARK_CLOSURE but it doesn't matter, our
         // MarkQueueEnt encoding always places the pointer to the object to be
         // marked first.
-        prefetchForRead(&new.mark_closure.p->header.info);
+        prefetchForRead(&(UNTAG_CLOSURE(new.mark_closure.p)->header.info));
 #if !defined(ASSERTS_ENABLED)
         prefetchForRead(Bdescr((StgPtr) new.mark_closure.p));
 #endif


=====================================
testsuite/tests/ghci/scripts/T9181.stdout
=====================================
@@ -99,7 +99,7 @@ pattern GHC.Internal.TypeLits.SChar
 type role GHC.Internal.TypeLits.SChar nominal
 type GHC.Internal.TypeLits.SChar :: Char -> *
 newtype GHC.Internal.TypeLits.SChar s
-  = GHC.Internal.TypeLits.UnsafeSChar Char
+  = GHC.Internal.TypeLits.UnsafeSChar_ Char
 pattern GHC.Internal.TypeNats.SNat
   :: () =>
      GHC.Internal.TypeNats.KnownNat n =>
@@ -107,7 +107,7 @@ pattern GHC.Internal.TypeNats.SNat
 type role GHC.Internal.TypeNats.SNat nominal
 type GHC.Internal.TypeNats.SNat :: GHC.Internal.TypeNats.Nat -> *
 newtype GHC.Internal.TypeNats.SNat n
-  = GHC.Internal.TypeNats.UnsafeSNat GHC.Num.Natural.Natural
+  = GHC.Internal.TypeNats.UnsafeSNat_ GHC.Num.Natural.Natural
 pattern GHC.Internal.TypeLits.SSymbol
   :: () =>
      GHC.Internal.TypeLits.KnownSymbol s =>
@@ -115,7 +115,7 @@ pattern GHC.Internal.TypeLits.SSymbol
 type role GHC.Internal.TypeLits.SSymbol nominal
 type GHC.Internal.TypeLits.SSymbol :: GHC.Types.Symbol -> *
 newtype GHC.Internal.TypeLits.SSymbol s
-  = GHC.Internal.TypeLits.UnsafeSSymbol String
+  = GHC.Internal.TypeLits.UnsafeSSymbol_ String
 type GHC.Internal.TypeLits.SomeChar :: *
 data GHC.Internal.TypeLits.SomeChar
   = forall (n :: Char).


=====================================
testsuite/tests/process/all.T
=====================================
@@ -7,7 +7,7 @@ test('process002', [fragile_for(16547, concurrent_ways), req_process], compile_a
 test('process003', [fragile_for(17245, concurrent_ways), req_process], compile_and_run, [''])
 test('process004', [normalise_exec, normalise_exe, req_process], compile_and_run, [''])
 test('T1780', [req_process], compile_and_run, [''])
-test('process005', [omit_ghci, req_process], compile_and_run, [''])
+test('process005', [omit_ghci, req_process, when(js_arch(), fragile(24373))], compile_and_run, [''])
 test('process006', [req_process], compile_and_run, [''])
 
 test('process007',



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6f8581efd3e4800e00ab64b6d5482afe3fb8501...579b8cdfc35894f337a1f8fe16b7d0867897507d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6f8581efd3e4800e00ab64b6d5482afe3fb8501...579b8cdfc35894f337a1f8fe16b7d0867897507d
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/20240530/4f7b13aa/attachment-0001.html>


More information about the ghc-commits mailing list