Advertisement
Guest User

Untitled

a guest
Jan 16th, 2020
161
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 2.43 KB | None | 0 0
  1. ;;;; mmix.lisp
  2. (in-package #:mmix-internal)
  3. (defclass mmixal-mixin (assembler-mixin)
  4.   ((instructions :initform (make-hash-table)
  5.                  :allocation :class)
  6.    (registers :initform (make-hash-table)
  7.               :allocation :class)))
  8.  
  9. (defclass mmix (architecture mmixal-mixin)
  10.   ((name :initform "MMIX"
  11.          :allocation :class)))
  12.  
  13. ;; MMIX Assembly Language
  14. (defclass mmixal (assembly)
  15.   ())
  16.  
  17.  
  18. ;;; Instructions
  19. (defclass mmix-pseudo-instruction (pseudo-instruction mmixal-mixin)
  20.   ())
  21.  
  22. (defclass mmix-instruction (machine-instruction mmixal-mixin)
  23.     ())
  24.  
  25. ;;; Registers
  26.  
  27.  
  28. (defclass mmix-register (register) ())
  29.  
  30. (defclass general-mmix-register (mmix-register) ())
  31.  
  32. (defclass special-mmix-register (mmix-register) ())
  33.  
  34.  
  35. ;;;; common.lisp
  36. (in-package #:common)
  37.  
  38. (defun find-instruction (name &optional *current-architecture*)
  39.   (lisp:or (gethash name (instruction-database *current-architecture*) nil)
  40.            (error "No such instruction ~A." name)))
  41.  
  42. (defun find-register (name &optional *current-architecture*)
  43.   (gethash name (register-database *current-architecture*) nil))
  44.  
  45. (defclass architecture ()
  46.   ((name :reader architecture-name)))
  47.  
  48. (defclass instruction ()
  49.   ((name :initarg :name :reader instruction-name)))
  50.  
  51. (defclass pseudo-instruction (instruction)
  52.   ((args :accessor pseudo-instruction-args)))
  53.  
  54. (defclass machine-instruction (instruction)
  55.   ((code :initarg :code :reader instruction-code)))
  56.  
  57. (defclass assembler-mixin ()
  58.   ((instructions :accessor instruction-database)
  59.    (registers :accessor register-database)))
  60.  
  61. (defmethod initialize-instance :after ((inst instruction)
  62.                                        &key &allow-other-keys)
  63.   (with-slots (name) inst
  64.     (setf (gethash name (instruction-database inst)) inst)))
  65.  
  66. (defmethod print-object ((inst instruction) stream)
  67.   (print-unreadable-object (inst stream :type t :identity t)
  68.     (princ (slot-value inst 'name) stream)))
  69.  
  70. (defclass register ()
  71.   ((name :initarg :name :reader register-name)
  72.    (code :initarg :code :reader register-code)
  73.    (asmname :initarg :asmname :reader register-asmname)))
  74.  
  75. (defmethod print-object ((reg register) stream)
  76.   (print-unreadable-object (reg stream :type t :identity t)
  77.     (princ (slot-value reg 'name) stream)))
  78.  
  79. (defmethod initialize-instance :after ((reg register) &key &allow-other-keys)
  80.   (with-slots (name) reg
  81.     (setf (gethash name (register-database reg)) reg)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement