Changeset 11871
- Timestamp:
- Mar 31, 2009, 11:10:45 AM (10 years ago)
- File:
-
- 1 edited
-
trunk/source/level-0/l0-cfm-support.lisp (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/level-0/l0-cfm-support.lisp
r11606 r11871 140 140 141 141 (defun soname-ptr-from-link-map (map) 142 (with-macptrs ((dyn-strings) 143 (dynamic-entries (pref map :link_map.l_ld))) 144 (let* ((soname-offset nil)) 145 ;; Walk over the entries in the file's dynamic segment; the 146 ;; last such entry will have a tag of #$DT_NULL. Note the 147 ;; (loaded,on Linux; relative to link_map.l_addr on FreeBSD) 148 ;; address of the dynamic string table and the offset of the 149 ;; #$DT_SONAME string in that string table. 150 ;; Actually, the above isn't quite right; there seem to 151 ;; be cases (involving vDSO) where the address of a library's 152 ;; dynamic string table is expressed as an offset relative 153 ;; to link_map.l_addr as well. 154 (loop 155 (case #+32-bit-target (pref dynamic-entries :<E>lf32_<D>yn.d_tag) 156 #+64-bit-target (pref dynamic-entries :<E>lf64_<D>yn.d_tag) 157 (#. #$DT_NULL (return)) 158 (#. #$DT_SONAME 159 (setq soname-offset 160 #+32-bit-target (pref dynamic-entries 161 :<E>lf32_<D>yn.d_un.d_val) 162 #+64-bit-target (pref dynamic-entries 163 :<E>lf64_<D>yn.d_un.d_val))) 164 (#. #$DT_STRTAB 165 (%setf-macptr dyn-strings 166 ;; Try to guess whether we're dealing 167 ;; with a displacement or with an 168 ;; absolute address. There may be 169 ;; a better way to determine this, 170 ;; but for now we assume that absolute 171 ;; addresses aren't negative and that 172 ;; displacements are. 173 (let* ((disp (%get-signed-natural 174 dynamic-entries 175 target::node-size))) 176 #+(or freebsd-target solaris-target) 177 (%inc-ptr (pref map :link_map.l_addr) disp) 178 #-(or freebsd-target solaris-target) 179 (let* ((udisp #+32-bit-target (pref dynamic-entries 180 :<E>lf32_<D>yn.d_un.d_val) 181 #+64-bit-target (pref dynamic-entries 182 :<E>lf64_<D>yn.d_un.d_val))) 183 (if (and (> udisp (pref map :link_map.l_addr)) 184 (< udisp (%ptr-to-int dynamic-entries))) 185 (%int-to-ptr udisp) 186 (%int-to-ptr 187 (if (< disp 0) 188 (+ disp (pref map :link_map.l_addr)) 189 disp)))))))) 190 (%setf-macptr dynamic-entries 191 (%inc-ptr dynamic-entries 192 #+32-bit-target 193 (record-length :<E>lf32_<D>yn) 194 #+64-bit-target 195 (record-length :<E>lf64_<D>yn)))) 196 (if (and soname-offset 197 (not (%null-ptr-p dyn-strings))) 198 (%inc-ptr dyn-strings soname-offset) 199 ;; Use the full pathname of the library. 200 (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)))))))) 201 208 202 209 (defun shared-library-at (base) … … 852 859 (defun last-dot-pos (name) 853 860 (do* ((i (1- (length name)) (1- i)) 854 (trailing-digits nil)) 855 ((<= i 0)) 861 (default i) 862 (trailing-digits nil)) 863 ((<= i 0) default) 856 864 (declare (fixnum i)) 857 865 (let* ((code (%scharcode name i))) … … 862 870 (if (= code (char-code #\.)) 863 871 (return (if trailing-digits i)) 864 (return nil))))))872 (return default)))))) 865 873 866 874 ;;; It's assumed that the set of libraries that the OS has open
Note: See TracChangeset
for help on using the changeset viewer.
