[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Don't consider large byte arrays/compact regions pinned.

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Dec 21 23:33:54 UTC 2022



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


Commits:
98837959 by Andreas Klebinger at 2022-12-21T18:33:40-05:00
Don't consider large byte arrays/compact regions pinned.

Workaround for #22255 which showed how treating large/compact regions
as pinned could cause segfaults.

- - - - -
b4066b70 by Matthew Pickering at 2022-12-21T18:33:42-05:00
hadrian bindist: Install manpages to share/man/man1/ghc.1

When the installation makefile was copied over the manpages were no
longer installed in the correct place. Now we install it into share/man/man1/ghc.1
as the make build system did.

Fixes #22371

- - - - -
bc4ec08c by Ben Gamari at 2022-12-21T18:33:43-05:00
rts: Drop paths from configure from cabal file

A long time ago we would rely on substitutions from the configure script
to inject paths of the include and library directories of libffi and
libdw. However, now these are instead handled inside Hadrian when
calling Cabal's `configure` (see the uses of `cabalExtraDirs` in
Hadrian's `Settings.Packages.packageArgs`).

While the occurrences in the cabal file were redundant, they did no
harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have
no longer been interpolated. @mpickering noticed the suspicious
uninterpolated occurrence of `@FFIIncludeDir@` in #22595,
prompting this commit to finally remove them.

- - - - -
1c53c36b by Simon Peyton Jones at 2022-12-21T18:33:44-05:00
Fix unifier bug: failing to decompose over-saturated type family

This simple patch fixes #22647

- - - - -
ce6ae36d by Ben Gamari at 2022-12-21T18:33:44-05:00
rts/m32: Fix sanity checking

Previously we would attempt to clear pages which were marked as
read-only. Fix this.

- - - - -


11 changed files:

- compiler/GHC/Core/Unify.hs
- hadrian/bindist/Makefile
- libraries/ghc-prim/changelog.md
- rts/PrimOps.cmm
- rts/linker/M32Alloc.c
- rts/rts.cabal.in
- testsuite/tests/rts/T13894.hs
- testsuite/tests/rts/T14900.hs
- testsuite/tests/rts/T14900.stdout
- + testsuite/tests/typecheck/should_compile/T22647.hs
- testsuite/tests/typecheck/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -1054,20 +1054,11 @@ unify_ty env ty1 ty2 _kco
             ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification]
               don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 }
 
-  | Just (tc1, _) <- mb_tc_app1
-  , not (isGenerativeTyCon tc1 Nominal)
-    -- E.g.   unify_ty (F ty1) b  =  MaybeApart
-    --        because the (F ty1) behaves like a variable
-    --        NB: if unifying, we have already dealt
-    --            with the 'ty2 = variable' case
-  = maybeApart MARTypeFamily
+  | isTyFamApp mb_tc_app1     -- A (not-over-saturated) type-family application
+  = maybeApart MARTypeFamily  -- behaves like a type variable; might match
 
-  | Just (tc2, _) <- mb_tc_app2
-  , not (isGenerativeTyCon tc2 Nominal)
-  , um_unif env
-    -- E.g.   unify_ty [a] (F ty2) =  MaybeApart, when unifying (only)
-    --        because the (F ty2) behaves like a variable
-    --        NB: we have already dealt with the 'ty1 = variable' case
+  | isTyFamApp mb_tc_app2     -- A (not-over-saturated) type-family application
+  , um_unif env               -- behaves like a type variable; might unify
   = maybeApart MARTypeFamily
 
   -- TYPE and CONSTRAINT are not Apart
@@ -1169,6 +1160,17 @@ unify_tys env orig_xs orig_ys
       -- Possibly different saturations of a polykinded tycon
       -- See Note [Polykinded tycon applications]
 
+isTyFamApp :: Maybe (TyCon, [Type]) -> Bool
+-- True if we have a saturated or under-saturated type family application
+-- If it is /over/ saturated then we return False.  E.g.
+--     unify_ty (F a b) (c d)    where F has arity 1
+-- we definitely want to decompose that type application! (#22647)
+isTyFamApp (Just (tc, tys))
+  =  not (isGenerativeTyCon tc Nominal)       -- Type family-ish
+  && not (tys `lengthExceeds` tyConArity tc)  -- Not over-saturated
+isTyFamApp Nothing
+  = False
+
 ---------------------------------
 uVar :: UMEnv
      -> InTyVar         -- Variable to be unified


=====================================
hadrian/bindist/Makefile
=====================================
@@ -66,7 +66,7 @@ install_bin: install_bin_libdir install_wrappers
 endif
 
 install: install_bin install_lib
-install: install_docs update_package_db
+install: install_man install_docs update_package_db
 
 ActualBinsDir=${ghclibdir}/bin
 ifeq "$(RelocatableBuild)" "YES"
@@ -187,19 +187,30 @@ install_lib: lib/settings
 install_docs:
 	@echo "Copying docs to $(DESTDIR)$(docdir)"
 	$(INSTALL_DIR) "$(DESTDIR)$(docdir)"
-	
+
 	if [ -d doc ]; then \
 		cd doc; $(FIND) . -type f -exec sh -c \
 			'$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`"' \
 			sh '{}' ';'; \
 	fi
-	
+
 	if [ -d docs-utils ]; then \
 		$(INSTALL_DIR) "$(DESTDIR)$(docdir)/html/libraries/"; \
 		$(INSTALL_DATA) docs-utils/prologue.txt "$(DESTDIR)$(docdir)/html/libraries/"; \
 		$(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \
 	fi
 
+MAN_SECTION := 1
+MAN_PAGES := doc/users_guide/build-man/ghc.1
+
+.PHONY: install_man
+install_man:
+	if [ -f $(MAN_PAGES) ]; then \
+		$(INSTALL_DIR) "$(DESTDIR)$(mandir)"; \
+		$(INSTALL_DIR) "$(DESTDIR)$(mandir)/man$(MAN_SECTION)"; \
+		$(INSTALL_MAN) $(INSTALL_OPTS) $(MAN_PAGES) "$(DESTDIR)$(mandir)/man$(MAN_SECTION)"; \
+	fi
+
 export SHELL
 install_wrappers: install_bin_libdir
 	@echo "Installing wrapper scripts"


=====================================
libraries/ghc-prim/changelog.md
=====================================
@@ -21,6 +21,13 @@
 - The `threadLabel#` primop was added, allowing the user to query the label of
   a given `ThreadId#`.
 
+- `isByteArrayPinned#` now only considers an array pinned if it was explicitly pinned
+  by the user. This is required to avoid ghc issue [#22255](https://gitlab.haskell.org/ghc/ghc/-/issues/22255)
+  which showed that the old behaviour could cause segfaults when used in combination
+  with compact regions.
+  We are working on ways to allow users and library authors to get back the
+  performance benefits of the old behaviour where possible.
+
 ## 0.9.0 *August 2022*
 
 - Shipped with GHC 9.4.1


=====================================
rts/PrimOps.cmm
=====================================
@@ -209,7 +209,10 @@ stg_isByteArrayPinnedzh ( gcptr ba )
     // See the comment in Storage.c:allocatePinned.
     // We also consider BF_COMPACT objects to be immovable. See #14900.
     flags = TO_W_(bdescr_flags(bd));
-    return (flags & (BF_PINNED | BF_LARGE | BF_COMPACT) != 0);
+
+    // We used to also consider BF_LARGE pinned, but stopped doing so
+    // because it interacted badly with compact regions. See #22255
+    return (flags & BF_PINNED != 0);
 }
 
 stg_isMutableByteArrayPinnedzh ( gcptr mba )


=====================================
rts/linker/M32Alloc.c
=====================================
@@ -286,13 +286,13 @@ m32_release_page(struct m32_page_t *page)
 
   const size_t pgsz = getPageSize();
   ssize_t sz = page->filled_page.size;
-  IF_DEBUG(sanity, memset(page, 0xaa, sz));
 
   // Break the page, which may be a large multi-page allocation, into
   // individual pages for the page pool
   while (sz > 0) {
     if (m32_free_page_pool_size < M32_MAX_FREE_PAGE_POOL_SIZE) {
       mprotectForLinker(page, pgsz, MEM_READ_WRITE);
+      IF_DEBUG(sanity, memset(page, 0xaa, pgsz));
       SET_PAGE_TYPE(page, FREE_PAGE);
       page->free_page.next = m32_free_page_pool;
       m32_free_page_pool = page;


=====================================
rts/rts.cabal.in
=====================================
@@ -205,10 +205,6 @@ library
          cpp-options: -DNOSMP
 
       include-dirs: include
-                    @FFIIncludeDir@
-                    @LibdwIncludeDir@
-
-
       includes: Rts.h
       install-includes: Cmm.h HsFFI.h MachDeps.h Rts.h RtsAPI.h Stg.h
                         ghcautoconf.h ghcconfig.h ghcplatform.h ghcversion.h


=====================================
testsuite/tests/rts/T13894.hs
=====================================
@@ -1,5 +1,5 @@
--- Test that isByteArray# returns True for large but not explicitly pinned byte
--- arrays
+-- Test that isByteArray# returns False for large but not explicitly pinned byte
+-- arrays, see #22255
 
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE UnboxedTuples  #-}
@@ -15,4 +15,4 @@ main = do
         (# s1, arr# #) ->
             case isMutableByteArrayPinned# arr# of
               n# -> (# s1, isTrue# n# #)
-    unless pinned $ putStrLn "BAD"
+    when pinned $ putStrLn "BAD"


=====================================
testsuite/tests/rts/T14900.hs
=====================================
@@ -13,6 +13,8 @@ newByteArray (I# sz) = IO $ \s -> case newByteArray# sz s of {
   (# s', arr# #) -> case unsafeFreezeByteArray# arr# s of {
   (# s'', barr# #) -> (# s', ByteArray barr# #) }}
 
+-- Currently we expect large/compact regions not to count as pinned.
+-- See #22255 for the reasoning.
 main :: IO ()
 main = do
   ByteArray arr1# <- fmap getCompact $ newByteArray 65000 >>= compact


=====================================
testsuite/tests/rts/T14900.stdout
=====================================
@@ -1,3 +1,3 @@
-1
-1
+0
+0
 Finished


=====================================
testsuite/tests/typecheck/should_compile/T22647.hs
=====================================
@@ -0,0 +1,21 @@
+{-# LANGUAGE TypeApplications, KindSignatures, DataKinds, TypeFamilies, FlexibleInstances #-}
+
+module T22647 where
+
+import Data.Kind
+
+data D = D
+type family F :: D -> Type
+
+class C f where
+  meth :: f
+
+instance C (f (p :: D)) where   -- f :: D -> Type
+  meth = error "urk1"
+
+instance C (g (q :: Type)) where -- g :: Type -> Type
+  meth = error "urk2"
+
+x = meth :: F 'D
+
+y = meth :: [Type]


=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -853,3 +853,4 @@ test('T21550', normal, compile, [''])
 test('T22310', normal, compile, [''])
 test('T22331', normal, compile, [''])
 test('T22516', normal, compile, [''])
+test('T22647', normal, compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1b1dcd45d4a3faf7967c5ad9950278c19ede81fc...ce6ae36dc1c02c8851b354bbd576d97d78bc9d9c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1b1dcd45d4a3faf7967c5ad9950278c19ede81fc...ce6ae36dc1c02c8851b354bbd576d97d78bc9d9c
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/20221221/0af3bb24/attachment-0001.html>


More information about the ghc-commits mailing list