raw-binary.lisp

   1 ;;;
   2 ;;; Raw binary output.
   3 ;;;
   4
   5 (in-package :st-linker)
   6
   7 (defun link-raw-bin (modules segment-sizes out-name entry-point)
   8   (with-open-file (prg-stream out-name :direction :io
   9                               :element-type 'unsigned-byte
  10                               :if-exists :new-version
  11                               :if-does-not-exist :create)
  12     (dolist (module modules)
  13       ;; over each object, read text segments
  14       (with-open-file (obj-stream (module-name module)
  15                                   :element-type 'unsigned-byte)
  16         (file-position obj-stream *aout-obj-header-length*) ;start of text segment
  17         (copy-from-stream obj-stream prg-stream
  18                           (module-segment-size module 'text))))
  19     (dolist (module modules)
  20       ;; over each object, read data segments
  21       (with-open-file (obj-stream (module-name module)
  22                                   :element-type 'unsigned-byte)
  23         (file-position obj-stream (+ *aout-obj-header-length*
  24                                      (module-segment-size module 'text)))
  25         (copy-from-stream obj-stream prg-stream
  26                           (module-segment-size module 'data))))
  27
  28     (let* ((*current-header-length* 0)
  29            (fixups (process-link-time-relocations prg-stream modules)))
  30       (process-own-fixups prg-stream fixups entry-point))))
  31
  32
  33 (defun process-own-fixups (stream fixups entry)
  34   (dolist (addr fixups)
  35     (patch-stream (value 32 stream (file-offset-of-address addr))
  36       (format t "~&fixup ~A => ~A -> ~A" addr value (+ value entry))
  37       (incf value entry))))