;;;; mmix.lisp
(in-package #:mmix-internal)
(defclass mmixal-mixin (assembler-mixin)
  ((instructions :initform (make-hash-table)
                 :allocation :class)
   (registers :initform (make-hash-table)
              :allocation :class)))

(defclass mmix (architecture mmixal-mixin)
  ((name :initform "MMIX"
         :allocation :class)))

;; MMIX Assembly Language
(defclass mmixal (assembly)
  ())


;;; Instructions
(defclass mmix-pseudo-instruction (pseudo-instruction mmixal-mixin)
  ())

(defclass mmix-instruction (machine-instruction mmixal-mixin)
    ())

;;; Registers


(defclass mmix-register (register) ())

(defclass general-mmix-register (mmix-register) ())

(defclass special-mmix-register (mmix-register) ())


;;;; common.lisp
(in-package #:common)

(defun find-instruction (name &optional *current-architecture*)
  (lisp:or (gethash name (instruction-database *current-architecture*) nil)
           (error "No such instruction ~A." name)))

(defun find-register (name &optional *current-architecture*)
  (gethash name (register-database *current-architecture*) nil))

(defclass architecture ()
  ((name :reader architecture-name)))

(defclass instruction ()
  ((name :initarg :name :reader instruction-name)))

(defclass pseudo-instruction (instruction)
  ((args :accessor pseudo-instruction-args)))

(defclass machine-instruction (instruction)
  ((code :initarg :code :reader instruction-code)))

(defclass assembler-mixin ()
  ((instructions :accessor instruction-database)
   (registers :accessor register-database)))

(defmethod initialize-instance :after ((inst instruction)
                                       &key &allow-other-keys)
  (with-slots (name) inst
    (setf (gethash name (instruction-database inst)) inst)))

(defmethod print-object ((inst instruction) stream)
  (print-unreadable-object (inst stream :type t :identity t)
    (princ (slot-value inst 'name) stream)))

(defclass register ()
  ((name :initarg :name :reader register-name)
   (code :initarg :code :reader register-code)
   (asmname :initarg :asmname :reader register-asmname)))

(defmethod print-object ((reg register) stream)
  (print-unreadable-object (reg stream :type t :identity t)
    (princ (slot-value reg 'name) stream)))

(defmethod initialize-instance :after ((reg register) &key &allow-other-keys)
  (with-slots (name) reg
    (setf (gethash name (register-database reg)) reg)))