annotate keiko/iparse.tcl @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
rev   line source
0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
1 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
2 # iparse.tcl
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
3 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
4 # This file is part of the Oxford Oberon-2 compiler
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
5 # Copyright (c) 2006--2016 J. M. Spivey
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
6 # All rights reserved
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
7 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
8 # Redistribution and use in source and binary forms, with or without
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
9 # modification, are permitted provided that the following conditions are met:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
10 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
11 # 1. Redistributions of source code must retain the above copyright notice,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
12 # this list of conditions and the following disclaimer.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
13 # 2. Redistributions in binary form must reproduce the above copyright notice,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
14 # this list of conditions and the following disclaimer in the documentation
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
15 # and/or other materials provided with the distribution.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
16 # 3. The name of the author may not be used to endorse or promote products
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
17 # derived from this software without specific prior written permission.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
18 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
19 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
20 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
21 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
22 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
23 # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
24 # PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
25 # OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
26 # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
27 # OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
28 # ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
29 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
30
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
31 # PARSER FOR INSTRUCTION SET DEFINITIONS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
32
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
33 # The input is a sequence of calls to TCL routines that are
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
34 # defined here. Instructions for the abstract machine are created by
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
35 # calling the routine 'inst' or one of its variants. Each rule has:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
36 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
37 # * A mnemonic, used in the assembly code output by the compiler.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
38 # * One or more patterns that match arguments of the instruction.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
39 # * A key that specifies the number and types is the operands and
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
40 # the result of the instruction.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
41 # * An action, written as a fragment of C code.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
42 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
43 # Patterns:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
44 # 1/2 Integer (1/2 bytes)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
45 # [lo,hi,step] Integer encoded in opcode
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
46 # R/S Branch displacement (1/2 bytes)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
47 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
48 # A rule may contain a list of patterns, and produces one template for
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
49 # each pattern. A template corresponds to one opcode or (with the
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
50 # form [lo,hi,step]) several opcodes. It's allowed to have more than
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
51 # one rule for the same instruction, with disjoint patterns.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
52 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
53 # A pattern can describe multiple arguments (so the pattern "1R"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
54 # describes two operands, a 1-byte integer and a 1-byte displacement),
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
55 # but this may not be combined with range patterns [lo,hi,step], which
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
56 # must always appear alone.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
57
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
58 # INPUT PROCESSING
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
59
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
60 # syntax -- syntax error message
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
61 proc syntax {msg {n -1}} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
62 error $msg
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
63
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
64 global input lcount status
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
65 if {$n < 0} {set n $lcount}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
66 puts stderr "$input:$n: $msg"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
67 set status 1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
68 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
69
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
70 set ncodes 0; # No. of opcodes used
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
71 set ntempl 0; # No. of templates
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
72 set ndir 0; # No. of directives
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
73 set ninstr 0; # No. of instructions
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
74 set maxargs 0; # Max args of any template
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
75 set status 0; # Exit status
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
76 set instrs {}; set dirs {}; set ops {}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
77 set defs {}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
78
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
79 proc make_inst {inst} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
80 global ninstr instrs instrno templates opcount
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
81
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
82 if {[info exists instrno($inst)]} return
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
83 set n [incr ninstr]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
84 lappend instrs $inst
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
85 set instrno($inst) $n
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
86 set templates($inst) {}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
87 set opcount($inst) 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
88 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
89
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
90 proc make_dir {dir} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
91 global dirs dirno ndir
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
92 set n [incr ndir]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
93 lappend dirs $dir
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
94 set dirno($dir) $n
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
95 set templates($dir) {}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
96 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
97
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
98 proc make_template {inst patt bounds op argbytes} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
99 global templates ntempl maxargs
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
100 if {$argbytes > 0} {set maxargs [max $maxargs [string length $patt]]}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
101 lappend templates($inst) [list $patt $bounds $op $argbytes]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
102 incr ntempl
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
103 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
104
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
105 proc make_macro {op codes} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
106 global macro
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
107 set macro($op) $codes
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
108 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
109
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
110 proc make_action {op base count inst key act argv length} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
111 global ops action
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
112
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
113 lappend ops $op
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
114 set action($op) [list $base $count $length $inst $key $act $argv]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
115 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
116
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
117 proc make_opcode {op inst patt arg len} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
118 global ncodes
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
119 global opcode
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
120 global opcount
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
121
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
122 incr opcount($inst)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
123 set opcode($ncodes) [list $op $inst $patt $arg $len]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
124 incr ncodes
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
125 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
126
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
127 # range_arg -- form expression for argument of action code
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
128 proc range_arg {bounds base} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
129 # The expression is "ir * step + off", where lo = base * step + off.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
130 with $bounds {lo hi step} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
131 set off [expr {$lo - $base * $step}]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
132 set exp "ir"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
133 if {$step != 1} {set exp "$exp*$step"}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
134 if {$off > 0} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
135 set exp "$exp+$off"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
136 } elseif {$off < 0} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
137 set exp "$exp-[expr {-$off}]"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
138 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
139 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
140 return $exp
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
141 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
142
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
143 proc map_args {patt bounds base vargs} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
144 upvar $vargs args
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
145
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
146 set off 1; set args {}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
147 foreach p [split $patt {}] {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
148 switch -glob $p {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
149 N {lappend args [range_arg $bounds $base]}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
150 [1SK] {lappend args "get1(pc0+$off)"; incr off 1}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
151 [2RTL] {lappend args "get2(pc0+$off)"; incr off 2}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
152 default {syntax "Bad pattern code $p"}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
153 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
154 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
155 return [expr {$off - 1}]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
156 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
157
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
158 # process -- process an instruction definition
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
159 proc process {inst patts key action} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
160 global ncodes status
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
161
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
162 if {$patts == "0"} {set patts [list ""]}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
163 make_inst $inst
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
164
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
165 set j 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
166 foreach patt $patts {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
167 if {[regexp {^\[(.*),(.*),(.*)\]} $patt _ lo hi step]} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
168 regsub {^\[.*\]} $patt "N" patt
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
169 if {[llength $patts] == 1} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
170 set op $inst
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
171 } else {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
172 set op "${inst}_x[incr j]"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
173 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
174 } else {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
175 set lo 0; set hi 0; set step 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
176 if {$patt == ""} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
177 set op $inst
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
178 } else {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
179 set op "${inst}_$patt"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
180 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
181 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
182
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
183 if {![regexp {^[12RSTNKL]*$} $patt]} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
184 syntax "Bad pattern $patt"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
185 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
186
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
187 # Compute offsets for the arguments
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
188 set base $ncodes; set n 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
189 set bounds [list $lo $hi $step]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
190 set arglen [map_args $patt $bounds $base args]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
191 set totlen [expr {$arglen+1}]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
192
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
193 for {set arg $lo} {$arg <= $hi} {incr arg [expr {$step>0?$step:1}]} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
194 make_opcode $op $inst $patt $arg $totlen
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
195 incr n
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
196 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
197
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
198 make_template $inst $patt $bounds $op $arglen
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
199 make_action $op $base $n $inst $key $action $args $totlen
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
200 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
201 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
202
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
203 proc defs {text} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
204 global defs
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
205 append defs "$text\n"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
206 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
207
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
208 # Create an instruction
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
209 proc inst {inst patts key act} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
210 process $inst $patts $key $act
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
211 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
212
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
213 # Create a dummy instruction (used for CASE labels)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
214 proc zinst {inst template} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
215 make_inst $inst
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
216 if {$template != "0"} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
217 set arglen [map_args $template none 0 args]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
218 make_template $inst $template {0 0 0} NOP $arglen
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
219 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
220 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
221
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
222 # Create an assembler directive
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
223 proc dir {inst patt} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
224 # A directive
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
225 if {$patt == "0"} {set patt ""}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
226 make_dir $inst
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
227 make_template $inst $patt {0 0 0} $inst -1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
228 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
229
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
230 # Make an instruction equivalent to a sequence of others
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
231 proc equiv {inst patt equiv} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
232 global ncodes status
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
233
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
234 if {$patt == "0"} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
235 set patt ""; set op $inst
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
236 } else {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
237 set op "${inst}_$patt"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
238 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
239
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
240 set arglen [map_args $patt none 0 args]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
241 set codes [map trim [split $equiv ","]]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
242
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
243 make_inst $inst
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
244 make_template $inst $patt {0 0 0} $op $arglen
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
245 make_macro $op $codes
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
246 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
247
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
248 # Provide expansion for use by JIT translator
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
249 proc expand {inst patt equiv} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
250 global expand
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
251 set expand($inst) [map trim [split $equiv ","]]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
252 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
253
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
254 proc readfile {name} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
255 global input opcount
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
256
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
257 set input $name
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
258
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
259 set opcount(ILLEGAL) 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
260 make_opcode ILLEGAL ILLEGAL "" 0 1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
261
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
262 uplevel #0 source $name
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
263 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
264