Skip to content

Commit d2ec7b9

Browse files
dvanhorndvanhorn
authored
Merge pull request #117 from cmsc430/jo
Jo
2 parents 01b3e78 + fbc525f commit d2ec7b9

22 files changed

Lines changed: 664 additions & 295 deletions

‎langs/a86/ast.rkt‎

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,14 @@
2929
(error n "expects symbol; given ~v" x))
3030
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
(λ (a1 a2 n)
3442
(unless (register? a1)
@@ -157,6 +165,20 @@
157165
(instruct Jle (x) check:target)
158166
(instruct Jg (x) check:target)
159167
(instruct Jge (x) check:target)
168+
(instruct Jo (x) check:target)
169+
(instruct Jno (x) check:target)
170+
(instruct Jc (x) check:target)
171+
(instruct Jnc (x) check:target)
172+
(instruct Cmove (dst src) check:cmov)
173+
(instruct Cmovne (dst src) check:cmov)
174+
(instruct Cmovl (dst src) check:cmov)
175+
(instruct Cmovle (dst src) check:cmov)
176+
(instruct Cmovg (dst src) check:cmov)
177+
(instruct Cmovge (dst src) check:cmov)
178+
(instruct Cmovo (dst src) check:cmov)
179+
(instruct Cmovno (dst src) check:cmov)
180+
(instruct Cmovc (dst src) check:cmov)
181+
(instruct Cmovnc (dst src) check:cmov)
160182
(instruct And (dst src) check:src-dest)
161183
(instruct Or (dst src) check:src-dest)
162184
(instruct Xor (dst src) check:src-dest)
@@ -165,6 +187,7 @@
165187
(instruct Push (a1) check:push)
166188
(instruct Pop (a1) check:register)
167189
(instruct Lea (dst x) check:lea)
190+
(instruct Not (x) check:register)
168191
(instruct Div (den) check:register)
169192

170193
(instruct Offset (r i) check:offset)
@@ -229,6 +252,20 @@
229252
(Jle? x)
230253
(Jg? x)
231254
(Jge? x)
255+
(Jo? x)
256+
(Jno? x)
257+
(Jc? x)
258+
(Jnc? x)
259+
(Cmove? x)
260+
(Cmovne? x)
261+
(Cmovl? x)
262+
(Cmovle? x)
263+
(Cmovg? x)
264+
(Cmovge? x)
265+
(Cmovo? x)
266+
(Cmovno? x)
267+
(Cmovc? x)
268+
(Cmovnc? x)
232269
(And? x)
233270
(Or? x)
234271
(Xor? x)
@@ -237,6 +274,7 @@
237274
(Push? x)
238275
(Pop? x)
239276
(Lea? x)
277+
(Not? x)
240278
(Div? x)
241279
(Comment? x)
242280
(Equ? x)

‎langs/a86/printer.rkt‎

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -141,6 +141,58 @@
141141
[(Jge l)
142142
(string-append tab "jge "
143143
(jump-target->string l))]
144+
[(Jo l)
145+
(string-append tab "jo "
146+
(jump-target->string l))]
147+
[(Jno l)
148+
(string-append tab "jno "
149+
(jump-target->string l))]
150+
[(Jc l)
151+
(string-append tab "jc "
152+
(jump-target->string l))]
153+
[(Jnc l)
154+
(string-append tab "jnc "
155+
(jump-target->string l))]
156+
[(Cmove dst src)
157+
(string-append tab "cmove "
158+
(reg->string dst) ", "
159+
(arg->string src))]
160+
[(Cmovne dst src)
161+
(string-append tab "cmovne "
162+
(reg->string dst) ", "
163+
(arg->string src))]
164+
[(Cmovl dst src)
165+
(string-append tab "cmovl "
166+
(reg->string dst) ", "
167+
(arg->string src))]
168+
[(Cmovle dst src)
169+
(string-append tab "cmovle "
170+
(reg->string dst) ", "
171+
(arg->string src))]
172+
[(Cmovg dst src)
173+
(string-append tab "cmovg "
174+
(reg->string dst) ", "
175+
(arg->string src))]
176+
[(Cmovge dst src)
177+
(string-append tab "cmovge "
178+
(reg->string dst) ", "
179+
(arg->string src))]
180+
[(Cmovo dst src)
181+
(string-append tab "cmovo "
182+
(reg->string dst) ", "
183+
(arg->string src))]
184+
[(Cmovno dst src)
185+
(string-append tab "cmovno "
186+
(reg->string dst) ", "
187+
(arg->string src))]
188+
[(Cmovc dst src)
189+
(string-append tab "cmovc "
190+
(reg->string dst) ", "
191+
(arg->string src))]
192+
[(Cmovnc dst src)
193+
(string-append tab "cmovnc "
194+
(reg->string dst) ", "
195+
(arg->string src))]
144196
[(Call l)
145197
(string-append tab "call "
146198
(jump-target->string l))]
@@ -158,6 +210,9 @@
158210
(string-append tab "lea "
159211
(arg->string d) ", [rel "
160212
(exp->string x) "]")]
213+
[(Not r)
214+
(string-append tab "not "
215+
(reg->string r))]
161216
[(Div r)
162217
(string-append tab "div "
163218
(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)