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
|
module test
import StdEnv
import ABC.Machine
import ABC.Code
Start = toString end.io
where
(prog,descs) = assemble length
state = boot (prog,descs)
end = fetch_cycle state
ints :: Assembler
ints
= [ Label "+I1"
, PushI_a 0
, PushI_a 1
, AddI
, Pop_a 1
, FillI_b 0 0
, Pop_b 1
, Rtn
]
list :: Assembler
list
= [ Descriptor "Cons" "_rnf" 2 "Cons"
, Descriptor "Nil" "_rnf" 0 "Nil"
]
length :: Assembler // p. 87-88
length
= rts ++
list ++
ints ++
[ Descriptor "Length" "a_Length" 2 "Length"
, Label "n_Length"
, SetEntry "_cycle" 0
, PushArgs 0 2 2
, Label "a_Length"
, Push_a 1
, JsrEval
, Pop_a 1
, Label "Length1"
, EqDescArity "Cons" 2 1
, JmpFalse "Length2"
, PushArgs 1 2 2
, Push_a 1
, JsrEval
, Create
, FillI 1 0
, Push_a 4
, Jsr "+I1"
, Update_a 1 5
, Update_a 0 4
, Pop_a 4
, Jmp "Length1"
, Label "Length2"
, EqDescArity "Nil" 0 1
, JmpFalse "Length3"
, Fill_a 0 2
, Pop_a 2
, Rtn
, Label "Length3"
, Jmp "_type_error"
, Descriptor "Start" "n_Start" 0 "Start"
, Label "n_Start"
, Create
, Create
, Create
, Create
, Fill "Nil" 0 "_rnf" 1
, FillI 5 0
, Fill "Cons" 2 "_rnf" 2
, Create
, FillI 3 0
, Fill "Cons" 2 "_rnf" 2
, Create
] ++ show_list ++
[ JsrEval
, Rtn
]
where
show_length
= [ FillI 0 0
, Fill "Length" 2 "n_Length" 2
]
show_list
= [ FillI 2 0
, Fill "Cons" 2 "_rnf" 2
]
|
