blob: a5c94c6dde29dec65e3c8121f7482f9728a2bebb (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
(defpackage #:sarcasm.instr
(:use #:cl)
(:shadow cl:return cl:if cl:block cl:loop cl:t)
(:local-nicknames
(#:a #:alexandria-2)))
(in-package #:sarcasm.instr)
(defclass instr () ())
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun expand-instr-plist (plist)
(destructuring-bind (&key instr code type) plist
(let* ((class-name
(intern (string-upcase (first instr))))
(immediates
(cl:loop
:for arg :in (rest instr)
:for slot-name := (intern (string-upcase arg))
:for reader := (intern (format nil "~a-~a" class-name slot-name))
:for initarg := (a:make-keyword slot-name)
:collect `(,slot-name
:reader ,reader
:initarg ,initarg
:initform (error "~a required" ',slot-name)))))
`(defclass ,class-name (instr)
((instr-name
:allocation :class
:type string
:initform ,(first instr)
:reader instr-name)
(instr-code
:allocation :class
:type (vector (unsigned-byte 8) ,(length code))
:initform (make-array ,(length code)
:element-type '(unsigned-byte 8)
:initial-contents ',code))
(instr-type
:allocation :class
:type t
:initform ',type)
,@immediates))))))
(macrolet ((create-instr-classes (raw)
`(progn
,@(mapcar #'expand-instr-plist raw))))
(create-instr-classes #.sarcasm.raw-instrs:raw-instrs))
|
