Changeset 10281
- Timestamp:
- Aug 4, 2008, 2:07:06 AM (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/level-0/l0-cfm-support.lisp
r10155 r10281 22 22 23 23 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")) 25 49 26 50 … … 512 536 (unless *statically-linked* 513 537 (with-macptrs (p) 514 ( %setf-macptr-to-object p entry)538 (entry->addr entry p) 515 539 (shlib-containing-address p name)))) 516 540 ) … … 525 549 (defvar *nsmodule-for-symbol*) 526 550 (defvar *ns-is-symbol-name-defined-in-image*) 551 (defvar *dladdr-entry* 0) 527 552 528 553 (defun setup-lookup-calls () 554 #+notyet 555 (setq *dladdr-entry* (foreign-symbol-entry "_dladdr")) 529 556 (setq *dyld-image-count* (foreign-symbol-entry "__dyld_image_count")) 530 557 (setq *dyld-get-image-header* (foreign-symbol-entry "__dyld_get_image_header")) … … 549 576 ;;; 550 577 551 (defun shlib-containing-address (addr name)578 (defun legacy-shlib-containing-address (addr name) 552 579 (dotimes (i (ff-call *dyld-image-count* :unsigned-fullword)) 553 580 (let ((header (ff-call *dyld-get-image-header* :unsigned-fullword i :address))) … … 585 612 (return (shared-library-from-header-module-or-name libheader libmodule libname))))))))))))) 586 613 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 587 630 (defun shlib-containing-entry (entry &optional name) 588 ( when (not name)589 (error "shared libraryname must be non-NIL."))631 (unless name 632 (error "foreign name must be non-NIL.")) 590 633 (with-macptrs (addr) 591 ( %setf-macptr-to-object addr entry)634 (entry->addr entry addr) 592 635 (shlib-containing-address addr name))) 593 636
Note: See TracChangeset
for help on using the changeset viewer.