2 ;;; 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 object file (collect sections, write symbol table,
12 (with-open-file (output-stream name
:direction
:output
13 :element-type
'unsigned-byte
14 :if-exists
:new-version
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
21 (write-big-endian-data output-stream
22 (cdr (assoc x section-lengths
))
26 (write-big-endian-data output-stream
(length symbols
) 32)
28 (write-big-endian-data output-stream
0 32)
30 (write-big-endian-data output-stream
31 (hash-table-count *relocation-table
*)
34 (write-big-endian-data output-stream
38 (copy-stream-contents (cdr (assoc 'text
*object-streams
*))
40 (copy-stream-contents (cdr (assoc 'data
*object-streams
*))
43 (maphash (lambda (k v
)
46 (write-big-endian-data output-stream
47 (relocation-address v
)
49 ;; index|24 pc-rel-p length|2 extern-p spare|4
50 (write-big-endian-data
52 (logior (ash (relocation-index-bits v symbols
) 8)
53 (ash (if (relocation-pc-relative-p v
) 1 0) 7)
54 (ash (ceiling (log (relocation-size v
) 2)) 5)
55 (ash (if (relocation-extern-p v
) 1 0) 4))
58 ;; output symbol table
61 ((>= i
(length symbols
)))
62 (setf sym
(aref symbols i
))
63 (write-big-endian-data output-stream i
32)
64 (write-big-endian-data
66 (logior (ash (position (asm-symbol-type sym
)
67 '(text data bss absolute extern
))
69 (ash (if (asm-symbol-global-p sym
) 1 0) 24)
70 (aout-munge-debug-info (asm-symbol-debug-info sym
)))
72 (write-big-endian-data output-stream
(asm-symbol-value sym
) 32))
73 ;; output string table
74 (dotimes (i (length symbols
))
75 (write-string (asm-symbol-name (aref symbols i
)) output-stream
)
76 (write-byte 0 output-stream
)))))
78 ;;; XXX we could do something much more sophisticated, such as having
79 ;;; debug info serve as an index into a debugging info table later in
80 ;;; the file, but who cares for now?
81 (defun aout-munge-debug-info (debug-info)
82 (lexer-state-line debug-info
))
84 (defun relocation-index-bits (v symbols
)
85 (if (relocation-extern-p v
)
86 (position (relocation-symbol v
) symbols
:test
#'string-equal
)
87 (position (relocation-segment v
) '(text data bss
))))
89 (defun serialize-symbol-table ()
90 (let ((table (make-array (list 0))))
91 (maphash (lambda (k v
)
93 (when (asm-symbol-global-p v
)
94 (vector-push-extend v table
)))
98 (defun serialize-reloc-table ()
99 (let ((table (make-array (list (hash-table-count *relocation-table
*)))))
100 (with-hash-table-iterator (next *relocation-table
*)
101 (dotimes (i (length table
))
102 (multiple-value-bind (more-p k v
) (next)
105 (setf (aref table i
) v
))))