rts/linker: Move shared library loading logic into Elf.c

5 files changed, 197 insertions, 184 deletions

diff --git a/rts/Linker.c b/rts/Linker.c
index 136f3f3a7d..ef08a282dc 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -63,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>
@@ -170,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).
@@ -398,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
 
@@ -1869,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)) {
@@ -1959,141 +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);
-
-   /* 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, 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;
-
-#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;
-}
-
-#  endif
-
 #define UNUSED(x) (void)(x)
 
 void * loadNativeObj (pathchar *path, char **errmsg)
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index f060e4d38a..27ca52f0e3 100644
--- a/rts/LinkerInternals.h
+++ b/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
diff --git a/rts/linker/Elf.c b/rts/linker/Elf.c
index 8a8480018c..bcf7556bc1 100644
--- a/rts/linker/Elf.c
+++ b/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)
@@ -1970,6 +1975,143 @@ int ocRunInit_ELF( ObjectCode *oc )
 }
 
 /*
+ * 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, 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;
+
+#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
  */
 
diff --git a/rts/linker/Elf.h b/rts/linker/Elf.h
index 30c993b98c..a16255abba 100644
--- a/rts/linker/Elf.h
+++ b/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"
diff --git a/rts/linker/PEi386Types.h b/rts/linker/PEi386Types.h
index 67ea34345f..ec53ec800b 100644
--- a/rts/linker/PEi386Types.h
+++ b/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;