Changeset 9858 for trunk/source/level-0/l0-cfm-support.lisp

Timestamp:

Jul 1, 2008, 12:09:13 PM (12 years ago)

Author:

gb

Message:

Handle #+freebsd-target issues (handle returned by #_dlopen isn't
a link map, needs to be mapped to one) in %REOPEN-USER-LIBRARIES.

File:

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

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

@@ -718 +718 @@
              (lose nil))
         (dolist (lib *shared-libraries*)
-          (let* ((map (shlib.map lib)))
+          (let* ((map (shlib.map lib))
+                 (handle (shlib.handle lib)))
             (unless map
               (with-cstrs ((soname (shlib.soname lib)))
-                (setq map (ff-call
-                           (%kernel-import target::kernel-import-GetSharedLibrary)
-                           :address soname
-                           :unsigned-fullword *dlopen-flags*
-                           :address))
+                (setq handle
+                      (ff-call
+                       (%kernel-import target::kernel-import-GetSharedLibrary)
+                       :address soname
+                       :unsigned-fullword *dlopen-flags*
+                       :address))
+                #-freebsd-target (setq map handle)
+                #+freebsd-target (setq map
+                                       (if (%null-ptr-p handle)
+                                      handle
+                                      (rlet ((p :address))
+                                        (if (eql 0 (ff-call
+                                                    (foreign-symbol-entry "dlinfo")
+                                                    :address handle
+                                                    :int #$RTLD_DI_LINKMAP
+                                                    :address p
+                                                    :int))
+                                          (pref p :address)
+                                          (%null-ptr)))))
                 (if (%null-ptr-p map)
                   (setq lose t)
@@ -733 +748 @@
                         (%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)))))