2 ;;; Mostly-a.out object file support for m68k-assembler.
4 ;;; Julian Squires / 2005
6 (in-package :m68k-assembler
)
9 (defun finalize-object-file (name section-lengths
)
10 "Finalize a.out object file (collect sections, write symbol table,
12 (with-open-file (output-stream name
:direction
:output
13 :element-type
'unsigned-byte
15 :if-does-not-exist
:create
)
16 ;; revise symbol table/relocs to use numeric indices
17 (let* ((symbols (serialize-symbol-table)))
18 (write-big-endian-data output-stream
#x53544F26
32) ; Magic
20 (dolist (x '(text data bss
))
21 (write-big-endian-data output-stream
22 (cdr (assoc x section-lengths
))
25 (write-big-endian-data output-stream
(length symbols
) 32)
27 (write-big-endian-data output-stream
0 32)
29 (dolist (x '(text data
))
30 (write-big-endian-data output-stream
33 (cdr (assoc x
*sections
*))))
36 ;; actual contents of sections.
37 (dolist (x '(text data
))
38 (copy-stream-contents (section-object-stream (cdr (assoc x
*sections
*)))
42 (dolist (x '(text data
))
43 (output-reloc-table output-stream
44 (section-relocations (cdr (assoc x
*sections
*)))
47 (output-symbol-table output-stream symbols
)
48 (output-string-table output-stream symbols
))))
50 (defun output-reloc-table (output-stream relocs symbols
)
51 (maphash (lambda (k v
)
54 (write-big-endian-data output-stream
55 (relocation-address v
)
57 ;; index|24 pc-rel-p length|2 extern-p spare|4
58 ;; XXX should use dpb to avoid overflows
59 (write-big-endian-data
61 (logior (ash (relocation-index-bits v symbols
) 8)
62 (ash (if (relocation-pc-relative-p v
) 1 0) 7)
63 (ash (if (relocation-extern-p v
) 1 0) 6)
64 (ldb (byte 6 0) (relocation-size v
)))
68 (defun output-symbol-table (output-stream symbols
)
69 ;; output symbol table
72 ((>= i
(length symbols
)))
73 (setf sym
(aref symbols i
))
74 (assert (and (asm-symbol-value sym
)
75 (asm-symbol-type sym
)))
76 (write-big-endian-data output-stream i
32)
77 (write-big-endian-data
79 (logior (ash (section->bits
(asm-symbol-type sym
))
81 (ash (if (asm-symbol-global-p sym
) 1 0) 24)
82 (aout-munge-debug-info (asm-symbol-debug-info sym
)))
84 (write-big-endian-data output-stream
(asm-symbol-value sym
) 32)))
86 (defun section->bits
(section)
87 (position section
'(text data bss absolute extern
)))
89 ;;; XXX needs to be fixed.
90 (defun output-string-table (output-stream symbols
)
91 (dotimes (i (length symbols
))
92 (let ((sym (asm-symbol-name (aref symbols i
))))
93 (write-sequence #+sb-unicode
(sb-ext:string-to-octets sym
)
94 #-sb-unicode
(coerce (map 'list
#'char-code sym
)
95 '(vector unsigned-byte
))
97 (write-byte 0 output-stream
)))
99 ;;; XXX we could do something much more sophisticated, such as having
100 ;;; debug info serve as an index into a debugging info table later in
101 ;;; the file, but who cares for now?
102 (defun aout-munge-debug-info (debug-info)
103 (lexer-state-line debug-info
))
105 (defun relocation-index-bits (v symbols
)
106 (if (relocation-extern-p v
)
107 (position (relocation-symbol v
) symbols
109 :key
#'asm-symbol-name
)
110 (position (relocation-segment v
) '(text data bss
))))