Changeset 10535

Timestamp:

08/22/08 10:16:43 (3 months ago)

Author:

gb

Message:

Changes from trunk; among other things, foreign functions should
have a better idea of what shared libraries define them.

Files:

• branches/working-0711/ccl/level-0/l0-cfm-support.lisp (modified) (23 diffs)

branches/working-0711/ccl/level-0/l0-cfm-support.lisp

@@ -22 +22 @@
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
@@ -44 +68 @@
-  (istruct-typep x 'external-entry-point))
-
+;;; On both Linux and FreeBSD, RTLD_NEXT and RTLD_DEFAULT behave
+;;; the same way wrt symbols defined somewhere other than the lisp
+;;; kernel.  On Solaris, RTLD_DEFAULT will return the address of
+;;; an imported symbol's procedure linkage table entry if the symbol
+;;; has a plt entry (e.g., if it happens to be referenced by the
+;;; lisp kernel.)  *RTLD-NEXT* is therefore a slightly better
+;;; default; we've traditionaly used *RTLD-DEFAULT*.
-(defvar *rtld-next*)
-(defvar *rtld-default*)
@@ -50 +81 @@
-                                  #-(or linux-target darwin-target)  -2))
-
-
+ solaris-target
-(progn
-
@@ -99 +130 @@
-(defvar *shared-libraries* nil)
-
-
+ solaris-target
-(progn
-
@@ -137 +168 @@
-                                             dynamic-entries
-                                             target::node-size)))
-freebsd-target
+(or freebsd-target solaris-target)
-                                 (%inc-ptr (pref map :link_map.l_addr) disp)
-freebsd-target
+(or freebsd-target solaris-target)
-                                 (%int-to-ptr 
-                                  (if (< disp 0) 
@@ -232 +263 @@
-  (when (null *shared-libraries*)
-    (%walk-shared-libraries #'shlib-from-map-entry)
-    (dolist (l *shared-libraries*)
-      ;;; On Linux, it seems to be necessary to open each of these
-      ;;; libraries yet again, specifying the RTLD_GLOBAL flag.
-      ;;; On FreeBSD, it seems desirable -not- to do that.
-  
-  (%dlopen-shlib l
-setf (shlib.opened-by-lisp-kernel l) t
+
+(dolist (l *shared-libraries*
+%dlopen-shlib l
-
-(init-shared-libraries)
@@ -266 +296 @@
-loaded, signal a SIMPLE-ERROR which contains an often-cryptic message from
-the operating system."
-
-
+
-                        (ff-call
-                         (%kernel-import target::kernel-import-GetSharedLibrary)
-                         :address name
-                         :unsigned-fullword *dlopen-flags*
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-    (if (%null-ptr-p link-map)
-      (error "Error opening shared library ~s: ~a" name (dlerror))
-      (prog1 (let* ((lib (shlib-from-map-entry link-map)))
-               (incf (shlib.opencount lib))
+               (setf (shlib.handle lib) handle)
-               lib)
-        (%walk-shared-libraries
@@ -433 +464 @@
-(defun ensure-open-shlib (c force)
-  (if (or (shlib.map c) (not force))
-defaul
+nex
-    (error "Shared library not open: ~s" (shlib.soname c))))
-
@@ -439 +470 @@
-  (if c
-    (ensure-open-shlib c force)
-defaul
+nex
-    ))
-
@@ -455 +486 @@
-;;; linkers don't quite get the concept ...)
-
-defaul
+nex
-  "Try to resolve the address of the foreign symbol name. If successful,
-return a fixnum representation of that address, else return NIL."
@@ -468 +499 @@
-      (unless (%null-ptr-p addr)        ; No function can have address 0
-        (or (macptr->fixnum addr) (%inc-ptr addr 0))))
+    #+x8632-target
+    (let* ((addr (ff-call (%kernel-import target::kernel-import-FindSymbol)
+                          :address handle
+                          :address n
+                          :unsigned-fullword)))
+      (unless (eql 0 addr) addr))
-    #+x8664-target
-    (let* ((addr (ff-call (%kernel-import target::kernel-import-FindSymbol)
@@ -477 +514 @@
-(defvar *statically-linked* nil)
-
-
+ solaris-target
-(progn
-
@@ -499 +536 @@
-  (unless *statically-linked*
-    (with-macptrs (p)
-%setf-macptr-to-object p entry
+entry->addr entry p
-      (shlib-containing-address p name))))
-)
@@ -512 +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"))
@@ -536 +576 @@
-;;;
-
-
+legacy-
-  (dotimes (i (ff-call *dyld-image-count* :unsigned-fullword))
-    (let ((header (ff-call *dyld-get-image-header* :unsigned-fullword i :address)))
@@ -572 +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
+unless name
+  (error "foreign
-  (with-macptrs (addr)
-%setf-macptr-to-object addr entry
+entry->addr entry addr
-    (shlib-containing-address addr name)))
-
@@ -582 +638 @@
-)
-
-
+ solaris-target
-(defun shlib-containing-entry (entry &optional name)
-  (declare (ignore entry name))
@@ -604 +660 @@
-
-
-defaul
+nex
-  "Try to resolve the address of the foreign symbol name. If successful,
-return that address encapsulated in a MACPTR, else returns NIL."
@@ -631 +687 @@
-    eep))
-
+
+
-(defun load-fv (name type)
-  (let* ((fv (or (gethash name (fvs)) (setf (gethash name *fvs*) (%cons-foreign-variable name type)))))
@@ -641 +699 @@
-
-
-
+ solaris-target
-(progn
-;;; It's assumed that the set of libraries that the OS has open
@@ -688 +746 @@
-             (lose nil))
-        (dolist (lib *shared-libraries*)
-
+
+
-            (unless map
-              (with-cstrs ((soname (shlib.soname lib)))
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-                (if (%null-ptr-p map)
-                  (setq lose t)
@@ -703 +777 @@
-                        (%int-to-ptr (pref map :link_map.l_addr))
-                        (shlib.map lib) map
+                        (shlib.handle lib) handle
-                        win t))))))
-        (when (or (not lose) (not win)) (return)))))
@@ -713 +788 @@
-  (%revive-macptr *rtld-next*)
-  (%revive-macptr *rtld-default*)
-
+ solaris-target
-  (unless *statically-linked*
-    (setq *dladdr-entry* (foreign-symbol-entry "dladdr"))