0.8.13.78: Birds of Feather

[sbcl.git] / src / code / foreign.lisp

diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp
index fc4a3b8..3102c08 100644 (file)
--- a/src/code/foreign.lisp
+++ b/src/code/foreign.lisp
@@ -26,10 +26,10 @@
 ;;; It also works on OpenBSD, which isn't ELF, but is otherwise modern
 ;;; enough to have a fairly well working dlopen/dlsym implementation.
 (macrolet ((define-unsupported-fun (fun-name &optional (error-message "unsupported on this system"))
-            `(defun ,fun-name (&rest rest)
-               ,error-message
-                (declare (ignore rest))
-               (error 'unsupported-operator :name ',fun-name))))
+              `(defun ,fun-name (&rest rest)
+                ,error-message
+                (declare (ignore rest))
+                (error 'unsupported-operator :name ',fun-name))))
   #-(or linux sunos FreeBSD OpenBSD NetBSD darwin)
   (define-unsupported-fun load-shared-object)
   #+(or linux sunos FreeBSD OpenBSD NetBSD darwin)
@@ -67,13 +67,14 @@
     (push (lambda () (setq *handles-from-dlopen* nil))
          *after-save-initializations*)
 
-    (sb-alien:define-alien-routine dlopen system-area-pointer
-      (file sb-alien:c-string) (mode sb-alien:int))
-    (sb-alien:define-alien-routine dlsym system-area-pointer
-      (lib system-area-pointer)
-      (name sb-alien:c-string))
-    (sb-alien:define-alien-routine dlerror sb-alien:c-string)
-
+    (define-alien-routine dlopen system-area-pointer
+      (file c-string) (mode int))
+    
+    (define-alien-routine dlsym system-area-pointer
+      (lib system-area-pointer) (name c-string))
+    
+    (define-alien-routine dlerror c-string)
+    
 ;;; Ensure that we've opened our own binary so we can dynamically resolve 
 ;;; symbols in the C runtime.  
 ;;;
@@ -135,4 +136,26 @@
          (unless (zerop possible-result)
            (return possible-result)))))
 
+    #+os-provides-dladdr
+    ;;; Override the early definition in target-load.lisp
+    (defun foreign-symbol-in-address (sap)
+      (let ((addr (sap-int sap)))
+       (with-alien ((info
+                     (struct dl-info
+                             (filename c-string)
+                             (base unsigned)
+                             (symbol c-string)
+                             (symbol-address unsigned)))
+                    (dladdr
+                     (function unsigned
+                               unsigned (* (struct dl-info)))
+                     :extern "dladdr"))
+         (let ((err (alien-funcall dladdr addr (addr info))))
+           (if (zerop err)
+               nil
+               (values (slot info 'symbol)
+                       (slot info 'filename)
+                       addr
+                       (- addr (slot info 'symbol-address))))))))
+    
     ))                                 ; PROGN, MACROLET