[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: gitlab-ci: Introduce validation job for aarch64 cross-compilation
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Aug 9 00:11:07 UTC 2022
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00
gitlab-ci: Introduce validation job for aarch64 cross-compilation
Begins to address #11958.
- - - - -
e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00
Bump process submodule
- - - - -
ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00
gitlab-ci: Add basic support for cross-compiler testiing
Here we add a simple qemu-based test for cross-compilers.
- - - - -
50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00
rts: Ensure that Array# card arrays are initialized
In #19143 I noticed that newArray# failed to initialize the card table
of newly-allocated arrays. However, embarrassingly, I then only fixed
the issue in newArrayArray# and, in so doing, introduced the potential
for an integer underflow on zero-length arrays (#21962).
Here I fix the issue in newArray#, this time ensuring that we do not
underflow in pathological cases.
Fixes #19143.
- - - - -
e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00
testsuite: Add test for #21962
- - - - -
5b0ff652 by Ben Gamari at 2022-08-08T20:10:46-04:00
hadrian: Fix access mode of installed package registration files
Previously hadrian's bindist Makefile would modify package
registrations placed by `install` via a shell pipeline and `mv`.
However, the use of `mv` means that if umask is set then the user may
otherwise end up with package registrations which are inaccessible.
Fix this by ensuring that the mode is 0644.
- - - - -
3f8f6678 by Krzysztof Gogolewski at 2022-08-08T20:10:46-04:00
Cleanups around pretty-printing
* Remove hack when printing OccNames. No longer needed since e3dcc0d5
* Remove unused `pprCmms` and `instance Outputable Instr`
* Simplify `pprCLabel` (no need to pass platform)
* Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by
ImmLit, but that can take just a String instead.
* Remove instance `Outputable CLabel` - proper output of labels
needs a platform, and is done by the `OutputableP` instance
- - - - -
23 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Cmm.hs
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/AArch64/Regs.hs
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/CmmToAsm/PPC/Regs.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToAsm/X86/Regs.hs
- compiler/GHC/StgToCmm/Ticky.hs
- compiler/GHC/Types/Name/Occurrence.hs
- compiler/GHC/Unit/Types.hs
- hadrian/bindist/Makefile
- libraries/process
- rts/PrimOps.cmm
- rts/include/Cmm.h
- + testsuite/tests/array/should_run/T21962.hs
- testsuite/tests/array/should_run/all.T
- testsuite/tests/linters/notes.stdout
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -2,7 +2,7 @@ variables:
GIT_SSL_NO_VERIFY: "1"
# Commit of ghc/ci-images repository from which to pull Docker images
- DOCKER_REV: 58d08589371e78829a3279c6f8b1241e155d7f70
+ DOCKER_REV: 9e4c540d9e4972a36291dfdf81f079f37d748890
# Sequential version number of all cached things.
# Bump to invalidate GitLab CI cache.
=====================================
.gitlab/ci.sh
=====================================
@@ -93,6 +93,7 @@ Environment variables determining build configuration of Hadrian system:
BUILD_FLAVOUR Which flavour to build.
REINSTALL_GHC Build and test a reinstalled "stage3" ghc built using cabal-install
This tests the "reinstall" configuration
+ CROSS_EMULATOR The emulator to use for testing of cross-compilers.
Environment variables determining bootstrap toolchain (Linux):
@@ -564,15 +565,38 @@ function make_install_destdir() {
fi
info "merging file tree from $destdir to $instdir"
cp -a "$destdir/$instdir"/* "$instdir"/
- "$instdir"/bin/ghc-pkg recache
+ "$instdir"/bin/${cross_prefix}ghc-pkg recache
}
-function test_hadrian() {
- if [ -n "${CROSS_TARGET:-}" ]; then
- info "Can't test cross-compiled build."
- return
- fi
+# install the binary distribution in directory $1 to $2.
+function install_bindist() {
+ local bindist="$1"
+ local instdir="$2"
+ pushd "$bindist"
+ case "$(uname)" in
+ MSYS_*|MINGW*)
+ mkdir -p "$instdir"
+ cp -a * "$instdir"
+ ;;
+ *)
+ read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}"
+
+ # FIXME: The bindist configure script shouldn't need to be reminded of
+ # the target platform. See #21970.
+ if [ -n "${CROSS_TARGET:-}" ]; then
+ args+=( "--target=$CROSS_TARGET" "--host=$CROSS_TARGET" )
+ fi
+ run ./configure \
+ --prefix="$instdir" \
+ "${args[@]+"${args[@]}"}"
+ make_install_destdir "$TOP"/destdir "$instdir"
+ ;;
+ esac
+ popd
+}
+
+function test_hadrian() {
check_msys2_deps _build/stage1/bin/ghc --version
check_release_build
@@ -593,7 +617,21 @@ function test_hadrian() {
fi
- if [[ -n "${REINSTALL_GHC:-}" ]]; then
+ if [ -n "${CROSS_TARGET:-}" ]; then
+ if [ -n "${CROSS_EMULATOR:-}" ]; then
+ local instdir="$TOP/_build/install"
+ local test_compiler="$instdir/bin/${cross_prefix}ghc$exe"
+ install_bindist _build/bindist/ghc-*/ "$instdir"
+ echo 'main = putStrLn "hello world"' > hello.hs
+ echo "hello world" > expected
+ run "$test_compiler" hello.hs
+ $CROSS_EMULATOR ./hello > actual
+ run diff expected actual
+ else
+ info "Cannot test cross-compiled build without CROSS_EMULATOR being set."
+ return
+ fi
+ elif [[ -n "${REINSTALL_GHC:-}" ]]; then
run_hadrian \
test \
--test-root-dirs=testsuite/tests/stage1 \
@@ -602,20 +640,9 @@ function test_hadrian() {
--test-root-dirs=testsuite/tests/typecheck \
"runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test"
else
- cd _build/bindist/ghc-*/
- case "$(uname)" in
- MSYS_*|MINGW*)
- mkdir -p "$TOP"/_build/install
- cp -a * "$TOP"/_build/install
- ;;
- *)
- read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}"
- run ./configure --prefix="$TOP"/_build/install "${args[@]+"${args[@]}"}"
- make_install_destdir "$TOP"/destdir "$TOP"/_build/install
- ;;
- esac
- cd ../../../
- test_compiler="$TOP/_build/install/bin/ghc$exe"
+ local instdir="$TOP/_build/install"
+ local test_compiler="$instdir/bin/ghc$exe"
+ install_bindist _build/bindist/ghc-*/ "$instdir"
if [[ "${WINDOWS_HOST}" == "no" ]]; then
run_hadrian \
@@ -779,6 +806,9 @@ esac
if [ -n "${CROSS_TARGET:-}" ]; then
info "Cross-compiling for $CROSS_TARGET..."
target_triple="$CROSS_TARGET"
+ cross_prefix="$target_triple-"
+else
+ cross_prefix=""
fi
echo "Branch name ${CI_MERGE_REQUEST_SOURCE_BRANCH_NAME:-}"
=====================================
.gitlab/gen_ci.hs
=====================================
@@ -116,6 +116,8 @@ data BuildConfig
, llvmBootstrap :: Bool
, withAssertions :: Bool
, withNuma :: Bool
+ , crossTarget :: Maybe String
+ , crossEmulator :: Maybe String
, fullyStatic :: Bool
, tablesNextToCode :: Bool
, threadSanitiser :: Bool
@@ -126,6 +128,7 @@ configureArgsStr :: BuildConfig -> String
configureArgsStr bc = intercalate " " $
["--enable-unregisterised"| unregisterised bc ]
++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ]
+ ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ]
-- Compute the hadrian flavour from the BuildConfig
mkJobFlavour :: BuildConfig -> Flavour
@@ -156,6 +159,8 @@ vanilla = BuildConfig
, llvmBootstrap = False
, withAssertions = False
, withNuma = False
+ , crossTarget = Nothing
+ , crossEmulator = Nothing
, fullyStatic = False
, tablesNextToCode = True
, threadSanitiser = False
@@ -186,6 +191,14 @@ static = vanilla { fullyStatic = True }
staticNativeInt :: BuildConfig
staticNativeInt = static { bignumBackend = Native }
+crossConfig :: String -- ^ target triple
+ -> Maybe String -- ^ emulator for testing
+ -> BuildConfig
+crossConfig triple emulator =
+ vanilla { crossTarget = Just triple
+ , crossEmulator = emulator
+ }
+
llvm :: BuildConfig
llvm = vanilla { llvmBootstrap = True }
@@ -252,6 +265,7 @@ testEnv arch opsys bc = intercalate "-" $
++ ["unreg" | unregisterised bc ]
++ ["numa" | withNuma bc ]
++ ["no_tntc" | not (tablesNextToCode bc) ]
+ ++ ["cross_"++triple | Just triple <- pure $ crossTarget bc ]
++ [flavourString (mkJobFlavour bc)]
-- | The hadrian flavour string we are going to use for this build
@@ -597,7 +611,8 @@ 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
]
@@ -774,6 +789,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $
, standardBuilds I386 (Linux Debian9)
, allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static)
, disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))
+ , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Just "qemu-aarch64 -L /usr/aarch64-linux-gnu"))
]
where
=====================================
.gitlab/jobs.yaml
=====================================
@@ -1378,6 +1378,67 @@
"XZ_OPT": "-9"
}
},
+ "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": {
+ "after_script": [
+ ".gitlab/ci.sh save_cache",
+ ".gitlab/ci.sh clean",
+ "cat ci_timings"
+ ],
+ "allow_failure": false,
+ "artifacts": {
+ "expire_in": "8 weeks",
+ "paths": [
+ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz",
+ "junit.xml"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "x86_64-linux-deb11-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
+ "needs": [
+ {
+ "artifacts": false,
+ "job": "hadrian-ghc-in-ghci"
+ }
+ ],
+ "rules": [
+ {
+ "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")",
+ "when": "on_success"
+ }
+ ],
+ "script": [
+ "sudo chown ghc:ghc -R .",
+ ".gitlab/ci.sh setup",
+ ".gitlab/ci.sh configure",
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian"
+ ],
+ "stage": "full-build",
+ "tags": [
+ "x86_64-linux"
+ ],
+ "variables": {
+ "BIGNUM_BACKEND": "gmp",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate",
+ "BUILD_FLAVOUR": "validate",
+ "CONFIGURE_ARGS": "--with-intree-gmp",
+ "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu",
+ "CROSS_TARGET": "aarch64-linux-gnu",
+ "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate",
+ "XZ_OPT": "-9"
+ }
+ },
"nightly-x86_64-linux-deb11-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
@@ -3857,6 +3918,66 @@
"TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions"
}
},
+ "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": {
+ "after_script": [
+ ".gitlab/ci.sh save_cache",
+ ".gitlab/ci.sh clean",
+ "cat ci_timings"
+ ],
+ "allow_failure": false,
+ "artifacts": {
+ "expire_in": "2 weeks",
+ "paths": [
+ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz",
+ "junit.xml"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "x86_64-linux-deb11-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
+ "needs": [
+ {
+ "artifacts": false,
+ "job": "hadrian-ghc-in-ghci"
+ }
+ ],
+ "rules": [
+ {
+ "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")",
+ "when": "on_success"
+ }
+ ],
+ "script": [
+ "sudo chown ghc:ghc -R .",
+ ".gitlab/ci.sh setup",
+ ".gitlab/ci.sh configure",
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian"
+ ],
+ "stage": "full-build",
+ "tags": [
+ "x86_64-linux"
+ ],
+ "variables": {
+ "BIGNUM_BACKEND": "gmp",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate",
+ "BUILD_FLAVOUR": "validate",
+ "CONFIGURE_ARGS": "--with-intree-gmp",
+ "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu",
+ "CROSS_TARGET": "aarch64-linux-gnu",
+ "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate"
+ }
+ },
"x86_64-linux-deb11-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
=====================================
compiler/GHC/Cmm.hs
=====================================
@@ -33,7 +33,7 @@ module GHC.Cmm (
module GHC.Cmm.Expr,
-- * Pretty-printing
- pprCmms, pprCmmGroup, pprSection, pprStatic
+ pprCmmGroup, pprSection, pprStatic
) where
import GHC.Prelude
@@ -379,12 +379,6 @@ pprBBlock (BasicBlock ident stmts) =
--
-- These conventions produce much more readable Cmm output.
-pprCmms :: (OutputableP Platform info, OutputableP Platform g)
- => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc
-pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc platform) cmms))
- where
- separator = space $$ text "-------------------" $$ space
-
pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g)
=> Platform -> GenCmmGroup d info g -> SDoc
pprCmmGroup platform tops
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -294,9 +294,6 @@ data CLabel
instance Show CLabel where
show = showPprUnsafe . pprDebugCLabel genericPlatform
-instance Outputable CLabel where
- ppr = text . show
-
data ModuleLabelKind
= MLK_Initializer String
| MLK_InitializerArray
@@ -1412,19 +1409,19 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
AsmStyle | use_leading_underscores -> pp_cSEP <> doc
_ -> doc
- tempLabelPrefixOrUnderscore :: Platform -> SDoc
- tempLabelPrefixOrUnderscore platform = case sty of
+ tempLabelPrefixOrUnderscore :: SDoc
+ tempLabelPrefixOrUnderscore = case sty of
AsmStyle -> asmTempLabelPrefix platform
CStyle -> char '_'
in case lbl of
LocalBlockLabel u -> case sty of
- AsmStyle -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
- CStyle -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u
+ AsmStyle -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u
+ CStyle -> tempLabelPrefixOrUnderscore <> text "blk_" <> pprUniqueAlways u
AsmTempLabel u
- -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
+ -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u
AsmTempDerivedLabel l suf
-> asmTempLabelPrefix platform
@@ -1474,7 +1471,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
CStyle -> ppr name <> ppIdFlavor flavor
SRTLabel u
- -> maybe_underscore $ tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt"
+ -> maybe_underscore $ tempLabelPrefixOrUnderscore <> pprUniqueAlways u <> pp_cSEP <> text "srt"
RtsLabel (RtsApFast (NonDetFastString str))
-> maybe_underscore $ ftext str <> text "_fast"
@@ -1514,7 +1511,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
-> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr"
LargeBitmapLabel u
- -> maybe_underscore $ tempLabelPrefixOrUnderscore platform
+ -> maybe_underscore $ tempLabelPrefixOrUnderscore
<> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm"
-- Some bitmaps for tuple constructors have a numeric tag (e.g. '7')
-- until that gets resolved we'll just force them to start
=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -50,14 +50,14 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
vcat (map (pprBasicBlock config top_info) blocks) $$
(if ncgDwarfEnabled config
- then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
+ then pdoc platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
pprSizeDecl platform lbl
Just (CmmStaticsRaw info_lbl _) ->
pprSectionAlign config (Section Text info_lbl) $$
-- pprProcAlignment config $$
(if platformHasSubsectionsViaSymbols platform
- then ppr (mkDeadStripPreventer info_lbl) <> char ':'
+ then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':'
else empty) $$
vcat (map (pprBasicBlock config top_info) blocks) $$
-- above: Even the first block gets a label, because with branch-chain
@@ -65,9 +65,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
(if platformHasSubsectionsViaSymbols platform
then -- See Note [Subsections Via Symbols]
text "\t.long "
- <+> ppr info_lbl
+ <+> pdoc platform info_lbl
<+> char '-'
- <+> ppr (mkDeadStripPreventer info_lbl)
+ <+> pdoc platform (mkDeadStripPreventer info_lbl)
else empty) $$
pprSizeDecl platform info_lbl
@@ -87,9 +87,6 @@ pprAlignForSection _platform _seg
-- .balign is stable, whereas .align is platform dependent.
= text "\t.balign 8" -- always 8
-instance Outputable Instr where
- ppr = pprInstr genericPlatform
-
-- | Print section header and appropriate alignment for that section.
--
-- This one will emit the header:
@@ -118,7 +115,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
pprLabel platform asmLbl $$
vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$
(if ncgDwarfEnabled config
- then ppr (mkAsmTempEndLabel asmLbl) <> char ':'
+ then pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':'
else empty
)
where
@@ -138,7 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
pprLabel platform info_lbl $$
c $$
(if ncgDwarfEnabled config
- then ppr (mkAsmTempEndLabel info_lbl) <> char ':'
+ then pdoc platform (mkAsmTempEndLabel info_lbl) <> char ':'
else empty)
-- Make sure the info table has the right .loc for the block
-- coming right after it. See Note [Info Offset]
@@ -235,7 +232,7 @@ pprImm _ (ImmInt i) = int i
pprImm _ (ImmInteger i) = integer i
pprImm p (ImmCLbl l) = pdoc p l
pprImm p (ImmIndex l i) = pdoc p l <> char '+' <> int i
-pprImm _ (ImmLit s) = s
+pprImm _ (ImmLit s) = text s
-- TODO: See pprIm below for why this is a bad idea!
pprImm _ (ImmFloat f)
=====================================
compiler/GHC/CmmToAsm/AArch64/Regs.hs
=====================================
@@ -59,7 +59,7 @@ data Imm
= ImmInt Int
| ImmInteger Integer -- Sigh.
| ImmCLbl CLabel -- AbstractC Label (with baggage)
- | ImmLit SDoc -- Simple string
+ | ImmLit String
| ImmIndex CLabel Int
| ImmFloat Rational
| ImmDouble Rational
@@ -67,14 +67,8 @@ data Imm
| ImmConstantDiff Imm Imm
deriving (Eq, Show)
-instance Show SDoc where
- show = showPprUnsafe . ppr
-
-instance Eq SDoc where
- lhs == rhs = show lhs == show rhs
-
strImmLit :: String -> Imm
-strImmLit s = ImmLit (text s)
+strImmLit s = ImmLit s
litToImm :: CmmLit -> Imm
=====================================
compiler/GHC/CmmToAsm/PPC/CodeGen.hs
=====================================
@@ -407,7 +407,7 @@ getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' _ platform (CmmReg (CmmGlobal PicBaseReg))
| OSAIX <- platformOS platform = do
let code dst = toOL [ LD II32 dst tocAddr ]
- tocAddr = AddrRegImm toc (ImmLit (text "ghc_toc_table[TC]"))
+ tocAddr = AddrRegImm toc (ImmLit "ghc_toc_table[TC]")
return (Any II32 code)
| target32Bit platform = do
reg <- getPicBaseNat $ archWordFormat (target32Bit platform)
=====================================
compiler/GHC/CmmToAsm/PPC/Ppr.hs
=====================================
@@ -240,7 +240,7 @@ pprImm platform = \case
ImmInteger i -> integer i
ImmCLbl l -> pdoc platform l
ImmIndex l i -> pdoc platform l <> char '+' <> int i
- ImmLit s -> s
+ ImmLit s -> text s
ImmFloat f -> float $ fromRational f
ImmDouble d -> double $ fromRational d
ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b
=====================================
compiler/GHC/CmmToAsm/PPC/Regs.hs
=====================================
@@ -133,7 +133,7 @@ data Imm
= ImmInt Int
| ImmInteger Integer -- Sigh.
| ImmCLbl CLabel -- AbstractC Label (with baggage)
- | ImmLit SDoc -- Simple string
+ | ImmLit String
| ImmIndex CLabel Int
| ImmFloat Rational
| ImmDouble Rational
@@ -147,7 +147,7 @@ data Imm
strImmLit :: String -> Imm
-strImmLit s = ImmLit (text s)
+strImmLit s = ImmLit s
litToImm :: CmmLit -> Imm
=====================================
compiler/GHC/CmmToAsm/X86/Ppr.hs
=====================================
@@ -432,7 +432,7 @@ pprImm platform = \case
ImmInteger i -> integer i
ImmCLbl l -> pdoc platform l
ImmIndex l i -> pdoc platform l <> char '+' <> int i
- ImmLit s -> s
+ ImmLit s -> text s
ImmFloat f -> float $ fromRational f
ImmDouble d -> double $ fromRational d
ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b
=====================================
compiler/GHC/CmmToAsm/X86/Regs.hs
=====================================
@@ -55,7 +55,6 @@ import GHC.Platform.Reg.Class
import GHC.Cmm
import GHC.Cmm.CLabel ( CLabel )
-import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Platform
@@ -111,7 +110,7 @@ data Imm
= ImmInt Int
| ImmInteger Integer -- Sigh.
| ImmCLbl CLabel -- AbstractC Label (with baggage)
- | ImmLit SDoc -- Simple string
+ | ImmLit String
| ImmIndex CLabel Int
| ImmFloat Rational
| ImmDouble Rational
@@ -119,7 +118,7 @@ data Imm
| ImmConstantDiff Imm Imm
strImmLit :: String -> Imm
-strImmLit s = ImmLit (text s)
+strImmLit s = ImmLit s
litToImm :: CmmLit -> Imm
=====================================
compiler/GHC/StgToCmm/Ticky.hs
=====================================
@@ -363,7 +363,7 @@ emitTickyCounter cloType tickee
Just (CgIdInfo { cg_lf = cg_lf })
| isLFThunk cg_lf
-> return $! CmmLabel $ mkClosureInfoTableLabel (profilePlatform profile) tickee cg_lf
- _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> ppr (mkInfoTableLabel name NoCafRefs))
+ _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> pdoc (profilePlatform profile) (mkInfoTableLabel name NoCafRefs))
return $! zeroCLit platform
TickyLNE {} -> return $! zeroCLit platform
=====================================
compiler/GHC/Types/Name/Occurrence.hs
=====================================
@@ -6,7 +6,6 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE LambdaCase #-}
-- |
-- #name_types#
@@ -282,24 +281,9 @@ pprOccName (OccName sp occ)
= getPprStyle $ \ sty ->
if codeStyle sty
then ztext (zEncodeFS occ)
- else pp_occ <> whenPprDebug (braces (pprNameSpaceBrief sp))
- where
- pp_occ = sdocOption sdocSuppressUniques $ \case
- True -> text (strip_th_unique (unpackFS occ))
- False -> ftext occ
-
- -- See Note [Suppressing uniques in OccNames]
- strip_th_unique ('[' : c : _) | isAlphaNum c = []
- strip_th_unique (c : cs) = c : strip_th_unique cs
- strip_th_unique [] = []
+ else ftext occ <> whenPprDebug (braces (pprNameSpaceBrief sp))
{-
-Note [Suppressing uniques in OccNames]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-This is a hack to de-wobblify the OccNames that contain uniques from
-Template Haskell that have been turned into a string in the OccName.
-See Note [Unique OccNames from Template Haskell] in "GHC.ThToHs"
-
************************************************************************
* *
\subsection{Construction}
=====================================
compiler/GHC/Unit/Types.hs
=====================================
@@ -207,7 +207,7 @@ pprModule mod@(Module p n) = getPprStyle doc
| qualModule sty mod =
case p of
HoleUnit -> angleBrackets (pprModuleName n)
- _ -> ppr (moduleUnit mod) <> char ':' <> pprModuleName n
+ _ -> ppr p <> char ':' <> pprModuleName n
| otherwise =
pprModuleName n
=====================================
hadrian/bindist/Makefile
=====================================
@@ -83,6 +83,8 @@ define patchpackageconf \
((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy')
# We finally replace the original file.
mv '$2.copy.copy' '$2'
+ # Fix the mode, in case umask is set
+ chmod 644 '$2'
endef
# QUESTION : should we use shell commands?
=====================================
libraries/process
=====================================
@@ -1 +1 @@
-Subproject commit 7a7431a0ef586c0f1e602e382398b988c699dfc2
+Subproject commit b95e5fbdeb74e0cc36b6878b60f9807bd0001fa8
=====================================
rts/PrimOps.cmm
=====================================
@@ -350,6 +350,11 @@ stg_newArrayzh ( W_ n /* words */, gcptr init )
StgMutArrPtrs_ptrs(arr) = n;
StgMutArrPtrs_size(arr) = size;
+ /* Ensure that the card array is initialized */
+ if (n != 0) {
+ setCardsValue(arr, 0, n, 0);
+ }
+
// Initialise all elements of the array with the value in R2
p = arr + SIZEOF_StgMutArrPtrs;
for:
=====================================
rts/include/Cmm.h
=====================================
@@ -870,10 +870,11 @@
/*
* Set the cards in the array pointed to by arr for an
* update to n elements, starting at element dst_off to value (0 to indicate
- * clean, 1 to indicate dirty).
+ * clean, 1 to indicate dirty). n must be non-zero.
*/
#define setCardsValue(arr, dst_off, n, value) \
W_ __start_card, __end_card, __cards, __dst_cards_p; \
+ ASSERT(n != 0); \
__dst_cards_p = (arr) + SIZEOF_StgMutArrPtrs + WDS(StgMutArrPtrs_ptrs(arr)); \
__start_card = mutArrPtrCardDown(dst_off); \
__end_card = mutArrPtrCardDown((dst_off) + (n) - 1); \
=====================================
testsuite/tests/array/should_run/T21962.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE MagicHash #-}
+
+module Main where
+
+import GHC.IO
+import GHC.Exts
+
+main :: IO ()
+main = do
+ IO $ \s0 -> case newArray# 0# () s0 of (# s1, arr #) -> (# s1, () #)
=====================================
testsuite/tests/array/should_run/all.T
=====================================
@@ -23,3 +23,4 @@ test('arr017', when(fast(), skip), compile_and_run, [''])
test('arr018', when(fast(), skip), compile_and_run, [''])
test('arr019', normal, compile_and_run, [''])
test('arr020', normal, compile_and_run, [''])
+test('T21962', normal, compile_and_run, [''])
=====================================
testsuite/tests/linters/notes.stdout
=====================================
@@ -44,7 +44,6 @@ ref compiler/GHC/Tc/Types.hs:702:33: Note [Extra dependencies from .hs-bo
ref compiler/GHC/Tc/Types.hs:1433:47: Note [Care with plugin imports]
ref compiler/GHC/Tc/Types/Constraint.hs:253:34: Note [NonCanonical Semantics]
ref compiler/GHC/Types/Demand.hs:308:25: Note [Preserving Boxity of results is rarely a win]
-ref compiler/GHC/Types/Name/Occurrence.hs:301:4: Note [Unique OccNames from Template Haskell]
ref compiler/GHC/Unit/Module/Deps.hs:82:13: Note [Structure of dep_boot_mods]
ref compiler/GHC/Utils/Monad.hs:391:34: Note [multiShotIO]
ref compiler/Language/Haskell/Syntax/Binds.hs:204:31: Note [fun_id in Match]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/37ece3c67a9a75717d1f5be942d1f831df64994a...3f8f6678fbf3686fc6ffc73cbf3db9b485ef53ee
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/37ece3c67a9a75717d1f5be942d1f831df64994a...3f8f6678fbf3686fc6ffc73cbf3db9b485ef53ee
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/20220808/f951fb8d/attachment-0001.html>
More information about the ghc-commits
mailing list