[Git][ghc/ghc][ghc-8.10] 10 commits: typecheck: Drop SPECIALISE pragmas when there is no unfolding

Ben Gamari gitlab at gitlab.haskell.org
Sat Oct 17 17:35:04 UTC 2020



Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC


Commits:
da1b5345 by Ben Gamari at 2020-10-16T01:10:54+02:00
typecheck: Drop SPECIALISE pragmas when there is no unfolding

Previously the desugarer would instead fall over when it realized that
there was no unfolding for an imported function with a SPECIALISE
pragma. We now rather drop the SPECIALISE pragma and throw a warning.

Fixes #18118.

(cherry picked from commit 708e374a8bf108999c11b6cf59c7d27677ed24a8)

- - - - -
f3bc882d by Ben Gamari at 2020-10-16T01:13:02+02:00
testsuite: Add test for #18118

(cherry picked from commit 2cdb72a569f6049a390626bca0dd6e362045ed65)

Conflicts:
	testsuite/tests/typecheck/should_compile/all.T

- - - - -
7e6c6340 by Moritz Angermann at 2020-10-16T01:14:57+02:00
[fixup 3433] move debugBelch into IF_DEBUG(linker)

The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left
the `debugBelch` function without a comment or IF_DEBUG(linker,)
decoration. This rectifies it.

Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5

(cherry picked from commit 6189cc04ca6c3d79126744e988b487f75ccef9e2)

- - - - -
1ac0a2aa by Ben Gamari at 2020-10-16T01:16:06+02:00
rts: Add stg_copyArray_barrier to RtsSymbols list

It's incredible that this wasn't noticed until now.

(cherry picked from commit ea1cbb8f2ac9e077ed19530911c3a35c5f46ee8a)

- - - - -
1fdadd41 by Ben Gamari at 2020-10-16T01:16:38+02:00
rts: Fix erroneous usage of vsnprintf

As pointed out in #18685, this should be snprintf not vsnprintf. This
appears to be due to a cut-and-paste error.

Fixes #18658.

(cherry picked from commit ce42e187ebfc81174ed477f247f023ae094c9b24)

- - - - -
ec6b31f0 by Ben Gamari at 2020-10-16T01:17:08+02:00
rts/nonmoving: Add missing STM write barrier

When updating a TRec for a TVar already part of a transaction we
previously neglected to add the old value to the update remembered set.
I suspect this was the cause of #18587.

(cherry picked from commit 0799b3de3e3462224bddc0e4b6a3156d04a06361)

- - - - -
7367ae91 by Ben Gamari at 2020-10-16T01:17:33+02:00
rts: Drop field initializer on thread_basic_info_data_t

This struct has a number of fields and we only care that the value is
initialized with zeros. This eliminates the warnings noted in #17905.

(cherry picked from commit 057db94ce038970b14df1599fe83097c284b9c1f)

- - - - -
5b5dde18 by Benjamin Maurer at 2020-10-16T01:19:50+02:00
Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve
_all_ of it, leaving nothing for, e.g., thread stacks.
Fix will only allocate 2/3rds and check whether remainder is at least large
enough for minimum amount of thread stacks.

(cherry picked from commit 74c797f6b72c4d01f5e0092dfac1461f3f3dd7a2)

- - - - -
8cb4fe24 by Krzysztof Gogolewski at 2020-10-16T01:20:55+02:00
Add a flag to indicate that gcc supports -no-pie

Fixes #17919.

(cherry picked from commit 587c3c514f05f97082952d613695f1186ff3174e)

- - - - -
5a4d0c3d by Krzysztof Gogolewski at 2020-10-16T01:21:41+02:00
Add -pgmlm and -optlm flags

!3798 added documentation and semantics for the flags,
but not parsing.

(cherry picked from commit fd302e938ebf48c73d9f715d67ce8cd990f972ff)

- - - - -


13 changed files:

- compiler/main/DynFlags.hs
- compiler/typecheck/TcSigs.hs
- docs/users_guide/phases.rst
- rts/RtsMessages.c
- rts/RtsSymbols.c
- rts/STM.c
- rts/linker/Elf.c
- rts/posix/GetTime.c
- rts/posix/OSMem.c
- + testsuite/tests/rts/T18623/all.T
- + testsuite/tests/typecheck/should_compile/T18118.hs
- + testsuite/tests/typecheck/should_compile/T18118A.hs
- testsuite/tests/typecheck/should_compile/all.T


Changes:

=====================================
compiler/main/DynFlags.hs
=====================================
@@ -3064,6 +3064,8 @@ dynamic_flags_deps = [
       $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lo  = (f,[]) }
   , make_ord_flag defFlag "pgmlc"
       $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lc  = (f,[]) }
+  , make_ord_flag defFlag "pgmlm"
+      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lm  = (f,[]) }
   , make_ord_flag defFlag "pgmi"
       $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_i   =  f }
   , make_ord_flag defFlag "pgmL"
@@ -3079,6 +3081,8 @@ dynamic_flags_deps = [
            -- (see #15319)
            toolSettings_ccSupportsNoPie = False
          }
+  , make_ord_flag defFlag "pgmc-supports-no-pie"
+      $ noArg $ alterToolSettings $ \s -> s { toolSettings_ccSupportsNoPie = True }
   , make_ord_flag defFlag "pgms"
       (HasArg (\_ -> addWarn "Object splitting was removed in GHC 8.8"))
   , make_ord_flag defFlag "pgma"
@@ -3102,6 +3106,8 @@ dynamic_flags_deps = [
 
 
     -- need to appear before -optl/-opta to be parsed as LLVM flags.
+  , make_ord_flag defFlag "optlm"
+      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lm  = f : toolSettings_opt_lm s }
   , make_ord_flag defFlag "optlo"
       $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lo  = f : toolSettings_opt_lo s }
   , make_ord_flag defFlag "optlc"


=====================================
compiler/typecheck/TcSigs.hs
=====================================
@@ -818,9 +818,13 @@ tcImpPrags prags
 tcImpSpec :: (Name, Sig GhcRn) -> TcM [TcSpecPrag]
 tcImpSpec (name, prag)
  = do { id <- tcLookupId name
-      ; unless (isAnyInlinePragma (idInlinePragma id))
-               (addWarnTc NoReason (impSpecErr name))
-      ; tcSpecPrag id prag }
+      ; if isAnyInlinePragma (idInlinePragma id)
+        then tcSpecPrag id prag
+        else do { addWarnTc NoReason (impSpecErr name)
+                ; return [] } }
+      -- If there is no INLINE/INLINABLE pragma there will be no unfolding. In
+      -- that case, just delete the SPECIALISE pragma altogether, lest the
+      -- desugarer fall over because it can't find the unfolding. See #18118.
 
 impSpecErr :: Name -> SDoc
 impSpecErr name


=====================================
docs/users_guide/phases.rst
=====================================
@@ -180,6 +180,20 @@ the following flags:
 
     Pass ⟨option⟩ to the C compiler.
 
+.. ghc-flag:: -pgmc-supports-no-pie
+    :shortdesc: Indicate that the C compiler supports ``-no-pie``
+    :type: dynamic
+    :category: phase-options
+
+    When ``-pgmc`` is used, GHC by default will never pass the ``-no-pie``
+    command line flag. The rationale is that it is not known whether the
+    specified compiler will support it. This flag can be used to indicate
+    that ``-no-pie`` is supported. It has to be passed after ``-pgmc``.
+
+    This flag is not neccessary when ``-pgmc`` is not used, since GHC
+    remembers whether the default C compiler supports ``-no-pie`` in
+    an internal settings file.
+
 .. ghc-flag:: -optcxx ⟨option⟩
     :shortdesc: pass ⟨option⟩ to the C++ compiler
     :type: dynamic


=====================================
rts/RtsMessages.c
=====================================
@@ -248,7 +248,7 @@ rtsSysErrorMsgFn(const char *s, va_list ap)
 
         r = vsnprintf(buf, BUFSIZE, s, ap);
         if (r > 0 && r < BUFSIZE) {
-            r = vsnprintf(buf+r, BUFSIZE-r, ": %s", syserr);
+            r = snprintf(buf+r, BUFSIZE-r, ": %s", syserr);
             MessageBox(NULL /* hWnd */,
                        buf,
                        prog_name,


=====================================
rts/RtsSymbols.c
=====================================
@@ -700,6 +700,7 @@
       SymI_HasProto(stg_copySmallArrayzh)                               \
       SymI_HasProto(stg_copySmallMutableArrayzh)                        \
       SymI_HasProto(stg_casSmallArrayzh)                                \
+      SymI_HasProto(stg_copyArray_barrier)                              \
       SymI_HasProto(stg_newBCOzh)                                       \
       SymI_HasProto(stg_newByteArrayzh)                                 \
       SymI_HasProto(stg_casIntArrayzh)                                  \


=====================================
rts/STM.c
=====================================
@@ -1342,6 +1342,9 @@ void stmWriteTVar(Capability *cap,
   if (entry != NULL) {
     if (entry_in == trec) {
       // Entry found in our trec
+      IF_NONMOVING_WRITE_BARRIER_ENABLED {
+        updateRemembSetPushClosure(cap, (StgClosure *) entry->new_value);
+      }
       entry -> new_value = new_value;
     } else {
       // Entry found in another trec


=====================================
rts/linker/Elf.c
=====================================
@@ -903,8 +903,9 @@ ocGetNames_ELF ( ObjectCode* oc )
                    common_used += symbol->elf_sym->st_size;
                    ASSERT(common_used <= common_size);
 
-                   debugBelch("COMMON symbol, size %ld name %s allocated at %p\n",
-                                   symbol->elf_sym->st_size, nm, symbol->addr);
+                   IF_DEBUG(linker,
+                            debugBelch("COMMON symbol, size %ld name %s allocated at %p\n",
+                                       symbol->elf_sym->st_size, nm, symbol->addr));
 
                    /* Pointless to do addProddableBlock() for this area,
                       since the linker should never poke around in it. */


=====================================
rts/posix/GetTime.c
=====================================
@@ -71,7 +71,7 @@ Time getCurrentThreadCPUTime(void)
     // support clock_getcpuclockid. Hence we prefer to use the Darwin-specific
     // path on Darwin, even if clock_gettime is available.
 #if defined(darwin_HOST_OS)
-    thread_basic_info_data_t info = { 0 };
+    thread_basic_info_data_t info = { };
     mach_msg_type_number_t info_count = THREAD_BASIC_INFO_COUNT;
     kern_return_t kern_err = thread_info(mach_thread_self(), THREAD_BASIC_INFO,
                                          (thread_info_t) &info, &info_count);


=====================================
rts/posix/OSMem.c
=====================================
@@ -39,6 +39,7 @@
 #if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_SYS_TIME_H)
 #include <sys/time.h>
 #include <sys/resource.h>
+#include <pthread.h>
 #endif
 
 #include <errno.h>
@@ -545,13 +546,57 @@ void *osReserveHeapMemory(void *startAddressPtr, W_ *len)
     }
 
 #if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_SYS_TIME_H)
-    struct rlimit limit;
+    struct rlimit asLimit;
     /* rlim_t is signed on some platforms, including FreeBSD;
      * explicitly cast to avoid sign compare error */
-    if (!getrlimit(RLIMIT_AS, &limit)
-        && limit.rlim_cur > 0
-        && *len > (W_) limit.rlim_cur) {
-        *len = (W_) limit.rlim_cur;
+    if (!getrlimit(RLIMIT_AS, &asLimit)
+        && asLimit.rlim_cur > 0
+        && *len > (W_) asLimit.rlim_cur) {
+
+        /* In case address space/virtual memory was limited by rlimit (ulimit),
+           we try to reserver 2/3 of that limit. If we take all, there'll be
+           nothing left for spawning system threads etc. and we'll crash
+           (See #18623)
+        */
+
+        pthread_attr_t threadAttr;
+        if (pthread_attr_init(&threadAttr)) {
+            // Never fails on Linux
+            sysErrorBelch("failed to initialize thread attributes");
+            stg_exit(EXIT_FAILURE);
+        }
+
+        size_t stacksz = 0;
+        if (pthread_attr_getstacksize(&threadAttr, &stacksz)) {
+            // Should never fail
+            sysErrorBelch("failed to read default thread stack size");
+            stg_exit(EXIT_FAILURE);
+        }
+
+        // Cleanup
+        if (pthread_attr_destroy(&threadAttr)) {
+            // Should never fail
+            sysErrorBelch("failed to destroy thread attributes");
+            stg_exit(EXIT_FAILURE);
+        }
+
+        size_t pageSize = getPageSize();
+        // 2/3rds of limit, round down to multiple of PAGE_SIZE
+        *len = (W_) (asLimit.rlim_cur * 0.666) & ~(pageSize - 1);
+
+        // debugBelch("New len: %zu, pageSize: %zu\n", *len, pageSize);
+
+        /* Make sure we leave enough vmem for at least three threads.
+           This number was found through trial and error. We're at least launching
+           that many threads (e.g., itimer). We can't know for sure how much we need,
+           but at least we can fail early and give a useful error message in this case. */
+        if (((W_) (asLimit.rlim_cur - *len )) < ((W_) (stacksz * 3))) {
+            // Three stacks is 1/3 of needed, then convert to Megabyte
+            size_t needed = (stacksz * 3 * 3) / (1024 * 1024);
+            errorBelch("the current resource limit for virtual memory ('ulimit -v' or RLIMIT_AS) is too low.\n"
+                "Please make sure that at least %zuMiB of virtual memory are available.", needed);
+            stg_exit(EXIT_FAILURE);
+        }
     }
 #endif
 
@@ -577,9 +622,11 @@ void *osReserveHeapMemory(void *startAddressPtr, W_ *len)
             // of memory will be wasted (e.g. imagine a machine with 512GB of
             // physical memory but a 511GB ulimit). See #14492.
             *len -= *len / 8;
+            // debugBelch("Limit hit, reduced len: %zu\n", *len);
         } else if ((W_)at >= minimumAddress) {
             // Success! We were given a block of memory starting above the 8 GB
             // mark, which is what we were looking for.
+
             break;
         } else {
             // We got addressing space but it wasn't above the 8GB mark.


=====================================
testsuite/tests/rts/T18623/all.T
=====================================
@@ -0,0 +1,6 @@
+# Starting GHC on *nix with vmem limit, RTS will reserve all available memory
+# and crash when creating a thread. Fix reserves only 2/3rds  of vmem_limit.
+test('T18623',
+    [when(opsys('mingw32'), skip), cmd_prefix('ulimit -v ' + str(1024 ** 2) + ' && '), ignore_stdout],
+    run_command,
+    ['{compiler} --version'])
\ No newline at end of file


=====================================
testsuite/tests/typecheck/should_compile/T18118.hs
=====================================
@@ -0,0 +1,5 @@
+module T18118 (myfun) where
+
+import T18118A
+
+{-# SPECIALISE myfun :: Double #-}


=====================================
testsuite/tests/typecheck/should_compile/T18118A.hs
=====================================
@@ -0,0 +1,5 @@
+module T18118A where
+
+myfun :: a
+myfun = undefined
+


=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -696,3 +696,4 @@ test('T17343', exit_code(1), compile_and_run, [''])
 test('T17792', normal, compile, [''])
 test('T18185', normal, compile, [''])
 test('T17566', [extra_files(['T17566a.hs'])], makefile_test, [])
+test('T18118', normal, multimod_compile, ['T18118', '-v0'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43f970499d053098d1928ce3921176192ec07d7a...5a4d0c3dcd2d83744293ea82a7e5606ad2038109

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43f970499d053098d1928ce3921176192ec07d7a...5a4d0c3dcd2d83744293ea82a7e5606ad2038109
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/20201017/31bf1a31/attachment-0001.html>


More information about the ghc-commits mailing list