128 lines
4.8 KiB
Common Lisp
128 lines
4.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)
|
|
(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)))
|
|
,@(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)))))))
|
|
|
|
(defun fix-label-addresses-in-instruction-list (instruction-list origin)
|
|
(loop :with address := origin
|
|
:for obj :in instruction-list
|
|
:if (typep obj 'label)
|
|
:do (setf (address obj) address)
|
|
:else
|
|
:do (incf address (instruction-length obj))))
|
|
|
|
;;; 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))
|