0001-ghc-prim-ghc-prim-needs-to-depend-on-libc-and-libm.patch

From 0bba971db4bcada2a39e151816c2dc16444455d6 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 14 May 2020 08:10:43 +0800
Subject: [PATCH 1/9] [ghc-prim] ghc-prim needs to depend on libc and libm

libm is just an empty shell on musl, and all the math functions are contained in
libc.
---
 libraries/ghc-prim/ghc-prim.cabal | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal
index 132fe1255f..f716db8a95 100644
--- a/libraries/ghc-prim/ghc-prim.cabal
+++ b/libraries/ghc-prim/ghc-prim.cabal
@@ -76,6 +76,11 @@ Library
         --         on Windows. Required because of mingw32.
         extra-libraries: user32, mingw32, mingwex
 
+    if os(linux)
+        -- we need libm, but for musl and other's we might need libc, as libm
+        -- is just an empty shell.
+        extra-libraries: c, m
+
     c-sources:
         cbits/atomic.c
         cbits/bswap.c
-- 
2.24.3 (Apple Git-128)

0002-rts-linker-Load-.lo-as-well.patch

From ae7efeebe6f69e5522cb755f65f3b22d6cd4aff1 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 14 May 2020 08:17:59 +0800
Subject: [PATCH 2/9] [rts/linker] Load .lo as well.

Some archives contain so called linker objects, with the affectionate
.lo suffic.  For example the musl libc.a will come in that form.  We
still want to load those objects, hence we should not discard them and
look for .lo as well.  Ultimately we might want to fix this proerly by
looking at the file magic.
---
 rts/linker/LoadArchive.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/rts/linker/LoadArchive.c b/rts/linker/LoadArchive.c
index 85eedb930d..dda442d164 100644
--- a/rts/linker/LoadArchive.c
+++ b/rts/linker/LoadArchive.c
@@ -465,6 +465,7 @@ static HsInt loadArchive_ (pathchar *path)
         /* TODO: Stop relying on file extensions to determine input formats.
                  Instead try to match file headers. See Trac #13103.  */
         isObject = (thisFileNameSize >= 2 && strncmp(fileName + thisFileNameSize - 2, ".o"  , 2) == 0)
+                || (thisFileNameSize >= 3 && strncmp(fileName + thisFileNameSize - 3, ".lo" , 3) == 0)
                 || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".p_o", 4) == 0)
                 || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".obj", 4) == 0);
 
-- 
2.24.3 (Apple Git-128)

0003-ghc-ghci-Disable-DLL-loading-if-without-system-linke.patch

From 3b2b7e6b8b779fc8383f9696a3a495054ce13476 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 14 May 2020 08:18:31 +0800
Subject: [PATCH 3/9] [ghc; ghci] Disable DLL loading if without system linker

Some platforms (musl, aarch64) do not have a working dynamic linker
implemented in the libc, even though we might see dlopen.  It will
ultimately just return that this is not supported.  Hence we'll add
a flag to the compiler to flat our disable loading dlls.  This is
needed as we will otherwise try to load the shared library even
if this will subsequently fail.  At that point we have given up
looking for static options though.
---
 compiler/ghc.cabal.in   |  8 ++++++++
 compiler/ghci/Linker.hs | 19 +++++++++++++++----
 2 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index a0ec5d73a6..2f5e3ba666 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -45,6 +45,11 @@ Flag terminfo
     Default: True
     Manual: True
 
+Flag dynamic-system-linker
+    Description: The system can load dynamic code. This is not the case for musl.
+    Default: True
+    Manual: False
+
 Library
     Default-Language: Haskell2010
     Exposed: False
@@ -96,6 +101,9 @@ Library
         CPP-Options: -DGHCI
         Include-Dirs: ../rts/dist/build @FFIIncludeDir@
 
+    if flag(dynamic-system-linker)
+        CPP-Options: -DCAN_LOAD_DLL
+
     Other-Extensions:
         BangPatterns
         CPP
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index b09cb947d1..2d3f09b59c 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -1297,13 +1297,13 @@ linkPackage hsc_env pkg
 
         maybePutStr dflags
             ("Loading package " ++ sourcePackageIdString pkg ++ " ... ")
-
         -- See comments with partOfGHCi
+#if defined(CAN_LOAD_DLL)
         when (packageName pkg `notElem` partOfGHCi) $ do
             loadFrameworks hsc_env platform pkg
             mapM_ (load_dyn hsc_env)
               (known_dlls ++ map (mkSOName platform) dlls)
-
+#endif
         -- After loading all the DLLs, we can load the static objects.
         -- Ordering isn't important here, because we do one final link
         -- step to resolve everything.
@@ -1383,10 +1383,15 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib
     --   O(n). Loading an import library is also O(n) so in general we prefer
     --   shared libraries because they are simpler and faster.
     --
-  = findDll   user `orElse`
+  =
+#if defined(CAN_LOAD_DLL)
+    findDll   user `orElse`
+#endif
     tryImpLib user `orElse`
+#if defined(CAN_LOAD_DLL)
     findDll   gcc  `orElse`
     findSysDll     `orElse`
+#endif
     tryImpLib gcc  `orElse`
     findArchive    `orElse`
     tryGcc         `orElse`
@@ -1452,7 +1457,13 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib
                          full     = dllpath $ search lib_so_name lib_dirs
                          gcc name = liftM (fmap Archive) $ search name lib_dirs
                          files    = import_libs ++ arch_files
-                     in apply $ short : full : map gcc files
+                         dlls     = [short, full]
+                         archives = map gcc files
+                     in apply $
+#if defined(CAN_LOAD_DLL)
+                          dlls ++
+#endif
+                          archives
      tryImpLib re = case os of
                        OSMinGW32 ->
                         let dirs' = if re == user then lib_dirs else gcc_dirs
-- 
2.24.3 (Apple Git-128)

0004-rts-linker-Add-_GLOBAL_OFFSET_TABLE_-support.patch

From 4cd342869315bb6fd323493f8892e3e1154b9cf1 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 16 May 2019 13:35:31 +0800
Subject: [PATCH 4/9] [rts/linker] Add _GLOBAL_OFFSET_TABLE_ support

This adds lookup logic for _GLOBAL_OFFSET_TABLE_ as well as
relocation logic for R_ARM_BASE_PREL and R_ARM_GOT_BREL which
the gnu toolchain (gas, gcc, ...) prefers to produce.  Apparently
recent llvm toolchains will produce those as well.

Lookup _GLOBAL_OFFSET_TABLE by symbol->addr when doing relocations.
---
 rts/linker/Elf.c     | 35 ++++++++++++++++++++++++++++++++---
 rts/linker/elf_got.c | 11 ++++++++---
 2 files changed, 40 insertions(+), 6 deletions(-)

diff --git a/rts/linker/Elf.c b/rts/linker/Elf.c
index ede0482c6b..51ff9f1551 100644
--- a/rts/linker/Elf.c
+++ b/rts/linker/Elf.c
@@ -1010,6 +1010,19 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
        return 1;
    }
 
+   /* The following nomenclature is used for the operation:
+    * - S -- (when used on its own) is the address of the symbol.
+    * - A -- is the addend for the relocation.
+    * - P -- is the address of the place being relocated (derived from r_offset).
+    * - Pa - is the adjusted address of the place being relocated, defined as (P & 0xFFFFFFFC).
+    * - T -- is 1 if the target symbol S has type STT_FUNC and the symbol addresses a Thumb instruction; it is 0 otherwise.
+    * - B(S) is the addressing origin of the output segment defining the symbol S. The origin is not required to be the
+    *        base address of the segment. This value must always be word-aligned.
+    * - GOT_ORG is the addressing origin of the Global Offset Table (the indirection table for imported data addresses).
+    *        This value must always be word-aligned.  See §4.6.1.8, Proxy generating relocations.
+    * - GOT(S) is the address of the GOT entry for the symbol S.
+    */
+
    for (j = 0; j < nent; j++) {
        Elf_Addr offset = rtab[j].r_offset;
        Elf_Addr info   = rtab[j].r_info;
@@ -1038,7 +1051,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
        } else {
            symbol = &stab->symbols[ELF_R_SYM(info)];
            /* First see if it is a local symbol. */
-           if (ELF_ST_BIND(symbol->elf_sym->st_info) == STB_LOCAL) {
+           if (ELF_ST_BIND(symbol->elf_sym->st_info) == STB_LOCAL || strncmp(symbol->name, "_GLOBAL_OFFSET_TABLE_", 21) == 0) {
                S = (Elf_Addr)symbol->addr;
            } else {
                S_tmp = lookupSymbol_( symbol->name );
@@ -1104,19 +1117,35 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
 #        endif
 
 #        ifdef arm_HOST_ARCH
-       case COMPAT_R_ARM_ABS32:
+       case COMPAT_R_ARM_ABS32:     /* (S + A) | T */
            // Specified by Linux ARM ABI to be equivalent to ABS32
        case COMPAT_R_ARM_TARGET1:
            *(Elf32_Word *)P += S;
            *(Elf32_Word *)P |= T;
            break;
 
-       case COMPAT_R_ARM_REL32:
+       case COMPAT_R_ARM_REL32:     /* ((S + A) | T) – P */
            *(Elf32_Word *)P += S;
            *(Elf32_Word *)P |= T;
            *(Elf32_Word *)P -= P;
            break;
 
+       case COMPAT_R_ARM_BASE_PREL: /* B(S) + A – P */
+       {
+           int32_t A = *pP;
+           // bfd used to encode sb (B(S)) as 0.
+           *(uint32_t *)P += 0 + A - P;
+           break;
+       }
+
+       case COMPAT_R_ARM_GOT_BREL: /* GOT(S) + A – GOT_ORG */
+       {
+           int32_t A = *pP;
+           void* GOT_S = symbol->got_addr;
+           *(uint32_t *)P = (uint32_t) GOT_S + A - (uint32_t) oc->info->got_start;
+           break;
+       }
+
        case COMPAT_R_ARM_CALL:
        case COMPAT_R_ARM_JUMP24:
        {
diff --git a/rts/linker/elf_got.c b/rts/linker/elf_got.c
index 0395d169df..a6945d6f10 100644
--- a/rts/linker/elf_got.c
+++ b/rts/linker/elf_got.c
@@ -1,4 +1,5 @@
 #include "elf_got.h"
+#include <string.h>
 #if defined(OBJFORMAT_ELF)
 /*
  * Check if we need a global offset table slot for a
@@ -80,9 +81,13 @@ fillGot(ObjectCode * oc) {
                     if(0x0 == symbol->addr) {
                         symbol->addr = lookupSymbol_(symbol->name);
                         if(0x0 == symbol->addr) {
-                            errorBelch("Failed to lookup symbol: %s\n",
-                                       symbol->name);
-                            return EXIT_FAILURE;
+                            if(0 == strncmp(symbol->name,"_GLOBAL_OFFSET_TABLE_",21)) {
+                                symbol->addr = oc->info->got_start;
+                            } else {
+                                errorBelch("Failed to lookup symbol: %s\n",
+                                           symbol->name);
+                                return EXIT_FAILURE;
+                            }
                         }
                     } else {
                         // we already have the address.
-- 
2.24.3 (Apple Git-128)

0005-ghc-prim-atomics-No-atomics-on-arm32-this-will-just-.patch

From 045a69f9d1d7928ae69b5de276a69e91c41c1156 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Wed, 22 May 2019 11:19:41 +0800
Subject: [PATCH 5/9] [ghc-prim/atomics] No atomics on arm32; this will just
 yield stubs.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

As such the internal linker will fail for them.  The alternative
would be to implement them as stubs in the linker and have them
barf when called.

> Not all operations are supported by all target processors. If a
  particular operation cannot be implemented on the target processor,
  a warning is generated and a call an external function is
  generated. The external function carries the same name as the
  built-in version, with an additional suffix ‘_n’ where n is the size
  of the data type.

(https://gcc.gnu.org/onlinedocs/gcc/_005f_005fsync-Builtins.html)
---
 libraries/ghc-prim/cbits/atomic.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/libraries/ghc-prim/cbits/atomic.c b/libraries/ghc-prim/cbits/atomic.c
index 0a471b31ad..f3f4a9ec07 100644
--- a/libraries/ghc-prim/cbits/atomic.c
+++ b/libraries/ghc-prim/cbits/atomic.c
@@ -1,5 +1,6 @@
 #include "Rts.h"
 
+#if !defined(arm_HOST_ARCH)
 // Fallbacks for atomic primops on byte arrays. The builtins used
 // below are supported on both GCC and LLVM.
 //
@@ -418,3 +419,4 @@ hs_atomicwrite64(StgWord x, StgWord64 val)
   while (!__sync_bool_compare_and_swap((StgWord64 *) x, *(StgWord64 *) x, (StgWord64) val));
 #endif
 }
+#endif
-- 
2.24.3 (Apple Git-128)

0006-aarch64-reloc-Range-is-actually-2-32-not-2-31.patch

From fe565c53d3cf023e844e49d9e05f50c4eeecb318 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Fri, 15 May 2020 13:34:31 +0800
Subject: [PATCH 6/9] [aarch64/reloc] Range is actually +/-2^32, not +/-2^31

See also: https://static.docs.arm.com/ihi0056/g/aaelf64.pdf
---
 rts/linker/elf_reloc_aarch64.c | 12 +++++++-----
 1 file changed, 7 insertions(+), 5 deletions(-)

diff --git a/rts/linker/elf_reloc_aarch64.c b/rts/linker/elf_reloc_aarch64.c
index c50ef04080..150d7d1212 100644
--- a/rts/linker/elf_reloc_aarch64.c
+++ b/rts/linker/elf_reloc_aarch64.c
@@ -90,12 +90,14 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
             // ...              hi            ] [     Rd     ]
             //
             // imm64 = SignExtend(hi:lo:0x000,64)
-            assert(isInt64(32, addend));
+            // 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 */
 
             *(inst_t *)P = (*(inst_t *)P & 0x9f00001f)
-                           | (inst_t) (((uint64_t) addend << 17) & 0x60000000)
-                           | (inst_t) (((uint64_t) addend >> 9) & 0x00ffffe0);
+                        | (inst_t) (((uint64_t) addend << 17) & 0x60000000)
+                        | (inst_t) (((uint64_t) addend >> 9) & 0x00ffffe0);
             break;
         }
         /* - control flow relocations */
@@ -108,8 +110,8 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
             break;
         }
         case COMPAT_R_AARCH64_ADR_GOT_PAGE: {
-
-            assert(isInt64(32, addend)); /* X in range */
+            /* range is -2^32 <= X < 2^32 */
+            assert(isInt64(21+12, addend)); /* X in range */
             assert((addend & 0xfff) == 0); /* page relative */
 
             *(inst_t *)P = (*(inst_t *)P & 0x9f00001f)
-- 
2.24.3 (Apple Git-128)

0007-linker-rtsSymbols-More-linker-symbols.patch

From af160e5cf3efe3a40de5f46119f4195672a15f81 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 14 May 2020 08:16:22 +0800
Subject: [PATCH 7/9] [linker/rtsSymbols] More linker symbols

Mostly symbols needed for aarch64/armv7l
and in combination with musl, where we have
to rely on loading *all* objects/archives

- __stack_chk_* only when not DYNAMIC
---
 rts/RtsSymbols.c | 215 +++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 198 insertions(+), 17 deletions(-)

diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index 87fa98dd4f..4be2b7f3df 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -53,7 +53,6 @@
       SymI_HasProto(signal_handlers)            \
       SymI_HasProto(stg_sig_install)            \
       SymI_HasProto(rtsTimerSignal)             \
-      SymI_HasProto(atexit)                     \
       SymI_NeedsDataProto(nocldstop)
 #endif
 
@@ -929,30 +928,201 @@
       SymI_HasProto(load_load_barrier)                                  \
       SymI_HasProto(cas)                                                \
       SymI_HasProto(_assertFail)                                        \
+      SymI_HasProto(keepCAFs)                                           \
       RTS_USER_SIGNALS_SYMBOLS                                          \
       RTS_INTCHAR_SYMBOLS
 
-
 // 64-bit support functions in libgcc.a
-#if defined(__GNUC__) && SIZEOF_VOID_P <= 4 && !defined(_ABIN32)
-#define RTS_LIBGCC_SYMBOLS                             \
-      SymI_NeedsProto(__divdi3)                        \
-      SymI_NeedsProto(__udivdi3)                       \
-      SymI_NeedsProto(__moddi3)                        \
-      SymI_NeedsProto(__umoddi3)                       \
-      SymI_NeedsProto(__muldi3)                        \
-      SymI_NeedsProto(__ashldi3)                       \
-      SymI_NeedsProto(__ashrdi3)                       \
-      SymI_NeedsProto(__lshrdi3)                       \
-      SymI_NeedsProto(__fixunsdfdi)
-#elif defined(__GNUC__) && SIZEOF_VOID_P == 8
-#define RTS_LIBGCC_SYMBOLS                             \
+// See https://gcc.gnu.org/onlinedocs/gccint/Libgcc.html#Libgcc
+#define RTS_LIBGCC_SYMBOLS_32                          \
+      SymI_NeedsProto(__fixunsdfdi)                    \
+      /* 4 The GCC low-level runtime library         */\
+      /* 4.1.1 Arithmetic functions                  */\
+      /* SymI_NeedsProto(__ashlsi3) */\
+      SymI_NeedsProto(__ashldi3) \
+      /* SymI_NeedsProto(__ashlti3) */\
+      /* These functions return the result of shifting a left by b bits. */\
+      /* SymI_NeedsProto(__ashrsi3) */\
+      SymI_NeedsProto(__ashrdi3) \
+      /* SymI_NeedsProto(__ashrti3) */\
+      /* These functions return the result of arithmetically shifting a right by b bits. */\
+      /* SymI_NeedsProto(__divsi3) */\
+      SymI_NeedsProto(__divdi3) \
+      /* SymI_NeedsProto(__divti3) */\
+      /* These functions return the quotient of the signed division of a and b. */\
+      /* SymI_NeedsProto(__lshrsi3) */ \
+      SymI_NeedsProto(__lshrdi3) \
+      /* SymI_NeedsProto(__lshrti3) */ \
+      /* These functions return the result of logically shifting a right by b bits. */\
+      /* SymI_NeedsProto(__modsi3) */ \
+      SymI_NeedsProto(__moddi3) \
+      /* SymI_NeedsProto(__modti3) */ \
+      /* These functions return the remainder of the signed division of a and b. */\
+      /* SymI_NeedsProto(__mulsi3) */ \
+      SymI_NeedsProto(__muldi3) \
+      /* SymI_NeedsProto(__multi3) */ \
+      /* These functions return the product of a and b. */\
+      SymI_NeedsProto(__negdi2) \
+      /* SymI_NeedsProto(__negti2) */ \
+      /* These functions return the negation of a. */\
+      /* SymI_NeedsProto(__udivsi3) */ \
+      SymI_NeedsProto(__udivdi3) \
+      /* SymI_NeedsProto(__udivti3) */ \
+      /* These functions return the quotient of the unsigned division of a and b. */\
+      SymI_NeedsProto(__udivmoddi4) \
+      /* SymI_NeedsProto(__udivmodti4) */ \
+      /* These functions calculate both the quotient and remainder of the unsigned division of a and b. The return value is the quotient, and the remainder is placed in variable pointed to by c. */\
+      /* SymI_NeedsProto(__umodsi3) */ \
+      SymI_NeedsProto(__umoddi3) \
+      /* SymI_NeedsProto(__umodti3) */ \
+      /* These functions return the remainder of the unsigned division of a and b. */\
+      /* 4.1.2 Comparison functions */\
+      /* The following functions implement integral comparisons. These functions implement a low-level compare, upon which the higher level comparison operators (such as less than and greater than or equal to) can be constructed. The returned values lie in the range zero to two, to allow the high-level operators to be implemented by testing the returned result using either signed or unsigned comparison. */\
+      SymI_NeedsProto(__cmpdi2) \
+      /* SymI_NeedsProto(__cmpti2) */ \
+      /* These functions perform a signed comparison of a and b. If a is less than b, they return 0; if a is greater than b, they return 2; and if a and b are equal they return 1. */\
+      SymI_NeedsProto(__ucmpdi2) \
+      /* SymI_NeedsProto(__ucmpti2) */ \
+      /* These functions perform an unsigned comparison of a and b. If a is less than b, they return 0; if a is greater than b, they return 2; and if a and b are equal they return 1. */\
+      /* 4.1.3 Trapping arithmetic functions */\
+      /* The following functions implement trapping arithmetic. These functions call the libc function abort upon signed arithmetic overflow. */\
+      SymI_NeedsProto(__absvsi2) \
+      SymI_NeedsProto(__absvdi2) \
+      /* These functions return the absolute value of a. */\
+      /* SymI_NeedsProto(__addvsi3) */ \
+      SymI_NeedsProto(__addvdi3) \
+      /* These functions return the sum of a and b; that is a + b. */\
+      /* SymI_NeedsProto(__mulvsi3) */ \
+      SymI_NeedsProto(__mulvdi3) \
+      /* The functions return the product of a and b; that is a * b. */\
+      SymI_NeedsProto(__negvsi2) \
+      SymI_NeedsProto(__negvdi2) \
+      /* These functions return the negation of a; that is -a. */\
+      /* SymI_NeedsProto(__subvsi3) */ \
+      SymI_NeedsProto(__subvdi3) \
+      /* These functions return the difference between b and a; that is a - b. */\
+      /* 4.1.4 Bit operations */\
+      SymI_NeedsProto(__clzsi2) \
+      SymI_NeedsProto(__clzdi2) \
+      /* SymI_NeedsProto(__clzti2) */ \
+      /* These functions return the number of leading 0-bits in a, starting at the most significant bit position. If a is zero, the result is undefined. */\
+      SymI_NeedsProto(__ctzsi2) \
+      SymI_NeedsProto(__ctzdi2) \
+      /* SymI_NeedsProto(__ctzti2) */ \
+      /* These functions return the number of trailing 0-bits in a, starting at the least significant bit position. If a is zero, the result is undefined. */\
+      SymI_NeedsProto(__ffsdi2) \
+      /* SymI_NeedsProto(__ffsti2) */ \
+      /* These functions return the index of the least significant 1-bit in a, or the value zero if a is zero. The least significant bit is index one. */\
+      SymI_NeedsProto(__paritysi2) \
+      SymI_NeedsProto(__paritydi2) \
+      /* SymI_NeedsProto(__parityti2) */\
+      /* These functions return the value zero if the number of bits set in a is even, and the value one otherwise. */\
+      SymI_NeedsProto(__popcountsi2) \
+      SymI_NeedsProto(__popcountdi2) \
+      /* SymI_NeedsProto(__popcountti2) */ \
+      /* These functions return the number of bits set in a. */\
+      SymI_NeedsProto(__bswapsi2) \
+      SymI_NeedsProto(__bswapdi2) \
+      /* armv6l                                      */\
+      /* TODO: should check for __ARM_EABI__         */\
+      SymI_NeedsProto(__aeabi_d2f) \
+      SymI_NeedsProto(__aeabi_d2iz) \
+      SymI_NeedsProto(__aeabi_d2lz) \
+      SymI_NeedsProto(__aeabi_d2uiz) \
+      SymI_NeedsProto(__aeabi_d2ulz) \
+      SymI_NeedsProto(__aeabi_dadd) \
+      SymI_NeedsProto(__aeabi_dcmpeq) \
+      SymI_NeedsProto(__aeabi_dcmpge) \
+      SymI_NeedsProto(__aeabi_dcmpgt) \
+      SymI_NeedsProto(__aeabi_dcmple) \
+      SymI_NeedsProto(__aeabi_dcmplt) \
+      SymI_NeedsProto(__aeabi_dcmpun) \
+      SymI_NeedsProto(__aeabi_ddiv) \
+      SymI_NeedsProto(__aeabi_dmul) \
+      SymI_NeedsProto(__aeabi_dneg) \
+      SymI_NeedsProto(__aeabi_dsub) \
+      SymI_NeedsProto(__aeabi_f2d) \
+      SymI_NeedsProto(__aeabi_f2iz) \
+      SymI_NeedsProto(__aeabi_f2lz) \
+      SymI_NeedsProto(__aeabi_f2uiz) \
+      SymI_NeedsProto(__aeabi_f2ulz) \
+      SymI_NeedsProto(__aeabi_fadd) \
+      SymI_NeedsProto(__aeabi_fcmpeq) \
+      SymI_NeedsProto(__aeabi_fcmpge) \
+      SymI_NeedsProto(__aeabi_fcmpgt) \
+      SymI_NeedsProto(__aeabi_fcmple) \
+      SymI_NeedsProto(__aeabi_fcmplt) \
+      SymI_NeedsProto(__aeabi_fcmpun) \
+      SymI_NeedsProto(__aeabi_fdiv) \
+      SymI_NeedsProto(__aeabi_fmul) \
+      SymI_NeedsProto(__aeabi_fneg) \
+      SymI_NeedsProto(__aeabi_fsub) \
+      SymI_NeedsProto(__aeabi_i2d) \
+      SymI_NeedsProto(__aeabi_i2f) \
+      SymI_NeedsProto(__aeabi_idiv) \
+      SymI_NeedsProto(__aeabi_idivmod) \
+      SymI_NeedsProto(__aeabi_l2d) \
+      SymI_NeedsProto(__aeabi_l2f) \
+      SymI_NeedsProto(__aeabi_lasr) \
+      SymI_NeedsProto(__aeabi_lcmp) \
+      SymI_NeedsProto(__aeabi_ldivmod) \
+      SymI_NeedsProto(__aeabi_llsl) \
+      SymI_NeedsProto(__aeabi_llsr) \
+      SymI_NeedsProto(__aeabi_lmul) \
+      SymI_NeedsProto(__aeabi_ui2d) \
+      SymI_NeedsProto(__aeabi_ui2f) \
+      SymI_NeedsProto(__aeabi_uidiv) \
+      SymI_NeedsProto(__aeabi_uidivmod) \
+      SymI_NeedsProto(__aeabi_ul2d) \
+      SymI_NeedsProto(__aeabi_ul2f) \
+      SymI_NeedsProto(__aeabi_ulcmp) \
+      SymI_NeedsProto(__aeabi_uldivmod)
+#define RTS_LIBGCC_SYMBOLS_64                          \
       SymI_NeedsProto(__udivti3)                       \
       SymI_NeedsProto(__umodti3)
+
+/* for aarch64                                        */
+#define RTS_LIBGCC_SYMBOLS_aarch64                     \
+      SymI_NeedsProto(__netf2)                         \
+      SymI_NeedsProto(__addtf3)                        \
+      SymI_NeedsProto(__subtf3)                        \
+      SymI_NeedsProto(__multf3)                        \
+      SymI_NeedsProto(__extenddftf2)                   \
+      SymI_NeedsProto(__fixtfsi)                       \
+      SymI_NeedsProto(__fixunstfsi)                    \
+      SymI_NeedsProto(__floatsitf)                     \
+      SymI_NeedsProto(__floatunsitf)
+
+#if defined(__GNUC__) && SIZEOF_VOID_P <= 4 && !defined(_ABIN32)
+#define RTS_LIBGCC_SYMBOLS LIBGCC_SYMBOLS_32
+#elif defined(__GNUC__) && SIZEOF_VOID_P == 8 && defined(aarch64_HOST_OS)
+#define RTS_LIBGCC_SYMBOLS \
+      RTS_LIBGCC_SYMBOLS_64 \
+      RTS_LIBGCC_SYMBOLS_aarch64
+#elif defined(__GNUC__) && SIZEOF_VOID_P == 8
+#define RTS_LIBGCC_SYMBOLS RTS_LIBGCC_SYMBOLS_64
 #else
 #define RTS_LIBGCC_SYMBOLS
 #endif
 
+#if !defined(mingw32_HOST_OS) && !defined(DYNAMIC)
+#define RTS_SSP_SYMBOLS                                \
+      SymI_NeedsProto(__stack_chk_guard)               \
+      SymI_NeedsProto(__stack_chk_fail)
+#else
+#define RTS_SSP_SYMBOLS
+#endif
+#if !defined(DYNAMIC) && defined(linux_HOST_OS)
+// we need these for static musl builds. However when
+// linking shared objects (DLLs) this will fail, hence
+// we do not include them when building with -DDYNAMIC
+#define RTS_LINKER_SYMBOLS                             \
+      SymI_NeedsProto(__fini_array_start)              \
+      SymI_NeedsProto(__fini_array_end)
+#else
+#define RTS_LINKER_SYMBOLS
+#endif
+
 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
       // Symbols that don't have a leading underscore
       // on Mac OS X. They have to receive special treatment,
@@ -963,7 +1133,11 @@
 #endif
 
 /* entirely bogus claims about types of these symbols */
-#define SymI_NeedsProto(vvv)  extern void vvv(void);
+/* to prevent a bit of define expansion, SymI_NeedsProto is a variadic
+ * macro.  And we'll concat vvv with the __VA_ARGS__. This prevents
+ * vvv from getting macro expanded.
+ */
+#define SymI_NeedsProto(vvv,...) extern void vvv ## __VA_ARGS__ (void);
 #define SymI_NeedsDataProto(vvv)  extern StgWord vvv[];
 #if defined(COMPILING_WINDOWS_DLL)
 #define SymE_HasProto(vvv)    SymE_HasProto(vvv);
@@ -990,6 +1164,8 @@ RTS_DARWIN_ONLY_SYMBOLS
 RTS_OPENBSD_ONLY_SYMBOLS
 RTS_LIBGCC_SYMBOLS
 RTS_LIBFFI_SYMBOLS
+RTS_SSP_SYMBOLS
+RTS_LINKER_SYMBOLS
 #undef SymI_NeedsProto
 #undef SymI_NeedsDataProto
 #undef SymI_HasProto
@@ -1009,7 +1185,7 @@ RTS_LIBFFI_SYMBOLS
 #define SymE_HasDataProto(vvv) \
                     SymE_HasProto(vvv)
 
-#define SymI_NeedsProto(vvv) SymI_HasProto(vvv)
+#define SymI_NeedsProto(vvv,...) SymI_HasProto(vvv ## __VA_ARGS__)
 #define SymI_NeedsDataProto(vvv) SymI_HasDataProto(vvv)
 #define SymE_NeedsProto(vvv) SymE_HasProto(vvv)
 #define SymE_NeedsDataProto(vvv) SymE_HasDataProto(vvv)
@@ -1030,6 +1206,8 @@ RTS_LIBFFI_SYMBOLS
 #define SymI_HasProto_deprecated(vvv)   \
    { #vvv, (void*)0xBAADF00D, true },
 
+void *RTS_DYNAMIC = NULL;
+
 RtsSymbolVal rtsSyms[] = {
       RTS_SYMBOLS
       RTS_RET_SYMBOLS
@@ -1040,11 +1218,14 @@ RtsSymbolVal rtsSyms[] = {
       RTS_OPENBSD_ONLY_SYMBOLS
       RTS_LIBGCC_SYMBOLS
       RTS_LIBFFI_SYMBOLS
+      RTS_SSP_SYMBOLS
+      RTS_LINKER_SYMBOLS
 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
       // dyld stub code contains references to this,
       // but it should never be called because we treat
       // lazy pointers as nonlazy.
       { "dyld_stub_binding_helper", (void*)0xDEADBEEF, false },
 #endif
+      { "_DYNAMIC", (void*)(&RTS_DYNAMIC), false },
       { 0, 0, false } /* sentinel */
 };
-- 
2.24.3 (Apple Git-128)

0008-linker-Fix-out-of-range-relocations.patch

From 7d73d089aedc0d20865cf88b39d76bdea519bfdf Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Thu, 14 May 2020 08:14:44 +0800
Subject: [PATCH 8/9] [linker] Fix out of range relocations.

mmap may return address all over the place. mmap_next will ensure we get
the next free page after the requested address.

This is especially important for linking on aarch64, where the memory model with PIC
admits relocations in the +-4GB range, and as such we can't work with
arbitrary object locations in memory.

Of note: we map the rts into process space, so any mapped objects must
not be ouside of the 4GB from the processes address space.
---
 rts/Linker.c              | 84 ++++++++++++++++++++++++++++++++-------
 rts/LinkerInternals.h     |  3 +-
 rts/linker/Elf.c          | 41 ++++++++++++++-----
 rts/linker/LoadArchive.c  |  4 +-
 rts/linker/M32Alloc.c     |  6 +--
 rts/linker/MachO.c        |  8 ++--
 rts/linker/SymbolExtras.c |  1 +
 rts/linker/elf_got.c      |  2 +-
 8 files changed, 115 insertions(+), 34 deletions(-)

diff --git a/rts/Linker.c b/rts/Linker.c
index b7e83858b0..13cc549535 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -192,7 +192,7 @@ int ocTryLoad( ObjectCode* oc );
  *
  * MAP_32BIT not available on OpenBSD/amd64
  */
-#if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
+#if (defined(x86_64_HOST_ARCH) || (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH))) && defined(MAP_32BIT)
 #define TRY_MAP_32BIT MAP_32BIT
 #else
 #define TRY_MAP_32BIT 0
@@ -209,12 +209,25 @@ int ocTryLoad( ObjectCode* oc );
  * in the low 2Gb of the address space and try to allocate memory from
  * there.
  *
+ * The same holds for aarch64, where the default, even with PIC, model
+ * is 4GB. The linker is free to emit AARCH64_ADR_PREL_PG_HI21
+ * relocations.
+ *
  * We pick a default address based on the OS, but also make this
  * configurable via an RTS flag (+RTS -xm)
  */
-#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
-
-#if defined(MAP_32BIT)
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH) || (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH))
+
+#define MMAP_MAX_RETRY 100
+
+#if (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH))
+// Try to use stg_upd_frame_info as the base. We need to be within +-4GB of that
+// address, otherwise we violate the aarch64 memory model. Any object we load
+// can potentially reference any of the ones we bake into the binary (and list)
+// in RtsSymbols. Thus we'll need to be within +-4GB of those,
+// stg_upd_frame_info is a good candidate as it's referenced often.
+#define MMAP_32BIT_BASE_DEFAULT (void*)&stg_upd_frame_info;
+#elif defined(MAP_32BIT)
 // Try to use MAP_32BIT
 #define MMAP_32BIT_BASE_DEFAULT 0
 #else
@@ -997,11 +1010,28 @@ resolveSymbolAddr (pathchar* buffer, int size,
 }
 
 #if RTS_LINKER_USE_MMAP
+
+void*
+mmap_next(void *addr, size_t length, int prot, int flags, int fd, off_t offset) {
+  if(addr == NULL) return mmap(addr, length, prot, flags, fd, offset);
+  // we are going to look for up to pageSize * 1024 * 1024 (4GB) from the
+  // address.
+  size_t pageSize = getPageSize();
+  for(int i = (uintptr_t)addr & (pageSize-1) ? 1 : 0; i < 1024*1024; i++) {
+    void *target = (void*)(((uintptr_t)addr & ~(pageSize-1))+(i*pageSize));
+    void *mem = mmap(target, length, prot, flags, fd, offset);
+    if(mem == NULL) return mem;
+    if(mem == target) return mem;
+    munmap(mem, length);
+  }
+  return NULL;
+}
+
 //
 // Returns NULL on failure.
 //
 void *
-mmapForLinker (size_t bytes, uint32_t flags, int fd, int offset)
+mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset)
 {
    void *map_addr = NULL;
    void *result;
@@ -1011,9 +1041,14 @@ mmapForLinker (size_t bytes, uint32_t flags, int fd, int offset)
    IF_DEBUG(linker, debugBelch("mmapForLinker: start\n"));
    size = roundUpToPage(bytes);
 
-#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
-mmap_again:
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH) ||( defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH))
 
+    size_t mmap_counter = MMAP_MAX_RETRY;
+mmap_again:
+   if (0 == --mmap_counter) {
+       sysErrorBelch("mmap, small memory model: failed to allocate within 2GB after %d retries.\n", MMAP_MAX_RETRY);
+       stg_exit(EXIT_FAILURE);
+   }
    if (mmap_32bit_base != 0) {
        map_addr = mmap_32bit_base;
    }
@@ -1021,14 +1056,14 @@ mmap_again:
 
    IF_DEBUG(linker,
             debugBelch("mmapForLinker: \tprotection %#0x\n",
-                       PROT_EXEC | PROT_READ | PROT_WRITE));
+                       prot));
    IF_DEBUG(linker,
             debugBelch("mmapForLinker: \tflags      %#0x\n",
                        MAP_PRIVATE | TRY_MAP_32BIT | fixed | flags));
 
-   result = mmap(map_addr, size,
-                 PROT_EXEC|PROT_READ|PROT_WRITE,
-                 MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, offset);
+   result = mmap_next(map_addr, size,
+                      prot,
+                      MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, offset);
 
    if (result == MAP_FAILED) {
        sysErrorBelch("mmap %" FMT_Word " bytes at %p",(W_)size,map_addr);
@@ -1080,6 +1115,28 @@ mmap_again:
            goto mmap_again;
        }
    }
+#elif (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH))
+    // for aarch64 we need to make sure we stay within 4GB of the
+    // mmap_32bit_base, and we also do not want to update it.
+//    if (mmap_32bit_base != (void*)&stg_upd_frame_info) {
+    if (result == map_addr) {
+        mmap_32bit_base = (void*)((uintptr_t)map_addr + size);
+    } else {
+        // upper limit 4GB - size of the object file - 1mb wiggle room.
+        if(llabs((uintptr_t)result - (uintptr_t)&stg_upd_frame_info) > (2<<32) - size - (2<<20)) {
+            // not within range :(
+            debugTrace(DEBUG_linker,
+                        "MAP_32BIT didn't work; gave us %lu bytes at 0x%p",
+                        bytes, result);
+            munmap(result, size);
+            // TODO: some abort/mmap_32bit_base recomputation based on
+            //       if mmap_32bit_base is changed, or still at stg_upd_frame_info
+            goto mmap_again;
+        } else {
+            mmap_32bit_base = (void*)((uintptr_t)result + size);
+        }
+    }
+//   }
 #endif
 
    IF_DEBUG(linker,
@@ -1360,9 +1417,9 @@ preloadObjectFile (pathchar *path)
     * See also the misalignment logic for darwin below.
     */
 #if defined(ios_HOST_OS)
-   image = mmap(NULL, fileSize, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
+   image = mmapForLinker(fileSize, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
 #else
-   image = mmap(NULL, fileSize, PROT_READ|PROT_WRITE|PROT_EXEC,
+   image = mmapForLinker(fileSize, PROT_READ|PROT_WRITE|PROT_EXEC,
                 MAP_PRIVATE, fd, 0);
 #endif
 
@@ -1820,4 +1877,3 @@ addSection (Section *s, SectionKind kind, SectionAlloc alloc,
                        start, (void*)((StgWord)start + size),
                        size, kind ));
 }
-
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index b48fc75966..02cb6b814f 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -13,6 +13,7 @@
 
 #if RTS_LINKER_USE_MMAP
 #include <sys/mman.h>
+void* mmap_next(void *addr, size_t length, int prot, int flags, int fd, off_t offset);
 #endif
 
 #include "BeginPrivate.h"
@@ -246,7 +247,7 @@ void exitLinker( void );
 void freeObjectCode (ObjectCode *oc);
 SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo);
 
-void *mmapForLinker (size_t bytes, uint32_t flags, int fd, int offset);
+void *mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset);
 
 void addProddableBlock ( ObjectCode* oc, void* start, int size );
 void checkProddableBlock (ObjectCode *oc, void *addr, size_t size );
diff --git a/rts/linker/Elf.c b/rts/linker/Elf.c
index 51ff9f1551..832e0bb80f 100644
--- a/rts/linker/Elf.c
+++ b/rts/linker/Elf.c
@@ -626,7 +626,7 @@ mapObjectFileSection (int fd, Elf_Word offset, Elf_Word size,
 
     pageOffset = roundDownToPage(offset);
     pageSize = roundUpToPage(offset-pageOffset+size);
-    p = mmapForLinker(pageSize, 0, fd, pageOffset);
+    p = mmapForLinker(pageSize, PROT_READ | PROT_WRITE | PROT_EXEC, 0, fd, pageOffset);
     if (p == NULL) return NULL;
     *mapped_size = pageSize;
     *mapped_offset = pageOffset;
@@ -688,7 +688,7 @@ ocGetNames_ELF ( ObjectCode* oc )
            * address might be out of range for sections that are mmaped.
            */
           alloc = SECTION_MMAP;
-          start = mmap(NULL, size,
+          start = mmapForLinker(size,
                        PROT_READ | PROT_WRITE | PROT_EXEC,
                        MAP_ANON | MAP_PRIVATE,
                        -1, 0);
@@ -732,7 +732,7 @@ ocGetNames_ELF ( ObjectCode* oc )
           unsigned nstubs = numberOfStubsForSection(oc, i);
           unsigned stub_space = STUB_SIZE * nstubs;
 
-          void * mem = mmap(NULL, size+stub_space,
+          void * mem = mmapForLinker(size+stub_space,
                             PROT_READ | PROT_WRITE | PROT_EXEC,
                             MAP_ANON | MAP_PRIVATE,
                             -1, 0);
@@ -824,6 +824,26 @@ ocGetNames_ELF ( ObjectCode* oc )
 
       unsigned curSymbol = 0;
 
+      unsigned long common_size = 0;
+      unsigned long common_used = 0;
+      for(ElfSymbolTable *symTab = oc->info->symbolTables;
+           symTab != NULL; symTab = symTab->next) {
+           for (size_t j = 0; j < symTab->n_symbols; j++) {
+               ElfSymbol *symbol = &symTab->symbols[j];
+               if (SHN_COMMON == symTab->symbols[j].elf_sym->st_shndx) {
+                   common_size += symbol->elf_sym->st_size;
+               }
+           }
+      }
+      void * common_mem = NULL;
+      if(common_size > 0) {
+          common_mem = mmapForLinker(common_size,
+                            PROT_READ | PROT_WRITE,
+                            MAP_ANON | MAP_PRIVATE,
+                            -1, 0);
+          ASSERT(common_mem != NULL);
+      }
+
       //TODO: we ignore local symbols anyway right? So we can use the
       //      shdr[i].sh_info to get the index of the first non-local symbol
       // ie we should use j = shdr[i].sh_info
@@ -859,12 +879,15 @@ ocGetNames_ELF ( ObjectCode* oc )
 
                if (shndx == SHN_COMMON) {
                    isLocal = false;
-                   symbol->addr = stgCallocBytes(1, symbol->elf_sym->st_size,
-                                       "ocGetNames_ELF(COMMON)");
-                   /*
-                   debugBelch("COMMON symbol, size %d name %s\n",
-                                   stab[j].st_size, nm);
-                   */
+                   ASSERT(common_used < common_size);
+                   ASSERT(common_mem);
+                   symbol->addr = (void*)((uintptr_t)common_mem + common_used);
+                   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);
+
                    /* Pointless to do addProddableBlock() for this area,
                       since the linker should never poke around in it. */
                } else if ((ELF_ST_BIND(symbol->elf_sym->st_info) == STB_GLOBAL
diff --git a/rts/linker/LoadArchive.c b/rts/linker/LoadArchive.c
index dda442d164..bcc042f468 100644
--- a/rts/linker/LoadArchive.c
+++ b/rts/linker/LoadArchive.c
@@ -498,7 +498,7 @@ static HsInt loadArchive_ (pathchar *path)
                                                 isThin);
 #elif defined(darwin_HOST_OS) || defined(ios_HOST_OS)
             if (RTS_LINKER_USE_MMAP)
-                image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1, 0);
+                image = mmapForLinker(memberSize, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS, -1, 0);
             else {
                 /* See loadObj() */
                 misalignment = machoGetMisalignment(f);
@@ -556,7 +556,7 @@ while reading filename from `%" PATH_FMT "'", path);
             }
             DEBUG_LOG("Found GNU-variant file index\n");
 #if RTS_LINKER_USE_MMAP
-            gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1, 0);
+            gnuFileIndex = mmapForLinker(memberSize + 1, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS, -1, 0);
 #else
             gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
 #endif
diff --git a/rts/linker/M32Alloc.c b/rts/linker/M32Alloc.c
index 52b182e54d..3016704bd2 100644
--- a/rts/linker/M32Alloc.c
+++ b/rts/linker/M32Alloc.c
@@ -157,7 +157,7 @@ m32_allocator_init(void)
    // 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,MAP_ANONYMOUS,-1,0);
+   char* bigchunk = mmapForLinker(pgsz * M32_MAX_PAGES, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS,-1,0);
    if (bigchunk == NULL)
        barf("m32_allocator_init: Failed to map");
 
@@ -249,7 +249,7 @@ m32_alloc(size_t size, size_t alignment)
 
    if (m32_is_large_object(size,alignment)) {
        // large object
-       return mmapForLinker(size,MAP_ANONYMOUS,-1,0);
+       return mmapForLinker(size, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS,-1,0);
    }
 
    // small object
@@ -297,7 +297,7 @@ m32_alloc(size_t size, size_t alignment)
    }
 
    // Allocate a new page
-   void * addr = mmapForLinker(pgsz,MAP_ANONYMOUS,-1,0);
+   void * addr = mmapForLinker(pgsz, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS,-1,0);
    if (addr == NULL) {
       return NULL;
    }
diff --git a/rts/linker/MachO.c b/rts/linker/MachO.c
index b6a14d142c..8a48425637 100644
--- a/rts/linker/MachO.c
+++ b/rts/linker/MachO.c
@@ -588,7 +588,7 @@ makeGot(ObjectCode * oc) {
 
     if(got_slots > 0) {
         oc->info->got_size =  got_slots * sizeof(void*);
-        oc->info->got_start = mmap(NULL, oc->info->got_size,
+        oc->info->got_start = mmapForLinker(oc->info->got_size,
                                    PROT_READ | PROT_WRITE,
                                    MAP_ANON | MAP_PRIVATE,
                                    -1, 0);
@@ -1419,7 +1419,7 @@ ocGetNames_MachO(ObjectCode* oc)
             case S_ZEROFILL:
             case S_GB_ZEROFILL: {
                 // See Note [mmap r+w+x]
-                void * mem = mmap(NULL, section->size,
+                void * mem = mmapForLinker(section->size,
                                   PROT_READ | PROT_WRITE,
                                   MAP_ANON | MAP_PRIVATE,
                                   -1, 0);
@@ -1472,7 +1472,7 @@ ocGetNames_MachO(ObjectCode* oc)
                                      * instructions (ldr, br) for each relocation.
                                      */ 16 * n_ext_sec_sym;
                 // See Note [mmap r+w+x]
-                void * mem = mmap(NULL, section->size+stub_space,
+                void * mem = mmapForLinker(section->size+stub_space,
                                   PROT_READ | PROT_WRITE,
                                   MAP_ANON | MAP_PRIVATE,
                                   -1, 0);
@@ -1502,7 +1502,7 @@ ocGetNames_MachO(ObjectCode* oc)
             case S_GB_ZEROFILL: {
                 char * zeroFillArea;
                 if (RTS_LINKER_USE_MMAP) {
-                    zeroFillArea = mmapForLinker(section->size, MAP_ANONYMOUS,
+                    zeroFillArea = mmapForLinker(section->size, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS,
                                                  -1, 0);
                     if (zeroFillArea == NULL) return 0;
                     memset(zeroFillArea, 0, section->size);
diff --git a/rts/linker/SymbolExtras.c b/rts/linker/SymbolExtras.c
index 486fa4a572..f4485bba31 100644
--- a/rts/linker/SymbolExtras.c
+++ b/rts/linker/SymbolExtras.c
@@ -52,6 +52,7 @@ int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
 
       /* Keep image and symbol_extras contiguous */
       void *new = mmapForLinker(n + (sizeof(SymbolExtra) * count),
+                                PROT_READ | PROT_WRITE | PROT_EXEC,
                                 MAP_ANONYMOUS, -1, 0);
       if (new) {
           memcpy(new, oc->image, oc->fileSize);
diff --git a/rts/linker/elf_got.c b/rts/linker/elf_got.c
index a6945d6f10..70472c627c 100644
--- a/rts/linker/elf_got.c
+++ b/rts/linker/elf_got.c
@@ -45,7 +45,7 @@ makeGot(ObjectCode * oc) {
     }
     if(got_slots > 0) {
         oc->info->got_size = got_slots * sizeof(void *);
-         void * mem = mmap(NULL, oc->info->got_size,
+         void * mem = mmapForLinker(oc->info->got_size,
                            PROT_READ | PROT_WRITE,
                            MAP_ANON | MAP_PRIVATE,
                            -1, 0);
-- 
2.24.3 (Apple Git-128)

0009-linker-Adds-void-printLoadedObjects-void.patch

From c62b8de03294f55e826396da9300b343f0bf4c28 Mon Sep 17 00:00:00 2001
From: Moritz Angermann <moritz.angermann@gmail.com>
Date: Tue, 19 May 2020 15:52:03 +0800
Subject: [PATCH 9/9] [linker] Adds void printLoadedObjects(void);

This allows us to dump in-memory object code locations for debugging.

Fixup printLoadedObjects prototype
---
 rts/Linker.c          | 30 ++++++++++++++++++++++++++++--
 rts/LinkerInternals.h |  2 ++
 2 files changed, 30 insertions(+), 2 deletions(-)

diff --git a/rts/Linker.c b/rts/Linker.c
index 13cc549535..81d4e68f7e 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -888,8 +888,9 @@ SymbolAddr* lookupSymbol_ (SymbolName* lbl)
  * Symbol name only used for diagnostics output.
  */
 SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo) {
-    IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl,
-                                pinfo->value));
+    IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p, owned by %s\n", lbl,
+                                pinfo->value,
+                                pinfo->owner ? OC_INFORMATIVE_FILENAME(pinfo->owner) : "No owner, probably built-in."));
     ObjectCode* oc = pinfo->owner;
 
     /* Symbol can be found during linking, but hasn't been relocated. Do so now.
@@ -913,6 +914,27 @@ SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo) {
     return pinfo->value;
 }
 
+void
+printLoadedObjects() {
+    ObjectCode* oc;
+    for (oc = objects; oc; oc = oc->next) {
+        if (oc->sections != NULL) {
+            int i;
+            printf("%s\n", OC_INFORMATIVE_FILENAME(oc));
+            for (i=0; i < oc->n_sections; i++) {
+                if(oc->sections[i].mapped_start != NULL || oc->sections[i].start != NULL) {
+                    printf("\tsec %2d[alloc: %d; kind: %d]: %p - %p; mmaped: %p - %p\n",
+                        i, oc->sections[i].alloc, oc->sections[i].kind,
+                        oc->sections[i].start,
+                        (void*)((uintptr_t)(oc->sections[i].start) + oc->sections[i].size),
+                        oc->sections[i].mapped_start,
+                        (void*)((uintptr_t)(oc->sections[i].mapped_start) + oc->sections[i].mapped_size));
+                }
+            }
+        }
+   }
+}
+
 SymbolAddr* lookupSymbol( SymbolName* lbl )
 {
     ACQUIRE_LOCK(&linker_mutex);
@@ -920,6 +942,7 @@ SymbolAddr* lookupSymbol( SymbolName* lbl )
     if (!r) {
         errorBelch("^^ Could not load '%s', dependency unresolved. "
                    "See top entry above.\n", lbl);
+        IF_DEBUG(linker, printLoadedObjects());
         fflush(stderr);
     }
     RELEASE_LOCK(&linker_mutex);
@@ -1689,6 +1712,9 @@ static HsInt resolveObjs_ (void)
         r = ocTryLoad(oc);
         if (!r)
         {
+            errorBelch("Could not load Object Code %s.\n", OC_INFORMATIVE_FILENAME(oc));
+            IF_DEBUG(linker, printLoadedObjects());
+            fflush(stderr);
             return r;
         }
     }
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index 02cb6b814f..d470c9f32a 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -16,6 +16,8 @@
 void* mmap_next(void *addr, size_t length, int prot, int flags, int fd, off_t offset);
 #endif
 
+void printLoadedObjects(void);
+
 #include "BeginPrivate.h"
 
 typedef void SymbolAddr;
-- 
2.24.3 (Apple Git-128)