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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
# -*- tcl -*-
# ### ### ### ######### ######### #########
## Package description
## (struct::)Graph based ME Assembler, for use in grammar
## translations.
# ### ### ### ######### ######### #########
## Requisites
namespace eval grammar::me::cpu::gasm {}
# ### ### ### ######### ######### #########
## Implementation
proc ::grammar::me::cpu::gasm::begin {g n {mode okfail} {note {}}} {
variable gas
array unset gas *
# (Re)initialize the assmebler state, create the framework nodes
# upon which we will hang all instructions on.
set gas(mode) $mode
set gas(node) $n
set gas(grap) $g
array set gas {last {} cond always}
Nop $note ; /Label entry ; /Clear
if {$mode eq "okfail"} {
Nop Exit'OK ; /Label exit/ok ; /Clear
Nop Exit'FAIL ; /Label exit/fail ; /Clear
} elseif {$mode eq "halt"} {
Cmd icf_halt ; /Label exit/return ; /Clear
} else {
Cmd icf_ntreturn ; /Label exit/return ; /Clear
}
/At entry
return
}
proc ::grammar::me::cpu::gasm::done {__ t} {
variable gas
# Save the framework nodes in a grammar tree and shut the
# assembler down.
$t set $gas(node) gas::entry $gas(_entry)
if {$gas(mode) eq "okfail"} {
$t set $gas(node) gas::exit::ok $gas(_exit/ok)
$t set $gas(node) gas::exit::fail $gas(_exit/fail)
} else {
$t set $gas(node) gas::exit $gas(_exit/return)
}
# Remember the node in the grammar tree which is responsible for
# this entry point.
$gas(grap) node set $gas(_entry) expr $gas(node)
array unset gas *
return
}
proc ::grammar::me::cpu::gasm::lift {t dst __ src} {
$t set $dst gas::entry [$t get $src gas::entry]
$t set $dst gas::exit::ok [$t get $src gas::exit::ok]
$t set $dst gas::exit::fail [$t get $src gas::exit::fail]
return
}
proc ::grammar::me::cpu::gasm::state {} {
variable gas
return [array get gas]
}
proc ::grammar::me::cpu::gasm::state! {s} {
variable gas
array set gas $s
}
proc ::grammar::me::cpu::gasm::Inline {t node label} {
variable gas
set gas(_${label}/entry) [$t get $node gas::entry]
set gas(_${label}/exit/ok) [$t get $node gas::exit::ok]
set gas(_${label}/exit/fail) [$t get $node gas::exit::fail]
__Link $gas(_${label}/entry) $gas(cond)
/At ${label}/exit/ok
return
}
proc ::grammar::me::cpu::gasm::Cmd {cmd args} {
variable gas
# Add a new instruction, and link it to the anchor. The created
# instruction becomes the new anchor.
upvar 0 gas(grap) g gas(last) anchor gas(cond) cond
set node [$g node insert]
$g node set $node instruction $cmd
$g node set $node arguments $args
if {$anchor ne ""} {__Link $node $cond}
set anchor $node
set cond always
return
}
proc ::grammar::me::cpu::gasm::Bra {} {
Cmd .BRA
}
proc ::grammar::me::cpu::gasm::Nop {{text {}}} {
Cmd .NOP $text
}
proc ::grammar::me::cpu::gasm::Note {text} {
Cmd .C $text
}
proc ::grammar::me::cpu::gasm::Jmp {label} {
variable gas
__Link $gas(_$label) $gas(cond)
return
}
proc ::grammar::me::cpu::gasm::Exit {} {
variable gas
if {$gas(mode) eq "okfail"} {
__Link $gas(_exit/$gas(cond)) $gas(cond)
} else {
__Link $gas(_exit/return) always
}
return
}
proc ::grammar::me::cpu::gasm::Who {label} {
variable gas
return $gas(_$label)
}
proc ::grammar::me::cpu::gasm::__Link {to cond} {
variable gas
upvar 0 gas(grap) g gas(last) anchor
set arc [$g arc insert $anchor $to]
$g arc set $arc condition $cond
return
}
proc ::grammar::me::cpu::gasm::/Label {name} {
variable gas
set gas(_$name) $gas(last)
return
}
proc ::grammar::me::cpu::gasm::/Clear {} {
variable gas
set gas(last) {}
set gas(cond) always
return
}
proc ::grammar::me::cpu::gasm::/Ok {} {
variable gas
set gas(cond) ok
return
}
proc ::grammar::me::cpu::gasm::/Fail {} {
variable gas
set gas(cond) fail
return
}
proc ::grammar::me::cpu::gasm::/At {name} {
variable gas
set gas(last) $gas(_$name)
set gas(cond) always
return
}
proc ::grammar::me::cpu::gasm::/CloseLoop {} {
variable gas
$gas(grap) node set $gas(last) LOOP .
return
}
# ### ### ### ######### ######### #########
## Interfacing
namespace eval grammar::me::cpu::gasm {
namespace export begin done lift state state!
namespace export Inline Cmd Bra Nop Note Jmp Exit Who
namespace export /Label /Clear /Ok /Fail /At /CloseLoop
}
# ### ### ### ######### ######### #########
## Ready
package provide grammar::me::cpu::gasm 0.1
|
