tcl_support.tcl
11.5 KB
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
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
#
# Copyright (C) 1996-1998 by the Board of Trustees
# of Leland Stanford Junior University.
#
# This file is part of the SimOS distribution.
# See LICENSE file for terms of the license.
#
#
# tcl-support.tcl
#
# Random tcl functions that are needed by ALL simulations. This should
# be sourced by everyone's init.simos after the path has been setup
# but before everything else.
#
# Tcl checks this variable whenever a procedure can't be found
#
set tcl_interactive 0
#
# We try to source this procedure at login time. It will be overridden
# if you set it after this file.
#
proc loginScript {} { }
#
# Tcl that MUST be run before we do anything else
#
annotation type pc symbol
annotation type pre-pc symbol
annotation type load symbol
annotation type store symbol
annotation type cycle num
annotation type periodic num
annotation type utlb none
## this is machine specific and should be elsewhere. -Jamey 10/1/97
if {$SIMOS(ISA)=="MIPS" || $SIMOS(ISA)=="MIPS32"} {
annotation type exc enum {
intr mod rmiss wmiss rade wade ibe dbe
syscall break ii cpu ov trap vcei fpe
{} {} {} {} {} {} {} watch
{} {} {} {} {} {} {} vced }
}
## Only exception 0 - 18 have names, but valid vectors range up to 255
if {$SIMOS(ISA)=="X86"} {
annotation type exc enum {
divide debug nmi breakpoint INTO BOUND invalid nodevice doublefault
coprocessor invalidtss nosegment stackfault gpf pagefault reserved
fpu alignment check
}
set _tList ""
for {set i 0} {$i <= 255} {incr i} {lappend _tList int$i}
annotation type vec enum $_tList
set _tList ""
for {set i 0} {$i <= 255} {incr i} {lappend _tList int$i}
annotation type int enum $_tList
set _tList ""
for {set i 0} {$i <= 15} {incr i} {lappend _tList irq$i}
annotation type irq enum $_tList
}
annotation type inst enum {rfe}
annotation type simos enum { periodic enter exit sigusr }
annotation type scache enum { instr read write upg sc_upg }
annotation type scsi enum {
testUnitRdy read read6 write write6 inquiry modeSense readcapacity ack }
annotation type commit none
#
# Overridden when you source translate_virtual.tcl
#
proc TclTranslateVirtual {cpunum vaddr} {return 0}
################################################################
# Random nice functions.
################################################################
proc hex {num} {
format "0x%x" $num
}
proc trackProcedure {name} {
set tempCPU {$CPU}
set tempA0 {[hex $a0]}
set tempRA {[hex $ra]}
set tempV0 {[hex $v0]}
set space {" "}
set newline {"\n"}
annotation set pc kernel::$name:START "console --> $space $name $space CPU $space $tempCPU $space a0 $space $tempA0 $space ra $space $tempRA $newline"
annotation set pc kernel::$name:END "console <-- $space $name $space CPU $space $tempCPU $space v0 $space $tempV0 $newline"
}
if {$SIMOS(ISA) != "ALPHA"} {
proc causeName {} {
global cause
set bits [expr ($cause >> 2) & 0x1f]
set names {Int Mod LBL TLBS AdEL AdES IBE DBE Sys Bp RI CpU Ov Tr UNDEF FPE}
return [lindex $names $bits]
}
proc dumpRegs {} {
global zero at v0 v1 a0 a1 a2 a3
global t0 t1 t2 t3 t4 t5 t6 t7
global s0 s1 s2 s3 s4 s5 s6 s7
global t8 t9 k0 k1 gp sp fp ra
global pc cause bad hi lo fcrcs fcrir indx
global rand tlblo cntx tlbhi sr epc prid
set str ""
set str [format "$str%-19s" "zero = $zero"]
set str [format "$str%-19s" "at = $at"]
set str [format "$str%-19s" "v0 = $v0"]
set str [format "$str%-19s\n" "v1 = $v1"]
set str [format "$str%-19s" "a0 = $a0"]
set str [format "$str%-19s" "a1 = $a1"]
set str [format "$str%-19s" "a2 = $a2"]
set str [format "$str%-19s\n" "a3 = $a3"]
set str [format "$str%-19s" "t0 = $t0"]
set str [format "$str%-19s" "t1 = $t1"]
set str [format "$str%-19s" "t2 = $t2"]
set str [format "$str%-19s\n" "t3 = $t3"]
set str [format "$str%-19s" "t4 = $t4"]
set str [format "$str%-19s" "t5 = $t5"]
set str [format "$str%-19s" "t6 = $t6"]
set str [format "$str%-19s\n" "t7 = $t7"]
set str [format "$str%-19s" "t8 = $t8"]
set str [format "$str%-19s\n" "t9 = $t9"]
set str [format "$str%-19s" "s0 = $s0"]
set str [format "$str%-19s" "s1 = $s1"]
set str [format "$str%-19s" "s2 = $s2"]
set str [format "$str%-19s\n" "s3 = $s3"]
set str [format "$str%-19s" "s4 = $s4"]
set str [format "$str%-19s" "s5 = $s5"]
set str [format "$str%-19s" "s6 = $s6"]
set str [format "$str%-19s\n" "s7 = $s7"]
set str [format "$str%-19s" "k0 = $k0"]
set str [format "$str%-19s\n" "k1 = $k1"]
set str [format "$str%-19s" "gp = $gp"]
set str [format "$str%-19s" "sp = $sp"]
set str [format "$str%-19s" "fp = $fp"]
set str [format "$str%-19s\n" "ra = $ra"]
set str [format "$str%-19s" "pc = $pc"]
set str [format "$str%-19s" "cause = $cause"]
set str [format "$str%-19s" "bad = $bad"]
set str [format "$str%-19s\n" "epc = $epc"]
set str [format "$str%-19s" "tlbhi = $tlbhi"]
set str [format "$str%-19s" "tlblo = $tlblo"]
set str [format "$str%-19s" "cntx = $cntx"]
set str [format "$str%-19s\n" "sr = $sr"]
set str [format "$str%-19s" "hi = $hi"]
set str [format "$str%-19s" "lo = $lo"]
set str [format "$str%-19s" "fcrcs = $fcrcs"]
set str [format "$str%-19s\n" "fcrir = $fcrir"]
set str [format "$str%-19s" "rand = $rand"]
set str [format "$str%-19s" "prid = $prid"]
set str [format "$str%-19s\n" "indx = $indx"]
return $str
}
set dynMode(0) "C"
set dynMode(1) "N"
set dynMode(2) "R"
set dynMode(3) "P"
proc decodeFPCR {fpcr} {
global dynMode
set sum [expr $fpcr >> 63]
set ined [expr ($fpcr >> 62) & 1]
set unfd [expr ($fpcr >> 61) & 1]
set undz [expr ($fpcr >> 60) & 1]
set dyn [expr ($fpcr >> 58) & 3]
set iov [expr ($fpcr >> 57) & 1]
set ine [expr ($fpcr >> 56) & 1]
set unf [expr ($fpcr >> 55) & 1]
set ovf [expr ($fpcr >> 54) & 1]
set dze [expr ($fpcr >> 53) & 1]
set inv [expr ($fpcr >> 52) & 1]
set ovfd [expr ($fpcr >> 51) & 1]
set dzed [expr ($fpcr >> 50) & 1]
set invd [expr ($fpcr >> 49) & 1]
set res ""
if {$sum} {append res "S"} else {append res "s"}
append res ":"
if {$ined} {append res "N"} # else {append res "n"}
if {$unfd} {append res "U"} # else {append res "u"}
if {$undz} {append res "0"} # else {append res ""}
if {$ovfd} {append res "V"} # else {append res "v"}
if {$dzed} {append res "Z"} # else {append res "z"}
if {$invd} {append res "I"} # else {append res "i"}
append res ":" $dynMode($dyn) ":"
if {$iov} {append res "O"} # else {append res "o"}
if {$ine} {append res "N"} # else {append res "N"}
if {$unf} {append res "U"} # else {append res "u"}
if {$ovf} {append res "V"} # else {append res "v"}
if {$dze} {append res "Z"} # else {append res "Z"}
if {$inv} {append res "I"} # else {append res "i"}
return $res
}
} else {
proc dumpRegs {} {
global v0 t0 t1 t2 t3 t4 t5 t6
global t7 s0 s1 s2 s3 s4 s5 fp
global a0 a1 a2 a3 a4 a5 t8 t9
global t10 t11 ra t12 at gp sp zero
global f0 f1 f2 f3 f4 f5 f6 f7
global f8 f9 f10 f11 f12 f13 f14 f15
global f16 f17 f18 f19 f20 f21 f22 f23
global f24 f25 f26 f27 f28 f29 f30 f31
global pc
global shadowT7 shadowS0 shadowS1 shadowS2 shadowS3 shadowS4 shadowS5 shadowT11
global printfp
set str ""
set str [format "$str %-19s" "v0=$v0"]
set str [format "$str %-19s" "t0=$t0"]
set str [format "$str %-19s" "t1=$t1"]
set str [format "$str %-19s\n" "t2=$t2"]
set str [format "$str %-19s" "t3=$t3"]
set str [format "$str %-19s" "t4=$t4"]
set str [format "$str %-19s" "t5=$t5"]
set str [format "$str %-19s\n" "t6=$t6"]
set str [format "$str %-19s" "t7=$t7"]
set str [format "$str %-19s" "s0=$s0"]
set str [format "$str %-19s" "s1=$s1"]
set str [format "$str %-19s\n" "s2=$s2"]
set str [format "$str %-19s" "s3=$s3"]
set str [format "$str %-19s" "s4=$s4"]
set str [format "$str %-19s" "s5=$s5"]
set str [format "$str %-19s\n" "fp=$fp"]
set str [format "$str %-19s" "a0=$a0"]
set str [format "$str %-19s" "a1=$a1"]
set str [format "$str %-19s" "a2=$a2"]
set str [format "$str %-19s\n" "a3=$a3"]
set str [format "$str %-19s" "a4=$a4"]
set str [format "$str %-19s" "a5=$a5"]
set str [format "$str %-19s" "t8=$t8"]
set str [format "$str %-19s\n" "t9=$t9"]
set str [format "$str %-19s" "t10=$t10"]
set str [format "$str %-19s" "t11=$t11"]
set str [format "$str %-19s" "ra=$ra"]
set str [format "$str %-19s\n" "t12=$t12"]
set str [format "$str %-19s" "at=$at"]
set str [format "$str %-19s" "gp=$gp"]
set str [format "$str %-19s\n" "sp=$sp"]
# if {0} [
# set str [format "$str %-19s" "f0=$f0"]
# set str [format "$str %-19s" "f1=$f1"]
# set str [format "$str %-19s" "f2=$f2"]
# set str [format "$str %-19s\n" "f3=$f3"]
# set str [format "$str %-19s" "f4=$f4"]
# set str [format "$str %-19s" "f5=$f5"]
# set str [format "$str %-19s" "f6=$f6"]
# set str [format "$str %-19s\n" "f7=$f7"]
# set str [format "$str %-19s" "f8=$f8"]
# set str [format "$str %-19s" "f9=$f9"]
# set str [format "$str %-19s" "f10=$f10"]
# set str [format "$str %-19s\n" "f11=$f11"]
# set str [format "$str %-19s" "f12=$f12"]
# set str [format "$str %-19s" "f13=$f13"]
# set str [format "$str %-19s" "f14=$f14"]
# set str [format "$str %-19s\n" "f15=$f15"]
# set str [format "$str %-19s" "f16=$f16"]
# set str [format "$str %-19s" "f17=$f17"]
# set str [format "$str %-19s" "f18=$f18"]
# set str [format "$str %-19s\n" "f19=$f19"]
# set str [format "$str %-19s" "f20=$f20"]
# set str [format "$str %-19s" "f21=$f21"]
# set str [format "$str %-19s" "f22=$f22"]
# set str [format "$str %-19s\n" "f23=$f23"]
# set str [format "$str %-19s" "f24=$f24"]
# set str [format "$str %-19s" "f25=$f25"]
# set str [format "$str %-19s" "f26=$f26"]
# set str [format "$str %-19s\n" "f27=$f27"]
# set str [format "$str %-19s" "f28=$f28"]
# set str [format "$str %-19s" "f29=$f29"]
# set str [format "$str %-19s" "f30=$f30"]
# set str [format "$str %-19s\n" "f31=0"]
# ]
set str [format "$str %-19s" "sT7=$shadowT7"]
set str [format "$str %-19s" "sS0=$shadowS0"]
set str [format "$str %-19s" "sS1=$shadowS1"]
set str [format "$str %-19s\n" "sS2=$shadowS2"]
set str [format "$str %-19s" "sS3=$shadowS3"]
set str [format "$str %-19s" "sS4=$shadowS4"]
set str [format "$str %-19s" "sS5=$shadowS5"]
set str [format "$str %-19s\n" "sT11=$shadowT11"]
set str [format "$str %-19s\n" "pc=$pc"]
return $str
}
}
################################################################
# sourced files utilities
################################################################
proc FileSourced { name } {
global filesSourced
if [info exists filesSourced($name)] {
console "@@@@ file $name sourced twice!!! \n"
assert
}
set filesSourced($name) 1
console "@@@@ sourcing $name \n"
}
################################################################
# SimOS sound system
################################################################
proc play {file} {
global env
if {$SIMOS(HostOS) == "IRIX"} {
set error [ catch {
exec rsh [lindex [split $env(DISPLAY) :] 0] /usr/sbin/sfplay $file
} msg ]
} else {
set error yes
}
if {$error} {
console "FAILED PLAY: $file\n"
}
}
proc speak {phrase} {
global env SIMOS
if {$SIMOS(HostOS) == "IRIX"} {
set error [ catch {
exec rsh [lindex [split $env(DISPLAY) :] 0] /usr/local/bin/speak $phrase
} msg ]
} else {
set error yes
}
if {$error} {
console "FAILED SPEAK: $phrase\n"
}
}