Changeset 14520
- Timestamp:
- Dec 29, 2010, 9:40:13 PM (14 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
r14432 r14520 139 139 #+(or linux-target freebsd-target solaris-target) 140 140 (progn 141 #+android-target 142 (eval-when (:compile-toplevel :execute) 143 (def-foreign-type nil 144 (:struct :link_map 145 (:l_addr :unsigned) 146 (:l_name (:* :char)) 147 (:l_ld :address) 148 (:l_next (:* (:struct :link_map))) 149 (:l_prev (:* (:struct :link_map))))) 150 (def-foreign-type nil 151 (:struct :r_debug 152 (:r_version :int32_t) 153 (:r_map (:* (:struct :link_map))) 154 (:r_brk :address) 155 (:r_state :int32_t) 156 (:r_ldbase :address)))) 141 157 142 158 (defun soname-ptr-from-link-map (map) … … 150 166 (with-macptrs ((dyn-strings) 151 167 (dynamic-entries (pref map :link_map.l_ld))) 152 (let* ((soname-offset nil)) 153 ;; Walk over the entries in the file's dynamic segment; the 154 ;; last such entry will have a tag of #$DT_NULL. Note the 155 ;; (loaded,on Linux; relative to link_map.l_addr on FreeBSD) 156 ;; address of the dynamic string table and the offset of the 157 ;; #$DT_SONAME string in that string table. 158 ;; Actually, the above isn't quite right; there seem to 159 ;; be cases (involving vDSO) where the address of a library's 160 ;; dynamic string table is expressed as an offset relative 161 ;; to link_map.l_addr as well. 162 (loop 163 (case #+32-bit-target (pref dynamic-entries :<E>lf32_<D>yn.d_tag) 164 #+64-bit-target (pref dynamic-entries :<E>lf64_<D>yn.d_tag) 165 (#. #$DT_NULL (return)) 166 (#. #$DT_SONAME 167 (setq soname-offset 168 #+32-bit-target (pref dynamic-entries 169 :<E>lf32_<D>yn.d_un.d_val) 170 #+64-bit-target (pref dynamic-entries 171 :<E>lf64_<D>yn.d_un.d_val))) 172 (#. #$DT_STRTAB 173 (%setf-macptr dyn-strings 174 ;; Try to guess whether we're dealing 175 ;; with a displacement or with an 176 ;; absolute address. There may be 177 ;; a better way to determine this, 178 ;; but for now we assume that absolute 179 ;; addresses aren't negative and that 180 ;; displacements are. 181 (let* ((disp (%get-signed-natural 182 dynamic-entries 183 target::node-size))) 184 #+(or freebsd-target solaris-target) 185 (%inc-ptr (pref map :link_map.l_addr) disp) 186 #-(or freebsd-target solaris-target) 187 (let* ((udisp #+32-bit-target (pref dynamic-entries 188 :<E>lf32_<D>yn.d_un.d_val) 189 #+64-bit-target (pref dynamic-entries 190 :<E>lf64_<D>yn.d_un.d_val))) 191 (if (and (> udisp (pref map :link_map.l_addr)) 192 (< udisp (%ptr-to-int dynamic-entries))) 193 (%int-to-ptr udisp) 194 (%int-to-ptr 195 (if (< disp 0) 196 (+ disp (pref map :link_map.l_addr)) 197 disp)))))))) 198 (%setf-macptr dynamic-entries 199 (%inc-ptr dynamic-entries 200 #+32-bit-target 201 (record-length :<E>lf32_<D>yn) 202 #+64-bit-target 203 (record-length :<E>lf64_<D>yn)))) 204 (if (and soname-offset 205 (not (%null-ptr-p dyn-strings))) 206 (%inc-ptr dyn-strings soname-offset) 207 ;; Use the full pathname of the library. 208 (pref map :link_map.l_name)))))))) 168 (if (%null-ptr-p dynamic-entries) 169 (%null-ptr) 170 (let* ((soname-offset nil)) 171 ;; Walk over the entries in the file's dynamic segment; the 172 ;; last such entry will have a tag of #$DT_NULL. Note the 173 ;; (loaded,on Linux; relative to link_map.l_addr on FreeBSD) 174 ;; address of the dynamic string table and the offset of the 175 ;; #$DT_SONAME string in that string table. 176 ;; Actually, the above isn't quite right; there seem to 177 ;; be cases (involving vDSO) where the address of a library's 178 ;; dynamic string table is expressed as an offset relative 179 ;; to link_map.l_addr as well. 180 (loop 181 (case #+32-bit-target (pref dynamic-entries :<E>lf32_<D>yn.d_tag) 182 #+64-bit-target (pref dynamic-entries :<E>lf64_<D>yn.d_tag) 183 (#. #$DT_NULL (return)) 184 (#. #$DT_SONAME 185 (setq soname-offset 186 #+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 (#. #$DT_STRTAB 191 (%setf-macptr dyn-strings 192 ;; Try to guess whether we're dealing 193 ;; with a displacement or with an 194 ;; absolute address. There may be 195 ;; a better way to determine this, 196 ;; but for now we assume that absolute 197 ;; addresses aren't negative and that 198 ;; displacements are. 199 (let* ((disp (%get-signed-natural 200 dynamic-entries 201 target::node-size))) 202 #+(or freebsd-target solaris-target android-target) 203 (%inc-ptr (pref map :link_map.l_addr) disp) 204 #-(or freebsd-target solaris-target android-target) 205 (let* ((udisp #+32-bit-target (pref dynamic-entries 206 :<E>lf32_<D>yn.d_un.d_val) 207 #+64-bit-target (pref dynamic-entries 208 :<E>lf64_<D>yn.d_un.d_val))) 209 (if (and (> udisp (pref map :link_map.l_addr)) 210 (< udisp (%ptr-to-int dynamic-entries))) 211 (%int-to-ptr udisp) 212 (%int-to-ptr 213 (if (< disp 0) 214 (+ disp (pref map :link_map.l_addr)) 215 disp)))))))) 216 (%setf-macptr dynamic-entries 217 (%inc-ptr dynamic-entries 218 #+32-bit-target 219 (record-length :<E>lf32_<D>yn) 220 #+64-bit-target 221 (record-length :<E>lf64_<D>yn)))) 222 (if (and soname-offset 223 (not (%null-ptr-p dyn-strings))) 224 (%inc-ptr dyn-strings soname-offset) 225 ;; Use the full pathname of the library. 226 (pref map :link_map.l_name))))))))) 209 227 210 228 (defun shared-library-at (base) … … 231 249 (let* ((addr (%library-base-containing-address (pref m :link_map.l_ld)))) 232 250 (if addr (setq base addr)))) 233 (or (let* ((existing-lib (shared-library-at base))) 234 (when (and existing-lib (null (shlib.map existing-lib))) 235 (setf (shlib.map existing-lib) m 236 (shlib.pathname existing-lib) 237 (%get-cstring (pref m :link_map.l_name)) 238 (shlib.base existing-lib) base)) 239 existing-lib) 240 (let* ((soname-ptr (soname-ptr-from-link-map m)) 241 (soname (unless (%null-ptr-p soname-ptr) (%get-cstring soname-ptr))) 242 (pathname (%get-cstring (pref m :link_map.l_name))) 243 (shlib (shared-library-with-name soname))) 244 (if shlib 245 (setf (shlib.map shlib) m 246 (shlib.base shlib) base 247 (shlib.pathname shlib) pathname) 248 (push (setq shlib (%cons-shlib soname pathname m base)) 249 *shared-libraries*)) 250 shlib)))) 251 (unless (%null-ptr-p base) 252 (or (let* ((existing-lib (shared-library-at base))) 253 (when (and existing-lib (null (shlib.map existing-lib))) 254 (setf (shlib.map existing-lib) m 255 (shlib.pathname existing-lib) 256 (%get-cstring (pref m :link_map.l_name)) 257 (shlib.base existing-lib) base)) 258 existing-lib) 259 (let* ((soname-ptr (soname-ptr-from-link-map m)) 260 (soname (unless (%null-ptr-p soname-ptr) (%get-cstring soname-ptr))) 261 (pathname (%get-cstring (pref m :link_map.l_name))) 262 (shlib (shared-library-with-name soname))) 263 (if shlib 264 (setf (shlib.map shlib) m 265 (shlib.base shlib) base 266 (shlib.pathname shlib) pathname) 267 (push (setq shlib (%cons-shlib soname pathname m base)) 268 *shared-libraries*)) 269 shlib))))) 251 270 252 271
Note:
See TracChangeset
for help on using the changeset viewer.
