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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
(in-package #:parse)
(defparameter line-number 0
"The number of real instructions processed up until this point.")
(defparameter var-offset 0
"The number of variables processed up until this point.")
(esrap:defrule space
(+ (or #\space #\tab))
(:constant nil))
(esrap:defrule eol (and (esrap:? space) (esrap:? (and #\; (* (not #\newline)))) #\newline)
(:constant nil))
(esrap:defrule newline (+ eol)
(:constant nil))
(esrap:defrule sign (or #\+ #\-))
(esrap:defrule alphanumeric (+ (alphanumericp character))
(:text t))
;;; defines rules to parse an integer in various bases
(defmacro define-number-rule ())
(esrap:defrule binary-number (and #\0 #\B (+ (or "0" "1")))
(:lambda (e) (parse-integer (esrap:text (cddr e)) :radix 2)))
(esrap:defrule octal-number (and #\0 #\O (+ (or (esrap:character-ranges (#\0 #\7)))))
(:lambda (e) (parse-integer (esrap:text (cddr e)) :radix 8)))
(esrap:defrule decimal-number (+ (or (esrap:character-ranges (#\0 #\9))))
(:lambda (e) (parse-integer (esrap:text e) :radix 10)))
(esrap:defrule hexadecimal-number (and #\0 #\X (+ (or (esrap:character-ranges (#\0 #\9))
"A" "B" "C" "D" "E" "F")))
(:lambda (e) (parse-integer (esrap:text (cddr e)) :radix 16)))
(esrap:defrule integer (and (esrap:? sign) (or binary-number octal-number
hexadecimal-number decimal-number))
(:destructure (s i)
(if (and s (string= s "-")) (- i) i)))
;;; defines rules to parse an operand
(esrap:defrule register (and #\$ integer)
(:function cadr)
(:lambda (e) (list 'emit::rr e)))
(esrap:defrule variable alphanumeric
(:lambda (e) (list 'emit::var e)))
(esrap:defrule immediate (or integer variable)
(:lambda (e) e))
(esrap:defrule dereference (and immediate #\( register #\))
(:destructure (i1 w1 r w2)
(declare (ignore w1 w2))
(list r i1)))
;;; defines rules to parse labels
(esrap:defrule label alphanumeric
(:lambda (e) (list 'emit::l e line-number)))
(esrap:defrule label-declaration (and alphanumeric #\:)
(:function car)
(:lambda (e)
(util:add-label e line-number)
nil))
;;; defines rules to parse instruction types
(defun generate-mnemonic (name ops)
(let ((expr `(or ,@ops)))
(esrap:add-rule
name (make-instance 'esrap:rule :expression expr))))
;; define special cases first
(generate-mnemonic 'r-type-1-m '("NOT"))
(generate-mnemonic 'r-type-2-m '("CMP" "CEV"))
(generate-mnemonic 'i-type-1-m '("LOADV" "LOAD"))
(generate-mnemonic 'i-type-2-m '("STOREV" "STORE"))
(generate-mnemonic 'j-type-1-m '("JMP" "JAL"))
(generate-mnemonic 'j-type-2-m '("PUSH" "POP"))
(generate-mnemonic 'j-type-3-m '("RET" "NOP"))
;; we need to reverse to ensure rules like "ADDV" are matched before "ADD"
(generate-mnemonic 'r-type-3-m (reverse util:r-type))
(generate-mnemonic 'i-type-3-m (reverse util:i-type))
(generate-mnemonic 'j-type-4-m (reverse util:j-type))
;; TODO this is pretty gross
(defmacro defrule-instr (name type-id order &rest destructure-pattern)
"Defines the boilerplate for a common esrap instruction rule.
NAME is the name of the non-terminal symbol.
TYPE-ID is the symbol which appears as the first element of a successful parse.
ORDER is the order to place the parsed tokens in the resulting list.
DESTRUCTURE-PATTERN is the list of non-terminals on the right side of the grammar rule."
(let* ((pattern-size (length destructure-pattern))
(spaces (mapcar (lambda (x) (read-from-string (format nil "w~A" x))) (util:iota pattern-size)))
(vars (mapcar (lambda (x) (read-from-string (format nil "s~A" x))) (util:iota pattern-size))))
`(esrap:defrule ,name
(and ,(read-from-string (format nil "~A-m" name)) ,@(util:riffle (make-list pattern-size :initial-element 'space) destructure-pattern))
(:destructure (m ,@(util:riffle spaces vars))
(declare (ignore ,@spaces))
(list ,type-id m ,@(mapcar (lambda (x) (or (nth x vars) ''(emit::rr 0))) order))))))
(defrule-instr r-type-1 'emit::r (1 2 0) register register)
(defrule-instr r-type-2 'emit::r (0 1 2) register register)
(defrule-instr r-type-3 'emit::r (1 2 0) register register register)
(defrule-instr i-type-3 'emit::i (1 0 2) register register immediate)
(defrule-instr j-type-4 'emit::j (1 0) label)
(esrap:defrule i-type-1 (and i-type-1-m space register space dereference)
(:destructure (m w1 s w2 di)
(declare (ignore w1 w2))
`(emit::i ,m ,s ,@di)))
(esrap:defrule i-type-2 (and i-type-2-m space register space dereference)
(:destructure (m w1 s w2 di)
(declare (ignore w1 w2))
`(emit::i ,m ,@(util:insert-in-middle di s))))
(esrap:defrule j-type-1 (and j-type-1-m space dereference)
(:destructure (m w di)
(declare (ignore w))
`(emit::j ,m ,@di)))
(esrap:defrule j-type-2 (and j-type-2-m space register)
(:destructure (m w r)
(declare (ignore w))
`(emit::j ,m ,r 0)))
(esrap:defrule j-type-3 j-type-3-m
(:lambda (m)
`(emit::j ,m (emit::rr 0) 0)))
(esrap:defrule instr (or r-type-1 r-type-2 r-type-3 i-type-1 i-type-2
i-type-3 j-type-1 j-type-2 j-type-3 j-type-4))
;;; defines rules to parse the .text segment
(esrap:defrule instr-clean (and (esrap:? space) instr newline)
(:function cadr)
(:lambda (i) (incf line-number) i))
(esrap:defrule label-clean (and label-declaration newline)
(:function car))
(esrap:defrule text-line (or instr-clean label-clean))
(esrap:defrule text (and ".TEXT" (esrap:? space) newline (* text-line))
(:function cadddr)
(:lambda (e) `(emit::x ,@(remove nil e))))
;;; defines rules to parse the .data segment
(esrap:defrule data-word (and (esrap:? space) integer)
(:function cadr)
(:lambda (e)
(incf var-offset)
e))
(esrap:defrule var-declaration alphanumeric
(:lambda (e)
(util:add-variable e var-offset)
nil))
(esrap:defrule data-line (and (esrap:? space) var-declaration (+ data-word) newline)
(:function caddr))
(esrap:defrule data (and ".DATA" (esrap:? space) newline (* data-line))
(:function cadddr)
(:lambda (e) `(emit::d ,@(apply #'append e))))
;;; defines rules to parse a program
(esrap:defrule str->ast (and (* (or space newline)) data text)
(:function cdr)
(:lambda (e) `(emit::p ,@e)))
|
