sections.lisp

   1 (in-package :m68k-assembler)
   2
   3 ;;;; SECTIONS
   4
   5 (defstruct section
   6   (name)
   7   (object-stream)
   8   (output-fn #'write-big-endian-data)
   9   (relocations (make-hash-table))
  10   (program-counter 0))
  11
  12
  13 (defun section-length (section)
  14   ;; XXX broken for ORG; perhaps we should always defer org to the
  15   ;; linker? -JS
  16   (section-program-counter section))
  17
  18
  19 (eval-when (:compile-toplevel :load-toplevel :execute)
  20   (defun create-bss (name)
  21     `(push (cons ,name (make-section :name ,name
  22                         :output-fn #'bss-output-fn
  23                         :object-stream nil
  24                         :relocations nil))
  25       *sections*))
  26   (defun create-stream-section (name stream)
  27     `(push (cons ,name
  28             (make-section :name ,name
  29              :object-stream ,stream))
  30       *sections*)))
  31
  32 (defmacro with-sections (sections &body body)
  33   "Creates the sections named in the SECTIONS list, and executes BODY
  34 with *SECTIONS* bound to an alist containing the sections.  Except in
  35 the case of BSS, a temporary stream is created for the object file
  36 output to a given section."
  37   (cond ((null sections) `(progn ,@body))
  38         ((eq (car sections) 'bss)
  39          `(progn
  40            ,(create-bss sections)
  41            (with-sections ,(cdr sections) ,@body)))
  42         (t
  43          (let ((symbol-of-the-day (gensym)))
  44            `(osicat:with-temporary-file (,symbol-of-the-day
  45                                          :element-type '(unsigned-byte 8))
  46              ,(create-stream-section (car sections) symbol-of-the-day)
  47              (with-sections ,(cdr sections) ,@body))))))
  48
  49 (defmacro using-section ((section) &body body)
  50   "Binds various special variables (*PROGRAM-COUNTER*,
  51 *RELOCATION-TABLE*, *OBJECT-STREAM*) to the environment given by
  52 SECTION."
  53   (let ((temporary (gensym)))
  54     `(let* ((,temporary ,section)
  55             (*program-counter* (section-program-counter ,temporary))
  56             (*relocation-table* (section-relocations ,temporary))
  57             (*object-stream* (section-object-stream ,temporary)))
  58       (unwind-protect
  59            (progn ,@body)
  60         (setf (section-program-counter ,temporary) *program-counter*)))))