103 lines
3.8 KiB
Common Lisp
103 lines
3.8 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)
|
|
(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 (immediate-mixin) 1)
|
|
(:method (implied-mixin) 1)
|
|
(:method (accumulator-mixin) 1)
|
|
(:method (zero-page-mixin) 2)
|
|
(:method (relative-mixin) 2)
|
|
(:method (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)))
|
|
,@(loop :for (mode code) :in modes-and-codes
|
|
:collect `(defclass ,(intern (format nil "INST-~A-~A"
|
|
name mode))
|
|
,(append
|
|
`(,base-name
|
|
,(addressing-mode-to-class-name mode)
|
|
complete-mixin)
|
|
(when branching-p
|
|
'(branching-mixin)))
|
|
((%opcode :allocation :class :initform ,code)))))))
|
|
|
|
;;; Testing
|
|
|
|
(define-instruction "TXA" nil (:implied 0))
|
|
(define-instruction "PHA" nil (:implied 0))
|
|
(define-instruction "PLA" nil (:implied 0))
|
|
(define-instruction "TAX" nil (:implied 0))
|
|
(define-instruction "DEX" nil (:implied 0))
|
|
(define-instruction "BNE" t (:relative 0))
|
|
(define-instruction "LDA" nil
|
|
(:absolute 0)
|
|
(:zero-page 0)
|
|
(:immediate 0)
|
|
(:absolute-y 0))
|
|
(define-instruction "LDY" nil
|
|
(:absolute 0)
|
|
(:immediate 0))
|
|
(define-instruction "STA" nil
|
|
(:absolute 0)
|
|
(:immediate 0)
|
|
(:absolute-y 0))
|
|
(define-instruction "JSR" nil
|
|
(:absolute 0))
|