~kingcons/clones

05f460f44ed062320721e5b876797e076bc8b154 — Brit Butler 4 years ago 3801cf4
Add argument printing to the disassembler.
2 files changed, 38 insertions(+), 26 deletions(-)

M src/addressing.lisp
M src/disassembler.lisp
M src/addressing.lisp => src/addressing.lisp +29 -23
@@ 31,59 31,65 @@
           #:indirect
           #:indirect-x
           #:indirect-y
           #:relative))
           #:relative
           #:get-format-string))

(in-package :clones.addressing)

(defmacro defaddress (name &body body)
  `(defun ,name (cpu)
     (declare (type cpu cpu))
     (symbol-macrolet ((memory          (cpu-memory cpu))
                       (program-counter (cpu-pc cpu))
                       (accumulator     (cpu-accum cpu))
                       (x-register      (cpu-x-reg cpu))
                       (y-register      (cpu-y-reg cpu)))
       ,@body)))

(defaddress immediate
(defmacro defaddress (name (&key writer) &body body)
  `(progn
     (defun ,name (cpu)
       (declare (type cpu cpu))
       (symbol-macrolet ((memory          (cpu-memory cpu))
                         (program-counter (cpu-pc cpu))
                         (accumulator     (cpu-accum cpu))
                         (x-register      (cpu-x-reg cpu))
                         (y-register      (cpu-y-reg cpu)))
         ,@body))
     (setf (get ',name 'writer) ,writer)))

(defun get-format-string (mode)
  (get (find-symbol (symbol-name mode) 'clones.addressing) 'writer))

(defaddress immediate (:writer "~{#$~2,'0x~}")
  program-counter)

(defaddress accumulator
(defaddress accumulator (:writer "A")
  accumulator)

(defaddress zero-page
(defaddress zero-page (:writer "~{$~2,'0x~}")
  (fetch memory program-counter))

(defaddress zero-page-x
(defaddress zero-page-x (:writer "$~{~2,'0x~}, X")
  (let ((start (fetch memory program-counter)))
    (wrap-byte (+ start x-register))))

(defaddress zero-page-y
(defaddress zero-page-y (:writer "$~{~2,'0x~}, Y")
  (let ((start (fetch memory program-counter)))
    (wrap-byte (+ start y-register))))

(defaddress absolute
(defaddress absolute (:writer "$~{~2,'0x~}")
  (fetch-word memory program-counter))

(defaddress absolute-x
(defaddress absolute-x (:writer "$~{~2,'0x~}, X")
  (let* ((start (fetch-word memory program-counter))
         (final (wrap-word (+ start x-register))))
    (values final start)))

(defaddress absolute-y
(defaddress absolute-y (:writer "$~{~2,'0x~}, Y")
  (let* ((start (fetch-word memory program-counter))
         (final (wrap-word (+ start y-register))))
    (values final start)))

(defaddress indirect
(defaddress indirect (:writer "($~{~2,'0x~})")
  (let ((start (fetch-word memory program-counter)))
    (fetch-indirect memory start)))

(defaddress indirect-x
(defaddress indirect-x (:writer "($~{~2,'0x~}), X")
  (let ((start (wrap-byte (+ (fetch memory program-counter) x-register))))
    (fetch-indirect memory start)))

(defaddress indirect-y
(defaddress indirect-y (:writer "($~{~2,'0x~}), Y")
  (let* ((start (fetch-indirect memory (fetch memory program-counter)))
         (final (wrap-word (+ start y-register))))
    (values final start)))


@@ 92,7 98,7 @@
;; Offset is a signed byte in two's complement form.
;; If negative, xor the offset with 255 to determine the unsigned value and jump.
;; If positive, add one to offset to step over the offset and jump.
(defaddress relative
(defaddress relative (:writer "&~{~2,'0x~}")
  (let ((offset (fetch memory program-counter)))
    (if (logbitp 7 offset)
        (wrap-word (- program-counter (logxor #xff offset)))

M src/disassembler.lisp => src/disassembler.lisp +9 -3
@@ 31,9 31,15 @@
  (loop with index = start while (<= index end)
        for opcode = (fetch memory index)
        do (destructuring-bind (name size cycles mode docs) (aref *opcodes* opcode)
             (declare (ignore cycles mode docs))
             (let ((bytes (fetch-range memory index (+ index (1- size)))))
               (format t "~4,'0x  ~9a ;; ~a~%" index (hexify bytes) name))
             (declare (ignore cycles docs))
             (flet ((format-args (format-string bytes)
                      (if (member mode '(absolute absolute-x absolute-y indirect))
                          (format nil format-string (reverse bytes))
                          (format nil format-string bytes))))
               (let* ((writer (clones.addressing:get-format-string mode))
                      (bytes (fetch-range memory index (+ index (1- size))))
                      (args (format-args writer (rest bytes))))
                 (format t "~4,'0x  ~9a ;; ~a ~a~%" index (hexify bytes) name args)))
             (incf index size))))

(defun current-instruction (memory start)