136 lines
5.3 KiB
Common Lisp
136 lines
5.3 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
(defgeneric check-arguments (instruction))
|
|
|
|
(defclass instruction ()
|
|
((%mnemonic :allocation :class :reader mnemonic :initarg :mnemonic)
|
|
(%operand :accessor operand :initarg :operand)
|
|
(%next :accessor next :accessor normal-next :initarg :next)
|
|
(%source :accessor source :initarg :source :initform nil)))
|
|
|
|
(defmethod print-object ((object instruction) stream)
|
|
(cond ((some (lambda (type)
|
|
(typep object type))
|
|
'(immediate-mixin accumulator-mixin zero-page-mixin absolute-mixin))
|
|
(format stream "#<~A ~A~A~A>"
|
|
(mnemonic object)
|
|
(typecase object
|
|
(immediate-mixin "#")
|
|
((member indirect-y-mixin indirect-x-mixin) "(")
|
|
(t ""))
|
|
(typecase object
|
|
(accumulator-mixin "A")
|
|
(t (operand object)))
|
|
(typecase object
|
|
(indirect-x-mixin ", X)")
|
|
(indirect-y-mixin "),Y")
|
|
(t ""))))
|
|
(t
|
|
(format stream "#<~A~A>" (mnemonic object)
|
|
(if (or (typep object 'implied-mixin)
|
|
(typep object 'accumulator-mixin))
|
|
""
|
|
(format nil " ~S" (operand object)))))))
|
|
|
|
(defclass complete-mixin ()
|
|
((%opcode :allocation :class :reader opcode :initarg :opcode)))
|
|
|
|
(defclass immediate-mixin () ())
|
|
(defclass implied-mixin () ())
|
|
(defclass accumulator-mixin () ())
|
|
(defclass zero-page-mixin () ())
|
|
|
|
(defmethod shared-initialize :after ((instance zero-page-mixin) slot-names &rest initargs &key &allow-other-keys)
|
|
(declare (ignore slot-names initargs))
|
|
(when (numberp (operand instance))
|
|
(assert (< (operand instance) #x100))))
|
|
|
|
(defclass zero-page-x-mixin (zero-page-mixin) ())
|
|
(defclass absolute-mixin () ())
|
|
(defclass absolute-x-mixin (absolute-mixin) ())
|
|
(defclass absolute-y-mixin (absolute-mixin) ())
|
|
(defclass indirect-x-mixin (zero-page-mixin) ())
|
|
(defclass indirect-y-mixin (zero-page-mixin) ())
|
|
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(defun addressing-mode-to-class-name (mode-keyword)
|
|
(cadr (assoc mode-keyword
|
|
'((:implied implied-mixin)
|
|
(:immediate immediate-mixin)
|
|
(:accumulator accumulator-mixin)
|
|
(:zero-page zero-page-mixin)
|
|
(:zero-page-x zero-page-x-mixin)
|
|
(:zero-page-y zero-page-y-mixin)
|
|
(:relative relative-mixin)
|
|
(:absolute absolute-mixin)
|
|
(:absolute-x absolute-x-mixin)
|
|
(:absolute-y absolute-y-mixin)
|
|
(:indirect-x indirect-x-mixin)
|
|
(:indirect-y indirect-y-mixin))))))
|
|
|
|
(defgeneric instruction-length (object)
|
|
(:method ((obj immediate-mixin)) 2)
|
|
(:method ((obj implied-mixin)) 1)
|
|
(:method ((obj accumulator-mixin)) 1)
|
|
(:method ((obj zero-page-mixin)) 2)
|
|
(:method ((obj relative-mixin)) 2)
|
|
(:method ((obj absolute-mixin)) 3))
|
|
|
|
(defclass branching-mixin ()
|
|
((%branch-next :accessor branch-next :initarg :branch-next)))
|
|
|
|
(defmacro define-instruction (mnemonic branching-p &rest modes-and-codes)
|
|
(let* ((name (string-upcase mnemonic))
|
|
(base-name (intern (format nil "INST-~A" name))))
|
|
`(progn
|
|
(defclass ,base-name (instruction)
|
|
((%mnemonic :allocation :class :initform ',mnemonic)))
|
|
(setf (slot-value (make-instance ',base-name) '%mnemonic) ',mnemonic)
|
|
,@(loop :for (mode code) :in modes-and-codes
|
|
:for class-name := (intern (format nil "INST-~A-~A" name mode))
|
|
:collect `(progn
|
|
(defclass ,class-name
|
|
,(append
|
|
`(,base-name
|
|
,(addressing-mode-to-class-name mode)
|
|
complete-instruction-mixin)
|
|
(when branching-p
|
|
'(branching-mixin)))
|
|
((%opcode :allocation :class :initform ,code)))
|
|
(setf (slot-value (allocate-instance (find-class ',class-name)) '%opcode) ,code))))))
|
|
|
|
(defun fix-label-addresses-in-instruction-list (instruction-list origin)
|
|
(loop :with address := origin
|
|
:with cell := instruction-list
|
|
:for obj :in instruction-list
|
|
:if (typep obj 'label)
|
|
:do (setf (address obj) address)
|
|
:else
|
|
:do (when (typep obj 'instruction)
|
|
(incf address (instruction-length obj)))
|
|
:unless (null (rest cell))
|
|
:do (setf cell (rest cell))
|
|
:finally (setf (cdr cell)
|
|
(list (make-label :name "PROGRAM_END" :address address)))))
|
|
|
|
;;; Testing
|
|
|
|
(define-instruction "TXA" nil (:implied #x8a))
|
|
(define-instruction "PHA" nil (:implied #x48))
|
|
(define-instruction "PLA" nil (:implied #x68))
|
|
(define-instruction "TAX" nil (:implied #xaa))
|
|
(define-instruction "DEX" nil (:implied #xca))
|
|
(define-instruction "BNE" t (:relative #xd0))
|
|
(define-instruction "LDA" nil
|
|
(:immediate #xa9)
|
|
(:zero-page #xa5)
|
|
(:absolute #xad)
|
|
(:absolute-y #xb9))
|
|
(define-instruction "LDY" nil
|
|
(:immediate #xa0)
|
|
(:absolute #xac))
|
|
(define-instruction "STA" nil
|
|
(:absolute #x8d)
|
|
(:absolute-y #x99))
|
|
(define-instruction "JSR" nil
|
|
(:absolute #x20))
|