From 571dd4904fc88cad51c9c2dee0b3e6ed6ef9ce12 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Thu, 9 Oct 2014 22:54:49 -0700
Subject: [PATCH] Unify extern-alien-name for darwin x86 and ppc.

Initial attempt to unify extern-alien-name, primarily for darwin (x86
and ppc). Thus, systems using elf do not prepend an underscore, but
other systems are assumed to prepend an underscore.

This is currently only for darwin/x86.  A cross-compile on darwin x86
is needed.

 * code/x86-vm.lisp:
   * For elf systems, don't prepend an underscore.  For other systems,
     do prepend.
 * compiler/generic/new-genesis.lisp:
   * Fix long-standing bug where we should call EXTERN-ALIEN-NAME to
     get the right name for "resolve_linkage_tramp".
 * lisp/Darwin-os.c:
   * Update os_dlsym to assume the external name is always preceded by
     an underscore.  The lookup for dlysm is done by stripping off the
     leading underscore.
 * lisp/os-common.c:
   * Add EXTERN_ALIEN_NAME macro to create the correct alien name for
     elf and non-elf systems.
   * Use it to generate the correct name to be used for comparison in
     the sanity checks of the linkage table entries.
---
 src/code/x86-vm.lisp                       |  3 +++
 src/compiler/generic/new-genesis.lisp      |  2 +-
 src/lisp/Darwin-os.c                       | 24 +++++++++--------
 src/lisp/os-common.c                       | 31 +++++++++++++++-------
 src/tools/cross-scripts/cross-x86-x86.lisp |  3 +++
 5 files changed, 41 insertions(+), 22 deletions(-)

diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp
index 2171d60a5..a7e307d78 100644
--- a/src/code/x86-vm.lisp
+++ b/src/code/x86-vm.lisp
@@ -336,6 +336,9 @@
 ;;;
 (defun extern-alien-name (name)
   (declare (type simple-string name))
+  #-elf
+  (concatenate 'string "_"  name)
+  #+elf
   name)
 
 #+(and (or linux (and freebsd elf)) (not linkage-table))
diff --git a/src/compiler/generic/new-genesis.lisp b/src/compiler/generic/new-genesis.lisp
index 953d9ba9e..bae4df750 100644
--- a/src/compiler/generic/new-genesis.lisp
+++ b/src/compiler/generic/new-genesis.lisp
@@ -2183,7 +2183,7 @@
   ;; This has gotta be the first entry.  This has to match what
   ;; os_foreign_linkage_init does!
   #+(or x86 amd64)
-  (cold-register-foreign-linkage "resolve_linkage_tramp" :code)
+  (cold-register-foreign-linkage (vm::extern-alien-name "resolve_linkage_tramp") :code)
   #+(or sparc ppc)
   (progn
     (cold-register-foreign-linkage (vm::extern-alien-name "call_into_c") :code)
diff --git a/src/lisp/Darwin-os.c b/src/lisp/Darwin-os.c
index 0efb72f39..49e660cc7 100644
--- a/src/lisp/Darwin-os.c
+++ b/src/lisp/Darwin-os.c
@@ -532,7 +532,13 @@ os_dlsym(const char *sym_name, lispobj lib_list)
 {
     static void *program_handle;
     void *sym_addr = 0;
+    int offset = sym_name[0] == '_' ? 1 : 0;
 
+#if 1
+    if (offset == 0) {
+        fprintf(stderr, "sym-name = %s\n", sym_name);
+    }
+#endif    
     if (!program_handle)
 	program_handle = dlopen((void *) 0, RTLD_LAZY | RTLD_GLOBAL);
     if (lib_list != NIL) {
@@ -543,21 +549,17 @@ os_dlsym(const char *sym_name, lispobj lib_list)
 	    struct cons *lib_cons = CONS(CONS(lib_list_head)->car);
 	    struct sap *dlhandle = (struct sap *) PTR(lib_cons->car);
 
-#if 0 && defined(__ppc__)
-            sym_addr = dlsym((void *) dlhandle->pointer, (sym_name[0] == '_' ? sym_name + 1 : sym_name));
-#else
-	    sym_addr = dlsym((void *) dlhandle->pointer, sym_name);
-#endif
+            /*
+             * On Darwin, dlsym assumes the C name, so skip the underscore that
+             * is prepended by EXTERN-ALIEN-NAME.
+             */
+            sym_addr = dlsym((void *) dlhandle->pointer, sym_name + offset);
 	    if (sym_addr)
-		return sym_addr;
+                return sym_addr;
 	}
     }
 
-#if 0 && defined(__ppc__)
-    sym_addr = dlsym(program_handle, (sym_name[0] == '_' ? sym_name + 1 : sym_name));
-#else
-    sym_addr = dlsym(program_handle, sym_name);
-#endif
+    sym_addr = dlsym(program_handle, sym_name + offset);
 
     return sym_addr;
 }
diff --git a/src/lisp/os-common.c b/src/lisp/os-common.c
index b183d066a..ff9cffb5e 100755
--- a/src/lisp/os-common.c
+++ b/src/lisp/os-common.c
@@ -167,6 +167,16 @@ convert_lisp_string(char* c_string, void* lisp_string, int len)
     return c_string;
 }
 
+/*
+ * C version of lisp's EXTERN-ALIEN-NAME.  For systems that use elf,
+ * do nothing.  Otherwise, we prepend an underscore.
+ */
+#if defined(FEATURE_ELF)
+#define EXTERN_ALIEN_NAME(x) x
+#else
+#define EXTERN_ALIEN_NAME(x) "_" x
+#endif
+
 void
 os_foreign_linkage_init(void)
 {
@@ -212,25 +222,27 @@ os_foreign_linkage_init(void)
 #endif        
 	if (i == 0) {
 #if defined(sparc)
-	    if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name, "call_into_c")) {
+            if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name, EXTERN_ALIEN_NAME("call_into_c"))) {
 		fprintf(stderr, "linkage_data is %s but expected call_into_c\n",
-			(char *) symbol_name->data);
+			c_symbol_name);
 		lose("First element of linkage_data is bogus.\n");
 	    }
 	    arch_make_linkage_entry(i, (void*) call_into_c, 1);
 #elif (defined(DARWIN) && defined(__ppc__))
-	    if (type != 1 || strcmp(c_symbol_name, "call_into_c")) {
-		fprintf(stderr, "linkage_data is %s but expected call_into_c\n",
-			(char *) c_symbol_name);
+	    if (type != 1 || strcmp(c_symbol_name, EXTERN_ALIEN_NAME("call_into_c"))) {
+		fprintf(stderr, "linkage_data is %s but expected %s\n",
+			c_symbol_name,
+                        EXTERN_ALIEN_NAME("call_into_c"));
 		lose("First element of linkage_data is bogus.\n");
 	    }
 	    arch_make_linkage_entry(i, &call_into_c, 1);
 #else
 	    if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name,
-                                                    "resolve_linkage_tramp")) {
+                                                    EXTERN_ALIEN_NAME("resolve_linkage_tramp"))) {
 		fprintf(stderr,
-			"linkage_data is %s but expected resolve_linkage_tramp\n",
-			(char *) c_symbol_name);
+			"linkage_data is %s but expected %s\n",
+			c_symbol_name,
+                        EXTERN_ALIEN_NAME("resolve_linkage_tramp"));
 		lose("First element of linkage_data is bogus.\n");
 	    }
 	    arch_make_linkage_entry(i, (void *) &resolve_linkage_tramp, 1);
@@ -241,7 +253,7 @@ os_foreign_linkage_init(void)
 	    void *target_addr = os_dlsym(c_symbol_name, NIL);
 
 	    if (!target_addr) {
-#if 1
+#if 0
                 int k;
                 unsigned short int* wide_string;
                 
@@ -262,7 +274,6 @@ os_foreign_linkage_init(void)
 	} else {
 	    arch_make_lazy_linkage(i / LINKAGE_DATA_ENTRY_SIZE);
 	}
-
     }
 #endif /* LINKAGE_TABLE */
 }
diff --git a/src/tools/cross-scripts/cross-x86-x86.lisp b/src/tools/cross-scripts/cross-x86-x86.lisp
index 3f579f34f..eacbbe112 100644
--- a/src/tools/cross-scripts/cross-x86-x86.lisp
+++ b/src/tools/cross-scripts/cross-x86-x86.lisp
@@ -205,6 +205,9 @@
 (in-package :vm)
 (defun extern-alien-name (name)
   (declare (type simple-string name))
+  #-elf
+  (concatenate 'simple-string "_" name)
+  #+elf
   name)
 (export 'extern-alien-name)
 (in-package :cl-user)
-- 
GitLab