[Git][ghc/ghc][wip/9.6.6-backports] 13 commits: Reverse arguments to stgCallocBytes (fix #24828)
Zubin (@wz1000)
gitlab at gitlab.haskell.org
Fri Jun 28 10:04:52 UTC 2024
Zubin pushed to branch wip/9.6.6-backports at Glasgow Haskell Compiler / GHC
Commits:
942ddb2a by Sylvain Henry at 2024-06-28T15:34:28+05:30
Reverse arguments to stgCallocBytes (fix #24828)
(cherry picked from commit 6838a7c32ca29b5d44adc9d6280d3a960f31be7c)
- - - - -
05e4b390 by Ryan Scott at 2024-06-28T15:34:28+05:30
Add missing parenthesizePat in cvtp
We need to ensure that the output of `cvtp` is parenthesized (at precedence
`sigPrec`) so that any pattern signatures with a surrounding pattern signature
can parse correctly.
Fixes #24837.
(cherry picked from commit a3cd3a1d0d186f2aa4d0273c6b3e74a442de2ef0)
- - - - -
e0ff189b by Cheng Shao at 2024-06-28T15:34:28+05:30
compiler: emit NaturallyAligned when element type & index type are the same width
This commit fixes a subtle mistake in alignmentFromTypes that used to
generate Unaligned when element type & index type are the same width.
Fixes #24930.
(cherry picked from commit 0cff083abb24701530974872b21cf897c9955a9a)
- - - - -
52235ada by Cheng Shao at 2024-06-28T15:34:28+05:30
hadrian: fix no_dynamic_libs flavour transformer
This patch fixes the no_dynamic_libs flavour transformer and make
fully_static reuse it. Previously building with no_dynamic_libs fails
since ghc program is still dynamic and transitively brings in dyn ways
of rts which are produced by no rules.
(cherry picked from commit 1bb24432ff77e11a0340a7d8586e151e15bba2a1)
- - - - -
2b1fd267 by Cheng Shao at 2024-06-28T15:34:28+05:30
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.
(cherry picked from commit 7a660042395614e4b19534baf5b779f65059861e)
- - - - -
33584ad7 by Cheng Shao at 2024-06-28T15:34:28+05:30
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.
(cherry picked from commit c77a48af6e1f38337b305fec794e8c999f1c7f3a)
- - - - -
deb5497a by Ian-Woo Kim at 2024-06-28T15:34:28+05:30
Add missing BCO handling in scavenge_one.
(cherry picked from commit 902ebcc2b95707319d37a19d6b23c342cc14b162)
- - - - -
5a203d10 by Peter Trommler at 2024-06-28T15:34:28+05:30
PPC NCG: Fix sign hints in C calls
Sign hints for parameters are in the second component of the pair.
Fixes #23034
(cherry picked from commit 7fe85b1354a13749f14d588e3cc742b8ae2d8da9)
- - - - -
7d6907c8 by Zubin Duggal at 2024-06-28T15:34:28+05:30
Bump directory submodule to 1.3.8.5
- - - - -
86afa784 by Sebastian Graf at 2024-06-28T15:34:28+05:30
exprIsTrivial: Factor out shared implementation
The duplication between `exprIsTrivial` and `getIdFromTrivialExpr_maybe` has
been bugging me for a long time.
This patch introduces an inlinable worker function `trivial_expr_fold` acting
as the single, shared decision procedure of triviality. It "returns" a
Church-encoded `Maybe (Maybe Id)`, so when it is inlined, it fuses to similar
code as before.
(Better code, even, in the case of `getIdFromTrivialExpr` which presently
allocates a `Just` constructor that cancels away after this patch.)
(cherry picked from commit 9cb7e73a632bb570dd5d9100ea45536a5f13e182)
- - - - -
d0438f66 by Sebastian Graf at 2024-06-28T15:34:28+05:30
Some cherry-picked bits of 59202c8 to fix #24718
As noted in f3225ed4b3f3c4, the test below is flaky on Darwin.
Metric Decrease:
MultiLayerModulesTH_Make
(cherry picked from commit 78a253543d466ac511a1664a3e6aff032ca684d5)
- - - - -
40f0d19d by Zubin Duggal at 2024-06-28T15:34:28+05:30
Prepare release 9.6.6
- - - - -
28ddc41b by Andreas Klebinger at 2024-06-28T15:34:28+05:30
GHCi interpreter: Tag constructor closures when possible.
When evaluating PUSH_G try to tag the reference we are pushing if it's a
constructor. This is potentially helpful for performance and required to
fix #24870.
(cherry picked from commit 1bfa91115b8320ed99a5e946147528e21ca4f3e1)
- - - - -
29 changed files:
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/ThToHs.hs
- configure.ac
- docs/users_guide/9.6.5-notes.rst
- docs/users_guide/release-notes.rst
- hadrian/src/Flavour.hs
- libraries/directory
- rts/Interpreter.c
- rts/linker/Elf.c
- rts/sm/GC.c
- rts/sm/NonMovingMark.c
- rts/sm/Scav.c
- + testsuite/tests/codeGen/should_run/T23034.h
- + testsuite/tests/codeGen/should_run/T23034.hs
- + testsuite/tests/codeGen/should_run/T23034.stdout
- + testsuite/tests/codeGen/should_run/T23034_c.c
- testsuite/tests/codeGen/should_run/all.T
- + testsuite/tests/core-to-stg/T24718.hs
- testsuite/tests/core-to-stg/all.T
- + testsuite/tests/th/T24837.hs
- + testsuite/tests/th/T24837.stderr
- testsuite/tests/th/all.T
- + testsuite/tests/th/should_compile/T24870/Def.hs
- + testsuite/tests/th/should_compile/T24870/Use.hs
- + testsuite/tests/th/should_compile/T24870/all.T
Changes:
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -82,7 +82,7 @@ data BCInstr
| PUSH16_W !Word16
| PUSH32_W !Word16
- -- Push a ptr (these all map to PUSH_G really)
+ -- Push a (heap) ptr (these all map to PUSH_G really)
| PUSH_G Name
| PUSH_PRIMOP PrimOp
| PUSH_BCO (ProtoBCO Name)
=====================================
compiler/GHC/CmmToAsm/PPC/CodeGen.hs
=====================================
@@ -1752,7 +1752,7 @@ genCCall' config gcp target dest_regs args
_ -> panic "genCall': unknown calling conv."
argReps = map (cmmExprType platform) args
- (argHints, _) = foreignTargetHints target
+ (_, argHints) = foreignTargetHints target
roundTo a x | x `mod` a == 0 = x
| otherwise = x + a - (x `mod` a)
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -23,9 +23,9 @@ module GHC.Core.Utils (
-- * Properties of expressions
exprType, coreAltType, coreAltsType, mkLamType, mkLamTypes,
mkFunctionType,
- exprIsDupable, exprIsTrivial, getIdFromTrivialExpr,
- getIdFromTrivialExpr_maybe,
- exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
+ exprIsTrivial, getIdFromTrivialExpr, getIdFromTrivialExpr_maybe,
+ trivial_expr_fold,
+ exprIsDupable, exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprOkForSpecEval,
exprIsWorkFree, exprIsConLike,
isCheapApp, isExpandableApp, isSaturatedConApp,
@@ -1047,20 +1047,37 @@ and that confuses the code generator (#11155). So best to kill
it off at source.
-}
+{-# INLINE trivial_expr_fold #-}
+trivial_expr_fold :: (Id -> r) -> (Literal -> r) -> r -> r -> CoreExpr -> r
+-- ^ The worker function for Note [exprIsTrivial] and Note [getIdFromTrivialExpr]
+-- This is meant to have the code of both functions in one place and make it
+-- easy to derive custom predicates.
+--
+-- (trivial_expr_fold k_id k_triv k_not_triv e)
+-- * returns (k_id x) if `e` is a variable `x` (with trivial wrapping)
+-- * returns (k_lit x) if `e` is a trivial literal `l` (with trivial wrapping)
+-- * returns k_triv if `e` is a literal, type, or coercion (with trivial wrapping)
+-- * returns k_not_triv otherwise
+--
+-- where "trivial wrapping" is
+-- * Type application or abstraction
+-- * Ticks other than `tickishIsCode`
+-- * `case e of {}` an empty case
+trivial_expr_fold k_id k_lit k_triv k_not_triv = go
+ where
+ go (Var v) = k_id v -- See Note [Variables are trivial]
+ go (Lit l) | litIsTrivial l = k_lit l
+ go (Type _) = k_triv
+ go (Coercion _) = k_triv
+ go (App f t) | not (isRuntimeArg t) = go f
+ go (Lam b e) | not (isRuntimeVar b) = go e
+ go (Tick t e) | not (tickishIsCode t) = go e -- See Note [Tick trivial]
+ go (Cast e _) = go e
+ go (Case e _ _ []) = go e -- See Note [Empty case is trivial]
+ go _ = k_not_triv
+
exprIsTrivial :: CoreExpr -> Bool
--- If you modify this function, you may also
--- need to modify getIdFromTrivialExpr
-exprIsTrivial (Var _) = True -- See Note [Variables are trivial]
-exprIsTrivial (Type _) = True
-exprIsTrivial (Coercion _) = True
-exprIsTrivial (Lit lit) = litIsTrivial lit
-exprIsTrivial (App e arg) = not (isRuntimeArg arg) && exprIsTrivial e
-exprIsTrivial (Lam b e) = not (isRuntimeVar b) && exprIsTrivial e
-exprIsTrivial (Tick t e) = not (tickishIsCode t) && exprIsTrivial e
- -- See Note [Tick trivial]
-exprIsTrivial (Cast e _) = exprIsTrivial e
-exprIsTrivial (Case e _ _ []) = exprIsTrivial e -- See Note [Empty case is trivial]
-exprIsTrivial _ = False
+exprIsTrivial e = trivial_expr_fold (const True) (const True) True False e
{-
Note [getIdFromTrivialExpr]
@@ -1080,24 +1097,13 @@ T12076lit for an example where this matters.
-}
getIdFromTrivialExpr :: HasDebugCallStack => CoreExpr -> Id
-getIdFromTrivialExpr e
- = fromMaybe (pprPanic "getIdFromTrivialExpr" (ppr e))
- (getIdFromTrivialExpr_maybe e)
-
-getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id
-- See Note [getIdFromTrivialExpr]
--- Th equations for this should line up with those for exprIsTrivial
-getIdFromTrivialExpr_maybe e
- = go e
+getIdFromTrivialExpr e = trivial_expr_fold id (const panic) panic panic e
where
- go (App f t) | not (isRuntimeArg t) = go f
- go (Tick t e) | not (tickishIsCode t) = go e
- go (Cast e _) = go e
- go (Lam b e) | not (isRuntimeVar b) = go e
- go (Case e _ _ []) = go e
- go (Var v) = Just v
- go _ = Nothing
+ panic = pprPanic "getIdFromTrivialExpr" (ppr e)
+getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id
+getIdFromTrivialExpr_maybe e = trivial_expr_fold Just (const Nothing) Nothing Nothing e
{- *********************************************************************
* *
=====================================
compiler/GHC/CoreToStg.hs
=====================================
@@ -19,8 +19,7 @@ module GHC.CoreToStg ( CoreToStgOpts (..), coreToStg ) where
import GHC.Prelude
import GHC.Core
-import GHC.Core.Utils ( exprType, findDefault, isJoinBind
- , exprIsTickedString_maybe )
+import GHC.Core.Utils
import GHC.Core.Opt.Arity ( manifestArity )
import GHC.Core.Type
import GHC.Core.TyCon
@@ -49,7 +48,7 @@ import GHC.Unit.Module
import GHC.Data.FastString
import GHC.Platform ( Platform )
import GHC.Platform.Ways
-import GHC.Builtin.PrimOps ( PrimCall(..), primOpWrapperId )
+import GHC.Builtin.PrimOps
import GHC.Utils.Outputable
import GHC.Utils.Monad
@@ -574,6 +573,19 @@ coreToStgApp f args ticks = do
-- This is the guy that turns applications into A-normal form
-- ---------------------------------------------------------------------------
+getStgArgFromTrivialArg :: HasDebugCallStack => CoreArg -> StgArg
+-- A (non-erased) trivial CoreArg corresponds to an atomic StgArg.
+-- CoreArgs may not immediately look trivial, e.g., `case e of {}` or
+-- `case unsafeequalityProof of UnsafeRefl -> e` might intervene.
+-- Good thing we can just call `trivial_expr_fold` here.
+getStgArgFromTrivialArg e
+ | Just s <- exprIsTickedString_maybe e -- This case is just for backport to GHC 9.8,
+ = StgLitArg (LitString s) -- where we used to treat strings as valid StgArgs
+ | otherwise
+ = trivial_expr_fold StgVarArg StgLitArg panic panic e
+ where
+ panic = pprPanic "getStgArgFromTrivialArg" (ppr e)
+
coreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [StgTickish])
coreToStgArgs []
= return ([], [])
@@ -586,42 +598,29 @@ coreToStgArgs (Coercion _ : args) -- Coercion argument; See Note [Coercion token
= do { (args', ts) <- coreToStgArgs args
; return (StgVarArg coercionTokenId : args', ts) }
-coreToStgArgs (Tick t e : args)
- = assert (not (tickishIsCode t)) $
- do { (args', ts) <- coreToStgArgs (e : args)
- ; let !t' = coreToStgTick (exprType e) t
- ; return (args', t':ts) }
-
coreToStgArgs (arg : args) = do -- Non-type argument
(stg_args, ticks) <- coreToStgArgs args
- arg' <- coreToStgExpr arg
- let
- (aticks, arg'') = stripStgTicksTop tickishFloatable arg'
- stg_arg = case arg'' of
- StgApp v [] -> StgVarArg v
- StgConApp con _ [] _ -> StgVarArg (dataConWorkId con)
- StgOpApp (StgPrimOp op) [] _ -> StgVarArg (primOpWrapperId op)
- StgLit lit -> StgLitArg lit
- _ -> pprPanic "coreToStgArgs" (ppr arg $$ pprStgExpr panicStgPprOpts arg' $$ pprStgExpr panicStgPprOpts arg'')
-
- -- WARNING: what if we have an argument like (v `cast` co)
- -- where 'co' changes the representation type?
- -- (This really only happens if co is unsafe.)
- -- Then all the getArgAmode stuff in CgBindery will set the
- -- cg_rep of the CgIdInfo based on the type of v, rather
- -- than the type of 'co'.
- -- This matters particularly when the function is a primop
- -- or foreign call.
- -- Wanted: a better solution than this hacky warning
-
+ -- We know that `arg` must be trivial, but it may contain Ticks.
+ -- Example from test case `decodeMyStack`:
+ -- $ @... ((src<decodeMyStack.hs:18:26-28> Data.Tuple.snd) @Int @[..])
+ -- Note that unfortunately the Tick is not at the top.
+ -- So we'll traverse the expression twice:
+ -- * Once with `stripTicksT` (which collects *all* ticks from the expression)
+ -- * and another time with `getStgArgFromTrivialArg`.
+ -- Since the argument is trivial, the only place the Tick can occur is
+ -- somehow wrapping a variable (give or take type args, as above).
platform <- getPlatform
- let
- arg_rep = typePrimRep (exprType arg)
- stg_arg_rep = typePrimRep (stgArgType stg_arg)
+ let arg_ty = exprType arg
+ ticks' = map (coreToStgTick arg_ty) (stripTicksT (not . tickishIsCode) arg)
+ arg' = getStgArgFromTrivialArg arg
+ arg_rep = typePrimRep arg_ty
+ stg_arg_rep = typePrimRep (stgArgType arg')
bad_args = not (primRepsCompatible platform arg_rep stg_arg_rep)
- warnPprTrace bad_args "Dangerous-looking argument. Probable cause: bad unsafeCoerce#" (ppr arg) $
- return (stg_arg : stg_args, ticks ++ aticks)
+ massertPpr (length ticks' <= 1) (text "More than one Tick in trivial arg:" <+> ppr arg)
+ warnPprTrace bad_args "Dangerous-looking argument. Probable cause: bad unsafeCoerce#" (ppr arg) (return ())
+
+ return (arg' : stg_args, ticks' ++ ticks)
coreToStgTick :: Type -- type of the ticked expression
-> CoreTickish
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -2026,8 +2026,8 @@ alignmentFromTypes :: CmmType -- ^ element type
-> CmmType -- ^ index type
-> AlignmentSpec
alignmentFromTypes ty idx_ty
- | typeWidth ty < typeWidth idx_ty = NaturallyAligned
- | otherwise = Unaligned
+ | typeWidth ty <= typeWidth idx_ty = NaturallyAligned
+ | otherwise = Unaligned
doIndexOffAddrOp :: Maybe MachOp
-> CmmType
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1442,7 +1442,8 @@ cvtp (ListP ps) = do { ps' <- cvtPats ps
; return
$ ListPat noAnn ps'}
cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t
- ; return $ SigPat noAnn p' (mkHsPatSigType noAnn t') }
+ ; let pp = parenthesizePat sigPrec p'
+ ; return $ SigPat noAnn pp (mkHsPatSigType noAnn t') }
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
; return $ ViewPat noAnn e' p'}
=====================================
configure.ac
=====================================
@@ -13,7 +13,7 @@ dnl
# see what flags are available. (Better yet, read the documentation!)
#
-AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.5], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION])
+AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.6], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION])
# Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable
# to be useful (cf #19058). However, the version must have three components
# (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are
=====================================
docs/users_guide/9.6.5-notes.rst
=====================================
@@ -63,49 +63,3 @@ Core libraries
- Bump ``Cabal`` to 3.10.3.0
- Bump ``process`` to 1.6.19.0
- Bump ``libffi-tarballs`` to 3.4.6
-
-Included libraries
-------------------
-
-The package database provided with this distribution also contains a number of
-packages other than GHC itself. See the changelogs provided with these packages
-for further change information.
-
-.. ghc-package-list::
-
- libraries/array/array.cabal: Dependency of ``ghc`` library
- libraries/base/base.cabal: Core library
- libraries/binary/binary.cabal: Dependency of ``ghc`` library
- libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library
- libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility
- libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility
- libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library
- libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library
- libraries/directory/directory.cabal: Dependency of ``ghc`` library
- libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library
- libraries/filepath/filepath.cabal: Dependency of ``ghc`` library
- compiler/ghc.cabal: The compiler itself
- libraries/ghci/ghci.cabal: The REPL interface
- libraries/ghc-boot/ghc-boot.cabal: Internal compiler library
- libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library
- libraries/ghc-compact/ghc-compact.cabal: Core library
- libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library
- libraries/ghc-prim/ghc-prim.cabal: Core library
- libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable
- libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable
- libraries/integer-gmp/integer-gmp.cabal: Core library
- libraries/libiserv/libiserv.cabal: Internal compiler library
- libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library
- libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library
- libraries/pretty/pretty.cabal: Dependency of ``ghc`` library
- libraries/process/process.cabal: Dependency of ``ghc`` library
- libraries/stm/stm.cabal: Dependency of ``haskeline`` library
- libraries/template-haskell/template-haskell.cabal: Core library
- libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library
- libraries/text/text.cabal: Dependency of ``Cabal`` library
- libraries/time/time.cabal: Dependency of ``ghc`` library
- libraries/transformers/transformers.cabal: Dependency of ``ghc`` library
- libraries/unix/unix.cabal: Dependency of ``ghc`` library
- libraries/Win32/Win32.cabal: Dependency of ``ghc`` library
- libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable
-
=====================================
docs/users_guide/release-notes.rst
=====================================
@@ -9,3 +9,4 @@ Release notes
9.6.3-notes
9.6.4-notes
9.6.5-notes
+ 9.6.6-notes
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -232,10 +232,12 @@ enableProfiledGhc flavour =
disableDynamicGhcPrograms :: Flavour -> Flavour
disableDynamicGhcPrograms flavour = flavour { dynamicGhcPrograms = pure False }
--- | Don't build libraries in profiled 'Way's.
+-- | Don't build libraries in dynamic 'Way's.
disableDynamicLibs :: Flavour -> Flavour
disableDynamicLibs flavour =
- flavour { libraryWays = prune $ libraryWays flavour
+ flavour { libraryWays = prune $ libraryWays flavour,
+ rtsWays = prune $ rtsWays flavour,
+ dynamicGhcPrograms = pure False
}
where
prune :: Ways -> Ways
@@ -295,18 +297,8 @@ enableBootNonmovingGc = addArgs $ mconcat
-- for static linking.
fullyStatic :: Flavour -> Flavour
fullyStatic flavour =
- addArgs staticExec
- $ flavour { dynamicGhcPrograms = return False
- , libraryWays = prune $ libraryWays flavour
- , rtsWays = prune $ rtsWays flavour }
+ addArgs staticExec $ disableDynamicLibs flavour
where
- -- Remove any Way that contains a WayUnit of Dynamic
- prune :: Ways -> Ways
- prune = fmap $ Set.filter staticCompatible
-
- staticCompatible :: Way -> Bool
- staticCompatible = not . wayUnit Dynamic
-
staticExec :: Args
{- Some packages, especially iserv, seem to force a set of build ways,
- including some that are dynamic (in Rules.BinaryDist). Trying to
@@ -315,7 +307,7 @@ fullyStatic flavour =
- the Ways will need to include a Way that's not explicitly dynamic
- (like "vanilla").
-}
- staticExec = staticCompatible <$> getWay ? mconcat
+ staticExec = mconcat
{-
- Disable dynamic linking by the built ghc executable because the
- statically-linked musl doesn't support dynamic linking, but will
=====================================
libraries/directory
=====================================
@@ -1 +1 @@
-Subproject commit a97a8a8f30d652f972192122fd5f459a147c13e5
+Subproject commit e8ee4d5565ec82272ca612034ba6029993e23fd0
=====================================
rts/Interpreter.c
=====================================
@@ -4,6 +4,30 @@
* Copyright (c) The GHC Team, 1994-2002.
* ---------------------------------------------------------------------------*/
+/*
+Note [CBV Functions and the interpreter]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When the byte code interpreter loads a reference to a value it often
+ends up as a non-tagged pointers *especially* if we already know a value
+is a certain constructor and therefore don't perform an eval on the reference.
+This causes friction with CBV functions which assume
+their value arguments are properly tagged by the caller.
+
+In order to ensure CBV functions still get passed tagged functions we have
+three options:
+a) Special case the interpreter behaviour into the tag inference analysis.
+ If we assume the interpreter can't properly tag value references the STG passes
+ would then wrap such calls in appropriate evals which are executed at runtime.
+ This would ensure tags by doing additional evals at runtime.
+b) When the interpreter pushes references for known constructors instead of
+ pushing the objects address add the tag to the value pushed. This is what
+ the NCG backends do.
+c) When the interpreter pushes a reference inspect the closure of the object
+ and apply the appropriate tag at runtime.
+
+For now we use approach c). Mostly because it's easiest to implement. We also don't
+tag functions as tag inference currently doesn't rely on those being properly tagged.
+*/
#include "rts/PosixSource.h"
#include "Rts.h"
@@ -1295,8 +1319,43 @@ run_BCO:
}
case bci_PUSH_G: {
- int o1 = BCO_GET_LARGE_ARG;
- SpW(-1) = BCO_PTR(o1);
+ W_ o1 = BCO_GET_LARGE_ARG;
+ StgClosure *tagged_obj = (StgClosure*) BCO_PTR(o1);
+
+ tag_push_g:
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR((StgClosure*) tagged_obj));
+ // Here we make sure references we push are tagged.
+ // See Note [CBV Functions and the interpreter] in Info.hs
+
+ //Safe some memory reads if we already have a tag.
+ if(GET_CLOSURE_TAG(tagged_obj) == 0) {
+ StgClosure *obj = UNTAG_CLOSURE(tagged_obj);
+ switch ( get_itbl(obj)->type ) {
+ case IND:
+ case IND_STATIC:
+ {
+ tagged_obj = ACQUIRE_LOAD(&((StgInd*)obj)->indirectee);
+ goto tag_push_g;
+ }
+ case CONSTR:
+ case CONSTR_1_0:
+ case CONSTR_0_1:
+ case CONSTR_2_0:
+ case CONSTR_1_1:
+ case CONSTR_0_2:
+ case CONSTR_NOCAF:
+ // The value is already evaluated, so we can just return it. However,
+ // before we do, we MUST ensure that the pointer is tagged, because we
+ // might return to a native `case` expression, which assumes the returned
+ // pointer is tagged so it can use the tag to select an alternative.
+ tagged_obj = tagConstr(obj);
+ break;
+ default:
+ break;
+ }
+ }
+
+ SpW(-1) = (W_) tagged_obj;
Sp_subW(1);
goto nextInsn;
}
=====================================
rts/linker/Elf.c
=====================================
@@ -707,7 +707,7 @@ ocGetNames_ELF ( ObjectCode* oc )
ASSERT(symhash != NULL);
- sections = (Section*)stgCallocBytes(sizeof(Section), shnum,
+ sections = (Section*)stgCallocBytes(shnum, sizeof(Section),
"ocGetNames_ELF(sections)");
oc->sections = sections;
oc->n_sections = shnum;
=====================================
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>
@@ -1209,8 +1210,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]);
@@ -1235,7 +1237,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
=====================================
@@ -919,6 +919,7 @@ static MarkQueueEnt markQueuePop (MarkQueue *q)
// 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));
prefetchForRead(Bdescr((StgPtr) new.mark_closure.p));
q->prefetch_queue[i] = new;
i = (i + 1) % MARK_PREFETCH_QUEUE_DEPTH;
=====================================
rts/sm/Scav.c
=====================================
@@ -1593,6 +1593,14 @@ scavenge_one(StgPtr p)
#endif
break;
+ case BCO: {
+ StgBCO *bco = (StgBCO *)p;
+ evacuate((StgClosure **)&bco->instrs);
+ evacuate((StgClosure **)&bco->literals);
+ evacuate((StgClosure **)&bco->ptrs);
+ break;
+ }
+
case COMPACT_NFDATA:
scavenge_compact((StgCompactNFData*)p);
break;
=====================================
testsuite/tests/codeGen/should_run/T23034.h
=====================================
@@ -0,0 +1 @@
+void t_printf(signed long a, signed int b, signed short c, signed char d);
=====================================
testsuite/tests/codeGen/should_run/T23034.hs
=====================================
@@ -0,0 +1,8 @@
+module Main where
+
+import Foreign.C
+
+foreign import ccall unsafe "T23034.h t_printf"
+ t_printf :: CLong -> CInt -> CShort -> CSChar -> IO ()
+
+main = t_printf (-1) (-2) (-3) (-4)
=====================================
testsuite/tests/codeGen/should_run/T23034.stdout
=====================================
@@ -0,0 +1 @@
+-1 -2 -3 -4
=====================================
testsuite/tests/codeGen/should_run/T23034_c.c
=====================================
@@ -0,0 +1,6 @@
+#include "T23034.h"
+#include <stdio.h>
+
+void t_printf(signed long a, signed int b, signed short c, signed char d) {
+ printf("%ld %ld %ld %ld\n", a, 0L + b, 0L + c, 0L + d);
+}
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -246,3 +246,6 @@ test('MulMayOflo_full',
['MulMayOflo', [('MulMayOflo_full.cmm', '')], ''])
test('T24295a', normal, compile_and_run, ['-O -floopification'])
test('T24295b', normal, compile_and_run, ['-O -floopification -fpedantic-bottoms'])
+test('T23034', [req_c
+ , when(arch('x86_64') and opsys('darwin'), expect_broken(25018))
+ ], compile_and_run, ['-O2 T23034_c.c'])
=====================================
testsuite/tests/core-to-stg/T24718.hs
=====================================
@@ -0,0 +1,12 @@
+module T24718 where
+
+import GHC.Exts ( Any )
+import Unsafe.Coerce ( unsafeCoerce )
+
+data T = MkT (Any -> Any)
+
+g :: () -> ()
+g x = x
+
+f :: T
+f = unsafeCoerce MkT g
=====================================
testsuite/tests/core-to-stg/all.T
=====================================
@@ -2,3 +2,4 @@
test('T19700', normal, compile, ['-O'])
test('T23914', normal, compile, ['-O'])
+test('T24718', normal, compile, ['-O'])
=====================================
testsuite/tests/th/T24837.hs
=====================================
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T24837 where
+
+import Language.Haskell.TH
+
+$([d| f ((x :: Bool) :: Bool) = x |])
=====================================
testsuite/tests/th/T24837.stderr
=====================================
@@ -0,0 +1,4 @@
+T24837.hs:6:2-37: Splicing declarations
+ [d| f ((x :: Bool) :: Bool) = x |]
+ ======>
+ f ((x :: Bool) :: Bool) = x
=====================================
testsuite/tests/th/all.T
=====================================
@@ -560,3 +560,4 @@ test('T22818', normal, compile, ['-v0'])
test('T22819', normal, compile, ['-v0'])
test('TH_fun_par', normal, compile, [''])
test('T23748', normal, compile, [''])
+test('T24837', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
=====================================
testsuite/tests/th/should_compile/T24870/Def.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module SDef where
+
+{-# NOINLINE aValue #-}
+aValue = True
+
+{-# NOINLINE aStrictFunction #-}
+aStrictFunction !x = [| x |]
=====================================
testsuite/tests/th/should_compile/T24870/Use.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module SUse where
+
+import qualified Language.Haskell.TH.Syntax as TH
+import SDef
+import GHC.Exts
+
+bar = $( inline aStrictFunction aValue )
=====================================
testsuite/tests/th/should_compile/T24870/all.T
=====================================
@@ -0,0 +1,6 @@
+# The interpreter must uphold tagging invariants, and failed to do so in #24870
+# We test this here by having the interpreter calls a strict worker function
+# with a reference to a value it constructed.
+# See also Note [CBV Functions and the interpreter]
+test('T24870', [extra_files(['Def.hs', 'Use.hs']), req_th],
+ multimod_compile, ['Def Use', '-dtag-inference-checks -v0'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc539e64e3d1a22dd7d970725ca82a48544cdddc...28ddc41b48e0947f2b31d1217b522df91b3756ac
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc539e64e3d1a22dd7d970725ca82a48544cdddc...28ddc41b48e0947f2b31d1217b522df91b3756ac
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/20240628/e1fabeb7/attachment-0001.html>
More information about the ghc-commits
mailing list