Skip to content

Commit 44e5e9b

Browse files
dvanhorndvanhorn
committed
Conditional moves for knock and loot.
1 parent 5cbd32f commit 44e5e9b

File tree

6 files changed

+78
-94
lines changed

6 files changed

+78
-94
lines changed

‎langs/knock/compile-ops.rkt‎

Lines changed: 34 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@
1515
;; Op0 -> Asm
1616
(define (compile-op0 p)
1717
(match p
18-
['void (seq (Mov rax val-void))]
18+
['void (seq (Mov rax (value->bits (void))))]
1919
['read-byte (seq pad-stack
2020
(Call 'read_byte)
2121
unpad-stack)]
@@ -28,13 +28,13 @@
2828
(match p
2929
['add1
3030
(seq (assert-integer rax)
31-
(Add rax (imm->bits 1)))]
31+
(Add rax (value->bits 1)))]
3232
['sub1
3333
(seq (assert-integer rax)
34-
(Sub rax (imm->bits 1)))]
34+
(Sub rax (value->bits 1)))]
3535
['zero?
3636
(seq (assert-integer rax)
37-
(eq-imm 0))]
37+
(eq-value 0))]
3838
['char?
3939
(type-pred mask-char type-char)]
4040
['char->integer
@@ -46,14 +46,14 @@
4646
(Sar rax int-shift)
4747
(Sal rax char-shift)
4848
(Xor rax type-char))]
49-
['eof-object? (eq-imm eof)]
49+
['eof-object? (eq-value eof)]
5050
['write-byte
5151
(seq (assert-byte rax)
5252
pad-stack
5353
(Mov rdi rax)
5454
(Call 'write_byte)
5555
unpad-stack
56-
(Mov rax val-void))]
56+
(Mov rax (value->bits (void))))]
5757
['box
5858
(seq (Mov (Offset rbx 0) rax)
5959
(Mov rax rbx)
@@ -71,7 +71,7 @@
7171
(seq (assert-cons rax)
7272
(Xor rax type-cons)
7373
(Mov rax (Offset rax 0)))]
74-
['empty? (eq-imm '())]
74+
['empty? (eq-value '())]
7575
['box?
7676
(type-pred ptr-mask type-box)]
7777
['cons?
@@ -126,21 +126,13 @@
126126
(assert-integer r8)
127127
(assert-integer rax)
128128
(Cmp r8 rax)
129-
(Mov rax val-true)
130-
(let ((true (gensym)))
131-
(seq (Jl true)
132-
(Mov rax val-false)
133-
(Label true))))]
129+
(if-lt))]
134130
['=
135131
(seq (Pop r8)
136132
(assert-integer r8)
137133
(assert-integer rax)
138134
(Cmp r8 rax)
139-
(Mov rax val-true)
140-
(let ((true (gensym)))
141-
(seq (Je true)
142-
(Mov rax val-false)
143-
(Label true))))]
135+
(if-equal))]
144136
['cons
145137
(seq (Mov (Offset rbx 0) rax)
146138
(Pop rax)
@@ -150,7 +142,8 @@
150142
(Add rbx 16))]
151143
['eq?
152144
(seq (Pop r8)
153-
(eq r8 rax))]
145+
(Cmp rax r8)
146+
(if-equal))]
154147
['make-vector
155148
(let ((loop (gensym))
156149
(done (gensym))
@@ -275,7 +268,7 @@
275268
(Sal r10 3)
276269
(Add r8 r10)
277270
(Mov (Offset r8 8) rax)
278-
(Mov rax val-void))]))
271+
(Mov rax (value->bits (void))))]))
279272

280273

281274
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -291,9 +284,9 @@
291284
(let ((l (gensym)))
292285
(seq (And rax mask)
293286
(Cmp rax type)
294-
(Mov rax (imm->bits #t))
287+
(Mov rax (value->bits #t))
295288
(Je l)
296-
(Mov rax (imm->bits #f))
289+
(Mov rax (value->bits #f))
297290
(Label l))))
298291

299292
(define assert-integer
@@ -312,45 +305,43 @@
312305
(define (assert-codepoint r)
313306
(let ((ok (gensym)))
314307
(seq (assert-integer r)
315-
(Cmp r (imm->bits 0))
308+
(Cmp r (value->bits 0))
316309
(Jl 'raise_error_align)
317-
(Cmp r (imm->bits 1114111))
310+
(Cmp r (value->bits 1114111))
318311
(Jg 'raise_error_align)
319-
(Cmp r (imm->bits 55295))
312+
(Cmp r (value->bits 55295))
320313
(Jl ok)
321-
(Cmp r (imm->bits 57344))
314+
(Cmp r (value->bits 57344))
322315
(Jg ok)
323316
(Jmp 'raise_error_align)
324317
(Label ok))))
325318

326319
(define (assert-byte r)
327320
(seq (assert-integer r)
328-
(Cmp r (imm->bits 0))
321+
(Cmp r (value->bits 0))
329322
(Jl 'raise_error_align)
330-
(Cmp r (imm->bits 255))
323+
(Cmp r (value->bits 255))
331324
(Jg 'raise_error_align)))
332325

333326
(define (assert-natural r)
334327
(seq (assert-integer r)
335-
(Cmp r (imm->bits 0))
328+
(Cmp r (value->bits 0))
336329
(Jl 'raise_error_align)))
337330

331+
;; -> Asm
332+
;; set rax to #t or #f based on given comparison
333+
(define (if-compare c)
334+
(seq (Mov rax (value->bits #f))
335+
(Mov r9 (value->bits #t))
336+
(c rax r9)))
337+
338+
(define (if-equal) (if-compare Cmove))
339+
(define (if-lt) (if-compare Cmovl))
340+
338341
;; Value -> Asm
339-
(define (eq-imm imm)
340-
(let ((l1 (gensym)))
341-
(seq (Cmp rax (imm->bits imm))
342-
(Mov rax val-true)
343-
(Je l1)
344-
(Mov rax val-false)
345-
(Label l1))))
346-
347-
(define (eq ir1 ir2)
348-
(let ((l1 (gensym)))
349-
(seq (Cmp ir1 ir2)
350-
(Mov rax val-true)
351-
(Je l1)
352-
(Mov rax val-false)
353-
(Label l1))))
342+
(define (eq-value v)
343+
(seq (Cmp rax (value->bits v))
344+
(if-equal)))
354345

355346
;; Asm
356347
;; Dynamically pad the stack to be aligned for a call

‎langs/knock/compile.rkt‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -72,7 +72,7 @@
7272

7373
;; Value -> Asm
7474
(define (compile-value v)
75-
(seq (Mov rax (imm->bits v))))
75+
(seq (Mov rax (value->bits v))))
7676

7777
;; Id CEnv -> Asm
7878
(define (compile-variable x c)
@@ -235,7 +235,7 @@
235235
(cons x cm))]
236236
[(PLit l)
237237
(let ((fail (gensym)))
238-
(list (seq (Cmp rax (imm->bits l))
238+
(list (seq (Cmp rax (value->bits l))
239239
(Jne fail))
240240
(seq (Label fail)
241241
(Add rsp (* 8 (length cm)))

‎langs/knock/types.rkt‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@
3232
[(= b val-empty) '()]
3333
[else (error "invalid bits")]))
3434

35-
(define (imm->bits v)
35+
(define (value->bits v)
3636
(cond [(eof-object? v) val-eof]
3737
[(integer? v) (arithmetic-shift v int-shift)]
3838
[(char? v)
@@ -41,7 +41,8 @@
4141
[(eq? v #t) val-true]
4242
[(eq? v #f) val-false]
4343
[(void? v) val-void]
44-
[(empty? v) val-empty]))
44+
[(empty? v) val-empty]
45+
[else (error "not an immediate value" v)]))
4546

4647

4748
(define (imm-bits? v)

‎langs/loot/compile-ops.rkt‎

Lines changed: 34 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@
1515
;; Op0 -> Asm
1616
(define (compile-op0 p)
1717
(match p
18-
['void (seq (Mov rax val-void))]
18+
['void (seq (Mov rax (value->bits (void))))]
1919
['read-byte (seq pad-stack
2020
(Call 'read_byte)
2121
unpad-stack)]
@@ -28,13 +28,13 @@
2828
(match p
2929
['add1
3030
(seq (assert-integer rax)
31-
(Add rax (imm->bits 1)))]
31+
(Add rax (value->bits 1)))]
3232
['sub1
3333
(seq (assert-integer rax)
34-
(Sub rax (imm->bits 1)))]
34+
(Sub rax (value->bits 1)))]
3535
['zero?
3636
(seq (assert-integer rax)
37-
(eq-imm 0))]
37+
(eq-value 0))]
3838
['char?
3939
(type-pred mask-char type-char)]
4040
['char->integer
@@ -46,14 +46,14 @@
4646
(Sar rax int-shift)
4747
(Sal rax char-shift)
4848
(Xor rax type-char))]
49-
['eof-object? (eq-imm eof)]
49+
['eof-object? (eq-value eof)]
5050
['write-byte
5151
(seq (assert-byte rax)
5252
pad-stack
5353
(Mov rdi rax)
5454
(Call 'write_byte)
5555
unpad-stack
56-
(Mov rax val-void))]
56+
(Mov rax (value->bits (void))))]
5757
['box
5858
(seq (Mov (Offset rbx 0) rax)
5959
(Mov rax rbx)
@@ -71,7 +71,7 @@
7171
(seq (assert-cons rax)
7272
(Xor rax type-cons)
7373
(Mov rax (Offset rax 0)))]
74-
['empty? (eq-imm '())]
74+
['empty? (eq-value '())]
7575
['box?
7676
(type-pred ptr-mask type-box)]
7777
['cons?
@@ -126,21 +126,13 @@
126126
(assert-integer r8)
127127
(assert-integer rax)
128128
(Cmp r8 rax)
129-
(Mov rax val-true)
130-
(let ((true (gensym)))
131-
(seq (Jl true)
132-
(Mov rax val-false)
133-
(Label true))))]
129+
(if-lt))]
134130
['=
135131
(seq (Pop r8)
136132
(assert-integer r8)
137133
(assert-integer rax)
138134
(Cmp r8 rax)
139-
(Mov rax val-true)
140-
(let ((true (gensym)))
141-
(seq (Je true)
142-
(Mov rax val-false)
143-
(Label true))))]
135+
(if-equal))]
144136
['cons
145137
(seq (Mov (Offset rbx 0) rax)
146138
(Pop rax)
@@ -150,7 +142,8 @@
150142
(Add rbx 16))]
151143
['eq?
152144
(seq (Pop r8)
153-
(eq r8 rax))]
145+
(Cmp rax r8)
146+
(if-equal))]
154147
['make-vector
155148
(let ((loop (gensym))
156149
(done (gensym))
@@ -275,7 +268,7 @@
275268
(Sal r10 3)
276269
(Add r8 r10)
277270
(Mov (Offset r8 8) rax)
278-
(Mov rax val-void))]))
271+
(Mov rax (value->bits (void))))]))
279272

280273

281274
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -291,9 +284,9 @@
291284
(let ((l (gensym)))
292285
(seq (And rax mask)
293286
(Cmp rax type)
294-
(Mov rax (imm->bits #t))
287+
(Mov rax (value->bits #t))
295288
(Je l)
296-
(Mov rax (imm->bits #f))
289+
(Mov rax (value->bits #f))
297290
(Label l))))
298291

299292
(define assert-integer
@@ -314,45 +307,43 @@
314307
(define (assert-codepoint r)
315308
(let ((ok (gensym)))
316309
(seq (assert-integer r)
317-
(Cmp r (imm->bits 0))
310+
(Cmp r (value->bits 0))
318311
(Jl 'raise_error_align)
319-
(Cmp r (imm->bits 1114111))
312+
(Cmp r (value->bits 1114111))
320313
(Jg 'raise_error_align)
321-
(Cmp r (imm->bits 55295))
314+
(Cmp r (value->bits 55295))
322315
(Jl ok)
323-
(Cmp r (imm->bits 57344))
316+
(Cmp r (value->bits 57344))
324317
(Jg ok)
325318
(Jmp 'raise_error_align)
326319
(Label ok))))
327320

328321
(define (assert-byte r)
329322
(seq (assert-integer r)
330-
(Cmp r (imm->bits 0))
323+
(Cmp r (value->bits 0))
331324
(Jl 'raise_error_align)
332-
(Cmp r (imm->bits 255))
325+
(Cmp r (value->bits 255))
333326
(Jg 'raise_error_align)))
334327

335328
(define (assert-natural r)
336329
(seq (assert-integer r)
337-
(Cmp r (imm->bits 0))
330+
(Cmp r (value->bits 0))
338331
(Jl 'raise_error_align)))
339332

333+
;; -> Asm
334+
;; set rax to #t or #f based on given comparison
335+
(define (if-compare c)
336+
(seq (Mov rax (value->bits #f))
337+
(Mov r9 (value->bits #t))
338+
(c rax r9)))
339+
340+
(define (if-equal) (if-compare Cmove))
341+
(define (if-lt) (if-compare Cmovl))
342+
340343
;; Value -> Asm
341-
(define (eq-imm imm)
342-
(let ((l1 (gensym)))
343-
(seq (Cmp rax (imm->bits imm))
344-
(Mov rax val-true)
345-
(Je l1)
346-
(Mov rax val-false)
347-
(Label l1))))
348-
349-
(define (eq ir1 ir2)
350-
(let ((l1 (gensym)))
351-
(seq (Cmp ir1 ir2)
352-
(Mov rax val-true)
353-
(Je l1)
354-
(Mov rax val-false)
355-
(Label l1))))
344+
(define (eq-value v)
345+
(seq (Cmp rax (value->bits v))
346+
(if-equal)))
356347

357348
;; Asm
358349
;; Dynamically pad the stack to be aligned for a call

0 commit comments

Comments
 (0)