CmmToLlvm: Declare signature for memcmpwip/T18857

Otherwise `opt` fails with:

    error: use of undefined value '@memcmp$def'

6 files changed, 47 insertions, 8 deletions

diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index 43eaab424e..d68b5d5c8e 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -476,13 +476,15 @@ ghcInternalFunctions :: LlvmM ()
 ghcInternalFunctions = do
     platform <- getPlatform
     let w = llvmWord platform
+        cint = LMInt $ widthInBits $ cIntWidth platform
+    mk "memcmp" cint [i8Ptr, i8Ptr, w]
     mk "memcpy" i8Ptr [i8Ptr, i8Ptr, w]
     mk "memmove" i8Ptr [i8Ptr, i8Ptr, w]
     mk "memset" i8Ptr [i8Ptr, w, w]
     mk "newSpark" w [i8Ptr, i8Ptr]
   where
     mk n ret args = do
-      let n' = llvmDefLabel $ fsLit n
+      let n' = fsLit n
           decl = LlvmFunctionDecl n' ExternallyVisible CC_Ccc ret
                                  FixedArgs (tysToParams args) Nothing
       renderLlvm $ ppLlvmFunctionDecl decl
@@ -516,7 +518,10 @@ getGlobalPtr llvmLbl = do
   let mkGlbVar lbl ty = LMGlobalVar lbl (LMPointer ty) Private Nothing Nothing
   case m_ty of
     -- Directly reference if we have seen it already
-    Just ty -> return $ mkGlbVar (llvmDefLabel llvmLbl) ty Global
+    Just ty -> do
+      if llvmLbl `elem` (map fsLit ["newSpark", "memmove", "memcpy", "memcmp", "memset"])
+        then return $ mkGlbVar (llvmLbl) ty Global
+        else return $ mkGlbVar (llvmDefLabel llvmLbl) ty Global
     -- Otherwise use a forward alias of it
     Nothing -> do
       saveAlias llvmLbl
diff --git a/libraries/ghc-boot/GHC/Data/ShortText.hs b/libraries/ghc-boot/GHC/Data/ShortText.hs
index f51d79864b..108b5a43cd 100644
--- a/libraries/ghc-boot/GHC/Data/ShortText.hs
+++ b/libraries/ghc-boot/GHC/Data/ShortText.hs
@@ -1,6 +1,22 @@
-{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, GeneralizedNewtypeDeriving, DerivingStrategies #-}
+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, GeneralizedNewtypeDeriving, DerivingStrategies, CPP #-}
 {-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
-
+-- gross hack: we manuvered ourselves into a position where we can't boot GHC with a LLVM based GHC anymore.
+-- LLVM based GHC's fail to compile memcmp ffi calls.  These end up as memcmp$def in the llvm ir, however we
+-- don't have any prototypes and subsequently the llvm toolchain chokes on them.  Since 7fdcce6d, we use
+-- ShortText for the package database.  This however introduces this very module; which through inlining ends
+-- up bringing memcmp_ByteArray from bytestring:Data.ByteString.Short.Internal into scope, which results in
+-- the memcmp call we choke on.
+--
+-- The solution thusly is to force late binding via the linker instead of inlining when comping with the
+-- bootstrap compiler.  This will produce a slower (slightly less optimised) stage1 compiler only.
+--
+-- See issue 18857. hsyl20 deserves credit for coming up with the idea for the soltuion.
+--
+-- This can be removed when we exit the boot compiler window. Thus once we drop GHC-9.2 as boot compiler,
+-- we can drop this code as well.
+#if GHC_STAGE < 1
+{-# OPTIONS_GHC -fignore-interface-pragmas #-}
+#endif
 -- |
 -- An Unicode string for internal GHC use. Meant to replace String
 -- in places where being a lazy linked is not very useful and a more
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index 93e949f2f2..f060e4d38a 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -141,7 +141,7 @@ typedef struct _Segment {
     int n_sections;
 } Segment;
 
-#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
+#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH)
 #define NEED_SYMBOL_EXTRAS 1
 #endif
 
diff --git a/rts/linker/Elf.c b/rts/linker/Elf.c
index 023ce1f6ce..a839ab68af 100644
--- a/rts/linker/Elf.c
+++ b/rts/linker/Elf.c
@@ -781,7 +781,12 @@ ocGetNames_ELF ( ObjectCode* oc )
           else if (!oc->imageMapped || size < getPageSize() / 3) {
               bool executable = kind == SECTIONKIND_CODE_OR_RODATA;
               m32_allocator *allocator = executable ? oc->rx_m32 : oc->rw_m32;
-              start = m32_alloc(allocator, size, 8);
+              // align on 16 bytes. The reason being that llvm will emit see
+              // paddq statements for x86_64 under optimisation and load from
+              // RODATA sections. Specifically .rodata.cst16. However we don't
+              // handle the cst part in any way what so ever, so 16 seems
+              // better than 8.
+              start = m32_alloc(allocator, size, 16);
               if (start == NULL) goto fail;
               memcpy(start, oc->image + offset, size);
               alloc = SECTION_M32;
@@ -940,7 +945,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);
                    if (ELF_ST_BIND(symbol->elf_sym->st_info) == STB_LOCAL) {
                        isLocal = true;
                        isWeak = false;
@@ -1867,6 +1872,7 @@ ocResolve_ELF ( ObjectCode* oc )
 #endif
                 ASSERT(symbol->elf_sym->st_name == 0);
                 ASSERT(symbol->elf_sym->st_value == 0);
+                ASSERT(0x0 != oc->sections[ secno ].start);
                 symbol->addr = oc->sections[ secno ].start;
             }
         }
@@ -1940,6 +1946,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);
             (*init)(argc, argv, envv);
          }
       }
diff --git a/rts/linker/elf_reloc_aarch64.c b/rts/linker/elf_reloc_aarch64.c
index cdaaa67711..8cffb9f03e 100644
--- a/rts/linker/elf_reloc_aarch64.c
+++ b/rts/linker/elf_reloc_aarch64.c
@@ -297,7 +297,7 @@ relocateObjectCodeAarch64(ObjectCode * oc) {
                                relTab->sectionHeader->sh_link,
                                ELF64_R_SYM((Elf64_Xword)rel->r_info));
 
-            assert(symbol != NULL);
+            assert(0x0 != symbol);
 
             /* decode implicit addend */
             int64_t addend = decodeAddendAarch64(targetSection, rel);
@@ -324,6 +324,7 @@ relocateObjectCodeAarch64(ObjectCode * oc) {
                                ELF64_R_SYM((Elf64_Xword)rel->r_info));
 
             assert(0x0 != symbol);
+            assert(0x0 != symbol->addr);
 
             /* take explicit addend */
             int64_t addend = rel->r_addend;
diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py
index 8ef5a8450c..4828df9736 100644
--- a/testsuite/driver/testlib.py
+++ b/testsuite/driver/testlib.py
@@ -2216,6 +2216,13 @@ def normalise_errmsg(s: str) -> str:
         s = re.sub('Failed to remove file (.*); error= (.*)$', '', s)
         s = re.sub('DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s)
 
+    # filter out unsupported GNU_PROPERTY_TYPE (5), which is emitted by LLVM10
+    # and not understood by older binutils (ar, ranlib, ...)
+    s = modify_lines(s, lambda l: re.sub('^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l))
+
+    # filter out nix garbage, that just keeps on showing up as errors on darwin
+    s = modify_lines(s, lambda l: re.sub('^(.+)\.dylib, ignoring unexpected dylib file$','', l))
+
     return s
 
 # normalise a .prof file, so that we can reasonably compare it against
@@ -2286,6 +2293,9 @@ def normalise_output( s: str ) -> str:
     s = re.sub('([^\\s])\\.exe', '\\1', s)
     s = normalise_callstacks(s)
     s = normalise_type_reps(s)
+    # ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is
+    # requires for -fPIC
+    s = re.sub('  -fexternal-dynamic-refs\n','',s)
     return s
 
 def normalise_asm( s: str ) -> str: