aout.lisp

   1
   2 (in-package :st-linker)
   3
   4 (defparameter *aout-obj-header-length* 32) ; bytes
   5
   6 ;; Object magic is STO^Z
   7 (defun check-magic (stream)
   8   (unless (= (read-big-endian-data stream 32) #x53544F26)
   9     (error "Bad magic.")))
  10
  11
  12
  13 (defun read-relocations (n-relocations stream)
  14   (let ((table (make-array (list n-relocations)
  15                            :element-type 'linker-symbol)))
  16     (dotimes (i n-relocations)
  17       (let ((address (read-big-endian-data stream 32))
  18             (rest (read-big-endian-data stream 32)))
  19         (setf (aref table i)
  20               (make-relocation :address address
  21                                :symbol (ldb (byte 24 8) rest)
  22                                :pc-relative-p (= 1 (ldb (byte 1 7) rest))
  23                                :extern-p (= 1 (ldb (byte 1 6) rest))
  24                                :length (ldb (byte 6 0) rest)))))
  25     table))
  26
  27 (defun bits->linker-symbol-type (bits)
  28   (nth bits '(text data bss absolute extern)))
  29
  30 (defun read-symbol-table (n-symbols stream module)
  31   (let ((table (make-array (list n-symbols) :element-type 'relocation)))
  32     (dotimes (i n-symbols)
  33       (let ((name-idx (read-big-endian-data stream 32))
  34             (type (read-big-endian-data stream 32))
  35             (value (read-big-endian-data stream 32)))
  36         (setf (aref table i)
  37               (make-linker-symbol :name name-idx
  38                                   :type (bits->linker-symbol-type
  39                                          (ldb (byte 7 25) type))
  40                                   :value value
  41                                   :module module))))
  42     table))
  43
  44 (defun read-string-table (stream symbols)
  45   (dotimes (i (length symbols))
  46     (setf (linker-symbol-name (aref symbols i))
  47           (read-nul-terminated-string stream))))
  48
  49 (defun read-object-header (stream object)
  50   (let ((segment-sizes (mapcar (lambda (x)
  51                                  (cons x (read-big-endian-data stream 32)))
  52                                '(text data bss)))
  53         (symbol-count (read-big-endian-data stream 32))
  54         (entry (read-big-endian-data stream 32))
  55         (reloc-sizes (mapcar (lambda (x)
  56                                (cons x (read-big-endian-data stream 32)))
  57                              '(text data))))
  58     (make-module :name object
  59                  :segment-sizes segment-sizes
  60                  :symbol-table-size symbol-count
  61                  :entry-point entry
  62                  :relocations reloc-sizes)))
  63
  64
  65 (defun read-module (filename)
  66   (with-open-file (stream filename :element-type 'unsigned-byte)
  67     (check-magic stream)
  68     (let ((module (read-object-header stream filename)))
  69       (file-position stream (+ *aout-obj-header-length*
  70                                (module-segment-size module 'text)
  71                                (module-segment-size module 'data)))
  72       (let ((relocs (mapcar
  73                      (lambda (x)
  74                        (cons x
  75                              (read-relocations
  76                               (module-segment-relocations module x)
  77                               stream)))
  78                      '(text data)))
  79             (symbols (read-symbol-table (module-symbol-table-size module)
  80                                         stream filename)))
  81         (read-string-table stream symbols)
  82         (setf (module-relocations module) relocs
  83               (module-symbols module) symbols))
  84       module)))