Changeset 7378


Ignore:
Timestamp:
Oct 12, 2007, 5:59:12 AM (12 years ago)
Author:
gb
Message:

Get this working, at least well enough for our immediate purposes.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0709/ccl/library/elf.lisp

    r7318 r7378  
    3838      (progn
    3939        (open-shared-library "libelf.so")
    40         (if (eql #$EV_NONE (#_elf_version #$EV_CURRENT))
    41           (error "ELF library initialization failed: ~a" (libelf-error-string)))
    42         (setq *checked-libelf-version* t))))
     40        (let* ((version (#_elf_version #$EV_CURRENT)))
     41          (if (eql #$EV_NONE version)
     42            (error "ELF library initialization failed: ~a" (libelf-error-string)))
     43          (setq *checked-libelf-version* version)))))
    4344
    4445
     
    6263                             :pathname pathname)))))))
    6364
     65(defun elf-end (object)
     66  (#_elf_end (elf-object-libelf-pointer object))
     67  (setf (elf-object-libelf-pointer object) nil
     68        (elf-object-fd object) nil))
     69
    6470(defun new-elf-file-header (object format type machine)
    6571  (let* ((ehdr (#_elf64_newehdr (elf-object-libelf-pointer object))))
     
    7177        (setf (paref (pref ehdr :<E>lf64_<E>hdr.e_ident) (:* :unsigned-char) #$EI_DATA) format
    7278              (pref ehdr :<E>lf64_<E>hdr.e_machine) machine
    73               (pref ehdr :<E>lf64_<E>hdr.e_type) type)
     79              (pref ehdr :<E>lf64_<E>hdr.e_type) type
     80              (pref ehdr :<E>lf64_<E>hdr.e_version) *checked-libelf-version*)
    7481        (assert-pointer-type ehdr :<E>lf64_<E>hdr)))))
    7582
     
    8390
    8491(defun new-elf-section (object)
    85   (let* ((scn (#_elf_newscn object)))
     92  (let* ((scn (#_elf_newscn (elf-object-libelf-pointer object))))
    8693    (if (%null-ptr-p scn)
    8794      (error "Can' create ELF section for ~s: ~a"
     
    98105      (assert-pointer-type shdr :<E>lf64_<S>hdr))))
    99106
    100 (defun elf-data-pointer-for-secton (object section)
     107(defun elf-data-pointer-for-section (object section)
    101108  (let* ((data (#_elf_newdata section)))
    102109    (if (%null-ptr-p data)
     
    105112             (libelf-error-string))
    106113      (assert-pointer-type data :<E>lf_<D>ata))))
    107 
    108 
    109  
    110 
    111  
    112                    
    113114                   
    114115
     
    159160  (let* ((functions (collect-elf-static-functions))
    160161         (n (length functions))
    161          (data (#_calloc n (record-length :<E>lf64_<S>ym)))
     162         (data (#_calloc (1+ n) (record-length :<E>lf64_<S>ym)))
    162163         (string-table (make-elf-string-table)))
    163164    (declare (fixnum n))
    164165    (do* ((i 0 (1+ i))
    165           (p (%inc-ptr data 0) (progn (%incf-ptr p (record-length :<E>lf64_<S>ym)) p))
     166          (p (%inc-ptr data (record-length :<E>lf64_<S>ym)) (progn (%incf-ptr p (record-length :<E>lf64_<S>ym)) p))
    166167          (f (pop functions) (pop functions)))
    167168         ((= i n)
     
    177178  (#_elf_ndxscn section))
    178179
    179    
     180(defun elf-set-shstrab-section (object scn)
     181  #+freebsd-target
     182  (#_elf_setshstrndx (elf-object-libelf-pointer object) (elf-section-index scn))
     183  #-freebsd-target
     184  (declare (ignore object scn)))
     185
     186
     187(defun elf-init-section-data-from-string-table (object section string-table)
     188  (let* ((strings-data (elf-data-pointer-for-section object section))
     189         (s (elf-string-table-string string-table))
     190         (bytes (array-data-and-offset s))
     191         (n (length s))
     192         (buf (#_malloc n)))
     193    (%copy-ivector-to-ptr bytes 0 buf 0 n)
     194    (setf (pref strings-data :<E>lf_<D>ata.d_align) 1
     195          (pref strings-data :<E>lf_<D>ata.d_off) 0
     196          (pref strings-data :<E>lf_<D>ata.d_type) #$ELF_T_BYTE
     197          (pref strings-data :<E>lf_<D>ata.d_version) #$EV_CURRENT
     198          (pref strings-data :<E>lf_<D>ata.d_size) n
     199          (pref strings-data :<E>lf_<D>ata.d_buf) buf)
     200    n))
     201
     202(defun elf-init-symbol-section-from-symbol-table (object section symbols)
     203  (let* ((symbols-data (elf-data-pointer-for-section object section))
     204         (buf (elf-symbol-table-data symbols))
     205         (nsyms (elf-symbol-table-nsyms symbols) )
     206         (n (* (1+ nsyms) (record-length :<E>lf64_<S>ym))))
     207    (setf (pref symbols-data :<E>lf_<D>ata.d_align) 8
     208          (pref symbols-data :<E>lf_<D>ata.d_off) 0
     209          (pref symbols-data :<E>lf_<D>ata.d_type) #$ELF_T_SYM
     210          (pref symbols-data :<E>lf_<D>ata.d_version) #$EV_CURRENT
     211          (pref symbols-data :<E>lf_<D>ata.d_size) n
     212          (pref symbols-data :<E>lf_<D>ata.d_buf) buf)
     213    nsyms))
     214
     215(defun elf-make-empty-data-for-section (object section &optional (size 0))
     216  (let* ((data (elf-data-pointer-for-section object section))
     217         (buf +null-ptr+))
     218    (setf (pref data :<E>lf_<D>ata.d_align) 0
     219          (pref data :<E>lf_<D>ata.d_off) 0
     220          (pref data :<E>lf_<D>ata.d_type) #$ELF_T_BYTE
     221          (pref data :<E>lf_<D>ata.d_version) #$EV_CURRENT
     222          (pref data :<E>lf_<D>ata.d_size) size
     223          (pref data :<E>lf_<D>ata.d_buf) buf)
     224    0))
     225 
     226
     227(defun elf-flag-phdr (object cmd flags)
     228  (#_elf_flagphdr (elf-object-libelf-pointer object) cmd flags))
     229
     230(defun elf-update (object cmd)
     231  (let* ((size (#_elf_update (elf-object-libelf-pointer object) cmd)))
     232    (if (< size 0)
     233      (error "elf_update failed for for ~s: ~a"
     234             (elf-object-pathname object)
     235             (libelf-error-string))
     236      size)))
     237
     238(defun fixup-lisp-section-offset (fd eof sectnum)
     239  (fd-lseek fd 0 #$SEEK_SET)
     240  (rlet ((fhdr :<E>lf64_<E>hdr)
     241         (shdr :<E>lf64_<S>hdr))
     242    (fd-read fd fhdr (record-length :<E>lf64_<E>hdr))
     243    (let* ((pos (+ (pref fhdr :<E>lf64_<E>hdr.e_shoff)
     244                   (* sectnum (pref fhdr :<E>lf64_<E>hdr.e_shentsize)))))
     245      (fd-lseek fd pos #$SEEK_SET)
     246      (fd-read fd shdr (record-length :<E>lf64_<S>hdr))
     247      (setf (pref shdr :<E>lf64_<S>hdr.sh_offset)
     248            (+ #x2000 (logandc2 (+ eof 4095) 4095))) ; #x2000 for nilreg-area
     249      (fd-lseek fd pos #$SEEK_SET)
     250      (fd-write fd shdr (record-length :<E>lf64_<S>hdr))
     251      t)))
     252 
    180253(defun write-elf-symbols-to-file (pathname)
    181254  (let* ((object (create-elf-object pathname))
     
    185258         (symbols-section (new-elf-section object))
    186259         (strings-section (new-elf-section object))
    187          (shstrtab (new-elf-section object))
     260         (shstrtab-section (new-elf-section object))
    188261         (section-names (make-elf-string-table))
    189          (symbols (register-elf-functions (elf-section-index lisp-section)))
     262         (lisp-section-index (elf-section-index lisp-section))
     263         (symbols (register-elf-functions lisp-section-index))
    190264         (lisp-section-header (elf-section-header-for-section object lisp-section))
    191265         (symbols-section-header (elf-section-header-for-section object symbols-section))
    192266         (strings-section-header (elf-section-header-for-section object strings-section))
    193          (shstrtab-header (elf-section-header-for-section object shstrtab)))
    194     (setf (pref lisp-header :<E>lf64_<S>hdr.sh_name) (elf-register-string ".lisp" section-names)
    195           (pref lisp-header :<E>lf64_<S>hdr.sh_type) #$SHT_NOBITS
    196           (pref lisp-header :<E>lf64_<S>hdr.sh_flags) (logior #$SHF_WRITE #$SHF_ALLOC #$SHF_EXECINSTR)
    197           (pref lisp-header :<E>lf64_<S>hdr.sh_addr) (ash (%get-kernel-global heap-start) target::fixnumshift)
    198           (pref lisp-header :<E>lf64_<S>hdr.sh_size (ash (frozen-space-dnodes) target::dnode-shift))
    199           (pref lisp-header :<E>lf64_<S>hdr.sh_offset) 0
    200           (pref lisp-header :<E>lf64_<S>hdr.sh_addralign) 1)
    201     (setf (pref symbol-header :<E>lf64_<S>hdr.sh_name) (elf-register-string ".symtab" section-names)
    202           (pref symbol-header :<E>lf64_<S>hdr.sh_type) #$SHT_SYMTAB
    203           (pref symbol-header :<E>lf64_<S>hdr.sh_size
    204          
     267         (shstrtab-section-header (elf-section-header-for-section object shstrtab-section)))
     268   
     269    (setf (pref file-header :<E>lf64_<E>hdr.e_shstrndx) (elf-section-index shstrtab-section))
     270    (setf (pref lisp-section-header :<E>lf64_<S>hdr.sh_name) (elf-register-string ".lisp" section-names)
     271          (pref lisp-section-header :<E>lf64_<S>hdr.sh_type) #$SHT_NOBITS
     272          (pref lisp-section-header :<E>lf64_<S>hdr.sh_flags) (logior #$SHF_WRITE #$SHF_ALLOC #$SHF_EXECINSTR)
     273          (pref lisp-section-header :<E>lf64_<S>hdr.sh_addr) (ash (%get-kernel-global heap-start) target::fixnumshift)
     274          (pref lisp-section-header :<E>lf64_<S>hdr.sh_size) (ash (frozen-space-dnodes) target::dnode-shift)
     275          (pref lisp-section-header :<E>lf64_<S>hdr.sh_offset) 0
     276          (pref lisp-section-header :<E>lf64_<S>hdr.sh_addralign) 1)
     277    (setf (pref symbols-section-header :<E>lf64_<S>hdr.sh_name) (elf-register-string ".symtab" section-names)
     278          (pref symbols-section-header :<E>lf64_<S>hdr.sh_type) #$SHT_SYMTAB
     279          (pref symbols-section-header :<E>lf64_<S>hdr.sh_entsize) (record-length :<E>lf64_<S>ym)
     280          (pref symbols-section-header :<E>lf64_<S>hdr.sh_link) (elf-section-index strings-section))
     281    (setf (pref strings-section-header :<E>lf64_<S>hdr.sh_name) (elf-register-string ".strtab" section-names)
     282          (pref strings-section-header :<E>lf64_<S>hdr.sh_type) #$SHT_STRTAB
     283          (pref strings-section-header :<E>lf64_<S>hdr.sh_flags) (logior #$SHF_STRINGS #$SHF_ALLOC))
     284    (setf (pref shstrtab-section-header :<E>lf64_<S>hdr.sh_name) (elf-register-string ".shstrtab" section-names)
     285          (pref shstrtab-section-header :<E>lf64_<S>hdr.sh_type) #$SHT_STRTAB
     286          (pref shstrtab-section-header :<E>lf64_<S>hdr.sh_flags) (logior #$SHF_STRINGS #$SHF_ALLOC))
     287    (elf-make-empty-data-for-section object lisp-section (ash (frozen-space-dnodes) target::dnode-shift))
     288    (elf-init-section-data-from-string-table object strings-section (elf-symbol-table-strings symbols))
     289    (elf-init-section-data-from-string-table object shstrtab-section section-names)
     290    (elf-init-symbol-section-from-symbol-table object symbols-section symbols)
     291    ;; Prepare in-memory data structures.
     292    (elf-update object #$ELF_C_NULL)
     293    ;; Fix up the program header.
     294    (setf (pref program-header :<E>lf64_<P>hdr.p_type) #$PT_PHDR
     295          (pref program-header :<E>lf64_<P>hdr.p_offset) (pref file-header :<E>lf64_<E>hdr.e_phoff)
     296          (pref program-header :<E>lf64_<P>hdr.p_filesz) (#_elf64_fsize #$ELF_T_PHDR 1 #$EV_CURRENT))
     297    ;; Mark the program header as being dirty.
     298    (elf-flag-phdr object #$ELF_C_SET #$ELF_F_DIRTY)
     299    (let* ((eof (elf-update object #$ELF_C_WRITE))
     300           (fd (elf-object-fd object)))
     301      (elf-end object)
     302      (fixup-lisp-section-offset fd eof lisp-section-index)
     303      (fd-close fd))
     304    pathname))
     305
     306     
    205307   
    206308   
Note: See TracChangeset for help on using the changeset viewer.