pseudo-ops.lisp

   1 (in-package :m68k-assembler)
   2
   3 ;;;; PSEUDO-OPS
   4
   5 (defun pseudo-op-p (string)
   6   (or (get-pseudo-op string) (eql (get-symbol-type string) 'macro)))
   7
   8 (eval-when (:compile-toplevel :load-toplevel :execute)
   9   (let ((asm-pseudo-op-table (make-hash-table :test 'equalp)))
  10     (dolist (x `(("SECTION"
  11                   ,(lambda (label op operands modifier)
  12                     (declare (ignore op modifier))
  13                     (handle-label-normally label)
  14                     (assert (and (eql (caar operands) 'absolute)
  15                                  (eql (caadar operands) 'symbol)))
  16                     (assert (= (length operands) 1))
  17                     (let ((section (intern (string-upcase
  18                                             (cadar (cdar operands)))
  19                                            (find-package "M68K-ASSEMBLER"))))
  20                       (setf *current-section* (cdr (assoc section *sections*)))
  21                       (assert *current-section*))))
  22                  ("XDEF" ,#'define-global)
  23                  ("GLOBAL" ,#'define-global)
  24                  ("XREF" ,#'define-extern)
  25                  ("EXTERN" ,#'define-extern)
  26                  ("ORG" ,(lambda (label op operands modifier)
  27                           (declare (ignore label op modifier))
  28                           (assert (eql (car (first operands)) 'absolute))
  29                           (assert (= (length operands) 1))
  30                           (setf *program-counter* (absolute-value (first operands)))))
  31
  32                  ("INCLUDE"
  33                   ,(lambda (label op operands modifier)
  34                     (declare (ignore op modifier))
  35                     (assert (= (length operands) 1))
  36                     (handle-label-normally label)
  37                     (nested-lexing (extract-string-from-tree (first operands)))))
  38                  ("INCBIN"
  39                   ,(lambda (label op operands modifier)
  40                     (declare (ignore op modifier))
  41                     (assert (= (length operands) 1))
  42                     (handle-label-normally label)
  43                     (with-open-file (stream (extract-string-from-tree
  44                                              (first operands))
  45                                             :direction :input
  46                                             :element-type 'unsigned-byte)
  47                       (copy-stream-contents stream
  48                                             (section-object-stream
  49                                              *current-section*))
  50                       (incf *program-counter* (file-position stream)))))
  51
  52                  ("ALIGN" ,(lambda (label op operands modifier)
  53                             (declare (ignore op modifier))
  54                             (assert (= (length operands) 1))
  55                             (handle-label-normally label)
  56                             (let ((align (absolute-value (first operands))))
  57                               (do ()
  58                                   ((zerop (mod *program-counter* align)))
  59                                 (output-data 0 8)))))
  60                  ("EVEN" ,(lambda (label op operands modifier)
  61                            (declare (ignore op modifier operands))
  62                            (handle-label-normally label)
  63                            (unless (evenp *program-counter*)
  64                              (output-data 0 8))))
  65                  ;; offsetalign -- offset+(PC+align-1)&~(align-1)
  66                  ;; XXX untested.
  67                  ("CNOP" ,(lambda (label op operands modifier)
  68                            (declare (ignore op modifier))
  69                            (handle-label-normally label)
  70                            (let ((offset (absolute-value (first operands)))
  71                                  (align (absolute-value (second operands))))
  72                              (do ()
  73                                  ((zerop (mod (- *program-counter* offset) align)))
  74                                (output-data 0 8)))))
  75
  76                  ("MACRO" ,#'start-macro)
  77                  ("ENDM" ,#'end-macro)
  78
  79                  ("REPT"
  80                   ,(lambda (label op operands modifier)
  81                     (declare (ignore label op modifier))
  82                     (assert (not *defining-rept-p*))
  83                     (assert (= (length operands) 1))
  84                     (setf *macro-buffer* (list (absolute-value (first operands)))
  85                           *defining-rept-p* t)))
  86                  ("ENDR"
  87                   ,(lambda (label op operands modifier)
  88                     (declare (ignore label op operands modifier))
  89                     (assert *defining-rept-p*)
  90                     (setf *macro-buffer* (nreverse *macro-buffer*)
  91                           *defining-rept-p* nil)
  92                     (dotimes (i (pop *macro-buffer*))
  93                       (dolist (x *macro-buffer*)
  94                         (process-line x)))))
  95
  96                  ("DC"
  97                   ,(lambda (label op operands modifier)
  98                     (declare (ignore op))
  99                     (handle-label-normally label)
 100                     (unless modifier (setf modifier 'word))
 101                     (dolist (x operands)
 102                       (let ((data (absolute-value x modifier))
 103                             (length (modifier-size-in-bits modifier)))
 104                         (when (consp data)
 105                           (push (make-backpatch-item `((,length (absolute-value ,data ,modifier)))
 106                                                      length)
 107                                 *backpatch-list*)
 108                           (setf data 0))
 109                         ;; The behavior here is that if we're asked to DC
 110                         ;; some constant larger than the length we output
 111                         ;; it in length chunks.  This might be undesired
 112                         ;; behavior for some modifiers although it's
 113                         ;; almost certainly desired behavior for bytes.
 114                         ;; Maybe some heuristics and warnings should go
 115                         ;; here or at least a flag to enable/disable this
 116                         ;; behavior.
 117                         (when (minusp data) ; XXX this is totally broken!
 118                           (setf data (+ (ash 1 length) data)))
 119                         (do ((total (if (<= 0 data 1) 1 (ceiling (log data 2)
 120                                                                  length))
 121                                     (1- total)))
 122                             ((<= total 0))
 123                           (output-data (ldb (byte length (* (1- total) length))
 124                                             data)
 125                                        length))))))
 126                  ("DS"
 127                   ,(lambda (label op operands modifier)
 128                     (declare (ignore op))
 129                     (handle-label-normally label)
 130                     (unless modifier (setf modifier 'word))
 131                     (assert (eql (car (first operands)) 'absolute))
 132                     (assert (= (length operands) 1))
 133                     (let ((data (absolute-value (first operands) modifier))
 134                           (length (modifier-size-in-bits modifier)))
 135                       (unless (integerp data)
 136                         (error "~A: Need to be able to resolve DS immediately."
 137                                *source-position*))
 138                       (output-data 0 (* data length)))))
 139                  ;; ("DCB")           ; constant block -- numbervalue
 140
 141                  ("EQU" ,#'define-equate)
 142                  ("=" ,#'define-equate)
 143                  ;; EQUR (register equate)
 144
 145                  ;; Conditional compilation.
 146                  ;; XXX What other conditions are there?
 147                  ("IFEQ"
 148                   ,(lambda (label op operands modifier)
 149                     (declare (ignore label op modifier))
 150                     (assert (not *defining-conditional-compilation-p*))
 151                     (assert (= (length operands) 1))
 152                     (setf *macro-buffer* (list (zerop (absolute-value (first operands))))
 153                           *defining-conditional-compilation-p* t)))
 154                  ("IFNE"
 155                   ,(lambda (label op operands modifier)
 156                     (declare (ignore label op modifier))
 157                     (assert (not *defining-conditional-compilation-p*))
 158                     (assert (= (length operands) 1))
 159                     (setf *macro-buffer* (list (/= 0 (absolute-value (first operands))))
 160                           *defining-conditional-compilation-p* t)))
 161                  ("ENDC"
 162                   ,(lambda (label op operands modifier)
 163                     (declare (ignore label op operands modifier))
 164                     (assert *defining-conditional-compilation-p*)
 165                     (setf *macro-buffer* (nreverse *macro-buffer*)
 166                           *defining-conditional-compilation-p* nil)
 167                     (when (pop *macro-buffer*)
 168                       (dolist (x *macro-buffer*)
 169                         (process-line x)))))
 170
 171                  ;; ("END")  ; early end of source.
 172                  ))
 173       (setf (gethash (first x) asm-pseudo-op-table) (second x)))
 174     (defun get-pseudo-op (name)
 175       (gethash name asm-pseudo-op-table))))