blob: 752f250c3d755ec3da0dbcc8beb0ffa8c2eb534d (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
(define-library (csc codegen-test)
(import (scheme base)
(only (csc gensym)
gensym)
(only (csc ir2)
*globals*
make-apply
make-branch
make-closure
make-constant
make-fix
make-label
make-library-ref
make-primitive
make-variable)
(only (csc loop)
loop
return)
(only (csc match)
match)
(only (csc testing)
assert-equal
test)
(csc codegen))
(begin
(define (test-var)
(make-variable (gensym)))
(define (test-label)
(make-label (gensym)))
(test codegen-apply
(define p (test-var))
(assert-equal
'((peek (local 1) (local 0) (const 5))
(mov (local 2) (local 1))
(mov (local 1) (const 10))
(jmp (local 2))
(label 0))
(ir2->ir3
(make-fix '()
(make-primitive 'peek (list *globals* (make-constant 5)) (list p)
(make-apply p (list (make-constant 10))))))))
(test codegen-call-global
(define p (test-var))
(assert-equal
'((peek (local 1) (local 0) (global cons (csc based)))
(mov (local 3) (local 1))
(mov (local 1) (const 5))
(mov (local 2) (const ()))
(jmp (local 3))
(label 0))
(ir2->ir3
(make-fix '()
(make-primitive 'peek (list *globals* (make-library-ref 'cons '(csc based))) (list p)
(make-apply p (list (make-constant 5) (make-constant '()))))))))
(test codegen-call-known
(define f (test-label))
(define ret (test-var))
(assert-equal
'((mov (local 1) (label 1))
(jmp (label 1))
(label 1)
(mov (local 2) (local 1))
(jmp (local 2))
(label 0))
(ir2->ir3
(make-fix
(list (make-closure f (list ret)
(make-apply ret (list ret))))
(make-apply f (list f))))))
(test codegen-permute
(define f (test-label))
(define g (test-label))
(define f1 (test-var))
(define f2 (test-var))
(define g1 (test-var))
(define g2 (test-var))
(define g3 (test-var))
(assert-equal
'((mov (local 1) (const 0))
(mov (local 2) (const 1))
(jmp (label 1))
(label 1)
(mov (local 255) (local 1))
(mov (local 1) (local 2))
(mov (local 2) (local 255))
(mov (local 3) (const 0))
(jmp (label 2))
(label 2)
(mov (local 2) (local 1))
(mov (local 1) (local 3))
(jmp (label 1))
(label 0))
(ir2->ir3
(make-fix
(list (make-closure f (list f1 f2)
(make-apply g (list f2 f1 (make-constant 0))))
(make-closure g (list g1 g2 g3)
(make-apply f (list g3 g1))))
(make-apply f (list (make-constant 0) (make-constant 1)))))))
(test codegen-branch
(define p (test-var))
(assert-equal
'((peek (local 1) (local 0) (const 1))
(jmpif (const #t) (label 1))
(mov (local 2) (local 1))
(mov (local 1) (const 10))
(jmp (local 2))
(label 1)
(mov (local 2) (local 1))
(mov (local 1) (const 5))
(jmp (local 2))
(label 0))
(ir2->ir3
(make-fix '()
(make-primitive 'peek (list *globals* (make-constant 1)) (list p)
(make-branch (make-constant #t)
(make-apply p (list (make-constant 5)))
(make-apply p (list (make-constant 10)))))))))))
|
