Skip to content

Commit fd330a0

Browse files
dvanhorndvanhorn
authored
Merge branch 'main' into instruction-magic
2 parents afb6f43 + 4e1f289 commit fd330a0

54 files changed

Lines changed: 831 additions & 466 deletions

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

‎langs/a86/ast.rkt‎

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,14 @@
2929
(error n "expects symbol; given ~v" x))
3030
(values a x)))
3131

32+
(define check:cmov
33+
(λ (a1 a2 n)
34+
(unless (register? a1)
35+
(error n "expects register; given ~v" a1))
36+
(unless (or (register? a2) (offset? a2))
37+
(error n "expects register or offset; given ~v" a2))
38+
(values a1 a2)))
39+
3240
(define check:arith
3341
(λ (a a1 a2 n)
3442
(unless (register? a1)
@@ -187,6 +195,20 @@
187195
(instruct Jle (x) check:target)
188196
(instruct Jg (x) check:target)
189197
(instruct Jge (x) check:target)
198+
(instruct Jo (x) check:target)
199+
(instruct Jno (x) check:target)
200+
(instruct Jc (x) check:target)
201+
(instruct Jnc (x) check:target)
202+
(instruct Cmove (dst src) check:cmov)
203+
(instruct Cmovne (dst src) check:cmov)
204+
(instruct Cmovl (dst src) check:cmov)
205+
(instruct Cmovle (dst src) check:cmov)
206+
(instruct Cmovg (dst src) check:cmov)
207+
(instruct Cmovge (dst src) check:cmov)
208+
(instruct Cmovo (dst src) check:cmov)
209+
(instruct Cmovno (dst src) check:cmov)
210+
(instruct Cmovc (dst src) check:cmov)
211+
(instruct Cmovnc (dst src) check:cmov)
190212
(instruct And (dst src) check:src-dest)
191213
(instruct Or (dst src) check:src-dest)
192214
(instruct Xor (dst src) check:src-dest)
@@ -195,6 +217,7 @@
195217
(instruct Push (a1) check:push)
196218
(instruct Pop (a1) check:register)
197219
(instruct Lea (dst x) check:lea)
220+
(instruct Not (x) check:register)
198221
(instruct Div (den) check:register)
199222

200223
(instruct Offset (r i) check:offset) ;; May need to make this not an instruction
@@ -240,6 +263,7 @@
240263
(nasm-label? x)
241264
(not (register? x))))
242265

266+
243267
(provide (rename-out [a86:instruction? instruction?]))
244268
(define (a86:instruction? x)
245269
(or (instruction? x)

‎langs/a86/printer.rkt‎

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -151,6 +151,58 @@
151151
[(Jge l)
152152
(string-append tab "jge "
153153
(jump-target->string l))]
154+
[(Jo l)
155+
(string-append tab "jo "
156+
(jump-target->string l))]
157+
[(Jno l)
158+
(string-append tab "jno "
159+
(jump-target->string l))]
160+
[(Jc l)
161+
(string-append tab "jc "
162+
(jump-target->string l))]
163+
[(Jnc l)
164+
(string-append tab "jnc "
165+
(jump-target->string l))]
166+
[(Cmove dst src)
167+
(string-append tab "cmove "
168+
(reg->string dst) ", "
169+
(arg->string src))]
170+
[(Cmovne dst src)
171+
(string-append tab "cmovne "
172+
(reg->string dst) ", "
173+
(arg->string src))]
174+
[(Cmovl dst src)
175+
(string-append tab "cmovl "
176+
(reg->string dst) ", "
177+
(arg->string src))]
178+
[(Cmovle dst src)
179+
(string-append tab "cmovle "
180+
(reg->string dst) ", "
181+
(arg->string src))]
182+
[(Cmovg dst src)
183+
(string-append tab "cmovg "
184+
(reg->string dst) ", "
185+
(arg->string src))]
186+
[(Cmovge dst src)
187+
(string-append tab "cmovge "
188+
(reg->string dst) ", "
189+
(arg->string src))]
190+
[(Cmovo dst src)
191+
(string-append tab "cmovo "
192+
(reg->string dst) ", "
193+
(arg->string src))]
194+
[(Cmovno dst src)
195+
(string-append tab "cmovno "
196+
(reg->string dst) ", "
197+
(arg->string src))]
198+
[(Cmovc dst src)
199+
(string-append tab "cmovc "
200+
(reg->string dst) ", "
201+
(arg->string src))]
202+
[(Cmovnc dst src)
203+
(string-append tab "cmovnc "
204+
(reg->string dst) ", "
205+
(arg->string src))]
154206
[(Call l)
155207
(string-append tab "call "
156208
(jump-target->string l))]
@@ -168,6 +220,9 @@
168220
(string-append tab "lea "
169221
(arg->string d) ", [rel "
170222
(exp->string x) "]")]
223+
[(Not r)
224+
(string-append tab "not "
225+
(reg->string r))]
171226
[(Div r)
172227
(string-append tab "div "
173228
(arg->string r))]

‎langs/dodger/compile-ops.rkt‎

Lines changed: 10 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -3,28 +3,24 @@
33
(require "ast.rkt" "types.rkt" a86/ast)
44

55
(define rax 'rax)
6+
(define r9 'r9) ; scratch
67

78
;; Op1 -> Asm
89
(define (compile-op1 p)
910
(match p
1011
['add1 (Add rax (value->bits 1))]
1112
['sub1 (Sub rax (value->bits 1))]
1213
['zero?
13-
(let ((l1 (gensym)))
14-
(seq (Cmp rax 0)
15-
(Mov rax val-true)
16-
(Je l1)
17-
(Mov rax val-false)
18-
(Label l1)))]
14+
(seq (Cmp rax 0)
15+
(Mov rax val-false)
16+
(Mov r9 val-true)
17+
(Cmove rax r9))]
1918
['char?
20-
(let ((l1 (gensym)))
21-
(seq (And rax mask-char)
22-
(Xor rax type-char)
23-
(Cmp rax 0)
24-
(Mov rax val-true)
25-
(Je l1)
26-
(Mov rax val-false)
27-
(Label l1)))]
19+
(seq (And rax mask-char)
20+
(Cmp rax type-char)
21+
(Mov rax val-false)
22+
(Mov r9 val-true)
23+
(Cmove rax r9))]
2824
['char->integer
2925
(seq (Sar rax char-shift)
3026
(Sal rax int-shift))]

‎langs/dupe/compile-ops.rkt‎

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -3,16 +3,15 @@
33
(require "ast.rkt" "types.rkt" a86/ast)
44

55
(define rax 'rax)
6+
(define r9 'r9) ; scratch
67

78
;; Op1 -> Asm
89
(define (compile-op1 p)
910
(match p
1011
['add1 (Add rax (value->bits 1))]
1112
['sub1 (Sub rax (value->bits 1))]
1213
['zero?
13-
(let ((l1 (gensym)))
14-
(seq (Cmp rax 0)
15-
(Mov rax val-true)
16-
(Je l1)
17-
(Mov rax val-false)
18-
(Label l1)))]))
14+
(seq (Cmp rax 0)
15+
(Mov rax (value->bits #f))
16+
(Mov r9 (value->bits #t))
17+
(Cmove rax r9))]))

‎langs/evildoer/compile-ops.rkt‎

Lines changed: 17 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -4,11 +4,12 @@
44

55
(define rax 'rax) ; return
66
(define rdi 'rdi) ; arg
7+
(define r9 'r9) ; scratch
78

89
;; Op0 -> Asm
910
(define (compile-op0 p)
1011
(match p
11-
['void (seq (Mov rax val-void))]
12+
['void (seq (Mov rax (value->bits (void))))]
1213
['read-byte (seq (Call 'read_byte))]
1314
['peek-byte (seq (Call 'peek_byte))]))
1415

@@ -18,21 +19,12 @@
1819
['add1 (Add rax (value->bits 1))]
1920
['sub1 (Sub rax (value->bits 1))]
2021
['zero?
21-
(let ((l1 (gensym)))
22-
(seq (Cmp rax 0)
23-
(Mov rax val-true)
24-
(Je l1)
25-
(Mov rax val-false)
26-
(Label l1)))]
22+
(seq (Cmp rax 0)
23+
(if-equal))]
2724
['char?
28-
(let ((l1 (gensym)))
29-
(seq (And rax mask-char)
30-
(Xor rax type-char)
31-
(Cmp rax 0)
32-
(Mov rax val-true)
33-
(Je l1)
34-
(Mov rax val-false)
35-
(Label l1)))]
25+
(seq (And rax mask-char)
26+
(Cmp rax type-char)
27+
(if-equal))]
3628
['char->integer
3729
(seq (Sar rax char-shift)
3830
(Sal rax int-shift))]
@@ -41,13 +33,16 @@
4133
(Sal rax char-shift)
4234
(Xor rax type-char))]
4335
['eof-object?
44-
(let ((l1 (gensym)))
45-
(seq (Cmp rax val-eof)
46-
(Mov rax val-true)
47-
(Je l1)
48-
(Mov rax val-false)
49-
(Label l1)))]
36+
(seq (Cmp rax (value->bits eof))
37+
(if-equal))]
5038
['write-byte
5139
(seq (Mov rdi rax)
5240
(Call 'write_byte)
53-
(Mov rax val-void))]))
41+
(Mov rax (value->bits (void))))]))
42+
43+
;; -> Asm
44+
;; set rax to #t or #f if comparison flag is equal
45+
(define (if-equal)
46+
(seq (Mov rax (value->bits #f))
47+
(Mov r9 (value->bits #t))
48+
(Cmove rax r9)))

‎langs/evildoer/compile.rkt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,7 @@
4848
(let ((l1 (gensym 'if))
4949
(l2 (gensym 'if)))
5050
(seq (compile-e e1)
51-
(Cmp rax val-false)
51+
(Cmp rax (value->bits #f))
5252
(Je l1)
5353
(compile-e e2)
5454
(Jmp l2)

‎langs/extort/compile-ops.rkt‎

Lines changed: 22 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -4,12 +4,12 @@
44

55
(define rax 'rax) ; return
66
(define rdi 'rdi) ; arg
7-
(define r9 'r9) ; scratch in assert-type
7+
(define r9 'r9) ; scratch
88

99
;; Op0 -> Asm
1010
(define (compile-op0 p)
1111
(match p
12-
['void (seq (Mov rax val-void))]
12+
['void (seq (Mov rax (value->bits (void))))]
1313
['read-byte (seq (Call 'read_byte))]
1414
['peek-byte (seq (Call 'peek_byte))]))
1515

@@ -23,22 +23,11 @@
2323
(seq (assert-integer rax)
2424
(Sub rax (value->bits 1)))]
2525
['zero?
26-
(let ((l1 (gensym)))
27-
(seq (assert-integer rax)
28-
(Cmp rax 0)
29-
(Mov rax val-true)
30-
(Je l1)
31-
(Mov rax val-false)
32-
(Label l1)))]
26+
(seq (assert-integer rax)
27+
(Cmp rax 0)
28+
(if-equal))]
3329
['char?
34-
(let ((l1 (gensym)))
35-
(seq (And rax mask-char)
36-
(Xor rax type-char)
37-
(Cmp rax 0)
38-
(Mov rax val-true)
39-
(Je l1)
40-
(Mov rax val-false)
41-
(Label l1)))]
30+
(type-pred mask-char type-char)]
4231
['char->integer
4332
(seq (assert-char rax)
4433
(Sar rax char-shift)
@@ -48,12 +37,12 @@
4837
(Sar rax int-shift)
4938
(Sal rax char-shift)
5039
(Xor rax type-char))]
51-
['eof-object? (eq-imm val-eof)]
40+
['eof-object? (eq-value eof)]
5241
['write-byte
5342
(seq (assert-byte)
5443
(Mov rdi rax)
5544
(Call 'write_byte)
56-
(Mov rax val-void))]))
45+
(Mov rax (value->bits (void))))]))
5746

5847

5948
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -66,13 +55,9 @@
6655
(Jne 'err))))
6756

6857
(define (type-pred mask type)
69-
(let ((l (gensym)))
70-
(seq (And rax mask)
71-
(Cmp rax type)
72-
(Mov rax (value->bits #t))
73-
(Je l)
74-
(Mov rax (value->bits #f))
75-
(Label l))))
58+
(seq (And rax mask)
59+
(Cmp rax type)
60+
(if-equal)))
7661

7762
(define assert-integer
7863
(assert-type mask-int type-int))
@@ -100,11 +85,14 @@
10085
(Cmp rax (value->bits 255))
10186
(Jg 'err)))
10287

103-
;; Imm -> Asm
104-
(define (eq-imm imm)
105-
(let ((l1 (gensym)))
106-
(seq (Cmp rax imm)
107-
(Mov rax val-true)
108-
(Je l1)
109-
(Mov rax val-false)
110-
(Label l1))))
88+
;; -> Asm
89+
;; set rax to #t or #f if comparison flag is equal
90+
(define (if-equal)
91+
(seq (Mov rax (value->bits #f))
92+
(Mov r9 (value->bits #t))
93+
(Cmove rax r9)))
94+
95+
;; Value -> Asm
96+
(define (eq-value v)
97+
(seq (Cmp rax (value->bits v))
98+
(if-equal)))

‎langs/extort/compile.rkt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@
5252
(let ((l1 (gensym 'if))
5353
(l2 (gensym 'if)))
5454
(seq (compile-e e1)
55-
(Cmp rax val-false)
55+
(Cmp rax (value->bits #f))
5656
(Je l1)
5757
(compile-e e2)
5858
(Jmp l2)

0 commit comments

Comments
 (0)