Changeset 10535


Ignore:
Timestamp:
Aug 22, 2008, 2:16:43 PM (11 years ago)
Author:
gb
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-0/l0-cfm-support.lisp

    r9578 r10535  
    2222
    2323
    24 
     24;;; We have several different conventions for representing an
     25;;; "entry" (a foreign symbol address, possibly represented as
     26;;; something cheaper than a MACPTR.)  Destructively modify
     27;;; ADDR so that it points to where ENTRY points.
     28(defun entry->addr (entry addr)
     29  #+ppc32-target
     30  ;; On PPC32, all function addresses have their low 2 bits clear;
     31  ;; so do fixnums.
     32  (%setf-macptr-to-object addr entry)
     33  #+ppc64-target
     34  ;; On PPC64, some addresses can use the fixnum trick.  In other
     35  ;; cases, an "entry" is just a MACPTR.
     36  (if (typep entry 'fixnum)
     37    (%setf-macptr-to-object addr entry)
     38    (%setf-macptr addr entry))
     39  ;; On x86, an "entry" is just an integer.  There might elswehere be
     40  ;; some advantage in treating those integers as signed (they might
     41  ;; be more likely to be fixnums, for instance), so ensure that they
     42  ;; aren't.
     43  #+x86-target
     44  (%setf-macptr addr (%int-to-ptr
     45                      (if (< entry 0)
     46                        (logand entry (1- (ash 1 target::nbits-in-word)))
     47                        entry)))
     48  #-(or ppc-target x86-target) (dbg "Fix entry->addr"))
    2549
    2650
     
    4468  (istruct-typep x 'external-entry-point))
    4569
     70;;; On both Linux and FreeBSD, RTLD_NEXT and RTLD_DEFAULT behave
     71;;; the same way wrt symbols defined somewhere other than the lisp
     72;;; kernel.  On Solaris, RTLD_DEFAULT will return the address of
     73;;; an imported symbol's procedure linkage table entry if the symbol
     74;;; has a plt entry (e.g., if it happens to be referenced by the
     75;;; lisp kernel.)  *RTLD-NEXT* is therefore a slightly better
     76;;; default; we've traditionaly used *RTLD-DEFAULT*.
    4677(defvar *rtld-next*)
    4778(defvar *rtld-default*)
     
    5081                                  #-(or linux-target darwin-target)  -2))
    5182
    52 #+(or linux-target freebsd-target)
     83#+(or linux-target freebsd-target solaris-target)
    5384(progn
    5485
     
    99130(defvar *shared-libraries* nil)
    100131
    101 #+(or linux-target freebsd-target)
     132#+(or linux-target freebsd-target solaris-target)
    102133(progn
    103134
     
    137168                                             dynamic-entries
    138169                                             target::node-size)))
    139                                  #+freebsd-target
     170                                 #+(or freebsd-target solaris-target)
    140171                                 (%inc-ptr (pref map :link_map.l_addr) disp)
    141                                  #-freebsd-target
     172                                 #-(or freebsd-target solaris-target)
    142173                                 (%int-to-ptr
    143174                                  (if (< disp 0)
     
    232263  (when (null *shared-libraries*)
    233264    (%walk-shared-libraries #'shlib-from-map-entry)
    234     (dolist (l *shared-libraries*)
    235265      ;;; On Linux, it seems to be necessary to open each of these
    236266      ;;; libraries yet again, specifying the RTLD_GLOBAL flag.
    237267      ;;; On FreeBSD, it seems desirable -not- to do that.
    238       #+linux-target
    239       (%dlopen-shlib l)
    240       (setf (shlib.opened-by-lisp-kernel l) t))))
     268    #+linux-target
     269    (dolist (l *shared-libraries*)
     270      (%dlopen-shlib l))))
    241271
    242272(init-shared-libraries)
     
    266296loaded, signal a SIMPLE-ERROR which contains an often-cryptic message from
    267297the operating system."
    268   (let* ((link-map
    269           (let* ((lib (with-cstrs ((name name))
     298  (let* ((handle (with-cstrs ((name name))
    270299                        (ff-call
    271300                         (%kernel-import target::kernel-import-GetSharedLibrary)
    272301                         :address name
    273302                         :unsigned-fullword *dlopen-flags*
    274                          :address))))
    275             #+linux-target lib
    276             #+freebsd-target (if (%null-ptr-p lib)
    277                                lib
    278                                (rlet ((p :address))
    279                                  (if (eql 0 (ff-call
    280                                              (foreign-symbol-entry "dlinfo")
    281                                              :address lib
    282                                              :int #$RTLD_DI_LINKMAP
    283                                              :address p
    284                                              :int))
    285                                    (pref p :address)
    286                                    (%null-ptr)))))))
     303                         :address)))
     304         (link-map #-(or freebsd-target solaris-target) handle
     305                   #+(or freebsd-target solaris-target)
     306                   (if (%null-ptr-p handle)
     307                     handle
     308                     (rlet ((p :address))
     309                       (if (eql 0 (ff-call
     310                                   (foreign-symbol-entry "dlinfo")
     311                                   :address handle
     312                                   :int #$RTLD_DI_LINKMAP
     313                                   :address p
     314                                   :int))
     315                         (pref p :address)
     316                         (%null-ptr))))))
    287317    (if (%null-ptr-p link-map)
    288318      (error "Error opening shared library ~s: ~a" name (dlerror))
    289319      (prog1 (let* ((lib (shlib-from-map-entry link-map)))
    290320               (incf (shlib.opencount lib))
     321               (setf (shlib.handle lib) handle)
    291322               lib)
    292323        (%walk-shared-libraries
     
    433464(defun ensure-open-shlib (c force)
    434465  (if (or (shlib.map c) (not force))
    435     *rtld-default*
     466    *rtld-next*
    436467    (error "Shared library not open: ~s" (shlib.soname c))))
    437468
     
    439470  (if c
    440471    (ensure-open-shlib c force)
    441     *rtld-default*
     472    *rtld-next*
    442473    ))
    443474
     
    455486;;; linkers don't quite get the concept ...)
    456487
    457 (defun foreign-symbol-entry (name &optional (handle *rtld-default*))
     488(defun foreign-symbol-entry (name &optional (handle *rtld-next*))
    458489  "Try to resolve the address of the foreign symbol name. If successful,
    459490return a fixnum representation of that address, else return NIL."
     
    468499      (unless (%null-ptr-p addr)        ; No function can have address 0
    469500        (or (macptr->fixnum addr) (%inc-ptr addr 0))))
     501    #+x8632-target
     502    (let* ((addr (ff-call (%kernel-import target::kernel-import-FindSymbol)
     503                          :address handle
     504                          :address n
     505                          :unsigned-fullword)))
     506      (unless (eql 0 addr) addr))
    470507    #+x8664-target
    471508    (let* ((addr (ff-call (%kernel-import target::kernel-import-FindSymbol)
     
    477514(defvar *statically-linked* nil)
    478515
    479 #+(or linux-target freebsd-target)
     516#+(or linux-target freebsd-target solaris-target)
    480517(progn
    481518
     
    499536  (unless *statically-linked*
    500537    (with-macptrs (p)
    501       (%setf-macptr-to-object p entry)
     538      (entry->addr entry p)
    502539      (shlib-containing-address p name))))
    503540)
     
    512549(defvar *nsmodule-for-symbol*)
    513550(defvar *ns-is-symbol-name-defined-in-image*)
     551(defvar *dladdr-entry* 0)
    514552
    515553(defun setup-lookup-calls ()
     554  #+notyet
     555  (setq *dladdr-entry* (foreign-symbol-entry "_dladdr"))
    516556  (setq *dyld-image-count* (foreign-symbol-entry "__dyld_image_count"))
    517557  (setq *dyld-get-image-header* (foreign-symbol-entry "__dyld_get_image_header"))
     
    536576;;;
    537577
    538 (defun shlib-containing-address (addr name)
     578(defun legacy-shlib-containing-address (addr name)
    539579  (dotimes (i (ff-call *dyld-image-count* :unsigned-fullword))
    540580    (let ((header (ff-call *dyld-get-image-header* :unsigned-fullword i :address)))
     
    572612                      (return (shared-library-from-header-module-or-name libheader libmodule libname)))))))))))))
    573613
     614(defun shlib-containing-address (address name)
     615  (if (zerop *dladdr-entry*)
     616    (legacy-shlib-containing-address address name)
     617    ;; Bootstrapping.  RLET might be clearer here.
     618    (%stack-block ((info (record-length #>Dl_info) :clear t))
     619      (unless (zerop (ff-call *dladdr-entry*
     620                              :address address
     621                              :address info
     622                              :signed-fullword))
     623        (let* ((addr (pref info #>Dl_info.dli_fbase)))
     624          (format t "~&name = ~s" (pref info  #>Dl_info.dli_fname))
     625         
     626          (dolist (lib *shared-libraries*)
     627            (when (eql (shlib.base lib) addr)
     628              (return lib))))))))
     629
    574630(defun shlib-containing-entry (entry &optional name)
    575   (when (not name)
    576         (error "shared library name must be non-NIL."))
     631  (unless name
     632    (error "foreign name must be non-NIL."))
    577633  (with-macptrs (addr)
    578     (%setf-macptr-to-object addr entry)
     634    (entry->addr entry addr)
    579635    (shlib-containing-address addr name)))
    580636
     
    582638)
    583639
    584 #-(or linux-target darwin-target freebsd-target)
     640#-(or linux-target darwin-target freebsd-target solaris-target)
    585641(defun shlib-containing-entry (entry &optional name)
    586642  (declare (ignore entry name))
     
    604660
    605661
    606 (defun foreign-symbol-address (name &optional (map *rtld-default*))
     662(defun foreign-symbol-address (name &optional (map *rtld-next*))
    607663  "Try to resolve the address of the foreign symbol name. If successful,
    608664return that address encapsulated in a MACPTR, else returns NIL."
     
    631687    eep))
    632688
     689
     690
    633691(defun load-fv (name type)
    634692  (let* ((fv (or (gethash name (fvs)) (setf (gethash name *fvs*) (%cons-foreign-variable name type)))))
     
    641699
    642700
    643 #+(or linux-target freebsd-target)
     701#+(or linux-target freebsd-target solaris-target)
    644702(progn
    645703;;; It's assumed that the set of libraries that the OS has open
     
    688746             (lose nil))
    689747        (dolist (lib *shared-libraries*)
    690           (let* ((map (shlib.map lib)))
     748          (let* ((map (shlib.map lib))
     749                 (handle (shlib.handle lib)))
    691750            (unless map
    692751              (with-cstrs ((soname (shlib.soname lib)))
    693                 (setq map (ff-call
    694                            (%kernel-import target::kernel-import-GetSharedLibrary)
    695                            :address soname
    696                            :unsigned-fullword *dlopen-flags*
    697                            :address))
     752                (setq handle
     753                      (ff-call
     754                       (%kernel-import target::kernel-import-GetSharedLibrary)
     755                       :address soname
     756                       :unsigned-fullword *dlopen-flags*
     757                       :address))
     758                #-(or freebsd-target solaris-target) (setq map handle)
     759                #+(or freebsd-target solaris-target)
     760                (setq map
     761                      (if (%null-ptr-p handle)
     762                        handle
     763                        (rlet ((p :address))
     764                          (if (eql 0 (ff-call
     765                                      (foreign-symbol-entry "dlinfo")
     766                                      :address handle
     767                                      :int #$RTLD_DI_LINKMAP
     768                                      :address p
     769                                      :int))
     770                            (pref p :address)
     771                            (%null-ptr)))))
    698772                (if (%null-ptr-p map)
    699773                  (setq lose t)
     
    703777                        (%int-to-ptr (pref map :link_map.l_addr))
    704778                        (shlib.map lib) map
     779                        (shlib.handle lib) handle
    705780                        win t))))))
    706781        (when (or (not lose) (not win)) (return)))))
     
    713788  (%revive-macptr *rtld-next*)
    714789  (%revive-macptr *rtld-default*)
    715   #+(or linux-target freebsd-target)
     790  #+(or linux-target freebsd-target solaris-target)
    716791  (unless *statically-linked*
    717792    (setq *dladdr-entry* (foreign-symbol-entry "dladdr"))
Note: See TracChangeset for help on using the changeset viewer.