source: trunk/source/library/mach-o.lisp @ 11987

Last change on this file since 11987 was 11987, checked in by gb, 10 years ago

work-in-progress; see also mach-o-symbols.lisp, which is also work-in-progress

File size: 5.1 KB
Line 
1(defstruct mach-o-file
2  header
3  load-commands
4  segments
5  symbols
6  strings)
7
8(defmethod print-object ((m mach-o-file) stream)
9  (print-unreadable-object (m stream :type t :identity t)))
10
11
12(defstruct mach-o-string-table
13  (hash (make-hash-table :test #'equal))
14  (string (make-array 100 :element-type '(unsigned-byte 8) :fill-pointer 1 :adjustable t)))
15
16(defstruct mach-o-symbol
17  string-index
18  type
19  sect
20  desc
21  value)
22
23(defun init-mach-o-string-table (fd symtab-command)
24  (fd-lseek fd (pref symtab-command #>symtab_command.stroff) #$SEEK_SET)
25  (let* ((strsize (pref symtab-command #>symtab_command.strsize))
26         (nbytes (+ strsize strsize))
27         (bytes (make-array nbytes :element-type '(unsigned-byte 8)))
28         (out 0))
29    (declare (fixnum nbytes strsize out))
30    (%stack-block ((buf 32768))
31      (do* ((n strsize))
32           ((= n 0))
33        (let* ((bufsize (fd-read fd buf (min n 32768))))
34          (%copy-ptr-to-ivector buf 0 bytes out bufsize)
35          (incf out bufsize)
36          (decf n bufsize))))
37    (make-mach-o-string-table
38     :string (make-array nbytes
39                         :element-type '(unsigned-byte 8)
40                         :displaced-to bytes
41                         :fill-pointer strsize
42                         :adjustable t))))
43
44(defun init-mach-o-symbols64 (fd symtab-command)
45  (fd-lseek fd (pref symtab-command #>symtab_command.symoff) #$SEEK_SET)
46  (rlet ((nlist #>nlist_64))
47    (let* ((nsyms (pref symtab-command #>symtab_command.nsyms))
48           (nentries (* nsyms 2))
49           (vec (make-array nentries)))
50      (declare (fixnum nsyms nentries))
51      (flet ((read-nlist ()
52               (fd-read fd nlist (record-length #>nlist_64))
53               (make-mach-o-symbol :string-index (pref nlist #>nlist_64.n_un.n_strx)
54                                   :type (pref nlist #>nlist_64.n_type)
55                                   :sect (pref nlist #>nlist_64.n_sect)
56                                   :desc (pref nlist #>nlist_64.n_desc)
57                                   :value (pref nlist #>nlist_64.n_value))))
58        (dotimes (i nsyms (make-array nentries
59                                      :displaced-to vec
60                                      :fill-pointer nsyms
61                                      :adjustable t))
62          (setf (svref vec i) (read-nlist)))))))
63   
64
65(defun read-header-and-load-commands64 (fd)
66  (fd-lseek fd 0 #$SEEK_SET)
67  (let* ((mh (make-record :mach_header_64))
68         (mach-o (make-mach-o-file :header mh)))
69    (when (= (fd-read fd mh (record-length :mach_header_64))
70             (record-length :mach_header_64))
71      (collect ((commands))
72        (flet ((read-command ()
73                 (rlet ((cmd :load_command))
74                   (fd-read fd cmd (record-length :load_command))
75                   (let* ((n (pref cmd :load_command.cmdsize))
76                          (p (#_malloc n))
77                          (q (%inc-ptr p (record-length :load_command))))
78                     (#_memcpy p cmd (record-length :load_command))
79                     (fd-read fd q (- n (record-length :load_command)))
80                     (let* ((lcmd (pref cmd :load_command.cmd))
81                            (ftype 
82                             (cond ((= lcmd #$LC_SEGMENT_64)
83                                    (load-record #>segment_command_64))
84                                   ((= lcmd #$LC_SYMTAB)
85                                    (load-record #>symtab_command))
86                                   ((= lcmd #$LC_DYSYMTAB)
87                                    (load-record #>dysymtab_command))
88                                   ((= lcmd #$LC_LOAD_DYLINKER)
89                                    (load-record #>dylinker_command))
90                                   ((= lcmd #$LC_UUID)
91                                    (load-record #>uuid_command))
92                                   ((= lcmd #$LC_LOAD_DYLIB)
93                                    (load-record #>dylib_command))
94                                   ((= lcmd #$LC_UNIXTHREAD)
95                                    (load-record #>thread_command)))))
96
97                       (if ftype
98                         (%set-macptr-type p (foreign-record-type-ordinal ftype))
99                         (format t "~&~x" lcmd)))
100                     p))))
101          (dotimes (i (pref mh :mach_header_64.ncmds))
102            (commands (read-command)))
103          (setf (mach-o-file-load-commands mach-o) (commands))
104          (dolist (cmd (mach-o-file-load-commands mach-o))
105            (when (= #$LC_SYMTAB (pref cmd #>load_command.cmd))
106              (setf (mach-o-file-strings mach-o)
107                    (init-mach-o-string-table fd cmd)
108                    (mach-o-file-symbols mach-o)
109                    (init-mach-o-symbols64 fd cmd))))
110          mach-o)))))
111
112(defun mach-o-string-index (mo string)
113  (let* ((bytes (make-array (the fixnum (+ (length string) 2)) :element-type '(unsigned-byte 8))))
114    (declare (dynamic-extent bytes))
115    (dotimes (i (length string))
116      (setf (aref bytes (1+ i)) (char-code (char string i))))
117    (let* ((pos (search bytes (mach-o-string-table-string (mach-o-file-strings mo)))))
118      (when pos (1+ pos)))))
119             
Note: See TracBrowser for help on using the repository browser.