summaryrefslogtreecommitdiffstats
path: root/tcllib/modules/grammar_me/gasm.tcl
blob: a42fd4041760136b13efa86cea59ab6f9447b235 (plain)
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