blob: d3481a9ca1a56cc7dc443979c67366f884f27f70 (
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
|
(import (scheme base)
(only (csc format)
sprintf)
(only (csc hash-map)
alist->map
hash-bytevector
make-comparer
make-map)
(only (csc list)
all)
(only (csc testing)
assert-equal
test)
(csc linker))
(define compare-globals
(make-comparer
(lambda (x)
(hash-bytevector (string->utf8 (sprintf "{}" x))))
(lambda (x y)
(cond
((equal? x y) 0)
((string<? (sprintf "{}" x) (sprintf "{}" y)) -1)
(else 1)))))
(test link-labels
(assert-equal
'((jmp (const 3))
(jmp (const 2))
(jmp (const 1))
(jmp (const 1)))
(link
'(((label 0)
(jmp (label 1))
(label 1)
(jmp (label 0))
(label init)
(jmp (label 0))))
(make-map compare-globals))))
(test link-labels-are-unique-per-program
(assert-equal
'((jmp (const 2))
(jmp (const 1))
(jmp (const 1))
(jmp (const 5))
(jmp (const 4))
(jmp (const 4)))
(link
'(((label 0)
(jmp (label 0))
(label init)
(jmp (label 0)))
((label 0)
(jmp (label 0))
(label init)
(jmp (label 0))))
(make-map compare-globals))))
(test link-globals
(assert-equal
'((jmp (const 1))
(peek (local 0) (const 10)))
(link
'(((label init)
(peek (local 0) (global cons (csc based)))))
(alist->map compare-globals '(((global cons (csc based)) . 10))))))
|