Skip to content

Commit 9d52a0a

Browse files
dvanhorndvanhorn
committed
Use conditional moves, use value->bits more; through Fraud.
1 parent a0ec37e commit 9d52a0a

8 files changed

Lines changed: 86 additions & 117 deletions

File tree

‎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)

‎langs/fraud/compile-ops.rkt‎

Lines changed: 29 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -5,14 +5,14 @@
55
(define rax 'rax) ; return
66
(define rdi 'rdi) ; arg
77
(define r8 'r8) ; scratch in +, -
8-
(define r9 'r9) ; scratch in assert-type
8+
(define r9 'r9) ; scratch
99
(define r15 'r15) ; stack pad (non-volatile)
1010
(define rsp 'rsp) ; stack
1111

1212
;; Op0 -> Asm
1313
(define (compile-op0 p)
1414
(match p
15-
['void (seq (Mov rax val-void))]
15+
['void (seq (Mov rax (value->bits (void))))]
1616
['read-byte (seq pad-stack
1717
(Call 'read_byte)
1818
unpad-stack)]
@@ -30,14 +30,11 @@
3030
(seq (assert-integer rax)
3131
(Sub rax (value->bits 1)))]
3232
['zero?
33-
(let ((l1 (gensym)))
34-
(seq (assert-integer rax)
35-
(Cmp rax 0)
36-
(Mov rax val-true)
37-
(Je l1)
38-
(Mov rax val-false)
39-
(Label l1)))]
40-
['char? (type-pred mask-char type-char)]
33+
(seq (assert-integer rax)
34+
(Cmp rax 0)
35+
(if-equal))]
36+
['char?
37+
(type-pred mask-char type-char)]
4138
['char->integer
4239
(seq (assert-char rax)
4340
(Sar rax char-shift)
@@ -47,14 +44,14 @@
4744
(Sar rax int-shift)
4845
(Sal rax char-shift)
4946
(Xor rax type-char))]
50-
['eof-object? (eq-imm val-eof)]
47+
['eof-object? (eq-value eof)]
5148
['write-byte
5249
(seq (assert-byte rax)
5350
pad-stack
5451
(Mov rdi rax)
5552
(Call 'write_byte)
5653
unpad-stack
57-
(Mov rax val-void))]))
54+
(Mov rax (value->bits (void))))]))
5855

5956
;; Op2 -> Asm
6057
(define (compile-op2 p)
@@ -74,22 +71,14 @@
7471
(seq (Pop r8)
7572
(assert-integer r8)
7673
(assert-integer rax)
77-
(Cmp r8 rax)
78-
(Mov rax val-true)
79-
(let ((true (gensym)))
80-
(seq (Jl true)
81-
(Mov rax val-false)
82-
(Label true))))]
74+
(Cmp r8 rax)
75+
(if-lt))]
8376
['=
8477
(seq (Pop r8)
8578
(assert-integer r8)
8679
(assert-integer rax)
8780
(Cmp r8 rax)
88-
(Mov rax val-true)
89-
(let ((true (gensym)))
90-
(seq (Je true)
91-
(Mov rax val-false)
92-
(Label true))))]))
81+
(if-equal))]))
9382

9483

9584
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -102,13 +91,9 @@
10291
(Jne 'raise_error_align))))
10392

10493
(define (type-pred mask type)
105-
(let ((l (gensym)))
106-
(seq (And rax mask)
107-
(Cmp rax type)
108-
(Mov rax (value->bits #t))
109-
(Je l)
110-
(Mov rax (value->bits #f))
111-
(Label l))))
94+
(seq (And rax mask)
95+
(Cmp rax type)
96+
(if-equal)))
11297

11398
(define assert-integer
11499
(assert-type mask-int type-int))
@@ -136,14 +121,20 @@
136121
(Cmp r (value->bits 255))
137122
(Jg 'raise_error_align)))
138123

139-
;; Imm -> Asm
140-
(define (eq-imm imm)
141-
(let ((l1 (gensym)))
142-
(seq (Cmp rax imm)
143-
(Mov rax val-true)
144-
(Je l1)
145-
(Mov rax val-false)
146-
(Label l1))))
124+
;; -> Asm
125+
;; set rax to #t or #f based on given comparison
126+
(define (if-compare c)
127+
(seq (Mov rax (value->bits #f))
128+
(Mov r9 (value->bits #t))
129+
(c rax r9)))
130+
131+
(define (if-equal) (if-compare Cmove))
132+
(define (if-lt) (if-compare Cmovl))
133+
134+
;; Value -> Asm
135+
(define (eq-value v)
136+
(seq (Cmp rax (value->bits v))
137+
(if-equal)))
147138

148139
;; Asm
149140
;; Dynamically pad the stack to be aligned for a call

‎langs/fraud/compile.rkt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@
6868
(let ((l1 (gensym 'if))
6969
(l2 (gensym 'if)))
7070
(seq (compile-e e1 c)
71-
(Cmp rax val-false)
71+
(Cmp rax (value->bits #f))
7272
(Je l1)
7373
(compile-e e2 c)
7474
(Jmp l2)

0 commit comments

Comments
 (0)