[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: rts/m32: Refactor handling of allocator seeding

Marge Bot gitlab at gitlab.haskell.org
Mon Nov 30 15:47:44 UTC 2020



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


Commits:
8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00
rts/m32: Refactor handling of allocator seeding

Previously, in an attempt to reduce fragmentation, each new allocator
would map a region of M32_MAX_PAGES fresh pages to seed itself. However,
this ends up being extremely wasteful since it turns out that we often
use fewer than this.  Consequently, these pages end up getting freed
which, ends up fragmenting our address space more than than we would
have if we had naively allocated pages on-demand.

Here we refactor m32 to avoid this waste while achieving the
fragmentation mitigation previously desired. In particular, we move all
page allocation into the global m32_alloc_page, which will pull a page
from the free page pool. If the free page pool is empty we then refill
it by allocating a region of M32_MAP_PAGES and adding them to the pool.

Furthermore, we do away with the initial seeding entirely. That is, the
allocator starts with no active pages: pages are rather allocated on an
as-needed basis.

On the whole this ends up being a pleasingly simple change,
simultaneously making m32 more efficient, more robust, and simpler.

Fixes #18980.

- - - - -
b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00
rts: Use CHECK instead of assert

Use the GHC wrappers instead of <assert.h>.

- - - - -
9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00
rts/linker: Replace some ASSERTs with CHECK

In the past some people have confused ASSERT, which is for checking
internal invariants, which CHECK, which should be used when checking
things that might fail due to bad input (and therefore should be enabled
even in the release compiler). Change some of these cases in the linker
to use CHECK.

- - - - -
0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00
Allow deploy:pages job to fail

See #18973.

- - - - -
1e3997bd by chessai at 2020-11-30T10:47:24-05:00
Optimisations in Data.Foldable (T17867)

This PR concerns the following functions from `Data.Foldable`:
* minimum
* maximum
* sum
* product
* minimumBy
* maximumBy

- Default implementations of these functions now use `foldl'` or `foldMap'`.
- All have been marked with INLINEABLE to make room for further optimisations.

- - - - -
644b0cde by chessai at 2020-11-30T10:47:24-05:00
Apply suggestion to libraries/base/Data/Foldable.hs
- - - - -
672d9e9f by chessai at 2020-11-30T10:47:24-05:00
Apply suggestion to libraries/base/Data/Foldable.hs
- - - - -
9aef8407 by Viktor Dukhovni at 2020-11-30T10:47:26-05:00
dirty MVAR after mutating TSO queue head

While the original head and tail of the TSO queue may be in the same
generation as the MVAR, interior elements of the queue could be younger
after a GC run and may then be exposed by putMVar operation that updates
the queue head.

Resolves #18919

- - - - -
b5daa339 by Ben Gamari at 2020-11-30T10:47:27-05:00
rts/linker: Don't allow shared libraries to be loaded multiple times

- - - - -
7f5f9a6d by Ben Gamari at 2020-11-30T10:47:27-05:00
rts/linker: Initialise CCSs from native shared objects

- - - - -
4f12907b by Ben Gamari at 2020-11-30T10:47:27-05:00
rts/linker: Move shared library loading logic into Elf.c

- - - - -
bda568f4 by GHC GitLab CI at 2020-11-30T10:47:27-05:00
rts/linker: Don't declare dynamic objects with image_mapped

This previously resulted in warnings due to spurious unmap failures.

- - - - -
0b4d3133 by jneira at 2020-11-30T10:47:29-05:00
Include tried paths in findToolDir error

- - - - -


17 changed files:

- .gitlab-ci.yml
- compiler/GHC/SysTools/BaseDir.hs
- libraries/base/Data/Foldable.hs
- rts/Linker.c
- rts/LinkerInternals.h
- rts/PrimOps.cmm
- rts/Profiling.c
- rts/Threads.c
- rts/linker/Elf.c
- rts/linker/Elf.h
- rts/linker/M32Alloc.c
- rts/linker/MachO.c
- rts/linker/PEi386.c
- rts/linker/PEi386Types.h
- rts/linker/elf_got.c
- rts/linker/elf_reloc_aarch64.c
- rts/win32/veh_excn.c


Changes:

=====================================
.gitlab-ci.yml
=====================================
@@ -1237,6 +1237,8 @@ pages:
   dependencies:
     - doc-tarball
   image: ghcci/x86_64-linux-deb9:0.2
+  # See #18973
+  allow_failure: true
   tags:
     - x86_64-linux
   script:


=====================================
compiler/GHC/SysTools/BaseDir.hs
=====================================
@@ -185,17 +185,19 @@ findToolDir
   :: FilePath -- ^ topdir
   -> IO (Maybe FilePath)
 #if defined(mingw32_HOST_OS) && !defined(USE_INPLACE_MINGW_TOOLCHAIN)
-findToolDir top_dir = go 0 (top_dir </> "..")
+findToolDir top_dir = go 0 (top_dir </> "..") []
   where maxDepth = 3
-        go :: Int -> FilePath -> IO (Maybe FilePath)
-        go k path
+        go :: Int -> FilePath -> [FilePath] -> IO (Maybe FilePath)
+        go k path tried
           | k == maxDepth = throwGhcExceptionIO $
-              InstallationError "could not detect mingw toolchain"
+              InstallationError $ "could not detect mingw toolchain in the following paths: " ++ show tried
           | otherwise = do
-              oneLevel <- doesDirectoryExist (path </> "mingw")
+              let try = path </> "mingw"
+              let tried = tried ++ [try]
+              oneLevel <- doesDirectoryExist try
               if oneLevel
                 then return (Just path)
-                else go (k+1) (path </> "..")
+                else go (k+1) (path </> "..") tried
 #else
 findToolDir _ = return Nothing
 #endif


=====================================
libraries/base/Data/Foldable.hs
=====================================
@@ -507,7 +507,8 @@ class Foldable t where
     -- @since 4.8.0.0
     maximum :: forall a . Ord a => t a -> a
     maximum = fromMaybe (errorWithoutStackTrace "maximum: empty structure") .
-       getMax . foldMap (Max #. (Just :: a -> Maybe a))
+       getMax . foldMap' (Max #. (Just :: a -> Maybe a))
+    {-# INLINEABLE maximum #-}
 
     -- | The least element of a non-empty structure.
     --
@@ -529,7 +530,8 @@ class Foldable t where
     -- @since 4.8.0.0
     minimum :: forall a . Ord a => t a -> a
     minimum = fromMaybe (errorWithoutStackTrace "minimum: empty structure") .
-       getMin . foldMap (Min #. (Just :: a -> Maybe a))
+       getMin . foldMap' (Min #. (Just :: a -> Maybe a))
+    {-# INLINEABLE minimum #-}
 
     -- | The 'sum' function computes the sum of the numbers of a structure.
     --
@@ -554,7 +556,8 @@ class Foldable t where
     --
     -- @since 4.8.0.0
     sum :: Num a => t a -> a
-    sum = getSum #. foldMap Sum
+    sum = getSum #. foldMap' Sum
+    {-# INLINEABLE sum #-}
 
     -- | The 'product' function computes the product of the numbers of a
     -- structure.
@@ -580,7 +583,8 @@ class Foldable t where
     --
     -- @since 4.8.0.0
     product :: Num a => t a -> a
-    product = getProduct #. foldMap Product
+    product = getProduct #. foldMap' Product
+    {-# INLINEABLE product #-}
 
 -- instances for Prelude types
 
@@ -1111,10 +1115,15 @@ all p = getAll #. foldMap (All #. p)
 
 -- See Note [maximumBy/minimumBy space usage]
 maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a
-maximumBy cmp = foldl1 max'
-  where max' x y = case cmp x y of
-                        GT -> x
-                        _  -> y
+maximumBy cmp = fromMaybe (errorWithoutStackTrace "maximumBy: empty structure")
+  . foldl' max' Nothing
+  where
+    max' mx y = Just $! case mx of
+      Nothing -> y
+      Just x -> case cmp x y of
+        GT -> x
+        _ -> y
+{-# INLINEABLE maximumBy #-}
 
 -- | The least element of a non-empty structure with respect to the
 -- given comparison function.
@@ -1128,10 +1137,15 @@ maximumBy cmp = foldl1 max'
 
 -- See Note [maximumBy/minimumBy space usage]
 minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a
-minimumBy cmp = foldl1 min'
-  where min' x y = case cmp x y of
-                        GT -> y
-                        _  -> x
+minimumBy cmp = fromMaybe (errorWithoutStackTrace "minimumBy: empty structure")
+  . foldl' min' Nothing
+  where
+    min' mx y = Just $! case mx of
+      Nothing -> y
+      Just x -> case cmp x y of
+        GT -> y
+        _ -> x
+{-# INLINEABLE minimumBy #-}
 
 -- | 'notElem' is the negation of 'elem'.
 --
@@ -1268,12 +1282,6 @@ proportional to the size of the data structure. For the common case of lists,
 this could be particularly bad (see #10830).
 
 For the common case of lists, switching the implementations of maximumBy and
-minimumBy to foldl1 solves the issue, as GHC's strictness analysis can then
-make these functions only use O(1) stack space. It is perhaps not the optimal
-way to fix this problem, as there are other conceivable data structures
-(besides lists) which might benefit from specialized implementations for
-maximumBy and minimumBy (see
-https://gitlab.haskell.org/ghc/ghc/issues/10830#note_129843 for a further
-discussion). But using foldl1 is at least always better than using foldr1, so
-GHC has chosen to adopt that approach for now.
+minimumBy to foldl1 solves the issue, assuming GHC's strictness analysis can then
+make these functions only use O(1) stack space. As of base 4.16, we have switched to employing foldl' over foldl1, not relying on GHC's optimiser. See https://gitlab.haskell.org/ghc/ghc/-/issues/17867 for more context.
 -}


=====================================
rts/Linker.c
=====================================
@@ -49,7 +49,6 @@
 #include <stdlib.h>
 #include <string.h>
 #include <stdio.h>
-#include <assert.h>
 #include <fs_rts.h>
 
 #if defined(HAVE_SYS_STAT_H)
@@ -64,7 +63,6 @@
 #  include "linker/Elf.h"
 #  include <regex.h>    // regex is already used by dlopen() so this is OK
                         // to use here without requiring an additional lib
-#  include <link.h>
 #elif defined(OBJFORMAT_PEi386)
 #  include "linker/PEi386.h"
 #  include <windows.h>
@@ -171,8 +169,6 @@ Mutex linker_mutex;
 /* Generic wrapper function to try and Resolve and RunInit oc files */
 int ocTryLoad( ObjectCode* oc );
 
-static void freeNativeCode_ELF (ObjectCode *nc);
-
 /* Link objects into the lower 2Gb on x86_64 and AArch64.  GHC assumes the
  * small memory model on this architecture (see gcc docs,
  * -mcmodel=small).
@@ -399,7 +395,7 @@ static void *dl_prog_handle;
 static regex_t re_invalid;
 static regex_t re_realso;
 #if defined(THREADED_RTS)
-static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
+Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
 #endif
 #endif
 
@@ -885,12 +881,11 @@ SymbolAddr* lookupDependentSymbol (SymbolName* lbl, ObjectCode *dependent)
         */
         IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n",
                                     lbl));
-        ASSERT(lbl[0] == '_');
+        CHECK(lbl[0] == '_');
         return internal_dlsym(lbl + 1);
 
 #       else
-        ASSERT(false);
-        return NULL;
+#       error No OBJFORMAT_* macro set
 #       endif
     } else {
         if (dependent) {
@@ -1871,7 +1866,7 @@ HsInt purgeObj (pathchar *path)
     return r;
 }
 
-static OStatus getObjectLoadStatus_ (pathchar *path)
+OStatus getObjectLoadStatus_ (pathchar *path)
 {
     for (ObjectCode *o = objects; o; o = o->next) {
        if (0 == pathcmp(o->fileName, path)) {
@@ -1961,126 +1956,6 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc,
                        size, kind ));
 }
 
-
-#  if defined(OBJFORMAT_ELF)
-static int loadNativeObjCb_(struct dl_phdr_info *info,
-    size_t _size GNUC3_ATTRIBUTE(__unused__), void *data) {
-  ObjectCode* nc = (ObjectCode*) data;
-
-  // This logic mimicks _dl_addr_inside_object from glibc
-  // For reference:
-  // int
-  // internal_function
-  // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr)
-  // {
-  //   int n = l->l_phnum;
-  //   const ElfW(Addr) reladdr = addr - l->l_addr;
-  //
-  //   while (--n >= 0)
-  //     if (l->l_phdr[n].p_type == PT_LOAD
-  //         && reladdr - l->l_phdr[n].p_vaddr >= 0
-  //         && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz)
-  //       return 1;
-  //   return 0;
-  // }
-
-  if ((void*) info->dlpi_addr == nc->l_addr) {
-    int n = info->dlpi_phnum;
-    while (--n >= 0) {
-      if (info->dlpi_phdr[n].p_type == PT_LOAD) {
-        NativeCodeRange* ncr =
-          stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_");
-        ncr->start = (void*) ((char*) nc->l_addr + info->dlpi_phdr[n].p_vaddr);
-        ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz);
-
-        ncr->next = nc->nc_ranges;
-        nc->nc_ranges = ncr;
-      }
-    }
-  }
-  return 0;
-}
-
-static void copyErrmsg(char** errmsg_dest, char* errmsg) {
-  if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error";
-  *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF");
-  strcpy(*errmsg_dest, errmsg);
-}
-
-// need dl_mutex
-static void freeNativeCode_ELF (ObjectCode *nc) {
-  dlclose(nc->dlopen_handle);
-
-  NativeCodeRange *ncr = nc->nc_ranges;
-  while (ncr) {
-    NativeCodeRange* last_ncr = ncr;
-    ncr = ncr->next;
-    stgFree(last_ncr);
-  }
-}
-
-static void * loadNativeObj_ELF (pathchar *path, char **errmsg)
-{
-   ObjectCode* nc;
-   void *hdl, *retval;
-
-   IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path));
-
-   retval = NULL;
-   ACQUIRE_LOCK(&dl_mutex);
-
-   nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, true, NULL, 0);
-
-   foreignExportsLoadingObject(nc);
-   hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL);
-   foreignExportsFinishedLoadingObject();
-   if (hdl == NULL) {
-     /* dlopen failed; save the message in errmsg */
-     copyErrmsg(errmsg, dlerror());
-     goto dlopen_fail;
-   }
-
-   struct link_map *map;
-   if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) {
-     /* dlinfo failed; save the message in errmsg */
-     copyErrmsg(errmsg, dlerror());
-     goto dlinfo_fail;
-   }
-
-   nc->l_addr = (void*) map->l_addr;
-   nc->dlopen_handle = hdl;
-   hdl = NULL; // pass handle ownership to nc
-
-   dl_iterate_phdr(loadNativeObjCb_, nc);
-   if (!nc->nc_ranges) {
-     copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj");
-     goto dl_iterate_phdr_fail;
-   }
-
-   insertOCSectionIndices(nc);
-
-   nc->next_loaded_object = loaded_objects;
-   loaded_objects = nc;
-
-   retval = nc->dlopen_handle;
-   goto success;
-
-dl_iterate_phdr_fail:
-   // already have dl_mutex
-   freeNativeCode_ELF(nc);
-dlinfo_fail:
-   if (hdl) dlclose(hdl);
-dlopen_fail:
-success:
-
-   RELEASE_LOCK(&dl_mutex);
-   IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval));
-
-   return retval;
-}
-
-#  endif
-
 #define UNUSED(x) (void)(x)
 
 void * loadNativeObj (pathchar *path, char **errmsg)
@@ -2112,7 +1987,7 @@ HsInt unloadNativeObj (void *handle)
             n_unloaded_objects += 1;
 
             // dynamic objects have no symbols
-            ASSERT(nc->symbols == NULL);
+            CHECK(nc->symbols == NULL);
             freeOcStablePtrs(nc);
 
             // Remove object code from root set


=====================================
rts/LinkerInternals.h
=====================================
@@ -20,8 +20,34 @@ void printLoadedObjects(void);
 
 #include "BeginPrivate.h"
 
+/* Which object file format are we targeting? */
+#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) \
+|| defined(linux_android_HOST_OS) \
+|| defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) \
+|| defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) \
+|| defined(openbsd_HOST_OS) || defined(gnu_HOST_OS)
+#  define OBJFORMAT_ELF
+#elif defined(mingw32_HOST_OS)
+#  define OBJFORMAT_PEi386
+#elif defined(darwin_HOST_OS) || defined(ios_HOST_OS)
+#  define OBJFORMAT_MACHO
+#endif
+
 typedef void SymbolAddr;
 typedef char SymbolName;
+typedef struct _ObjectCode ObjectCode;
+typedef struct _Section    Section;
+
+#if defined(OBJFORMAT_ELF)
+#  include "linker/ElfTypes.h"
+#elif defined(OBJFORMAT_PEi386)
+#  include "linker/PEi386Types.h"
+#elif defined(OBJFORMAT_MACHO)
+#  include "linker/MachOTypes.h"
+#else
+#  error "Unknown OBJECT_FORMAT for HOST_OS"
+#endif
+
 
 /* Hold extended information about a symbol in case we need to resolve it at a
    late stage.  */
@@ -102,26 +128,24 @@ typedef enum {
  * and always refer to it with the 'struct' qualifier.
  */
 
-typedef
-   struct _Section {
-      void*    start;              /* actual start of section in memory */
-      StgWord  size;               /* actual size of section in memory */
-      SectionKind kind;
-      SectionAlloc alloc;
-
-      /*
-       * The following fields are relevant for SECTION_MMAP sections only
-       */
-      StgWord mapped_offset;      /* offset from the image of mapped_start */
-      void* mapped_start;         /* start of mmap() block */
-      StgWord mapped_size;        /* size of mmap() block */
-
-      /* A customizable type to augment the Section type.
-       * See Note [No typedefs for customizable types]
-       */
-      struct SectionFormatInfo* info;
-   }
-   Section;
+struct _Section {
+  void*    start;              /* actual start of section in memory */
+  StgWord  size;               /* actual size of section in memory */
+  SectionKind kind;
+  SectionAlloc alloc;
+
+  /*
+   * The following fields are relevant for SECTION_MMAP sections only
+   */
+  StgWord mapped_offset;      /* offset from the image of mapped_start */
+  void* mapped_start;         /* start of mmap() block */
+  StgWord mapped_size;        /* size of mmap() block */
+
+  /* A customizable type to augment the Section type.
+   * See Note [No typedefs for customizable types]
+   */
+  struct SectionFormatInfo* info;
+};
 
 typedef
    struct _ProddableBlock {
@@ -175,7 +199,7 @@ typedef enum {
 /* Top-level structure for an object module.  One of these is allocated
  * for each object file in use.
  */
-typedef struct _ObjectCode {
+struct _ObjectCode {
     OStatus    status;
     pathchar  *fileName;
     int        fileSize;     /* also mapped image size when using mmap() */
@@ -295,7 +319,7 @@ typedef struct _ObjectCode {
 
     /* virtual memory ranges of loaded code */
     NativeCodeRange *nc_ranges;
-} ObjectCode;
+};
 
 #define OC_INFORMATIVE_FILENAME(OC)             \
     ( (OC)->archiveMemberName ?                 \
@@ -306,6 +330,10 @@ typedef struct _ObjectCode {
 
 #if defined(THREADED_RTS)
 extern Mutex linker_mutex;
+
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+extern Mutex dl_mutex;
+#endif
 #endif
 
 /* Type of the initializer */
@@ -388,6 +416,7 @@ resolveSymbolAddr (pathchar* buffer, int size,
 #endif
 
 HsInt isAlreadyLoaded( pathchar *path );
+OStatus getObjectLoadStatus_ (pathchar *path);
 HsInt loadOc( ObjectCode* oc );
 ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int imageSize,
                   bool mapped, pathchar *archiveMemberName,
@@ -403,24 +432,6 @@ void freeSegments(ObjectCode *oc);
 #define MAP_ANONYMOUS MAP_ANON
 #endif
 
-/* Which object file format are we targeting? */
-#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) \
-|| defined(linux_android_HOST_OS) \
-|| defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) \
-|| defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) \
-|| defined(openbsd_HOST_OS) || defined(gnu_HOST_OS)
-#  define OBJFORMAT_ELF
-#  include "linker/ElfTypes.h"
-#elif defined(mingw32_HOST_OS)
-#  define OBJFORMAT_PEi386
-#  include "linker/PEi386Types.h"
-#elif defined(darwin_HOST_OS) || defined(ios_HOST_OS)
-#  define OBJFORMAT_MACHO
-#  include "linker/MachOTypes.h"
-#else
-#error "Unknown OBJECT_FORMAT for HOST_OS"
-#endif
-
 /* In order to simplify control flow a bit, some references to mmap-related
    definitions are blocked off by a C-level if statement rather than a CPP-level
    #if statement. Since those are dead branches when !RTS_LINKER_USE_MMAP, we


=====================================
rts/PrimOps.cmm
=====================================
@@ -1827,9 +1827,16 @@ loop:
     // There are readMVar/takeMVar(s) waiting: wake up the first one
 
     tso = StgMVarTSOQueue_tso(q);
-    StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
-    if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
+    q = StgMVarTSOQueue_link(q);
+    StgMVar_head(mvar) = q;
+    if (q == stg_END_TSO_QUEUE_closure) {
         StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
+    } else {
+        if (info == stg_MVAR_CLEAN_info) {
+            // Resolve #18919.
+            ccall dirty_MVAR(BaseReg "ptr", mvar "ptr",
+                             StgMVar_value(mvar) "ptr");
+        }
     }
 
     ASSERT(StgTSO_block_info(tso) == mvar);
@@ -1854,10 +1861,8 @@ loop:
 
     // If it was a readMVar, then we can still do work,
     // so loop back. (XXX: This could take a while)
-    if (why_blocked == BlockedOnMVarRead) {
-        q = StgMVarTSOQueue_link(q);
+    if (why_blocked == BlockedOnMVarRead)
         goto loop;
-    }
 
     ASSERT(why_blocked == BlockedOnMVar);
 
@@ -1912,9 +1917,16 @@ loop:
     // There are takeMVar(s) waiting: wake up the first one
 
     tso = StgMVarTSOQueue_tso(q);
-    StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
-    if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
+    q = StgMVarTSOQueue_link(q);
+    StgMVar_head(mvar) = q;
+    if (q == stg_END_TSO_QUEUE_closure) {
         StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
+    } else {
+        if (info == stg_MVAR_CLEAN_info) {
+            // Resolve #18919.
+            ccall dirty_MVAR(BaseReg "ptr", mvar "ptr",
+                             StgMVar_value(mvar) "ptr");
+        }
     }
 
     ASSERT(StgTSO_block_info(tso) == mvar);
@@ -1939,10 +1951,8 @@ loop:
 
     // If it was a readMVar, then we can still do work,
     // so loop back. (XXX: This could take a while)
-    if (why_blocked == BlockedOnMVarRead) {
-        q = StgMVarTSOQueue_link(q);
+    if (why_blocked == BlockedOnMVarRead)
         goto loop;
-    }
 
     ASSERT(why_blocked == BlockedOnMVar);
 


=====================================
rts/Profiling.c
=====================================
@@ -54,7 +54,7 @@ FILE *prof_file;
 // List of all cost centres. Used for reporting.
 CostCentre      *CC_LIST  = NULL;
 // All cost centre stacks temporarily appear here, to be able to make CCS_MAIN a
-// parent of all cost centres stacks (done in initProfiling2()).
+// parent of all cost centres stacks (done in refreshProfilingCCSs()).
 static CostCentreStack *CCS_LIST = NULL;
 
 #if defined(THREADED_RTS)


=====================================
rts/Threads.c
=====================================
@@ -803,9 +803,14 @@ loop:
 
     // There are takeMVar(s) waiting: wake up the first one
     tso = q->tso;
-    mvar->head = q->link;
-    if (mvar->head == (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure) {
+    mvar->head = q = q->link;
+    if (q == (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure) {
         mvar->tail = (StgMVarTSOQueue*)&stg_END_TSO_QUEUE_closure;
+    } else {
+        if (info == &stg_MVAR_CLEAN_info) {
+            // Resolve #18919.
+            dirty_MVAR(&cap->r, (StgClosure*)mvar, mvar->value);
+        }
     }
 
     ASSERT(tso->block_info.closure == (StgClosure*)mvar);
@@ -829,10 +834,8 @@ loop:
 
     // If it was a readMVar, then we can still do work,
     // so loop back. (XXX: This could take a while)
-    if (why_blocked == BlockedOnMVarRead) {
-        q = ((StgMVarTSOQueue*)q)->link;
+    if (why_blocked == BlockedOnMVarRead)
         goto loop;
-    }
 
     ASSERT(why_blocked == BlockedOnMVar);
 


=====================================
rts/linker/Elf.c
=====================================
@@ -15,15 +15,20 @@
 
 #include "RtsUtils.h"
 #include "RtsSymbolInfo.h"
+#include "CheckUnload.h"
+#include "LinkerInternals.h"
 #include "linker/Elf.h"
 #include "linker/CacheFlush.h"
 #include "linker/M32Alloc.h"
 #include "linker/SymbolExtras.h"
+#include "ForeignExports.h"
+#include "Profiling.h"
 #include "sm/OSMem.h"
 #include "GetEnv.h"
 #include "linker/util.h"
 #include "linker/elf_util.h"
 
+#include <link.h>
 #include <stdlib.h>
 #include <string.h>
 #if defined(HAVE_SYS_STAT_H)
@@ -416,7 +421,7 @@ ocVerifyImage_ELF ( ObjectCode* oc )
              "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
              (long)ehdr->e_shoff, shnum, ehdr->e_shentsize  ));
 
-   ASSERT(ehdr->e_shentsize == sizeof(Elf_Shdr));
+   CHECK(ehdr->e_shentsize == sizeof(Elf_Shdr));
 
    shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
 
@@ -537,7 +542,7 @@ ocVerifyImage_ELF ( ObjectCode* oc )
 #if defined(SHN_XINDEX)
          /* See Note [Many ELF Sections] */
          if (secno == SHN_XINDEX) {
-            ASSERT(shndxTable);
+            CHECK(shndxTable);
             secno = shndxTable[j];
          }
 #endif
@@ -864,7 +869,7 @@ ocGetNames_ELF ( ObjectCode* oc )
                             PROT_READ | PROT_WRITE,
                             MAP_ANON | MAP_PRIVATE,
                             -1, 0);
-          ASSERT(common_mem != NULL);
+          CHECK(common_mem != NULL);
       }
 
       //TODO: we ignore local symbols anyway right? So we can use the
@@ -893,7 +898,7 @@ ocGetNames_ELF ( ObjectCode* oc )
                secno = shndx;
 #if defined(SHN_XINDEX)
                if (shndx == SHN_XINDEX) {
-                  ASSERT(shndxTable);
+                  CHECK(shndxTable);
                   secno = shndxTable[j];
                }
 #endif
@@ -902,11 +907,11 @@ ocGetNames_ELF ( ObjectCode* oc )
 
                if (shndx == SHN_COMMON) {
                    isLocal = false;
-                   ASSERT(common_used < common_size);
-                   ASSERT(common_mem);
+                   CHECK(common_used < common_size);
+                   CHECK(common_mem);
                    symbol->addr = (void*)((uintptr_t)common_mem + common_used);
                    common_used += symbol->elf_sym->st_size;
-                   ASSERT(common_used <= common_size);
+                   CHECK(common_used <= common_size);
 
                    IF_DEBUG(linker,
                             debugBelch("COMMON symbol, size %ld name %s allocated at %p\n",
@@ -935,7 +940,7 @@ ocGetNames_ELF ( ObjectCode* oc )
                           )
                        ) {
                    /* Section 0 is the undefined section, hence > and not >=. */
-                   ASSERT(secno > 0 && secno < shnum);
+                   CHECK(secno > 0 && secno < shnum);
                    /*
                    if (shdr[secno].sh_type == SHT_NOBITS) {
                       debugBelch("   BSS symbol, size %d off %d name %s\n",
@@ -945,7 +950,7 @@ ocGetNames_ELF ( ObjectCode* oc )
                    symbol->addr = (SymbolAddr*)(
                            (intptr_t) oc->sections[secno].start +
                            (intptr_t) symbol->elf_sym->st_value);
-                   ASSERT(symbol->addr != 0x0);
+                   CHECK(symbol->addr != 0x0);
                    if (ELF_ST_BIND(symbol->elf_sym->st_info) == STB_LOCAL) {
                        isLocal = true;
                        isWeak = false;
@@ -962,7 +967,7 @@ ocGetNames_ELF ( ObjectCode* oc )
                /* And the decision is ... */
 
                if (symbol->addr != NULL) {
-                   ASSERT(nm != NULL);
+                   CHECK(nm != NULL);
                    /* Acquire! */
                    if (!isLocal) {
 
@@ -1045,7 +1050,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
            break;
        }
    }
-   ASSERT(stab != NULL);
+   CHECK(stab != NULL);
 
    targ  = (Elf_Word*)oc->sections[target_shndx].start;
    IF_DEBUG(linker,debugBelch(
@@ -1251,7 +1256,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
                result = ((S + A) | T) - P;
                result &= ~1; // Clear thumb indicator bit
 
-               ASSERT(isInt(26, result)); /* X in range */
+               CHECK(isInt(26, result)); /* X in range */
            }
 
            // Update the branch target
@@ -1426,7 +1431,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
        case COMPAT_R_ARM_GOT_PREL: {
               int32_t A = *pP;
               void* GOT_S = symbol->got_addr;
-              ASSERT(GOT_S);
+              CHECK(GOT_S);
               *(uint32_t *)P = (uint32_t) GOT_S + A - P;
               break;
        }
@@ -1552,21 +1557,21 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
          case R_SPARC_WDISP30:
             w1 = *pP & 0xC0000000;
             w2 = (Elf_Word)((value - P) >> 2);
-            ASSERT((w2 & 0xC0000000) == 0);
+            CHECK((w2 & 0xC0000000) == 0);
             w1 |= w2;
             *pP = w1;
             break;
          case R_SPARC_HI22:
             w1 = *pP & 0xFFC00000;
             w2 = (Elf_Word)(value >> 10);
-            ASSERT((w2 & 0xFFC00000) == 0);
+            CHECK((w2 & 0xFFC00000) == 0);
             w1 |= w2;
             *pP = w1;
             break;
          case R_SPARC_LO10:
             w1 = *pP & ~0x3FF;
             w2 = (Elf_Word)(value & 0x3FF);
-            ASSERT((w2 & ~0x3FF) == 0);
+            CHECK((w2 & ~0x3FF) == 0);
             w1 |= w2;
             *pP = w1;
             break;
@@ -1866,13 +1871,13 @@ ocResolve_ELF ( ObjectCode* oc )
                 Elf_Word secno = symbol->elf_sym->st_shndx;
 #if defined(SHN_XINDEX)
                 if (secno == SHN_XINDEX) {
-                    ASSERT(shndxTable);
+                    CHECK(shndxTable);
                     secno = shndxTable[i];
                 }
 #endif
-                ASSERT(symbol->elf_sym->st_name == 0);
-                ASSERT(symbol->elf_sym->st_value == 0);
-                ASSERT(0x0 != oc->sections[ secno ].start);
+                CHECK(symbol->elf_sym->st_name == 0);
+                CHECK(symbol->elf_sym->st_value == 0);
+                CHECK(0x0 != oc->sections[ secno ].start);
                 symbol->addr = oc->sections[ secno ].start;
             }
         }
@@ -1946,7 +1951,7 @@ int ocRunInit_ELF( ObjectCode *oc )
          init_start = (init_t*)init_startC;
          init_end = (init_t*)(init_startC + shdr[i].sh_size);
          for (init = init_start; init < init_end; init++) {
-            ASSERT(0x0 != *init);
+            CHECK(0x0 != *init);
             (*init)(argc, argv, envv);
          }
       }
@@ -1969,6 +1974,143 @@ int ocRunInit_ELF( ObjectCode *oc )
    return 1;
 }
 
+/*
+ * Shared object loading
+ */
+
+static int loadNativeObjCb_(struct dl_phdr_info *info,
+    size_t _size GNUC3_ATTRIBUTE(__unused__), void *data) {
+  ObjectCode* nc = (ObjectCode*) data;
+
+  // This logic mimicks _dl_addr_inside_object from glibc
+  // For reference:
+  // int
+  // internal_function
+  // _dl_addr_inside_object (struct link_map *l, const ElfW(Addr) addr)
+  // {
+  //   int n = l->l_phnum;
+  //   const ElfW(Addr) reladdr = addr - l->l_addr;
+  //
+  //   while (--n >= 0)
+  //     if (l->l_phdr[n].p_type == PT_LOAD
+  //         && reladdr - l->l_phdr[n].p_vaddr >= 0
+  //         && reladdr - l->l_phdr[n].p_vaddr < l->l_phdr[n].p_memsz)
+  //       return 1;
+  //   return 0;
+  // }
+
+  if ((void*) info->dlpi_addr == nc->l_addr) {
+    int n = info->dlpi_phnum;
+    while (--n >= 0) {
+      if (info->dlpi_phdr[n].p_type == PT_LOAD) {
+        NativeCodeRange* ncr =
+          stgMallocBytes(sizeof(NativeCodeRange), "loadNativeObjCb_");
+        ncr->start = (void*) ((char*) nc->l_addr + info->dlpi_phdr[n].p_vaddr);
+        ncr->end = (void*) ((char*) ncr->start + info->dlpi_phdr[n].p_memsz);
+
+        ncr->next = nc->nc_ranges;
+        nc->nc_ranges = ncr;
+      }
+    }
+  }
+  return 0;
+}
+
+static void copyErrmsg(char** errmsg_dest, char* errmsg) {
+  if (errmsg == NULL) errmsg = "loadNativeObj_ELF: unknown error";
+  *errmsg_dest = stgMallocBytes(strlen(errmsg)+1, "loadNativeObj_ELF");
+  strcpy(*errmsg_dest, errmsg);
+}
+
+// need dl_mutex
+void freeNativeCode_ELF (ObjectCode *nc) {
+  dlclose(nc->dlopen_handle);
+
+  NativeCodeRange *ncr = nc->nc_ranges;
+  while (ncr) {
+    NativeCodeRange* last_ncr = ncr;
+    ncr = ncr->next;
+    stgFree(last_ncr);
+  }
+}
+
+void * loadNativeObj_ELF (pathchar *path, char **errmsg)
+{
+   ObjectCode* nc;
+   void *hdl, *retval;
+
+   IF_DEBUG(linker, debugBelch("loadNativeObj_ELF %" PATH_FMT "\n", path));
+
+   retval = NULL;
+   ACQUIRE_LOCK(&dl_mutex);
+
+   /* Loading the same object multiple times will lead to chaos
+    * as we will have two ObjectCodes but one underlying dlopen
+    * handle. Fail if this happens.
+    */
+   if (getObjectLoadStatus_(path) != OBJECT_NOT_LOADED) {
+     copyErrmsg(errmsg, "loadNativeObj_ELF: Already loaded");
+     goto dlopen_fail;
+   }
+
+   nc = mkOc(DYNAMIC_OBJECT, path, NULL, 0, false, NULL, 0);
+
+   foreignExportsLoadingObject(nc);
+   hdl = dlopen(path, RTLD_NOW|RTLD_LOCAL);
+   foreignExportsFinishedLoadingObject();
+   if (hdl == NULL) {
+     /* dlopen failed; save the message in errmsg */
+     copyErrmsg(errmsg, dlerror());
+     goto dlopen_fail;
+   }
+
+   struct link_map *map;
+   if (dlinfo(hdl, RTLD_DI_LINKMAP, &map) == -1) {
+     /* dlinfo failed; save the message in errmsg */
+     copyErrmsg(errmsg, dlerror());
+     goto dlinfo_fail;
+   }
+
+   nc->l_addr = (void*) map->l_addr;
+   nc->dlopen_handle = hdl;
+   hdl = NULL; // pass handle ownership to nc
+
+   dl_iterate_phdr(loadNativeObjCb_, nc);
+   if (!nc->nc_ranges) {
+     copyErrmsg(errmsg, "dl_iterate_phdr failed to find obj");
+     goto dl_iterate_phdr_fail;
+   }
+
+   insertOCSectionIndices(nc);
+
+   nc->next_loaded_object = loaded_objects;
+   loaded_objects = nc;
+
+   retval = nc->dlopen_handle;
+
+#if defined(PROFILING)
+  // collect any new cost centres that were defined in the loaded object.
+  refreshProfilingCCSs();
+#endif
+
+   goto success;
+
+dl_iterate_phdr_fail:
+   // already have dl_mutex
+   freeNativeCode_ELF(nc);
+dlinfo_fail:
+   if (hdl) dlclose(hdl);
+dlopen_fail:
+success:
+
+   RELEASE_LOCK(&dl_mutex);
+
+   IF_DEBUG(linker, debugBelch("loadNativeObj_ELF result=%p\n", retval));
+
+   return retval;
+}
+
+
 /*
  * PowerPC & X86_64 ELF specifics
  */


=====================================
rts/linker/Elf.h
=====================================
@@ -14,5 +14,7 @@ int ocGetNames_ELF       ( ObjectCode* oc );
 int ocResolve_ELF        ( ObjectCode* oc );
 int ocRunInit_ELF        ( ObjectCode* oc );
 int ocAllocateExtras_ELF ( ObjectCode *oc );
+void freeNativeCode_ELF  ( ObjectCode *nc );
+void *loadNativeObj_ELF  ( pathchar *path, char **errmsg );
 
 #include "EndPrivate.h"


=====================================
rts/linker/M32Alloc.c
=====================================
@@ -81,6 +81,7 @@ The allocator manages two kinds of allocations:
 
  * small allocations, which are allocated into a set of "nursery" pages
    (recorded in m32_allocator_t.pages; the size of the set is <= M32_MAX_PAGES)
+
  * large allocations are those larger than a page and are mapped directly
 
 Each page (or the first page of a large allocation) begins with a m32_page_t
@@ -126,7 +127,9 @@ code accordingly).
 To avoid unnecessary mapping/unmapping we maintain a global list of free pages
 (which can grow up to M32_MAX_FREE_PAGE_POOL_SIZE long). Pages on this list
 have the usual m32_page_t header and are linked together with
-m32_page_t.free_page.next.
+m32_page_t.free_page.next. When run out of free pages we allocate a chunk of
+M32_MAP_PAGES to both avoid fragmenting our address space and amortize the
+runtime cost of the mapping.
 
 The allocator is *not* thread-safe.
 
@@ -139,7 +142,12 @@ The allocator is *not* thread-safe.
  * M32 ALLOCATOR (see Note [M32 Allocator]
  ***************************************************************************/
 
+/* How many open pages each allocator will keep around? */
 #define M32_MAX_PAGES 32
+/* How many pages should we map at once when re-filling the free page pool? */
+#define M32_MAP_PAGES 32
+/* Upper bound on the number of pages to keep in the free page pool */
+#define M32_MAX_FREE_PAGE_POOL_SIZE 64
 
 /**
  * Page header
@@ -204,7 +212,6 @@ struct m32_allocator_t {
  *
  * We keep a small pool of free pages around to avoid fragmentation.
  */
-#define M32_MAX_FREE_PAGE_POOL_SIZE 16
 struct m32_page_t *m32_free_page_pool = NULL;
 unsigned int m32_free_page_pool_size = 0;
 // TODO
@@ -250,18 +257,33 @@ m32_release_page(struct m32_page_t *page)
 static struct m32_page_t *
 m32_alloc_page(void)
 {
-  if (m32_free_page_pool_size > 0) {
-    struct m32_page_t *page = m32_free_page_pool;
-    m32_free_page_pool = page->free_page.next;
-    m32_free_page_pool_size --;
-    return page;
-  } else {
-    struct m32_page_t *page = mmapForLinker(getPageSize(), PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
-    if (page > (struct m32_page_t *) 0xffffffff) {
+  if (m32_free_page_pool_size == 0) {
+    /*
+     * Free page pool is empty; refill it with a new batch of M32_MAP_PAGES
+     * pages.
+     */
+    const size_t pgsz = getPageSize();
+    char *chunk = mmapForLinker(pgsz * M32_MAP_PAGES, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
+    if (chunk > (char *) 0xffffffff) {
       barf("m32_alloc_page: failed to get allocation in lower 32-bits");
     }
-    return page;
+
+#define GET_PAGE(i) ((struct m32_page_t *) (chunk + (i) * pgsz))
+    for (int i=0; i < M32_MAP_PAGES; i++) {
+      struct m32_page_t *page = GET_PAGE(i);
+      page->free_page.next = GET_PAGE(i+1);
+    }
+
+    GET_PAGE(M32_MAP_PAGES-1)->free_page.next = m32_free_page_pool;
+    m32_free_page_pool = (struct m32_page_t *) chunk;
+    m32_free_page_pool_size += M32_MAP_PAGES;
+#undef GET_PAGE
   }
+
+  struct m32_page_t *page = m32_free_page_pool;
+  m32_free_page_pool = page->free_page.next;
+  m32_free_page_pool_size --;
+  return page;
 }
 
 /**
@@ -276,19 +298,6 @@ m32_allocator_new(bool executable)
     stgMallocBytes(sizeof(m32_allocator), "m32_new_allocator");
   memset(alloc, 0, sizeof(struct m32_allocator_t));
   alloc->executable = executable;
-
-  // Preallocate the initial M32_MAX_PAGES to ensure that they don't
-  // fragment the memory.
-  size_t pgsz = getPageSize();
-  char* bigchunk = mmapForLinker(pgsz * M32_MAX_PAGES, PROT_READ | PROT_WRITE, MAP_ANONYMOUS,-1,0);
-  if (bigchunk == NULL)
-      barf("m32_allocator_init: Failed to map");
-
-  int i;
-  for (i=0; i<M32_MAX_PAGES; i++) {
-     alloc->pages[i] = (struct m32_page_t *) (bigchunk + i*pgsz);
-     alloc->pages[i]->current_size = sizeof(struct m32_page_t);
-  }
   return alloc;
 }
 
@@ -350,7 +359,9 @@ m32_allocator_push_filled_list(struct m32_page_t **head, struct m32_page_t *page
 void
 m32_allocator_flush(m32_allocator *alloc) {
    for (int i=0; i<M32_MAX_PAGES; i++) {
-     if (alloc->pages[i]->current_size == sizeof(struct m32_page_t)) {
+     if (alloc->pages[i] == NULL) {
+       continue;
+     } else if (alloc->pages[i]->current_size == sizeof(struct m32_page_t)) {
        // the page is empty, free it
        m32_release_page(alloc->pages[i]);
      } else {


=====================================
rts/linker/MachO.c
=====================================
@@ -252,7 +252,6 @@ resolveImports(
                        "%s: unknown symbol `%s'", oc->fileName, symbol->name);
             return 0;
         }
-        ASSERT(addr);
 
         checkProddableBlock(oc,
                             ((void**)(oc->image + sect->offset)) + i,
@@ -847,7 +846,7 @@ relocateSection(ObjectCode* oc, int curSection)
             IF_DEBUG(linker, debugBelch("               : value = %p\n", (void *)symbol->nlist->n_value));
 
             if ((symbol->nlist->n_type & N_TYPE) == N_SECT) {
-                ASSERT(symbol->addr != NULL);
+                CHECK(symbol->addr != NULL);
                 value = (uint64_t) symbol->addr;
                 IF_DEBUG(linker, debugBelch("relocateSection, defined external symbol %s, relocated address %p\n",
                                             nm, (void *)value));
@@ -949,29 +948,29 @@ relocateSection(ObjectCode* oc, int curSection)
         {
             if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
             {
-                ASSERT(reloc->r_extern);
+                CHECK(reloc->r_extern);
                 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)
                                         -> jumpIsland;
             }
-            ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue));
+            CHECK((int32_t)(value - baseValue) == (int64_t)(value - baseValue));
             type = X86_64_RELOC_SIGNED;
         }
 
         switch(type)
         {
             case X86_64_RELOC_UNSIGNED:
-                ASSERT(!reloc->r_pcrel);
+                CHECK(!reloc->r_pcrel);
                 thing += value;
                 break;
             case X86_64_RELOC_SIGNED:
             case X86_64_RELOC_SIGNED_1:
             case X86_64_RELOC_SIGNED_2:
             case X86_64_RELOC_SIGNED_4:
-                ASSERT(reloc->r_pcrel);
+                CHECK(reloc->r_pcrel);
                 thing += value - baseValue;
                 break;
             case X86_64_RELOC_SUBTRACTOR:
-                ASSERT(!reloc->r_pcrel);
+                CHECK(!reloc->r_pcrel);
                 thing -= value;
                 break;
             default:


=====================================
rts/linker/PEi386.c
=====================================
@@ -1594,7 +1594,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
           barf ("Could not allocate any heap memory from private heap.");
       }
 
-      ASSERT(section.size == 0 || section.info->virtualSize == 0);
+      CHECK(section.size == 0 || section.info->virtualSize == 0);
       sz = section.size;
       if (sz < section.info->virtualSize) sz = section.info->virtualSize;
 
@@ -2032,7 +2032,7 @@ ocRunInit_PEi386 ( ObjectCode *oc )
   getProgEnvv(&envc, &envv);
 
   Section section = *oc->info->init;
-  ASSERT(SECTIONKIND_INIT_ARRAY == section.kind);
+  CHECK(SECTIONKIND_INIT_ARRAY == section.kind);
 
   uint8_t *init_startC = section.start;
   init_t *init_start   = (init_t*)init_startC;


=====================================
rts/linker/PEi386Types.h
=====================================
@@ -7,10 +7,6 @@
 #include <stdint.h>
 #include <stdio.h>
 
-/* Some forward declares.  */
-struct Section;
-
-
 struct SectionFormatInfo {
     char* name;
     size_t alignment;


=====================================
rts/linker/elf_got.c
=====================================
@@ -136,10 +136,10 @@ verifyGot(ObjectCode * oc) {
         for(size_t i=0; i < symTab->n_symbols; i++) {
             ElfSymbol * symbol = &symTab->symbols[i];
             if(symbol->got_addr) {
-                ASSERT((void*)(*(void**)symbol->got_addr)
-                       == (void*)symbol->addr);
+                CHECK((void*)(*(void**)symbol->got_addr)
+                      == (void*)symbol->addr);
             }
-            ASSERT(0 == ((uintptr_t)symbol->addr & 0xffff000000000000));
+            CHECK(0 == ((uintptr_t)symbol->addr & 0xffff000000000000));
         }
     }
     return EXIT_SUCCESS;


=====================================
rts/linker/elf_reloc_aarch64.c
=====================================
@@ -6,7 +6,6 @@
 #include "elf_plt.h"
 
 #include <stdlib.h>
-#include <assert.h>
 
 
 #if defined(aarch64_HOST_ARCH)
@@ -71,15 +70,15 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
             *(uint64_t*)P = (uint64_t)addend;
             break;
         case COMPAT_R_AARCH64_ABS32:
-            assert(isInt64(32, addend));
+            CHECK(isInt64(32, addend));
         case COMPAT_R_AARCH64_PREL32:
-            assert(isInt64(32, addend));
+            CHECK(isInt64(32, addend));
             *(uint32_t*)P = (uint32_t)addend;
             break;
         case COMPAT_R_AARCH64_ABS16:
-            assert(isInt64(16, addend));
+            CHECK(isInt64(16, addend));
         case COMPAT_R_AARCH64_PREL16:
-            assert(isInt64(16, addend));
+            CHECK(isInt64(16, addend));
             *(uint16_t*)P = (uint16_t)addend;
             break;
         /* static aarch64 relocations */
@@ -95,8 +94,8 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
             // imm64 = SignExtend(hi:lo:0x000,64)
             // Range is 21 bits + the 12 page relative bits
             // known to be 0. -2^32 <= X < 2^32
-            assert(isInt64(21+12, addend));
-            assert((addend & 0xfff) == 0); /* page relative */
+            CHECK(isInt64(21+12, addend));
+            CHECK((addend & 0xfff) == 0); /* page relative */
 
             *(inst_t *)P = (*(inst_t *)P & 0x9f00001f)
                         | (inst_t) (((uint64_t) addend << 17) & 0x60000000)
@@ -106,7 +105,7 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
         /* - control flow relocations */
         case COMPAT_R_AARCH64_JUMP26:   /* relocate b ... */
         case COMPAT_R_AARCH64_CALL26: { /* relocate bl ... */
-            assert(isInt64(26+2, addend)); /* X in range */
+            CHECK(isInt64(26+2, addend)); /* X in range */
             *(inst_t *)P = (*(inst_t *)P & 0xfc000000) /* keep upper 6 (32-6)
  * bits */
                          | ((uint32_t)(addend >> 2) & 0x03ffffff);
@@ -114,8 +113,8 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
         }
         case COMPAT_R_AARCH64_ADR_GOT_PAGE: {
             /* range is -2^32 <= X < 2^32 */
-            assert(isInt64(21+12, addend)); /* X in range */
-            assert((addend & 0xfff) == 0); /* page relative */
+            CHECK(isInt64(21+12, addend)); /* X in range */
+            CHECK((addend & 0xfff) == 0); /* page relative */
 
             *(inst_t *)P = (*(inst_t *)P & 0x9f00001f)
                | (inst_t)(((uint64_t)addend << 17) & 0x60000000)  // lo
@@ -149,10 +148,10 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
             FALLTHROUGH;
         case COMPAT_R_AARCH64_LD64_GOT_LO12_NC: {
             if(exp_shift == -1) {
-                assert( (addend & 7) == 0 );
+                CHECK( (addend & 7) == 0 );
                 exp_shift = 3;
             }
-            assert((addend & 0xfff) == addend);
+            CHECK((addend & 0xfff) == addend);
             int shift = 0;
             if(isLoadStore(P)) {
                 /* bits 31, 30 encode the size. */
@@ -161,7 +160,7 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
                     shift = 4;
                 }
             }
-            assert(addend == 0 || exp_shift == shift);
+            CHECK(addend == 0 || exp_shift == shift);
             *(inst_t *)P = (*(inst_t *)P & 0xffc003ff)
                | ((inst_t)(addend >> shift << 10) & 0x003ffc00);
             break;
@@ -188,12 +187,12 @@ computeAddend(Section * section, Elf_Rel * rel,
     /* Position where something is relocated */
     addr_t P = (addr_t)((uint8_t*)section->start + rel->r_offset);
 
-    assert(0x0 != P);
-    assert((uint64_t)section->start <= P);
-    assert(P <= (uint64_t)section->start + section->size);
+    CHECK(0x0 != P);
+    CHECK((uint64_t)section->start <= P);
+    CHECK(P <= (uint64_t)section->start + section->size);
     /* Address of the symbol */
     addr_t S = (addr_t) symbol->addr;
-    assert(0x0 != S);
+    CHECK(0x0 != S);
     /* GOT slot for the symbol */
     addr_t GOT_S = (addr_t) symbol->got_addr;
 
@@ -243,16 +242,16 @@ computeAddend(Section * section, Elf_Rel * rel,
                     }
                 }
 
-                assert(0 == (0xffff000000000000 & S));
+                CHECK(0 == (0xffff000000000000 & S));
                 V = S + A - P;
-                assert(isInt64(26+2, V)); /* X in range */
+                CHECK(isInt64(26+2, V)); /* X in range */
             }
             return V;
         }
-        case COMPAT_R_AARCH64_LDST128_ABS_LO12_NC: assert(0 == ((S+A) & 0x0f));
-        case COMPAT_R_AARCH64_LDST64_ABS_LO12_NC:  assert(0 == ((S+A) & 0x07));
-        case COMPAT_R_AARCH64_LDST32_ABS_LO12_NC:  assert(0 == ((S+A) & 0x03));
-        case COMPAT_R_AARCH64_LDST16_ABS_LO12_NC:  assert(0 == ((S+A) & 0x01));
+        case COMPAT_R_AARCH64_LDST128_ABS_LO12_NC: CHECK(0 == ((S+A) & 0x0f));
+        case COMPAT_R_AARCH64_LDST64_ABS_LO12_NC:  CHECK(0 == ((S+A) & 0x07));
+        case COMPAT_R_AARCH64_LDST32_ABS_LO12_NC:  CHECK(0 == ((S+A) & 0x03));
+        case COMPAT_R_AARCH64_LDST16_ABS_LO12_NC:  CHECK(0 == ((S+A) & 0x01));
         case COMPAT_R_AARCH64_LDST8_ABS_LO12_NC:
             /* type: static, class: aarch64, op: S + A */
             return (S + A) & 0xfff;
@@ -266,12 +265,12 @@ computeAddend(Section * section, Elf_Rel * rel,
             // TODO: fix this story proper, so that the transformation
             //       makes sense without resorting to: everyone else
             //       does it like this as well.
-            assert(0x0 != GOT_S);
+            CHECK(0x0 != GOT_S);
             return Page(GOT_S+A) - Page(P);
         }
         case COMPAT_R_AARCH64_LD64_GOT_LO12_NC: {
             // G(GDAT(S+A))
-            assert(0x0 != GOT_S);
+            CHECK(0x0 != GOT_S);
             return (GOT_S + A) & 0xfff;
         }
         default:
@@ -297,7 +296,7 @@ relocateObjectCodeAarch64(ObjectCode * oc) {
                                relTab->sectionHeader->sh_link,
                                ELF64_R_SYM((Elf64_Xword)rel->r_info));
 
-            assert(0x0 != symbol);
+            CHECK(0x0 != symbol);
 
             /* decode implicit addend */
             int64_t addend = decodeAddendAarch64(targetSection, rel);
@@ -323,8 +322,8 @@ relocateObjectCodeAarch64(ObjectCode * oc) {
                                relaTab->sectionHeader->sh_link,
                                ELF64_R_SYM((Elf64_Xword)rel->r_info));
 
-            assert(0x0 != symbol);
-            assert(0x0 != symbol->addr);
+            CHECK(0x0 != symbol);
+            CHECK(0x0 != symbol->addr);
 
             /* take explicit addend */
             int64_t addend = rel->r_addend;


=====================================
rts/win32/veh_excn.c
=====================================
@@ -10,7 +10,6 @@
 #include "ghcconfig.h"
 #include "veh_excn.h"
 #include "LinkerInternals.h"
-#include <assert.h>
 #include <stdbool.h>
 #include <dbghelp.h>
 #include <shellapi.h>
@@ -195,7 +194,7 @@ void __register_hs_exception_handler( void )
         __hs_handle = AddVectoredContinueHandler(CALL_LAST,
                                                  __hs_exception_handler);
         // should the handler not be registered this will return a null.
-        assert(__hs_handle);
+        CHECK(__hs_handle);
 
         // Register for an exception filter to ensure the continue handler gets
         // hit if no one handled the exception.



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be04dc9b63621f4500d31126df1701d14f3abf83...0b4d31339aff7f0a60fbf409a2637de8809a6572

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be04dc9b63621f4500d31126df1701d14f3abf83...0b4d31339aff7f0a60fbf409a2637de8809a6572
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/20201130/9fab59b4/attachment-0001.html>


More information about the ghc-commits mailing list