[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Drop 32-bit Windows support
Marge Bot
gitlab at gitlab.haskell.org
Mon Jul 27 17:19:04 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
b0e4b041 by Ben Gamari at 2020-07-27T13:18:59-04:00
Drop 32-bit Windows support
As noted in #18487, we have reached the end of this road.
- - - - -
cc72e209 by Michalis Pardalos at 2020-07-27T13:19:00-04:00
Add minimal test for #12492
- - - - -
f82bc7c9 by Michalis Pardalos at 2020-07-27T13:19:00-04:00
Use allocate, not ALLOC_PRIM_P for unpackClosure#
ALLOC_PRIM_P fails for large closures, by directly using allocate
we can handle closures which are larger than the block size.
Fixes #12492
- - - - -
fcbca90a by Simon Peyton Jones at 2020-07-27T13:19:01-04:00
Eta-expand the Simplifier monad
This patch eta-expands the Simplifier's monad, using the method
explained in GHC.Core.Unify Note [The one-shot state monad trick].
It's part of the exta-expansion programme in #18202.
It's a tiny patch, but is worth a 1-2% reduction in bytes-allocated
by the compiler. Here's the list, based on the compiler-performance
tests in perf/compiler:
Reduction in bytes allocated
T10858(normal) -0.7%
T12425(optasm) -1.3%
T13056(optasm) -1.8%
T14683(normal) -1.1%
T15164(normal) -1.3%
T15630(normal) -1.4%
T17516(normal) -2.3%
T18282(normal) -1.6%
T18304(normal) -0.8%
T1969(normal) -0.6%
T4801(normal) -0.8%
T5321FD(normal) -0.7%
T5321Fun(normal) -0.5%
T5642(normal) -0.9%
T6048(optasm) -1.1%
T9020(optasm) -2.7%
T9233(normal) -0.7%
T9675(optasm) -0.5%
T9961(normal) -2.9%
WWRec(normal) -1.2%
Metric Decrease:
T12425
T9020
T9961
- - - - -
cf67c2c8 by Ben Gamari at 2020-07-27T13:19:01-04:00
gitlab-ci: Ensure that Hadrian jobs don't download artifacts
Previously the Hadrian jobs had the default dependencies, meaning that
they would download artifacts from all jobs of earlier stages. This is
unneccessary.
- - - - -
61e1d542 by Ben Gamari at 2020-07-27T13:19:01-04:00
gitlab-ci: Bump bootstrap compiler to 8.8.4
Hopefully this will make the Windows jobs a bit more reliable.
- - - - -
6 changed files:
- .gitlab-ci.yml
- compiler/GHC/Core/Opt/Simplify/Monad.hs
- docs/users_guide/8.12.1-notes.rst
- rts/PrimOps.cmm
- + testsuite/tests/primops/should_run/T12492.hs
- testsuite/tests/primops/should_run/all.T
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -190,6 +190,7 @@ lint-release-changelogs:
key: hadrian
paths:
- cabal-cache
+ dependencies: []
artifacts:
reports:
junit: junit.xml
@@ -292,8 +293,8 @@ hadrian-ghc-in-ghci:
# porting guide [1].
# [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html)
CONFIGURE_ARGS: "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib"
- GHC_VERSION: 8.10.1
- CABAL_INSTALL_VERSION: 3.2.0.0
+ GHC_VERSION: "8.10.1"
+ CABAL_INSTALL_VERSION: "3.2.0.0"
BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-portbld-freebsd.tar.xz"
TEST_ENV: "x86_64-freebsd"
BUILD_FLAVOUR: "validate"
@@ -367,7 +368,7 @@ validate-x86_64-darwin:
tags:
- x86_64-darwin
variables:
- GHC_VERSION: 8.8.3
+ GHC_VERSION: 8.8.4
CABAL_INSTALL_VERSION: 3.0.0.0
BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-apple-darwin.tar.xz"
MACOSX_DEPLOYMENT_TARGET: "10.7"
@@ -395,7 +396,7 @@ validate-x86_64-darwin:
tags:
- x86_64-darwin
variables:
- GHC_VERSION: 8.8.3
+ GHC_VERSION: 8.8.4
MACOSX_DEPLOYMENT_TARGET: "10.7"
ac_cv_func_clock_gettime: "no"
LANG: "en_US.UTF-8"
@@ -776,8 +777,8 @@ validate-x86_64-linux-fedora27:
#FORCE_SYMLINKS: 1
LANG: "en_US.UTF-8"
SPHINXBUILD: "/mingw64/bin/sphinx-build.exe"
- CABAL_INSTALL_VERSION: 3.0.0.0
- GHC_VERSION: "8.8.3"
+ CABAL_INSTALL_VERSION: "3.0.0.0"
+ GHC_VERSION: "8.8.4"
cache:
paths:
- cabal-cache
@@ -817,15 +818,6 @@ validate-x86_64-windows-hadrian:
cache:
key: "x86_64-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION"
-nightly-i386-windows-hadrian:
- <<: *nightly
- extends: .build-windows-hadrian
- variables:
- MSYSTEM: MINGW32
- TEST_ENV: "i386-windows-hadrian"
- cache:
- key: "i386-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION"
-
.build-windows-make:
extends: .build-windows
stage: full-build
@@ -882,34 +874,6 @@ release-x86_64-windows-integer-simple:
BIGNUM_BACKEND: native
BUILD_FLAVOUR: "perf"
-
-.build-i386-windows-make:
- extends: .build-windows-make
- variables:
- MSYSTEM: MINGW32
- # Due to #15934
- BUILD_PROF_LIBS: "NO"
- TEST_ENV: "i386-windows"
- # Due to #17736
- allow_failure: true
- cache:
- key: "i386-windows-$WINDOWS_TOOLCHAIN_VERSION"
-
-validate-i386-windows:
- extends: .build-i386-windows-make
- variables:
- BUILD_FLAVOUR: "perf"
-
-release-i386-windows:
- <<: *release
- extends: .build-i386-windows-make
- variables:
- BUILD_FLAVOUR: "perf"
-
-nightly-i386-windows:
- <<: *nightly
- extends: .build-i386-windows-make
-
############################################################
# Cleanup
############################################################
=====================================
compiler/GHC/Core/Opt/Simplify/Monad.hs
=====================================
@@ -43,6 +43,7 @@ import GHC.Utils.Panic (throwGhcExceptionIO, GhcException (..))
import GHC.Types.Basic ( IntWithInf, treatZeroAsInf, mkIntWithInf )
import Control.Monad ( ap )
import GHC.Core.Multiplicity ( pattern Many )
+import GHC.Exts( oneShot )
{-
************************************************************************
@@ -56,14 +57,25 @@ For the simplifier monad, we want to {\em thread} a unique supply and a counter.
-}
newtype SimplM result
- = SM { unSM :: SimplTopEnv -- Envt that does not change much
- -> UniqSupply -- We thread the unique supply because
- -- constantly splitting it is rather expensive
- -> SimplCount
- -> IO (result, UniqSupply, SimplCount)}
- -- we only need IO here for dump output
+ = SM' { unSM :: SimplTopEnv -- Envt that does not change much
+ -> UniqSupply -- We thread the unique supply because
+ -- constantly splitting it is rather expensive
+ -> SimplCount
+ -> IO (result, UniqSupply, SimplCount)}
+ -- We only need IO here for dump output
deriving (Functor)
+pattern SM :: (SimplTopEnv -> UniqSupply -> SimplCount
+ -> IO (result, UniqSupply, SimplCount))
+ -> SimplM result
+-- This pattern synonym makes the simplifier monad eta-expand,
+-- which as a very beneficial effect on compiler performance
+-- (worth a 1-2% reduction in bytes-allocated). See #18202.
+-- See Note [The one-shot state monad trick] in GHC.Core.Unify
+pattern SM m <- SM' m
+ where
+ SM m = SM' (oneShot m)
+
data SimplTopEnv
= STE { st_flags :: DynFlags
, st_max_ticks :: IntWithInf -- Max #ticks in this simplifier run
=====================================
docs/users_guide/8.12.1-notes.rst
=====================================
@@ -79,6 +79,11 @@ Highlights
$(return [])
instance C Bool where foo = True
+ * Support for 32-bit Windows has officially been dropped as Microsoft has
+ formally discontinued new 32-bit Windows 10 releases in 2020. See
+ :ghc-ticket:`18487` for details.
+
+
Full details
------------
=====================================
rts/PrimOps.cmm
=====================================
@@ -2360,6 +2360,7 @@ stg_mkApUpd0zh ( P_ bco )
stg_unpackClosurezh ( P_ closure )
{
W_ info, ptrs, nptrs, p, ptrs_arr, dat_arr;
+ MAYBE_GC_P(stg_unpackClosurezh, closure);
info = %GET_STD_INFO(UNTAG(closure));
prim_read_barrier;
@@ -2375,12 +2376,13 @@ stg_unpackClosurezh ( P_ closure )
(len) = foreign "C" heap_view_closureSize(clos "ptr");
W_ ptrs_arr_sz, ptrs_arr_cards, dat_arr_sz;
- dat_arr_sz = SIZEOF_StgArrBytes + WDS(len);
-
- ALLOC_PRIM_P (dat_arr_sz, stg_unpackClosurezh, closure);
-
- dat_arr = Hp - dat_arr_sz + WDS(1);
+ dat_arr_sz = SIZEOF_StgArrBytes + WDS(len);
+ ("ptr" dat_arr) = ccall allocateMightFail(MyCapability() "ptr", BYTES_TO_WDS(dat_arr_sz));
+ if (dat_arr == NULL) (likely: False) {
+ jump stg_raisezh(base_GHCziIOziException_heapOverflow_closure);
+ }
+ TICK_ALLOC_PRIM(SIZEOF_StgArrBytes, WDS(len), 0);
SET_HDR(dat_arr, stg_ARR_WORDS_info, CCCS);
StgArrBytes_bytes(dat_arr) = WDS(len);
=====================================
testsuite/tests/primops/should_run/T12492.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+import GHC.Exts
+import GHC.IO
+
+main :: IO ()
+main = IO $ \s -> case newByteArray# 1032161# s of
+ (# s', mba# #) -> case unpackClosure# (unsafeCoerce# mba# :: Any) of
+ (# !_, _, _ #) -> (# s', () #)
=====================================
testsuite/tests/primops/should_run/all.T
=====================================
@@ -19,6 +19,7 @@ test('ArithWord8', omit_ways(['ghci']), compile_and_run, [''])
test('CmpInt8', normal, compile_and_run, [''])
test('CmpWord8', normal, compile_and_run, [''])
test('ShowPrim', normal, compile_and_run, [''])
+test('T12492', normal, compile_and_run, [''])
# These two tests use unboxed tuples, which GHCi doesn't support
test('ArithInt16', omit_ways(['ghci']), compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5174f38273ec93b4bb2a1c05aa5d20ca0da1fa3...61e1d542585b5be4e5fe26dc7e9245ff60efd32d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5174f38273ec93b4bb2a1c05aa5d20ca0da1fa3...61e1d542585b5be4e5fe26dc7e9245ff60efd32d
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/20200727/70e6327b/attachment-0001.html>
More information about the ghc-commits
mailing list