Changeset 10281

Timestamp:

Aug 4, 2008, 2:07:06 AM (11 years ago)

Author:

gb

Message:

Use entry->addr to hide the differences between a foreign "entry"
(which may be a fixnum representing a word-aligned address or
an integer or something equally platform-dependent) and an
address; this may make it possible to map external entry points
to the libraries that define them.

Towards that end, try to use #_dladdr on Darwin. Give up (after
much frustration) because there's no correlation between the
"handle" returned by Darwin's #_dlopen and the library base
returned by #_dladdr. (We might be able to find a static C++
function inside dyld to do this for us, but that's pretty ugly.)

I wouldn't be at all averse to dropping (nominal) support for
10.3.9 (and therefore the deprecated, legacy dyld stuff) if
the dlfcn stuff was actually useful.

File:

• trunk/source/level-0/l0-cfm-support.lisp (modified) (5 diffs)

trunk/source/level-0/l0-cfm-support.lisp

@@ -22 +22 @@
 
 
-
+;;; We have several different conventions for representing an
+;;; "entry" (a foreign symbol address, possibly represented as
+;;; something cheaper than a MACPTR.)  Destructively modify
+;;; ADDR so that it points to where ENTRY points.
+(defun entry->addr (entry addr)
+  #+ppc32-target
+  ;; On PPC32, all function addresses have their low 2 bits clear;
+  ;; so do fixnums.
+  (%setf-macptr-to-object addr entry)
+  #+ppc64-target
+  ;; On PPC64, some addresses can use the fixnum trick.  In other
+  ;; cases, an "entry" is just a MACPTR.
+  (if (typep entry 'fixnum)
+    (%setf-macptr-to-object addr entry)
+    (%setf-macptr addr entry))
+  ;; On x86, an "entry" is just an integer.  There might elswehere be
+  ;; some advantage in treating those integers as signed (they might
+  ;; be more likely to be fixnums, for instance), so ensure that they
+  ;; aren't.
+  #+x86-target
+  (%setf-macptr addr (%int-to-ptr
+                      (if (< entry 0)
+                        (logand entry (1- (ash 1 target::nbits-in-word)))
+                        entry)))
+  #-(or ppc-target x86-target) (dbg "Fix entry->addr"))
 
 
@@ -512 +536 @@
   (unless *statically-linked*
     (with-macptrs (p)
-      (%setf-macptr-to-object p entry)
+      (entry->addr entry p)
       (shlib-containing-address p name))))
 )
@@ -525 +549 @@
 (defvar *nsmodule-for-symbol*)
 (defvar *ns-is-symbol-name-defined-in-image*)
+(defvar *dladdr-entry* 0)
 
 (defun setup-lookup-calls ()
+  #+notyet
+  (setq *dladdr-entry* (foreign-symbol-entry "_dladdr"))
   (setq *dyld-image-count* (foreign-symbol-entry "__dyld_image_count"))
   (setq *dyld-get-image-header* (foreign-symbol-entry "__dyld_get_image_header"))
@@ -549 +576 @@
 ;;;
 
-(defun shlib-containing-address (addr name)
+(defun legacy-shlib-containing-address (addr name)
   (dotimes (i (ff-call *dyld-image-count* :unsigned-fullword))
     (let ((header (ff-call *dyld-get-image-header* :unsigned-fullword i :address)))
@@ -585 +612 @@
                       (return (shared-library-from-header-module-or-name libheader libmodule libname)))))))))))))
 
+(defun shlib-containing-address (address name)
+  (if (zerop *dladdr-entry*)
+    (legacy-shlib-containing-address address name)
+    ;; Bootstrapping.  RLET might be clearer here.
+    (%stack-block ((info (record-length #>Dl_info) :clear t))
+      (unless (zerop (ff-call *dladdr-entry*
+                              :address address
+                              :address info
+                              :signed-fullword))
+        (let* ((addr (pref info #>Dl_info.dli_fbase)))
+          (format t "~&name = ~s" (pref info  #>Dl_info.dli_fname))
+          
+          (dolist (lib *shared-libraries*)
+            (when (eql (shlib.base lib) addr)
+              (return lib))))))))
+
 (defun shlib-containing-entry (entry &optional name)
-  (when (not name)
-        (error "shared library name must be non-NIL."))
+  (unless name
+    (error "foreign name must be non-NIL."))
   (with-macptrs (addr)
-    (%setf-macptr-to-object addr entry)
+    (entry->addr entry addr)
     (shlib-containing-address addr name)))