[Git][ghc/ghc][ghc-8.10] rts linker: teach the linker about GLIBC's special handling of *stat, mknod...

Ben Gamari gitlab at gitlab.haskell.org
Mon Sep 14 18:05:22 UTC 2020



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


Commits:
721dc35d by Adam Sandberg Ericsson at 2020-09-12T10:19:57+01:00
rts linker: teach the linker about GLIBC's special handling of *stat, mknod and atexit functions #7072

(cherry picked from commit 0effc57d48ace6b719a9f4cbeac67c95ad55010b)

- - - - -


6 changed files:

- rts/Linker.c
- testsuite/tests/rts/linker/Makefile
- + testsuite/tests/rts/linker/T7072-main.c
- + testsuite/tests/rts/linker/T7072-obj.c
- + testsuite/tests/rts/linker/T7072.stderr
- testsuite/tests/rts/linker/all.T


Changes:

=====================================
rts/Linker.c
=====================================
@@ -655,23 +655,51 @@ internal_dlsym(const char *symbol) {
 
     // We acquire dl_mutex as concurrent dl* calls may alter dlerror
     ACQUIRE_LOCK(&dl_mutex);
+
+    // clears dlerror
     dlerror();
+
     // look in program first
     v = dlsym(dl_prog_handle, symbol);
     if (dlerror() == NULL) {
         RELEASE_LOCK(&dl_mutex);
+        IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol));
         return v;
     }
 
     for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) {
         v = dlsym(o_so->handle, symbol);
         if (dlerror() == NULL) {
+            IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol));
             RELEASE_LOCK(&dl_mutex);
             return v;
         }
     }
     RELEASE_LOCK(&dl_mutex);
-    return v;
+
+#   if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__)
+    // HACK: GLIBC implements these functions with a great deal of trickery where
+    //       they are either inlined at compile time to their corresponding
+    //       __xxxx(SYS_VER, ...) function or direct syscalls, or resolved at
+    //       link time via libc_nonshared.a.
+    //
+    //       We borrow the approach that the LLVM JIT uses to resolve these
+    //       symbols. See http://llvm.org/PR274 and #7072 for more info.
+
+    IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol));
+
+    if (strcmp(symbol, "stat") == 0) return (void*)&stat;
+    if (strcmp(symbol, "fstat") == 0) return (void*)&fstat;
+    if (strcmp(symbol, "lstat") == 0) return (void*)&lstat;
+    if (strcmp(symbol, "stat64") == 0) return (void*)&stat64;
+    if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64;
+    if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64;
+    if (strcmp(symbol, "atexit") == 0) return (void*)&atexit;
+    if (strcmp(symbol, "mknod") == 0) return (void*)&mknod;
+#   endif
+
+    // we failed to find the symbol
+    return NULL;
 }
 #  endif
 
@@ -847,13 +875,13 @@ SymbolAddr* lookupSymbol_ (SymbolName* lbl)
 
 SymbolAddr* lookupSymbol_ (SymbolName* lbl)
 {
-    IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl));
+    IF_DEBUG(linker, debugBelch("lookupSymbol: looking up '%s'\n", lbl));
 
     ASSERT(symhash != NULL);
     RtsSymbolInfo *pinfo;
 
     if (!ghciLookupSymbolInfo(symhash, lbl, &pinfo)) {
-        IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n"));
+        IF_DEBUG(linker, debugBelch("lookupSymbol: symbol '%s' not found, trying dlsym\n", lbl));
 
 #       if defined(OBJFORMAT_ELF)
         return internal_dlsym(lbl);


=====================================
testsuite/tests/rts/linker/Makefile
=====================================
@@ -96,3 +96,10 @@ linker_error3:
 	"$(TEST_HC)" -c linker_error3.c -o linker_error3_o.o
 	"$(TEST_HC)" linker_error3.o -o linker_error3 -no-hs-main -optc-g -debug -threaded
 	./linker_error3 linker_error3_o.o
+
+.PHONY: T7072
+T7072:
+	"$(TEST_HC)" -c T7072-obj.c -o T7072-obj.o
+	"$(TEST_HC)" -c T7072-main.c -o T7072-main.o
+	"$(TEST_HC)" T7072-main.c -o T7072-main -no-hs-main -debug
+	./T7072-main T7072-obj.o


=====================================
testsuite/tests/rts/linker/T7072-main.c
=====================================
@@ -0,0 +1,39 @@
+#include "ghcconfig.h"
+#include "Rts.h"
+#include <stdio.h>
+#include <stdlib.h>
+
+int main (int argc, char *argv[])
+{
+    int r;
+    char *obj;
+
+    hs_init(&argc, &argv);
+
+    initLinker_(0);
+
+    // Load object file argv[1] repeatedly
+
+    if (argc != 2) {
+        errorBelch("usage: T7072-main <object-file>");
+        exit(1);
+    }
+
+    obj = argv[1];
+
+    r = loadObj(obj);
+    if (!r) {
+        debugBelch("loadObj(%s) failed\n", obj);
+        exit(1);
+    }
+    r = resolveObjs();
+    if (!r) {
+        debugBelch("resolveObjs failed\n");
+        unloadObj(obj);
+        exit(1);
+    }
+    debugBelch("loading succeeded");
+
+    hs_exit();
+    return 0;
+}


=====================================
testsuite/tests/rts/linker/T7072-obj.c
=====================================
@@ -0,0 +1,17 @@
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <stdio.h>
+
+typedef int stat_func(const char*, struct stat*);
+
+stat_func *foo = &stat;
+
+void stat_test(void)
+{
+  struct stat buf;
+
+  printf("About to stat-test.c\n");
+  foo("stat-test.c", &buf);
+  printf("Done\n");
+}


=====================================
testsuite/tests/rts/linker/T7072.stderr
=====================================
@@ -0,0 +1 @@
+loading succeeded
\ No newline at end of file


=====================================
testsuite/tests/rts/linker/all.T
=====================================
@@ -92,3 +92,10 @@ test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip)
                  , omit_ways(['ghci'])
                  ],
      compile_and_run, ['-rdynamic -package ghc'])
+
+
+test('T7072',
+	[extra_files(['T7072-main.c', 'T7072-obj.c']),
+		unless(opsys('linux'), skip),
+		req_rts_linker],
+	makefile_test, ['T7072'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/721dc35dcc92684138e16968c19f77e299187956

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/721dc35dcc92684138e16968c19f77e299187956
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/20200914/f6a3f12f/attachment-0001.html>


More information about the ghc-commits mailing list