1 | #!/bin/sh |
---|
2 | # The next line restarts using expectk \ |
---|
3 | exec expectk "$0" "$@" |
---|
4 | |
---|
5 | #*********** |
---|
6 | # The comments with the code here are meant to address the details of the |
---|
7 | # code itself, not the functionality of XsimView. Refer to the XsimView's |
---|
8 | # man page for a discussion of functionality. |
---|
9 | # |
---|
10 | # The overall algorithm of XsimView is described at the bottom of the code |
---|
11 | # below where the "main" of XsimView is given. The anciliary procedures |
---|
12 | # are desribed in turn below. |
---|
13 | #----------- |
---|
14 | |
---|
15 | |
---|
16 | #********** |
---|
17 | # source fileSelect.src |
---|
18 | # |
---|
19 | # why: fileSelect provides the ability to save files. Here, it |
---|
20 | # is used to allow the user to select a filename so that in.simv, |
---|
21 | # the temporary file used for output, can be saved to whatever |
---|
22 | # name they desire. |
---|
23 | |
---|
24 | # All from fileSelect.src |
---|
25 | # Begins the file loading process. Can take one argument, fileName |
---|
26 | # which would specify the file being loaded, in which case, |
---|
27 | # fileSelect process is skipped and the file is directly loaded. |
---|
28 | proc loadFile {{file {}} {type {}}} { |
---|
29 | global globals |
---|
30 | set globals(optList) {} |
---|
31 | # if file is empty, ask user for new file, if still empty, exit |
---|
32 | # since they must have hit cancel or something else went wrong |
---|
33 | if {$file == {}} {set file [fileSelect Load]} |
---|
34 | if {$file == {}} {return} |
---|
35 | |
---|
36 | # if type is nil, then |
---|
37 | # find the final letters after last . to get file type |
---|
38 | if {$type == {}} { |
---|
39 | set type [string range [file extension $file] 1 end] |
---|
40 | } |
---|
41 | if {$globals(options)} { |
---|
42 | switch -- $type { |
---|
43 | mv {set globals(optList) \ |
---|
44 | [optionRead $globals(read_blif_mvOptions)]} |
---|
45 | blif {set globals(optList) \ |
---|
46 | [optionRead $globals(read_blifOptions)]} |
---|
47 | vl {set globals(optList) \ |
---|
48 | [optionRead $globals(read_verilogOptions)]} |
---|
49 | fair {set globals(optList) \ |
---|
50 | [optionRead $globals(read_fairnessOptions)]} |
---|
51 | ctl {set globals(optList) \ |
---|
52 | [optionRead $globals(model_checkOptions)]} |
---|
53 | } |
---|
54 | } |
---|
55 | switch -- $type { |
---|
56 | mv {Send "rlmv $globals(optList) $file"} |
---|
57 | blif {Send "read_blif $file"} |
---|
58 | vl {Send "read_verilog $file"} |
---|
59 | fair {Send "read_fairness $file"} |
---|
60 | ctl {Send "model_check $file"} |
---|
61 | default {loadFile "$file [giveFileType $file]"} |
---|
62 | } |
---|
63 | } |
---|
64 | |
---|
65 | proc writeFile {{file {}} {type {}}} { |
---|
66 | global globals |
---|
67 | set globals(optList) {} |
---|
68 | # if file is empty, ask user for filename to write to. |
---|
69 | # If still empty, then they must have hit cancel or something |
---|
70 | if {$file == {}} {set file [fileSelect Write]} |
---|
71 | if {$file == {}} {return} |
---|
72 | |
---|
73 | # find the final letters after last . to get file type |
---|
74 | set type [string range [file extension $file] 1 end] |
---|
75 | if {$globals(options)} { |
---|
76 | switch -- $type { |
---|
77 | mv {set globals(optList) \ |
---|
78 | [optionRead $globals(write_blif_mvOptions)]} |
---|
79 | blif {set globals(optList) \ |
---|
80 | [optionRead $globals(austin_write_blifOptions)]} |
---|
81 | } |
---|
82 | } |
---|
83 | switch -- $type { |
---|
84 | mv {Send "write_blif_mv $globals(optList) $file"} |
---|
85 | blif {Send "austin_write_blif $globals(optList) $file"} |
---|
86 | default {writeFile "$file.[giveFileType $file]"} |
---|
87 | } |
---|
88 | } |
---|
89 | |
---|
90 | proc giveFileType {file} { |
---|
91 | global temp globals |
---|
92 | toplevel .q |
---|
93 | set gFTDone 0 |
---|
94 | |
---|
95 | wm title .q "What type of file?" |
---|
96 | set short [string range $file [expr [string last / $file] + 1] end] |
---|
97 | message .q.msg -text "What type is $short ?" |
---|
98 | pack .q.msg -side top |
---|
99 | bind .q <Return> {set gFTDone 1} |
---|
100 | |
---|
101 | # Set up radio buttons for type of file to load |
---|
102 | frame .q.radio |
---|
103 | foreach type {{blif blif} {blif_mv mv} {verilog vl} {fairness fair}} { |
---|
104 | radiobutton .q.radio.[lindex $type 1] -variable temp \ |
---|
105 | -text [lindex $type 0] -value [lindex $type 1] |
---|
106 | pack .q.radio.[lindex $type 1] -side top |
---|
107 | } |
---|
108 | pack .q.radio -side top |
---|
109 | |
---|
110 | # Create the OK button |
---|
111 | # The OK button has a rim to indicate it is the default |
---|
112 | frame .q.button -bd 10 |
---|
113 | frame .q.button.ok -bd 2 -relief sunken |
---|
114 | button .q.button.ok.b -text OK -command {set gFTDone 1} |
---|
115 | pack .q.button.ok.b |
---|
116 | pack .q.button.ok -side top |
---|
117 | pack .q.button -side top |
---|
118 | |
---|
119 | tkwait variable gFTDone |
---|
120 | destroy .q |
---|
121 | return $temp |
---|
122 | } |
---|
123 | |
---|
124 | proc fileSelect {why {default {}}} { |
---|
125 | global fileSelect globals |
---|
126 | set globals(options) 0 |
---|
127 | set fileSelect(why) $why |
---|
128 | catch {destroy .fileSelect} |
---|
129 | set t [toplevel .fileSelect -bd 4] |
---|
130 | |
---|
131 | wm title $t $why |
---|
132 | message $t.msg -aspect 1000 -text $why |
---|
133 | pack $t.msg -side top -fill x |
---|
134 | |
---|
135 | # Create a read_only entry for the current pwd |
---|
136 | set fileSelect(dirEnt) [entry $t.dir -width 15 \ |
---|
137 | -relief flat -state disabled] |
---|
138 | pack $t.dir -side top -fill x |
---|
139 | |
---|
140 | # Create an entry for the pathname |
---|
141 | # The value is kept in the fileSelect(path) |
---|
142 | frame $t.top |
---|
143 | label $t.top.l -text "File:" -padx 0 |
---|
144 | set e [entry $t.top.path -relief sunken -textvariable fileSelect(path)] |
---|
145 | pack $t.top -side top -fill x |
---|
146 | pack $t.top.l -side left |
---|
147 | pack $t.top.path -side right -fill x -expand true |
---|
148 | set fileSelect(pathEnt) $e |
---|
149 | |
---|
150 | # Use $e to set up bindings for entry widget |
---|
151 | bind $e <Return> fileSelectOK |
---|
152 | bind $e <Control-c> fileSelectCancel |
---|
153 | bind $e <space> fileSelectComplete |
---|
154 | focus $e |
---|
155 | |
---|
156 | # Create a listbox to hold the directory contents |
---|
157 | listbox $t.list -yscrollcommand [list $t.scroll set] |
---|
158 | scrollbar $t.scroll -command [list $t.list yview] |
---|
159 | # A single click copies the name into the entry |
---|
160 | # A double-click selects the name |
---|
161 | bind $t.list <Button-1> {fileSelectClick %y} |
---|
162 | bind $t.list <Double-Button-1> { |
---|
163 | fileSelectClick %y; |
---|
164 | fileSelectOK |
---|
165 | } |
---|
166 | |
---|
167 | # Create the OK and cancel buttons and options button |
---|
168 | # The OK button has a rim to indicate it is the default |
---|
169 | frame $t.buttons -bd 10 |
---|
170 | frame $t.buttons.ok -bd 2 -relief sunken |
---|
171 | button $t.buttons.ok.b -text OK -command fileSelectOK |
---|
172 | button $t.buttons.cancel -text Cancel -command fileSelectCancel |
---|
173 | checkbutton $t.buttons.options -text "Choose Options" \ |
---|
174 | -variable globals(options) |
---|
175 | |
---|
176 | # Pack the list, scrollbar and button box |
---|
177 | # in a horizontal stack below the upper widgets |
---|
178 | pack $t.list -side left -fill both -expand true |
---|
179 | pack $t.scroll -side left -fill both |
---|
180 | pack $t.buttons -side left -fill both |
---|
181 | pack $t.buttons.ok $t.buttons.cancel $t.buttons.options -side top \ |
---|
182 | -padx 10 -pady 5 |
---|
183 | pack $t.buttons.ok.b -padx 4 -pady 4 |
---|
184 | |
---|
185 | # Initialize variables in the directory |
---|
186 | set fileSelect(path) {} |
---|
187 | set dir [pwd] |
---|
188 | |
---|
189 | set fileSelect(dir) {} |
---|
190 | set fileSelect(done) 0 |
---|
191 | |
---|
192 | # Wait for the listbox to be visible so we |
---|
193 | # can provide feedback during the listing |
---|
194 | tkwait visibility .fileSelect.list |
---|
195 | fileSelectList $dir |
---|
196 | |
---|
197 | tkwait variable fileSelect(done) |
---|
198 | destroy .fileSelect |
---|
199 | return $fileSelect(path) |
---|
200 | } |
---|
201 | |
---|
202 | # Creates the list of dirs and files to put into the listbox, if not given |
---|
203 | proc fileSelectList { dir {files {}} } { |
---|
204 | global fileSelect |
---|
205 | |
---|
206 | # Update the directory |
---|
207 | set e $fileSelect(dirEnt) |
---|
208 | $e config -state normal |
---|
209 | $e delete 0 end |
---|
210 | $e insert 0 $dir |
---|
211 | $e config -state disabled |
---|
212 | |
---|
213 | # Give the user some feedback |
---|
214 | set fileSelect(dir) $dir |
---|
215 | .fileSelect.list delete 0 end |
---|
216 | .fileSelect.list insert 0 Listing... |
---|
217 | |
---|
218 | .fileSelect.list delete 0 |
---|
219 | # If files is undefined, then match all files in current dir |
---|
220 | if {[string length $files] == 0} { |
---|
221 | # List the directory and add an entry for the parent dir. |
---|
222 | set files [glob -nocomplain $fileSelect(dir)/*] |
---|
223 | .fileSelect.list insert end ../ |
---|
224 | } |
---|
225 | |
---|
226 | # Take files, and sort all dirs to front |
---|
227 | set dirs {} |
---|
228 | set others {} |
---|
229 | foreach f [lsort $files] { |
---|
230 | if [file isdirectory $f] { |
---|
231 | lappend dirs [file tail $f]/ |
---|
232 | } else { |
---|
233 | lappend others [file tail $f] |
---|
234 | } |
---|
235 | } |
---|
236 | |
---|
237 | # Insert all dirs and files into the listbox |
---|
238 | foreach f [concat $dirs $others] { |
---|
239 | .fileSelect.list insert end $f |
---|
240 | } |
---|
241 | } |
---|
242 | |
---|
243 | |
---|
244 | # Checks files specified, and whether or not to return a value, or |
---|
245 | # make a new listbox. Basically, first check if command is to go to |
---|
246 | # parent directory. If not, check if fileSelect(path) is a directory. |
---|
247 | # If so, create new list. If not, check if is a file. If so, return |
---|
248 | # the file, else, try some magic to go somewhere else. (also known |
---|
249 | # as file name completion. |
---|
250 | proc fileSelectOK {} { |
---|
251 | global fileSelect |
---|
252 | |
---|
253 | # Handle the special case of the parent directory |
---|
254 | if {[regexp {\.\./} $fileSelect(path)]} { |
---|
255 | set fileSelect(path) {} |
---|
256 | fileSelectList [file dirname $fileSelect(dir)] |
---|
257 | return |
---|
258 | } |
---|
259 | |
---|
260 | # create a full path from fileSelect(dir) and fileSelect(path) |
---|
261 | set path $fileSelect(dir)/$fileSelect(path) |
---|
262 | if [file isdirectory $path] { |
---|
263 | set fileSelect(path) {} |
---|
264 | fileSelectList $path |
---|
265 | return |
---|
266 | } |
---|
267 | if [file exists $path] { |
---|
268 | set fileSelect(path) $path |
---|
269 | set fileSelect(done) 1 |
---|
270 | return |
---|
271 | } |
---|
272 | |
---|
273 | # Neither a file nor a directory |
---|
274 | # See if a glob will find something |
---|
275 | # catch returns true if something goes wrong |
---|
276 | if [catch {glob $path} files] { |
---|
277 | # Okay, maybe they typed in a new absolute pathname and we |
---|
278 | # should try fileSelect(path) as the ENTIRE path name |
---|
279 | if [catch {glob $fileSelect(path)} path] { |
---|
280 | # Okay, nothing there, if we're writing, then accept as |
---|
281 | # as new filename, else try filename completion. |
---|
282 | if {[string match $fileSelect(why) Write]} { |
---|
283 | set fileSelect(done) 1 |
---|
284 | return |
---|
285 | } else { |
---|
286 | # Try file name completion |
---|
287 | fileSelectComplete |
---|
288 | return |
---|
289 | } |
---|
290 | } else { |
---|
291 | # OK - there are files there, so let's reassign the dir and path |
---|
292 | set fileSelect(dir) [file dirname $fileSelect(path)] |
---|
293 | set fileSelect(path) [file tail $fileSelect(path)] |
---|
294 | fileSelectOK |
---|
295 | return |
---|
296 | } |
---|
297 | } else { |
---|
298 | # Current directory has stuff in it, catch returned no error |
---|
299 | # Ok - current directory is ok, select file or list 'em. |
---|
300 | if {[llength [split $files]] == 1} { |
---|
301 | set fileSelect(path) $files |
---|
302 | fileSelectOK |
---|
303 | } else { |
---|
304 | set fileSelect(dir) [file dirname [lindex $files 0]] |
---|
305 | fileSelectList $fileSelect(dir) $files |
---|
306 | } |
---|
307 | } |
---|
308 | } |
---|
309 | |
---|
310 | # Quits out of fileSelection and moves on. |
---|
311 | proc fileSelectCancel {} { |
---|
312 | global fileSelect |
---|
313 | set fileSelect(done) 1 |
---|
314 | set fileSelect(path) {} |
---|
315 | } |
---|
316 | |
---|
317 | # Find the file the user clicked on. |
---|
318 | proc fileSelectClick { y } { |
---|
319 | # Take the item the user clicked on |
---|
320 | global fileSelect |
---|
321 | set l .fileSelect.list |
---|
322 | set fileSelect(path) [$l get [$l nearest $y]] |
---|
323 | focus $fileSelect(pathEnt) |
---|
324 | } |
---|
325 | |
---|
326 | # Big nasty routine to do file name completion |
---|
327 | proc fileSelectComplete {} { |
---|
328 | global fileSelect |
---|
329 | |
---|
330 | # Do name completion, Nuke something. |
---|
331 | set fileSelect(path) [string trim $fileSelect(path) \t\ ] |
---|
332 | |
---|
333 | # Figure out what directory we are looking at, |
---|
334 | # dir is directory, tail is partial name |
---|
335 | if {[string match /* $fileSelect(path)]} { |
---|
336 | set dir [file dirname $fileSelect(path)] |
---|
337 | set tail [file tail $fileSelect(path)] |
---|
338 | } elseif [string match ~* $fileSelect(path)] { |
---|
339 | if [catch {file dirname $fileSelect(path)} dir] { |
---|
340 | return; # Bad user |
---|
341 | } |
---|
342 | set tail [file tail $fileSelect(path)] |
---|
343 | } else { |
---|
344 | set path $fileSelect(dir)/$fileSelect(path) |
---|
345 | set dir [file dirname $path] |
---|
346 | set tail [file tail $path] |
---|
347 | } |
---|
348 | |
---|
349 | # See what files are there |
---|
350 | set files [glob -nocomplain $dir/$tail*] |
---|
351 | if {[llength [split $files]] == 1} { |
---|
352 | # Matched a single file |
---|
353 | set fileSelect(dir) $dir |
---|
354 | set fileSelect(path) [file tail $files] |
---|
355 | } else { |
---|
356 | if {[llength [split $files]] > 1} { |
---|
357 | # Find the longest common prefix |
---|
358 | set l [expr [string length $tail]-1] |
---|
359 | set miss 0 |
---|
360 | # remember that files has absolute paths |
---|
361 | set file1 [file tail [lindex $files 0]] |
---|
362 | while {$miss == 0} { |
---|
363 | incr l |
---|
364 | if {$l == [string length $file1]} { |
---|
365 | # file1 is a prefix of all others |
---|
366 | break |
---|
367 | } |
---|
368 | set new [string range $file1 0 $l] |
---|
369 | foreach f $files { |
---|
370 | if ![string match $new* [file tail $f]] { |
---|
371 | set miss 1 |
---|
372 | incr l -1 |
---|
373 | break |
---|
374 | } |
---|
375 | } |
---|
376 | } |
---|
377 | set fileSelect(path) [string range $file1 0 $l] |
---|
378 | } |
---|
379 | fileSelectList $dir $files |
---|
380 | } |
---|
381 | } |
---|
382 | |
---|
383 | |
---|
384 | #********** |
---|
385 | # procedure match |
---|
386 | # |
---|
387 | # input: string is a string of characters |
---|
388 | # file is a string of characters that holds a file name. |
---|
389 | # |
---|
390 | # function: open the file given by input "file" and iteratively look for |
---|
391 | # a text line in "file" that a) does not start with a "#", and |
---|
392 | # b) whose first word (text string) matches input "string". Upon |
---|
393 | # finding such a line that meets this criteria, procedure match |
---|
394 | # returns a 1. If EOF is reached before a line meeting the said |
---|
395 | # criteria is found, then procedure match returns a 0. |
---|
396 | # |
---|
397 | proc match {string file} { |
---|
398 | |
---|
399 | set f [open $file r] |
---|
400 | |
---|
401 | while {1} { |
---|
402 | |
---|
403 | set cnt [gets $f inline] |
---|
404 | if {$cnt == -1} { |
---|
405 | close $f |
---|
406 | return 0 |
---|
407 | } |
---|
408 | set y [split $inline {}] |
---|
409 | set y1 [lindex $y 0] |
---|
410 | if {$y1 != "#"} { |
---|
411 | if {$string == $inline} { |
---|
412 | close $f |
---|
413 | return 1 |
---|
414 | } |
---|
415 | } |
---|
416 | } |
---|
417 | } |
---|
418 | |
---|
419 | |
---|
420 | #******************** |
---|
421 | # procedure parse |
---|
422 | # |
---|
423 | # input sf string that holds name of sim output file. |
---|
424 | # |
---|
425 | # output none |
---|
426 | # |
---|
427 | # function described with the code below. |
---|
428 | proc parse {sf} { |
---|
429 | |
---|
430 | |
---|
431 | # the following are globals. |
---|
432 | # observe is to hold all of the variables eligible for display. |
---|
433 | # ninps, nlats, nouts are to hold the number of inputs, latches, outputs. |
---|
434 | # cy is to hold the variable values for each cycle. |
---|
435 | # ncy is to hold the number of cycles |
---|
436 | # what is to hold the identity of each variable (input, latch, output). |
---|
437 | |
---|
438 | global observe ninps nlats nouts |
---|
439 | global cy ncy |
---|
440 | global what |
---|
441 | |
---|
442 | # the following globals are the display preference variables. |
---|
443 | # see the man page for a discussion of these variables. |
---|
444 | global bgtop bg1 bg2 |
---|
445 | global fgtop fg1 fg2 |
---|
446 | global fonttop font1 font2 |
---|
447 | global hlinescolor vlinescolor |
---|
448 | global cybarbg cybarfg |
---|
449 | |
---|
450 | # open the sim output file for parsing. |
---|
451 | set f [open $sf r] |
---|
452 | |
---|
453 | # find the .inputs, .latches, .outputs, and .initial lines in the sim output file |
---|
454 | # and make lists out of them. |
---|
455 | set finps 0 |
---|
456 | set flats 0 |
---|
457 | set fouts 0 |
---|
458 | set finit 0 |
---|
459 | while {$finps == 0 || $flats == 0 || $fouts == 0 || $finit == 0} { |
---|
460 | set cnt [gets $f inline] |
---|
461 | if {$cnt == -1} {break} |
---|
462 | split $inline |
---|
463 | set first [lindex $inline 0] |
---|
464 | switch $first { |
---|
465 | ".inputs" { |
---|
466 | set inps [lreplace $inline 0 0] |
---|
467 | set ninps [llength $inps] |
---|
468 | set finps 1 |
---|
469 | for {set j 0} {$j < $ninps} {incr j} { |
---|
470 | lappend what (I) |
---|
471 | } |
---|
472 | } |
---|
473 | ".latches" { |
---|
474 | set lats [lreplace $inline 0 0] |
---|
475 | set nlats [llength $lats] |
---|
476 | set flats 1 |
---|
477 | for {set j 0} {$j < $nlats} {incr j} { |
---|
478 | lappend what (L) |
---|
479 | } |
---|
480 | } |
---|
481 | ".outputs" { |
---|
482 | set outs [lreplace $inline 0 0] |
---|
483 | set nouts [llength $outs] |
---|
484 | set fouts 1 |
---|
485 | for {set j 0} {$j < $nouts} {incr j} { |
---|
486 | lappend what (O) |
---|
487 | } |
---|
488 | } |
---|
489 | ".initial" { |
---|
490 | set finit 1 |
---|
491 | } |
---|
492 | } |
---|
493 | } |
---|
494 | |
---|
495 | # if any of the .inputs, .latches, .outputs, or .initial lines are not |
---|
496 | # found, exit with an Error. |
---|
497 | if {$finps == 0} { |
---|
498 | puts "ERROR: No .inputs line was found!" |
---|
499 | return -1 |
---|
500 | } |
---|
501 | if {$flats == 0} { |
---|
502 | puts "ERROR: No .latches line was found!" |
---|
503 | return -1 |
---|
504 | } |
---|
505 | if {$fouts == 0} { |
---|
506 | puts "ERROR: No .outputs line was found!" |
---|
507 | return -1 |
---|
508 | } |
---|
509 | if {$finit == 0} { |
---|
510 | puts "ERROR: No .initial line was found!" |
---|
511 | return -1 |
---|
512 | } |
---|
513 | |
---|
514 | # list observe holds all the variables eligible to be viewed. |
---|
515 | # here the list of variables is dumped to the strike file (strk.simv) |
---|
516 | # so user can later access and select variables to strike. |
---|
517 | set observe [concat $inps $lats $outs] |
---|
518 | set ff [open strk.simv w] |
---|
519 | foreach i $observe { |
---|
520 | puts $ff $i |
---|
521 | } |
---|
522 | close $ff |
---|
523 | |
---|
524 | # Set defaults for the display preferences. |
---|
525 | # |
---|
526 | set bgtop Grey |
---|
527 | set bg1 White |
---|
528 | set bg2 Black |
---|
529 | set fgtop Black |
---|
530 | set fg1 Black |
---|
531 | set fg2 White |
---|
532 | set fonttop -adobe-courier-bold-r-normal--12-120-75-75-m-70-iso8859-1 |
---|
533 | set font1 -adobe-courier-bold-r-normal--12-120-75-75-m-70-iso8859-1 |
---|
534 | set font2 -adobe-courier-bold-r-normal--12-120-75-75-m-70-iso8859-1 |
---|
535 | set hlinescolor White |
---|
536 | set vlinescolor Yellow |
---|
537 | set cybarbg Blue |
---|
538 | set cybarfg White |
---|
539 | |
---|
540 | # And put them in the preferences file. |
---|
541 | # |
---|
542 | set ff [open prefs.simv w] |
---|
543 | |
---|
544 | puts $ff "bgtop $bgtop" |
---|
545 | puts $ff "bg1 $bg1" |
---|
546 | puts $ff "bg2 $bg2" |
---|
547 | puts $ff "fgtop $fgtop" |
---|
548 | puts $ff "fg1 $fg1" |
---|
549 | puts $ff "fg2 $fg2" |
---|
550 | puts $ff "fonttop $fonttop" |
---|
551 | puts $ff "font1 $font1" |
---|
552 | puts $ff "font2 $font2" |
---|
553 | puts $ff "hlinescolor $hlinescolor" |
---|
554 | puts $ff "vlinescolor $vlinescolor" |
---|
555 | puts $ff "cybarbg $cybarbg" |
---|
556 | puts $ff "cybarfg $cybarfg" |
---|
557 | |
---|
558 | close $ff |
---|
559 | |
---|
560 | # the following lines of code look for the beginning of the portion of |
---|
561 | # the sim output file that contains the cycle information and upon |
---|
562 | # finding it stores it in "array" for further processing. |
---|
563 | set i 0 |
---|
564 | while {1} { |
---|
565 | set cnt [gets $f inline] |
---|
566 | if {$cnt == -1} {break} |
---|
567 | set y [split $inline {}] |
---|
568 | set y1 [lindex $y 0] |
---|
569 | if {$y1 == {} || $y1 == "#" || $y1 == "."} {continue} |
---|
570 | set array($i) $inline |
---|
571 | incr i 1 |
---|
572 | } |
---|
573 | set ncy $i |
---|
574 | close $f |
---|
575 | |
---|
576 | # if no cycle lines were found, exit with an Error. |
---|
577 | if {$cnt == -1 && $i == 0} { |
---|
578 | puts "ERROR: No simulation results found!" |
---|
579 | return -1 |
---|
580 | } |
---|
581 | |
---|
582 | # the following lines of code parse the contents of "array" into |
---|
583 | # "cy". each list in "array" is itself a list of strings, this step turns |
---|
584 | # the cycle information so that each element in "cy" is a simple list of |
---|
585 | # strings. |
---|
586 | for {set j 0} {$j < $i} {incr j} { |
---|
587 | set z [split $array($j) \;] |
---|
588 | set p [lindex $z 0] |
---|
589 | set q [lindex $z 1] |
---|
590 | set r [lindex $z 2] |
---|
591 | set cy($j) [concat $p $q $r] |
---|
592 | } |
---|
593 | |
---|
594 | } |
---|
595 | |
---|
596 | #************* |
---|
597 | # procedure strike |
---|
598 | # |
---|
599 | # inputs sf string that holds file name |
---|
600 | # |
---|
601 | # outputs none |
---|
602 | # |
---|
603 | # function Reads the contents of the file pointed to by input "sf" and |
---|
604 | # based on its contents generates an array of flags that indicate |
---|
605 | # whether a given variable should be displayed. The array of |
---|
606 | # flags is in one-to-one correspondence with the array of variables |
---|
607 | # that are eligible to be displayed. |
---|
608 | proc strike {} { |
---|
609 | |
---|
610 | global observe |
---|
611 | global show nshow |
---|
612 | |
---|
613 | set nshow 0 |
---|
614 | |
---|
615 | set nobvs [llength $observe] |
---|
616 | set j 0 |
---|
617 | for {set i 0} {$i < $nobvs} {incr i} { |
---|
618 | set m [match [lindex $observe $i] strk.simv] |
---|
619 | if {$m == 0} { |
---|
620 | lappend show 0 |
---|
621 | } else { |
---|
622 | lappend show 1 |
---|
623 | incr nshow |
---|
624 | } |
---|
625 | } |
---|
626 | } |
---|
627 | |
---|
628 | #************* |
---|
629 | # procedure readprefs |
---|
630 | # |
---|
631 | # inputs pf string that holds file name |
---|
632 | # |
---|
633 | # outputs none |
---|
634 | # |
---|
635 | # function Reads the contents of the file pointed to by input "pf" and |
---|
636 | # sets the values of the preferences accordingly. See the "man" |
---|
637 | # page for description of the preferences currently supported. |
---|
638 | # |
---|
639 | proc readprefs {} { |
---|
640 | |
---|
641 | global bgtop bg1 bg2 |
---|
642 | global fgtop fg1 fg2 |
---|
643 | global fonttop font1 font2 |
---|
644 | global hlinescolor vlinescolor |
---|
645 | global cybarbg cybarfg |
---|
646 | global run |
---|
647 | |
---|
648 | set bgtop 0 |
---|
649 | set bg1 0 |
---|
650 | set bg2 0 |
---|
651 | set fgtop 0 |
---|
652 | set fg1 0 |
---|
653 | set fg2 0 |
---|
654 | set fonttop 0 |
---|
655 | set font1 0 |
---|
656 | set font2 0 |
---|
657 | set hlinescolor 0 |
---|
658 | set vlinescolor 0 |
---|
659 | set cybarbg 0 |
---|
660 | set cybarfg 0 |
---|
661 | |
---|
662 | set f [open prefs.simv r] |
---|
663 | |
---|
664 | while {1} { |
---|
665 | |
---|
666 | set cnt [gets $f inline] |
---|
667 | if {$cnt == -1} {break} |
---|
668 | set first [lindex $inline 0] |
---|
669 | |
---|
670 | switch $first { |
---|
671 | bgtop { set bgtop [lindex $inline 1] } |
---|
672 | bg1 { set bg1 [lindex $inline 1] } |
---|
673 | bg2 { set bg2 [lindex $inline 1] } |
---|
674 | fgtop { set fgtop [lindex $inline 1] } |
---|
675 | fg1 { set fg1 [lindex $inline 1] } |
---|
676 | fg2 { set fg2 [lindex $inline 1] } |
---|
677 | fonttop { set fonttop [lindex $inline 1] } |
---|
678 | font1 { set font1 [lindex $inline 1] } |
---|
679 | font2 { set font2 [lindex $inline 1] } |
---|
680 | hlinescolor { set hlinescolor [lindex $inline 1] } |
---|
681 | vlinescolor { set vlinescolor [lindex $inline 1] } |
---|
682 | cybarbg { set cybarbg [lindex $inline 1] } |
---|
683 | cybarfg { set cybarfg [lindex $inline 1] } |
---|
684 | } |
---|
685 | } |
---|
686 | |
---|
687 | close $f |
---|
688 | |
---|
689 | } |
---|
690 | |
---|
691 | #**************** |
---|
692 | # procedure findlongestvar |
---|
693 | # |
---|
694 | # input none |
---|
695 | # |
---|
696 | # output none |
---|
697 | # |
---|
698 | # function This procedure operates on the parsed lists of variables names and |
---|
699 | # values for each cycle to find a) the longest variable name, and b) |
---|
700 | # the longest value of any given variable. These values are then used |
---|
701 | # to set the corresponding field widths in the display. |
---|
702 | # |
---|
703 | proc findlongestvar {} { |
---|
704 | |
---|
705 | global observe |
---|
706 | global show |
---|
707 | global cywidth varwidth |
---|
708 | global cy ncy |
---|
709 | |
---|
710 | set nobvs [llength $observe] |
---|
711 | |
---|
712 | set maxlen 0 |
---|
713 | for {set i 0} {$i < $nobvs} {incr i} { |
---|
714 | set active [lindex $show $i] |
---|
715 | if {$active == 1} { |
---|
716 | set str [lindex $observe $i] |
---|
717 | set len [string length $str] |
---|
718 | if {$len > $maxlen} {set maxlen $len} |
---|
719 | } |
---|
720 | } |
---|
721 | set varwidth [expr ($maxlen+2)*0.25] |
---|
722 | |
---|
723 | set maxlen 0 |
---|
724 | for {set i 0} {$i < $ncy} {incr i} { |
---|
725 | for {set j 0} {$j < $nobvs} {incr j} { |
---|
726 | set active [lindex $show $j] |
---|
727 | if {$active == 1} { |
---|
728 | set str [lindex $cy($i) $j] |
---|
729 | set len [string length $str] |
---|
730 | if {$len > $maxlen} {set maxlen $len} |
---|
731 | } |
---|
732 | } |
---|
733 | } |
---|
734 | # Takes care of finding the maximum width for cycle width |
---|
735 | set cywidth_cycleInfo [expr (log($ncy)+2)*0.25] |
---|
736 | set cywidth_dataInfo [expr ($maxlen+2)*0.25] |
---|
737 | |
---|
738 | if {$cywidth_cycleInfo > $cywidth_dataInfo} { |
---|
739 | set cywidth $cywidth_cycleInfo |
---|
740 | } else { |
---|
741 | set cywidth $cywidth_dataInfo |
---|
742 | } |
---|
743 | |
---|
744 | } |
---|
745 | |
---|
746 | #*************** |
---|
747 | # procedure drawcanvas |
---|
748 | # |
---|
749 | # input none |
---|
750 | # |
---|
751 | # output none |
---|
752 | # |
---|
753 | # function This procedure carries out the actual displaying. It is described alongside |
---|
754 | # with the code below. |
---|
755 | # |
---|
756 | proc drawcanvas {} { |
---|
757 | |
---|
758 | #--------- |
---|
759 | # these globals are the display preferences, they are read |
---|
760 | # from file dprefs by procedure readprefs: |
---|
761 | # |
---|
762 | # varwidth holds the width of the left-most column that |
---|
763 | # lists the variables under observation |
---|
764 | # cywidth holds the width of the cycle columns that |
---|
765 | # lists the value of the variables for each |
---|
766 | # cycle. |
---|
767 | # |
---|
768 | |
---|
769 | global varwidth |
---|
770 | global cywidth |
---|
771 | |
---|
772 | #--------- |
---|
773 | # the following globals hold the items to be |
---|
774 | # displayed: |
---|
775 | # |
---|
776 | # cy is the array of lists, each element is a list |
---|
777 | # of the value of the items for that cycle, |
---|
778 | # ncy is the number of elements in cy, |
---|
779 | # show is an array that marks those elements in cy and |
---|
780 | # observe that are to be displayed, (i.e. after |
---|
781 | # some of the elements in observe are striken based |
---|
782 | # on the contents of the strike file. |
---|
783 | # nshow is the number of "1" elements in show, |
---|
784 | # observe is a list of _all_ the items that _can_ be displayed. |
---|
785 | # what is an array that identifies a variable as either an input, latch, or output. |
---|
786 | # |
---|
787 | global cy ncy |
---|
788 | global show nshow |
---|
789 | global observe |
---|
790 | global what |
---|
791 | |
---|
792 | |
---|
793 | #------------- |
---|
794 | # the following globals are the prefrences variables. |
---|
795 | # |
---|
796 | global bgtop bg1 bg2 |
---|
797 | global fgtop fg1 fg2 |
---|
798 | global fonttop font1 font2 |
---|
799 | global hlinescolor vlinescolor |
---|
800 | global cybarbg cybarfg |
---|
801 | |
---|
802 | #------------ |
---|
803 | # here the top level widget that holds the results display is |
---|
804 | # created and the two canvases that will be used to construct |
---|
805 | # the display are defined. |
---|
806 | |
---|
807 | # this width and height is a good start for a workstation monitor, |
---|
808 | # of course, the window can be resized in the usual way. |
---|
809 | # |
---|
810 | set wwidth 800 |
---|
811 | set wheight 500 |
---|
812 | |
---|
813 | global infile |
---|
814 | global t |
---|
815 | set t .top |
---|
816 | toplevel $t |
---|
817 | wm geometry $t ${wwidth}x${wheight} |
---|
818 | wm title $t "XsimView 0.1" |
---|
819 | set c1 $t.canvas1 |
---|
820 | set c2 $t.canvas2 |
---|
821 | |
---|
822 | # the top of the display holds generic information. |
---|
823 | # |
---|
824 | text $t.text -font $fonttop -bg $bgtop -fg $fgtop |
---|
825 | text $t.text1 -font $fonttop -bg $bgtop -fg $fgtop |
---|
826 | $t.text insert 1.0 "XSimView Rev. 0.1 (April 1996)\n" |
---|
827 | $t.text insert 2.0 "by J.S. Duran\n" |
---|
828 | $t.text insert 3.0 "ECE Department\n" |
---|
829 | $t.text insert 4.0 "UT Austin\n" |
---|
830 | $t.text1 insert 1.0 "Displaying file: $infile" |
---|
831 | place $t.text -x 0 -y 0 -relwidth 1.0 |
---|
832 | place $t.text1 -relx 0.5 -y 0 |
---|
833 | |
---|
834 | #--------------- |
---|
835 | # build the higher level canvas (holds the variable names at the left-most |
---|
836 | # of the display and also holds the lower level canvas). |
---|
837 | # |
---|
838 | set c1w [expr $wwidth] |
---|
839 | set c1h [expr $nshow+1] |
---|
840 | set c1dims [list 0 0 ${c1w} ${c1h}c] |
---|
841 | canvas $c1 -relief sunken -borderwidth 2 -scrollregion $c1dims -yscrollcommand "$t.vscroll set" -bg ${bg1} |
---|
842 | scrollbar $t.vscroll -command "$c1 yview" |
---|
843 | place $t.vscroll -relx 0.98 -rely 0.15 -relheight 0.85 -width 0.5c |
---|
844 | place $c1 -x 0 -rely 0.15 -relheight 0.85 -relwidth 1.0 |
---|
845 | |
---|
846 | set f $c1.frame |
---|
847 | frame $f -relief sunken -borderwidth 2 |
---|
848 | $c1 create window ${varwidth}c 0 -anchor nw -height ${c1h}c -width ${wwidth} -window $f |
---|
849 | |
---|
850 | #------------ |
---|
851 | # build the lower level canvas (holds the per cycle variable value information). |
---|
852 | # |
---|
853 | set c2xlen [expr $ncy*$cywidth*1.25] |
---|
854 | set c2scrl [list 0 0 ${c2xlen}c ${c1h}c] |
---|
855 | set hsw [expr $wwidth-$varwidth*40] |
---|
856 | canvas $f.c2 -relief sunken -borderwidth 2 -scrollregion $c2scrl -xscrollcommand "$t.hscroll set" -bg ${bg2} |
---|
857 | place $f.c2 -x 0 -y 0 -relheight 1.0 -relwidth 1.0 |
---|
858 | scrollbar $t.hscroll -orient horiz -command "$f.c2 xview" |
---|
859 | place $t.hscroll -x 0 -rely 0.125 -height 0.5c -relwidth 1.0 |
---|
860 | |
---|
861 | #------------ |
---|
862 | # place the variable names on the higher level canvas. also draw the horizontal grid |
---|
863 | # lines in the lower level canvas. |
---|
864 | # |
---|
865 | set q [llength $show] |
---|
866 | set v 1 |
---|
867 | for {set i 0} {$i < $q} {incr i} { |
---|
868 | set sh [lindex $show $i] |
---|
869 | if {$sh == 1} { |
---|
870 | set item1 [lindex $observe $i] |
---|
871 | set item2 [lindex $what $i] |
---|
872 | set item $item1$item2 |
---|
873 | $c1 create text ${varwidth}c ${v}c -text $item -anchor ne -fill $fg1 -font $font1 |
---|
874 | $f.c2 create line 0 [expr $v+0.4]c ${c2xlen}c [expr $v+0.4]c -fill $hlinescolor |
---|
875 | incr v |
---|
876 | } |
---|
877 | } |
---|
878 | |
---|
879 | #----------- |
---|
880 | # place the per cycle data on the lower level canvas. also draw the vertical grid lines on the |
---|
881 | # lower level canvas and generate the cycle number bar at the top of the lower level canvas. |
---|
882 | # |
---|
883 | set over1 [expr $cywidth*0.5] |
---|
884 | set over2 $cywidth |
---|
885 | set xtx $over1 |
---|
886 | set xln $over2 |
---|
887 | set xrc1 0 |
---|
888 | set xrc2 $over2 |
---|
889 | for {set i 0} {$i < $ncy} {incr i} { |
---|
890 | $f.c2 create rectangle ${xrc1}c 0 ${xrc2}c 0.5c -fill $cybarbg -outline $vlinescolor |
---|
891 | set cylabel "CY$i" |
---|
892 | $f.c2 create text ${xtx}c 0.25c -width ${cywidth}c -text $cylabel -fill $cybarfg -justify center -font $font2 |
---|
893 | $f.c2 create line ${xln}c 0 ${xln}c ${c1h}c -fill $vlinescolor |
---|
894 | set v 1 |
---|
895 | for {set k 0} {$k < $q} {incr k} { |
---|
896 | set sh [lindex $show $k] |
---|
897 | if {$sh == 1} { |
---|
898 | set item [lindex $cy($i) $k] |
---|
899 | $f.c2 create text ${xtx}c ${v}c -width ${cywidth}c -text $item -fill $fg2 -justify center -font $font2 |
---|
900 | incr v |
---|
901 | } |
---|
902 | } |
---|
903 | set xtx [expr $xtx+$cywidth] |
---|
904 | set xln [expr $xln+$cywidth] |
---|
905 | set xrc1 [expr $xrc1+$cywidth] |
---|
906 | set xrc2 [expr $xrc2+$cywidth] |
---|
907 | } |
---|
908 | |
---|
909 | unset show |
---|
910 | |
---|
911 | } |
---|
912 | |
---|
913 | |
---|
914 | ############################################# |
---|
915 | # main body of XsimView |
---|
916 | # |
---|
917 | |
---|
918 | #------- |
---|
919 | # parse the command line (either one argument -- sim output file name -- |
---|
920 | # or none. |
---|
921 | # |
---|
922 | |
---|
923 | global infile |
---|
924 | global t |
---|
925 | |
---|
926 | if {$argc == 0} { |
---|
927 | set infile "in.simv" |
---|
928 | puts "setting input file to in.simv\n" |
---|
929 | } elseif {$argc == 1} { |
---|
930 | set infile [lindex $argv 0] |
---|
931 | } else { |
---|
932 | puts "syntax is: xsimview <filename>\n" |
---|
933 | exit |
---|
934 | } |
---|
935 | |
---|
936 | ###################################################### |
---|
937 | ##### FILES NECESSARY FOR SAVING |
---|
938 | ###################################################### |
---|
939 | |
---|
940 | proc doSave {} { |
---|
941 | set file [fileSelect Write] |
---|
942 | catch {exec cp in.simv $file} |
---|
943 | } |
---|
944 | |
---|
945 | #################################################### |
---|
946 | ##### END FILES NECESSARY FOR SAVING |
---|
947 | #################################################### |
---|
948 | |
---|
949 | #------------------ |
---|
950 | # initialization sequence. |
---|
951 | # |
---|
952 | # parse the sim output file (only needs to be done once). |
---|
953 | # open the main window for XsimView |
---|
954 | # |
---|
955 | parse $infile |
---|
956 | wm title . "XsimView 0.1" |
---|
957 | button .go -text GO -command { |
---|
958 | strike |
---|
959 | findlongestvar |
---|
960 | readprefs |
---|
961 | drawcanvas |
---|
962 | } |
---|
963 | button .redraw -text ReDraw -command { |
---|
964 | destroy $t |
---|
965 | strike |
---|
966 | findlongestvar |
---|
967 | readprefs |
---|
968 | drawcanvas |
---|
969 | } |
---|
970 | button .save -text Save -command {doSave} |
---|
971 | button .quit -text Quit -command {destroy .} |
---|
972 | |
---|
973 | pack .go -side left -padx 2m -pady 2m |
---|
974 | pack .redraw -side left -padx 2m -pady 2m |
---|
975 | pack .save -side left -padx 2m -pady 2m |
---|
976 | pack .quit -side left -padx 2m -pady 2m |
---|
977 | |
---|
978 | |
---|
979 | |
---|
980 | |
---|
981 | |
---|
982 | |
---|
983 | |
---|
984 | |
---|
985 | |
---|
986 | |
---|
987 | |
---|
988 | |
---|
989 | |
---|
990 | |
---|
991 | |
---|
992 | |
---|
993 | |
---|