Skip to content

Commit 912e2bd

Browse files
dvanhorndvanhorn
committed
Clean up the mini a86 code a bit.
1 parent f55689d commit 912e2bd

File tree

2 files changed

+68
-91
lines changed

2 files changed

+68
-91
lines changed

‎langs/outlaw/a86/ast.rkt‎

Lines changed: 13 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -48,10 +48,14 @@
4848
'()
4949
xs))
5050

51+
(define registers
52+
'(cl eax rax rbx rcx rdx rbp rsp rsi rdi r8 r9 r10 r11 r12 r13 r14 r15))
53+
54+
;; Any -> Boolean
5155
(define (register? x)
52-
(and (memq x '(cl eax rax rbx rcx rdx rbp rsp rsi rdi r8 r9 r10 r11 r12 r13 r14 r15))
53-
#t))
56+
(and (memq x registers) #t))
5457

58+
;; Any -> Boolean
5559
(define (exp? x)
5660
(or (Offset? x)
5761
(and (Plus? x)
@@ -62,39 +66,15 @@
6266

6367
(define offset? Offset?)
6468

69+
;; Any -> Boolean
6570
(define (label? x)
6671
(and (symbol? x)
6772
(not (register? x))))
6873

74+
;; Any -> Boolean
6975
(define (instruction? x)
70-
(or (Text? x)
71-
(Data? x)
72-
(Global? x)
73-
(Label? x)
74-
(Extern? x)
75-
(Call? x)
76-
(Ret? x)
77-
(Mov? x)
78-
(Add? x)
79-
(Sub? x)
80-
(Cmp? x)
81-
(Jmp? x)
82-
(Je? x)
83-
(Jne? x)
84-
(Jl? x)
85-
(Jle? x)
86-
(Jg? x)
87-
(Jge? x)
88-
(And? x)
89-
(Or? x)
90-
(Xor? x)
91-
(Sal? x)
92-
(Sar? x)
93-
(Push? x)
94-
(Pop? x)
95-
(Lea? x)
96-
(Div? x)
97-
;(Comment? x)
98-
(Equ? x)
99-
(Dd? x)
100-
(Dq? x)))
76+
(ormap (λ (p) (p x))
77+
(list Text? Data? Global? Label? Extern? Call? Ret? Mov?
78+
Add? Sub? Cmp? Jmp? Je? Jne? Jl? Jle? Jg? Jge?
79+
And? Or? Xor? Sal? Sar? Push? Pop? Lea? Div? Equ?
80+
Dd? Dq?)))

‎langs/outlaw/a86/printer.rkt‎

Lines changed: 55 additions & 58 deletions
Original file line numberDiff line numberDiff line change
@@ -32,12 +32,12 @@
3232
[_
3333
(λ (s)
3434
(if (current-shared?)
35-
(if (memq s (unbox external-labels))
36-
; hack for ELF64 shared libraries in service of
37-
; calling external functions in asm-interp
38-
(string-append (symbol->string s) " wrt ..plt")
39-
(symbol->string s))
40-
(symbol->string s)))]))
35+
(if (memq s (unbox external-labels))
36+
; hack for ELF64 shared libraries in service of
37+
; calling external functions in asm-interp
38+
(string-append (symbol->string s) " wrt ..plt")
39+
(symbol->string s))
40+
(symbol->string s)))]))
4141

4242
;; (U Label Reg) -> String
4343
(define (jump-target->string t)
@@ -70,7 +70,6 @@
7070

7171
(define tab (make-string 8 #\space))
7272

73-
7473
(define external-labels (box '()))
7574

7675
(define (external-label-shared? x)
@@ -85,16 +84,16 @@
8584
;; when 1) ELF, 2) building a shared object
8685
[(Offset (? external-label-shared? l) i)
8786
(string-append tab "mov "
88-
(arg->string a1) ", "
89-
"[" (label-symbol->string l) " + " (number->string i) " wrt ..gotpc]\n"
90-
tab "mov "
91-
(arg->string a1) ", "
92-
"[" (arg->string a1) "]")]
87+
(arg->string a1) ", "
88+
"[" (label-symbol->string l) " + " (number->string i) " wrt ..gotpc]\n"
89+
tab "mov "
90+
(arg->string a1) ", "
91+
"[" (arg->string a1) "]")]
9392
;; the usual case
9493
[_
9594
(string-append tab "mov "
96-
(arg->string a1) ", "
97-
(arg->string a2))]))
95+
(arg->string a1) ", "
96+
(arg->string a2))]))
9897

9998
;; Instruction -> String
10099
(define (instr->string i)
@@ -105,89 +104,89 @@
105104
[(Label l) (string-append (label-symbol->string l) ":")]
106105
[(Global x) (string-append tab "global " (label-symbol->string x))]
107106
[(Extern l) (let ((r (string-append tab "extern " (label-symbol->string l))))
108-
(begin
109-
(set-box! external-labels (cons l (unbox external-labels)))
110-
r))]
107+
(begin
108+
(set-box! external-labels (cons l (unbox external-labels)))
109+
r))]
111110
[(Mov a1 a2)
112111
(mov->string a1 a2)]
113112
[(Add a1 a2)
114113
(string-append tab "add "
115-
(arg->string a1) ", "
116-
(arg->string a2))]
114+
(arg->string a1) ", "
115+
(arg->string a2))]
117116
[(Sub a1 a2)
118117
(string-append tab "sub "
119-
(arg->string a1) ", "
120-
(arg->string a2))]
118+
(arg->string a1) ", "
119+
(arg->string a2))]
121120
[(Cmp a1 a2)
122121
(string-append tab "cmp "
123-
(arg->string a1) ", "
124-
(arg->string a2))]
122+
(arg->string a1) ", "
123+
(arg->string a2))]
125124
[(Sal a1 a2)
126125
(string-append tab "sal "
127-
(arg->string a1) ", "
128-
(arg->string a2))]
126+
(arg->string a1) ", "
127+
(arg->string a2))]
129128
[(Sar a1 a2)
130129
(string-append tab "sar "
131-
(arg->string a1) ", "
132-
(arg->string a2))]
130+
(arg->string a1) ", "
131+
(arg->string a2))]
133132
[(And a1 a2)
134133
(string-append tab "and "
135-
(arg->string a1) ", "
136-
(arg->string a2))]
134+
(arg->string a1) ", "
135+
(arg->string a2))]
137136
[(Or a1 a2)
138137
(string-append tab "or "
139-
(arg->string a1) ", "
140-
(arg->string a2))]
138+
(arg->string a1) ", "
139+
(arg->string a2))]
141140
[(Xor a1 a2)
142141
(string-append tab "xor "
143-
(arg->string a1) ", "
144-
(arg->string a2))]
142+
(arg->string a1) ", "
143+
(arg->string a2))]
145144
[(Jmp l)
146145
(string-append tab "jmp "
147-
(jump-target->string l))]
146+
(jump-target->string l))]
148147
[(Je l)
149148
(string-append tab "je "
150-
(jump-target->string l))]
149+
(jump-target->string l))]
151150
[(Jne l)
152151
(string-append tab "jne "
153-
(jump-target->string l))]
152+
(jump-target->string l))]
154153
[(Jl l)
155154
(string-append tab "jl "
156-
(jump-target->string l))]
155+
(jump-target->string l))]
157156
[(Jle l)
158157
(string-append tab "jle "
159-
(jump-target->string l))]
158+
(jump-target->string l))]
160159
[(Jg l)
161160
(string-append tab "jg "
162-
(jump-target->string l))]
161+
(jump-target->string l))]
163162
[(Jge l)
164163
(string-append tab "jge "
165-
(jump-target->string l))]
164+
(jump-target->string l))]
166165
[(Call l)
167166
(string-append tab "call "
168-
(jump-target->string l))]
167+
(jump-target->string l))]
169168
[(Push a)
170169
(string-append tab "push "
171-
(arg->string a))]
170+
(arg->string a))]
172171
[(Pop r)
173172
(string-append tab "pop "
174-
(reg->string r))]
173+
(reg->string r))]
175174
[(Lea d (? offset? x))
176175
(string-append tab "lea "
177-
(arg->string d) ", "
178-
(arg->string x))]
176+
(arg->string d) ", "
177+
(arg->string x))]
179178
[(Lea d x)
180179
(string-append tab "lea "
181-
(arg->string d) ", [rel "
182-
(exp->string x) "]")]
180+
(arg->string d) ", [rel "
181+
(exp->string x) "]")]
183182
[(Div r)
184183
(string-append tab "div "
185-
(arg->string r))]
184+
(arg->string r))]
186185
[(Equ x c)
187186
(string-append tab
188-
(symbol->string x)
189-
" equ "
190-
(number->string c))]
187+
(symbol->string x)
188+
" equ "
189+
(number->string c))]
191190

192191
[(Dd x)
193192
(string-append tab "dd " (arg->string x))]
@@ -208,14 +207,12 @@
208207
(match (findf Label? a)
209208
[(Label g)
210209
(string-append
211-
tab "global " (label-symbol->string g) "\n"
212-
tab "default rel\n"
213-
tab "section .text\n"
214-
(instrs->string a))]
210+
tab "global " (label-symbol->string g) "\n"
211+
tab "default rel\n"
212+
tab "section .text\n"
213+
(instrs->string a))]
215214
[_
216-
(instrs->string a)
217-
#;
218-
(error "program does not have an initial label")])))
215+
(instrs->string a)])))
219216

220217
(define (asm-display a)
221218
(begin

0 commit comments

Comments
 (0)