Changeset 12078


Ignore:
Timestamp:
May 16, 2009, 7:02:34 PM (10 years ago)
Author:
gz
Message:

Merge r11518/r11605/11606/11871/11919 (shared library fixes)

File:
1 edited

Legend:

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

    r10972 r12078  
    7878;;; has a plt entry (e.g., if it happens to be referenced by the
    7979;;; lisp kernel.)  *RTLD-NEXT* is therefore a slightly better
    80 ;;; default; we've traditionaly used *RTLD-DEFAULT*.
     80;;; default; we've traditionaly used *RTLD-DEFAULT*. 
    8181(defvar *rtld-next*)
    8282(defvar *rtld-default*)
     83(defvar *rtld-use*)
    8384(setq *rtld-next* (%incf-ptr (%null-ptr) -1)
    8485      *rtld-default* (%int-to-ptr #+(or linux-target darwin-target windows-target)  0
    85                                   #-(or linux-target darwin-target windows-target)  -2))
     86                                  #-(or linux-target darwin-target windows-target)  -2)
     87      *rtld-use* #+solaris-target *rtld-next* #-solaris-target *rtld-default*)
    8688
    8789#+(or linux-target freebsd-target solaris-target)
     
    138140
    139141(defun soname-ptr-from-link-map (map)
    140   (with-macptrs ((dyn-strings)
    141                  (dynamic-entries (pref map :link_map.l_ld)))
    142     (let* ((soname-offset nil))
    143       ;; Walk over the entries in the file's dynamic segment; the
    144       ;; last such entry will have a tag of #$DT_NULL.  Note the
    145       ;; (loaded,on Linux; relative to link_map.l_addr on FreeBSD)
    146       ;; address of the dynamic string table and the offset of the
    147       ;; #$DT_SONAME string in that string table.
    148       ;; Actually, the above isn't quite right; there seem to
    149       ;; be cases (involving vDSO) where the address of a library's
    150       ;; dynamic string table is expressed as an offset relative
    151       ;; to link_map.l_addr as well.
    152       (loop
    153           (case #+32-bit-target (pref dynamic-entries :<E>lf32_<D>yn.d_tag)
    154                 #+64-bit-target (pref dynamic-entries :<E>lf64_<D>yn.d_tag)
    155             (#. #$DT_NULL (return))
    156             (#. #$DT_SONAME
    157                 (setq soname-offset
    158                       #+32-bit-target (pref dynamic-entries
    159                                            :<E>lf32_<D>yn.d_un.d_val)
    160                       #+64-bit-target (pref dynamic-entries
    161                                            :<E>lf64_<D>yn.d_un.d_val)))
    162             (#. #$DT_STRTAB
    163                 (%setf-macptr dyn-strings
    164                               ;; Try to guess whether we're dealing
    165                               ;; with a displacement or with an
    166                               ;; absolute address.  There may be
    167                               ;; a better way to determine this,
    168                               ;; but for now we assume that absolute
    169                               ;; addresses aren't negative and that
    170                               ;; displacements are.
    171                                (let* ((disp (%get-signed-natural
    172                                              dynamic-entries
    173                                              target::node-size)))
    174                                  #+(or freebsd-target solaris-target)
    175                                  (%inc-ptr (pref map :link_map.l_addr) disp)
    176                                  #-(or freebsd-target solaris-target)
    177                                  (let* ((udisp #+32-bit-target (pref dynamic-entries
    178                                                                      :<E>lf32_<D>yn.d_un.d_val)
    179                                                #+64-bit-target (pref dynamic-entries
    180                                                                      :<E>lf64_<D>yn.d_un.d_val)))
    181                                    (if (and (> udisp (pref map :link_map.l_addr))
    182                                             (< udisp (%ptr-to-int dynamic-entries)))
    183                                      (%int-to-ptr udisp)
    184                                      (%int-to-ptr
    185                                       (if (< disp 0)
    186                                         (+ disp (pref map :link_map.l_addr))
    187                                         disp))))))))
    188           (%setf-macptr dynamic-entries
    189                         (%inc-ptr dynamic-entries
    190                                   #+32-bit-target
    191                                   (record-length :<E>lf32_<D>yn)
    192                                   #+64-bit-target
    193                                   (record-length :<E>lf64_<D>yn))))
    194       (if (and soname-offset
    195                (not (%null-ptr-p dyn-strings)))
    196         (%inc-ptr dyn-strings soname-offset)
    197         ;; Use the full pathname of the library.
    198         (pref map :link_map.l_name)))))
     142  (let* ((path (pref map :link_map.l_name)))
     143    (if (%null-ptr-p path)
     144      (let* ((p (malloc 1)))
     145        (setf (%get-unsigned-byte p 0) 0)
     146        p)
     147      (if (eql (%get-unsigned-byte path 0) 0)
     148        path
     149        (with-macptrs ((dyn-strings)
     150                       (dynamic-entries (pref map :link_map.l_ld)))
     151          (let* ((soname-offset nil))
     152            ;; Walk over the entries in the file's dynamic segment; the
     153            ;; last such entry will have a tag of #$DT_NULL.  Note the
     154            ;; (loaded,on Linux; relative to link_map.l_addr on FreeBSD)
     155            ;; address of the dynamic string table and the offset of the
     156            ;; #$DT_SONAME string in that string table.
     157            ;; Actually, the above isn't quite right; there seem to
     158            ;; be cases (involving vDSO) where the address of a library's
     159            ;; dynamic string table is expressed as an offset relative
     160            ;; to link_map.l_addr as well.
     161            (loop
     162              (case #+32-bit-target (pref dynamic-entries :<E>lf32_<D>yn.d_tag)
     163                    #+64-bit-target (pref dynamic-entries :<E>lf64_<D>yn.d_tag)
     164                    (#. #$DT_NULL (return))
     165                    (#. #$DT_SONAME
     166                        (setq soname-offset
     167                              #+32-bit-target (pref dynamic-entries
     168                                                    :<E>lf32_<D>yn.d_un.d_val)
     169                              #+64-bit-target (pref dynamic-entries
     170                                                    :<E>lf64_<D>yn.d_un.d_val)))
     171                    (#. #$DT_STRTAB
     172                        (%setf-macptr dyn-strings
     173                                      ;; Try to guess whether we're dealing
     174                                      ;; with a displacement or with an
     175                                      ;; absolute address.  There may be
     176                                      ;; a better way to determine this,
     177                                      ;; but for now we assume that absolute
     178                                      ;; addresses aren't negative and that
     179                                      ;; displacements are.
     180                                      (let* ((disp (%get-signed-natural
     181                                                    dynamic-entries
     182                                                    target::node-size)))
     183                                        #+(or freebsd-target solaris-target)
     184                                        (%inc-ptr (pref map :link_map.l_addr) disp)
     185                                        #-(or freebsd-target solaris-target)
     186                                        (let* ((udisp #+32-bit-target (pref dynamic-entries
     187                                                                            :<E>lf32_<D>yn.d_un.d_val)
     188                                                      #+64-bit-target (pref dynamic-entries
     189                                                                            :<E>lf64_<D>yn.d_un.d_val)))
     190                                          (if (and (> udisp (pref map :link_map.l_addr))
     191                                                   (< udisp (%ptr-to-int dynamic-entries)))
     192                                            (%int-to-ptr udisp)
     193                                            (%int-to-ptr
     194                                             (if (< disp 0)
     195                                               (+ disp (pref map :link_map.l_addr))
     196                                               disp))))))))
     197              (%setf-macptr dynamic-entries
     198                            (%inc-ptr dynamic-entries
     199                                      #+32-bit-target
     200                                      (record-length :<E>lf32_<D>yn)
     201                                      #+64-bit-target
     202                                      (record-length :<E>lf64_<D>yn))))
     203            (if (and soname-offset
     204                     (not (%null-ptr-p dyn-strings)))
     205              (%inc-ptr dyn-strings soname-offset)
     206              ;; Use the full pathname of the library.
     207             (pref map :link_map.l_name))))))))
    199208
    200209(defun shared-library-at (base)
     
    608617(defun ensure-open-shlib (c force)
    609618  (if (or (shlib.map c) (not force))
    610     *rtld-next*
     619    *rtld-use*
    611620    (error "Shared library not open: ~s" (shlib.soname c))))
    612621
     
    614623  (if c
    615624    (ensure-open-shlib c force)
    616     *rtld-next*
     625    *rtld-use*
    617626    ))
    618627
     
    630639;;; linkers don't quite get the concept ...)
    631640
    632 (defun foreign-symbol-entry (name &optional (handle *rtld-next*))
     641(defun foreign-symbol-entry (name &optional (handle *rtld-use*))
    633642  "Try to resolve the address of the foreign symbol name. If successful,
    634643return a fixnum representation of that address, else return NIL."
     
    804813
    805814
    806 (defun foreign-symbol-address (name &optional (map *rtld-next*))
     815(defun foreign-symbol-address (name &optional (map *rtld-use*))
    807816  "Try to resolve the address of the foreign symbol name. If successful,
    808817return that address encapsulated in a MACPTR, else returns NIL."
     
    843852#+(or linux-target freebsd-target solaris-target)
    844853(progn
     854
     855;;; Return the position of the last dot character in name, if that
     856;;; character is followed by one or more decimal digits (e.g., the
     857;;; start of a numeric suffix on a library name.)  Return NIL if
     858;;; there's no such suffix.
     859(defun last-dot-pos (name)
     860  (do* ((i (1- (length name)) (1- i))
     861        (default i)
     862        (trailing-digits nil))
     863       ((<= i 0) default)
     864    (declare (fixnum i))
     865    (let* ((code (%scharcode name i)))
     866      (declare (type (mod #x110000) code))
     867      (if (and (>= code (char-code #\0))
     868               (<= code (char-code #\9)))
     869        (setq trailing-digits t)
     870        (if (= code (char-code #\.))
     871          (return (if trailing-digits i))
     872          (return default))))))
     873 
    845874;;; It's assumed that the set of libraries that the OS has open
    846875;;; (accessible via the _dl_loaded global variable) is a subset of
     
    852881          (shlib.pathname lib) nil
    853882          (shlib.base lib) nil)
    854     (let* ((soname (shlib.soname lib)))
     883    (let* ((soname (shlib.soname lib))
     884           (last-dot (if soname (last-dot-pos soname))))
    855885      (when soname
    856886        (with-cstrs ((soname soname))
     
    862892                                             (soname-ptr-from-link-map m))
    863893                               (unless (%null-ptr-p libname)
    864                                  (when (%cstrcmp soname libname)
     894                                 (when (or (%cstrcmp soname libname)
     895                                           (and last-dot
     896                                                (%cnstrcmp soname libname (1+ last-dot))))
    865897                                   (return-from found  m)))))))))
    866898            (when map
     
    877909                    (shlib.pathname lib) (%get-cstring
    878910                                          (pref map :link_map.l_name))
     911                    (shlib.soname lib) (%get-cstring (soname-ptr-from-link-map map))
    879912                    (shlib.map lib) map))))))))
    880913
Note: See TracChangeset for help on using the changeset viewer.