projects / OpenSPARC-T2-DV / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / src / gtrace,1.20
CommitLineData
86530b38
AT		 1#!/usr/bin/perl
2use strict;
3use Getopt::Long;
4
5$|=1;
6
7# Script to aid tracing and debugging assembly language diags with the N2 based
8# sparc bench. The script reads in the vcs.log file and extracts executed
9# instruction and state deltas from the log file. It then allows for printing
10# the architeced state at any instruction boundary.
11#
12# Requires that the log file have the state delta information (+show_delta).
13#
14#
15# $state{$thread}{$instr}{$regname} = value;
16# $trace{$thread}{$instr} = <string>
17# $fulltrace{$instr} = <string>
18# $delta{$thread}{$instr}{reg} = value
19# $current{$thread} = <current instr number>
20#
21# Track CWP/GL and display for appropriate CWP/GL
22# $cwp{$thread}{win}{instr}{regname} = value
23# $gl{$thread}{level}{instr}{regname} = value
24
25# Symbols
26# $symbols{address} = label
27# $offset{tid}{address} = label+offset
28
29my $debug = 0;
30
31chomp(my $prog=`basename $0`);
32#chomp(my $progpath=`dirname $0`);
33my $progpath = $ENV{DV_ROOT}."/tools/src";
34print "$prog ";
35
36my $logfile = "vcs.log";
37my $saslog = 0;
38our $newsasformat = 0;
39my $symfile = "symbol.tbl";
40my $diagexe = "diag.exe";
41our $dis_cmd = (-x "$progpath/dis") ? "$progpath/dis " : "g_objdump -dS ";
42my $have_symbols = 0;
43my $have_pa = 0;
44my $nosas = 0;
45my $have_disas = 0;
46my $nodisas = 0;
47my $usedis = 0;
48our %state;
49our %regmap;
50my %trace;
51my %fulltrace;
52my %expdelta;
53my %actdelta;
54my %symbols;
55my @sorted_symbols;
56my %offset;
57my %disas;
58my %cwp;
59my %gl;
60my %delta;
61my %current;
62my %current_label;
63my %last;
64my $line;
65my $numthreads = 0;
66our $num_threads_per_node = 64;
67our $num_threads_per_core = 8;
68my $i;
69my $tid = 9999;
70my $merge = 0;
71my $instr;
72my $char = 0;
73my $cores = "";
74my $only_cores = "";
75my $trace = 0;
76my $maxwin = 8;
77my $maxgl = 4;
78my @delta_index;
79my $statetype = 0; # Expected = 0, Actual = 1
80my $prevstate = 0;
81my $temp;
82my $maxtime = 0;
83my $gates = 0;
84
85my $addr_blurb = "Consume less. Share more. Enjoy life";
86my $status_blurb = "Insanity: Doing The Same Thing Over And Over Again And Expecting Different Results.";
87
88# Reg definitions and expansions {{{
89my @globals = qw(g0 g1 g2 g3 g4 g5 g6 g7);
90my @windows = qw(o0 o1 o2 o3 o4 o5 o6 o7
91 l0 l1 l2 l3 l4 l5 l6 l7
92 i0 i1 i2 i3 i4 i5 i6 i7);
93
94our @allregs = qw(f0 f2 f4 f6 f8 f10 f12 f14
95 f16 f18 f20 f22 f24 f26 f28 f30
96 f32 f34 f36 f38 f40 f42 f44 f46
97 f48 f50 f52 f54 f56 f58 f60 f62
98 PC NPC CWP CCR FPRS FSR PSTATE
99 HPSTATE ASI TICK TL PIL
100 CANSAVE CANRESTORE CLEANWIN OTHERWIN
101 VER WSTATE GL TBA HTBA
102 TICK_CMPR STICK_CMPR HSTICK_CMPR
103 HINTP SOFTINT GSR INTR_RECEIVE
104 TPC1 TNPC1 TSTATE1 TT1
105 TPC2 TNPC2 TSTATE2 TT2
106 TPC3 TNPC3 TSTATE3 TT3
107 TPC4 TNPC4 TSTATE4 TT4
108 TPC5 TNPC5 TSTATE5 TT5
109 TPC6 TNPC6 TSTATE6 TT6
110 HTSTATE1 HTSTATE2 HTSTATE3 HTSTATE4
111 HTSTATE5 HTSTATE6
112 LSU_CONTROL WATCHPOINT_ADDR
113 CTXT_PRIM_0 CTXT_SEC_0
114 CTXT_PRIM_1 CTXT_SEC_1
115 I_TAG_ACC D_TAG_ACC DSFAR
116 CTXT_Z_TSB_CFG0 CTXT_Z_TSB_CFG1
117 CTXT_Z_TSB_CFG2 CTXT_Z_TSB_CFG3
118 CTXT_NZ_TSB_CFG0 CTXT_NZ_TSB_CFG1
119 CTXT_NZ_TSB_CFG2 CTXT_NZ_TSB_CFG3
120 ) ;
121
122our %expandreg = (
123 "HPSTATE" => {'0:0'=>"tlz", '2:2'=>"hpriv", '5:5'=>"red",
124 '10:10'=>"ibe"},
125 "PSTATE" => {'1:1'=>"ie", '2:2'=>"priv", '3:3'=>"am",
126 '4:4'=>"pef", '8:8'=>"tle", '9:9'=>"cle",
127 '12:12'=>"tct"},
128 "CCR" => {'0:0'=>"icc.c", '1:1'=>"icc.v", '2:2'=>"icc.z",
129 '3:3'=>"\nicc.n",
130 '4:4'=>"xcc.c", '5:5'=>"xcc.v", '6:6'=>"xcc.z",
131 '7:7' =>"xcc.n"},
132 "FPRS" => {'0:0'=>"dl", '2:2'=>"du", '3:3'=>"fef"},
133 "FSR" => {'10:11'=>"fcc0",'5:9'=>"aexc",'0:4'=>"cexc",
134 '13:13'=>"qne",'14:16'=>"ftt",'17:19'=>"\nver",
135 '22:22'=>"ns",'23:27'=>"tem",'30:31'=>"rd",
136 '32:33'=>"fcc1",'34:35'=>"fcc2",'36:37'=>"fcc3"},
137 "GSR" => {'0:2'=>"align", '3:7'=>"scale", '8:15'=>"gcc",
138 '24:24'=>"gq_rdy", '25.:6'=>"irnd", '27:27'=>"\nim",
139 '32:63'=>"mask"},
140 "TSTATE1" => {'0:4'=>"cwp", '8:20'=>"\npstate",
141 '24:31'=>"asi", '32:39'=>"ccr",
142 '40:43'=>"gl"},
143 "TSTATE2" => {'0:4'=>"cwp", '8:20'=>"\npstate",
144 '24:31'=>"asi", '32:39'=>"ccr",
145 '40:43'=>"gl"},
146 "TSTATE3" => {'0:4'=>"cwp", '8:20'=>"\npstate",
147 '24:31'=>"asi", '32:39'=>"ccr",
148 '40:43'=>"gl"},
149 "TSTATE4" => {'0:4'=>"cwp", '8:20'=>"\npstate",
150 '24:31'=>"asi", '32:39'=>"ccr",
151 '40:43'=>"gl"},
152 "TSTATE5" => {'0:4'=>"cwp", '8:20'=>"\npstate",
153 '24:31'=>"asi", '32:39'=>"ccr",
154 '40:43'=>"gl"},
155 "TSTATE6" => {'0:4'=>"cwp", '8:20'=>"\npstate",
156 '24:31'=>"asi", '32:39'=>"ccr",
157 '40:43'=>"gl"},
158 "LSU_CONTROL" => { '0:0'=>"ic", '1:1'=>"dc", '2:2'=>"im",
159 '3:3'=>"dm", '4:4'=>"se", '23:23'=>"we", '24:24'=>"re",
160 '25:32'=>"bm", '33:34'=>"mode"},
161 "CTXT_Z_TSB_CFG0" => {'0:3'=>"tsb_size", '4:6'=>"page_size",
162 '8:8'=>"\nra_not_pa", '13:39'=>"\ntsb_base",
163 '61:61'=>"use_context_1", '62:62'=>"use_context_0",
164 '63:63'=>"enable"},
165 "CTXT_Z_TSB_CFG1" => {'0:3'=>"tsb_size", '4:6'=>"page_size",
166 '8:8'=>"\nra_not_pa", '13:39'=>"\ntsb_base",
167 '61:61'=>"use_context_1", '62:62'=>"use_context_0",
168 '63:63'=>"enable"},
169 "CTXT_Z_TSB_CFG2" => {'0:3'=>"tsb_size", '4:6'=>"page_size",
170 '8:8'=>"\nra_not_pa", '13:39'=>"\ntsb_base",
171 '61:61'=>"use_context_1", '62:62'=>"use_context_0",
172 '63:63'=>"enable"},
173 "CTXT_Z_TSB_CFG3" => {'0:3'=>"tsb_size", '4:6'=>"page_size",
174 '8:8'=>"\nra_not_pa", '13:39'=>"\ntsb_base",
175 '61:61'=>"use_context_1", '62:62'=>"use_context_0",
176 '63:63'=>"enable"},
177 "CTXT_NZ_TSB_CFG0" => {'0:3'=>"tsb_size", '4:6'=>"page_size",
178 '8:8'=>"\nra_not_pa", '13:39'=>"\ntsb_base",
179 '61:61'=>"use_context_1", '62:62'=>"use_context_0",
180 '63:63'=>"enable"},
181 "CTXT_NZ_TSB_CFG1" => {'0:3'=>"tsb_size", '4:6'=>"page_size",
182 '8:8'=>"\nra_not_pa", '13:39'=>"\ntsb_base",
183 '61:61'=>"use_context_1", '62:62'=>"use_context_0",
184 '63:63'=>"enable"},
185 "CTXT_NZ_TSB_CFG2" => {'0:3'=>"tsb_size", '4:6'=>"page_size",
186 '8:8'=>"\nra_not_pa", '13:39'=>"\ntsb_base",
187 '61:61'=>"use_context_1", '62:62'=>"use_context_0",
188 '63:63'=>"enable"},
189 "CTXT_NZ_TSB_CFG3" => {'0:3'=>"tsb_size", '4:6'=>"page_size",
190 '8:8'=>"\nra_not_pa", '13:39'=>"\ntsb_base",
191 '61:61'=>"use_context_1", '62:62'=>"use_context_0",
192 '63:63'=>"enable"},
193 );
194
195# }}}
196
197# Project stuff ..
198my $project;
199$project = (defined($ENV{PROJECT})&& -r "$progpath/defaults.$ENV{PROJECTLC}") ?
200 $ENV{PROJECTLC} : "generic";
201if (-r "$progpath/defaults.$project") {
202 require "$progpath/defaults.$project";
203}
204print " ($project)\n";
205
206# Help {{{
207my $help ="
208 Gtrace is a script to aid in tracing processor architectural state for
209 debugging diags.
210
211 Gtrace requires that the simulation log file contain delta state
212 information. This is generated by using \"-vcs_run_args=+show_delta\" as
213 a simulation argument.
214
215 If gtrace is being invoked with the \"-s\" option to load Riesling's
216 sas.log, then Riesling must have been run with
217 \"-sas_run_args=-DPLI_DEBUG=2\" to provide the delta state information in
218 sas.log.
219
220 Gtrace provides the following controls and aids :
221
222 Reload :
223 Reload the simulation logs without needing to quit and re-invoke
224 gtrace.
225
226 Reload Log Only :
227 Reload the simulation log ONLY without needing to quit and re-invoke
228 gtrace.
229
230 Thread Selector :
231 These checkbuttons will allow you to select which thread to trace and
232 display in the Trace and State panels. Thread 0 (T0) is the default
233 selected thread. This is a tear-away menu.
234
235 Merge All: This selection allows you to merge all thread traces
236 together. Clicking on a trace line will display the state
237 for the particular thread selected.
238
239 Single Stepper :
240 Single steps the trace. Incremental changes are highlighted.
241
242 Goto :
243 Quick means of going to first, last instrucion in trace window.
244
245 Show :
246 Choice of displaying the 'EXPECTED' Vs 'ACTUAL/DUT' values for logs
247 that have cosimulation enabled.
248
249 View :
250 Chose to increase or decrease font sizes in the various panes.
251
252 Tools:
253 Invoke additional debug tools
254
255 Help Button :
256 This blurb ;-)
257
258 Trace Panel :
259 This panel displays the trace of the simulation for the selected
260 thread. Clicking on a trace line will cause the State panel to
261 display the architectural state after the execution of the seleceted
262 instruction for the selected thread.
263
264 If a symbol file is found (symbol.tbl), labels are inserted at the
265 correct positions in the trace.
266
267 Right-clicking on the panel will bring up search functions.
268
269 Label/Offset Panel :
270 Shows the current instruction's offset from nearest (previous) label.
271
272 Status Panel :
273 Shows the current instruction for which the state is being displayed.
274
275 State Panel :
276 This panel shows the architected register values at the completion of
277 the selected instruction.
278
279 Incremental changes for the instruction selected are highlighted.
280
281 Right-clicking on the panel will bring up search functions.
282
283 Hovering the cursor over some of the registers will show exploded
284 register field settings.
285
286 Xdefaults Support :
287 Gtrace will honor X resource attributes (typically specified in
288 ~/.Xdefaults). Fonts, back/foreground colors etc may be secified
289 in the form :
290 gtrace*font: -adobe-courier-medium-r-normal--14-120-75-75-m-70-iso8859-1
291 or
292 gtrace*font: courier 14
293 etc, and loaded immediately using xrdb -merge ...
294
295 Bug Reporting :
296 Please report bugs/enhancement requests in Metrax.
297
298 Pending TODOs :
299 - Save trace and state to file
300 - Show memory contents (when/where written..)
301
302";
303sub usage {
304 die "@_\n",
305 "\nINFO > Script to aid in tracing Arch state via VCS logfile.",
306 "\nINFO > The simulation must have delta state dumped at run time",
307 "\nINFO > A log file (and optionally the symbol table) must exist in ",
308 "\nINFO > the current directory or be specified as an argument\n\n",
309 "\nINFO > Usage $prog [options] " ,
310 "\nINFO > Options are :" ,
311 "\nINFO > -log <file> : use <file> as input instead of vcs.log",
312 "\nINFO > -s : expect to read sas.log instead of vcs",
313 "\nINFO > -t : non-gui trace to stdout",
314 "\nINFO > -m : Startup with all traces merged",
315 "\nINFO > -g : GATESIM: don't look for state-delta in vcs log file",
316 "\nINFO > -nodis : Skip disassembly if needing to disassemble",
317 "\nINFO > -usedis=file : Use the specifed existing file for disassembly",
318 "\nINFO > -x <value> : Limit reading upto time \@<value> (vcs.log only)",
319 "\nINFO > -c <n[,n]*> : Scan for specified virtual cores only",
320 "\n\n";
321
322} #}}}
323&GetOptions("log=s" => \$logfile,
324 "d", => \$debug,
325 "t", => \$trace,
326 "m", => \$merge,
327 "x=i", => \$maxtime,
328 "s", => \$saslog,
329 "g", => \$gates,
330 "nodis", => \$nodisas,
331 "usedis=s", => \$usedis,
332 "c=s" => \$cores)
333 || &usage;
334if ($saslog && $logfile eq "vcs.log") {$logfile = "sas.log"}
335if ($trace) {$char = 1}
336
337if (!$char && $ENV{DISPLAY}) {
338 use Tk;
339 use Tk::Text;
340 use Tk::Adjuster;
341 use Tk::Balloon;
342 $Tk::encodeFallback=1;
343} else {
344 $char = 1; # Non Gui mode
345}
346
347# Figure out which files are around
348if (!$gates && ! have_deltas()) {
349 usage( "\nERROR > Could not find a logfile with show_delta information.",
350 "\n Please run simulation with \"-vcs_run_args=+show_delta\"",
351 "\n OR \"-sas_run_args=-DPLI_DEBUG=2\" for sas deltas\"",
352 "\n\n Exiting.\n\n");
353}
354
355# Get list of restricted cores ..
356if ($cores ne "") {
357 foreach (split(/,/, $cores)) {
358 $only_cores .= "|T$_";
359 }
360 $only_cores =~ s/^\|//;
361}
362
363bootup();
364
365###############################################################################
366# Boot Up .. Read all files .. {{{
367sub bootup {
368
369 if (-r $symfile || -r "$symfile.gz") {
370 $have_symbols = 1;
371 }
372
373 # Do the basics ..
374 %state=();
375 %trace=();
376 %fulltrace=();
377 %expdelta=();
378 %actdelta=();
379 %symbols=();
380 %disas=();
381 %cwp=();
382 %gl=();
383 %delta=();
384 if ($have_symbols) {
385 slurp_symbols();
386 }
387
388 # Do we need disassembly ?
389 if (no_sascheck()) {
390 $nosas = 1;
391 slurp_disas() if (! $nodisas);
392 }
393 if ($gates) {slurp_barelog()}
394 elsif ($saslog) {slurp_saslog()}
395 else {slurp_logfile()}
396} # }}}
397
398# Non GUI
399if ($trace) {
400 log_trace();
401}
402
403###############################################################################
404if (!$char) { ## {{{ GUI Stuff
405# Set up the main windows
406my $trace_t;
407my $state_t;
408my $status_t;
409my $search_m;
410my $state_m;
411my $addr_t;
412my $balloon;
413my $last_hover;
414my $main_w = new MainWindow;
415
416$main_w -> title ("gtrace :($ENV{PWD}) $logfile");
417$main_w -> iconname ("gtrace: ($ENV{PWD} $logfile");
418$main_w -> appname ('gtrace');
419$main_w -> optionClear;
420
421#### Menubar ####
422
423my $main_m = $main_w -> Menu (-type => 'menubar', -bd => 1);
424$main_w -> configure(-menu => $main_m);
425
426## File cascade
427my $file_m = $main_m -> cascade (-label => '~File', -tearoff => 0);
428$file_m ->command(-label => 'Reload',
429 -command => sub {bootup();
430 $status_t->configure(-state =>'normal');
431 $status_t ->delete("0.0", 'end');
432 $status_t -> insert ("0.0", "Reloading.. ");
433 $trace_t->configure(-state=>'normal');
434 $trace_t->delete("0.0", 'end');
435 show_trace($trace_t, $status_t, $addr_t, $tid);
436 $trace_t->configure(-state=>'disabled');
437 $state_t -> configure (-state => 'normal');
438 $state_t->delete("0.0", 'end');
439 $state_t -> insert("0.0", show_state($tid,-1));
440 tagstate($state_t, $balloon);
441 tagdelta($state_t);
442 $state_t -> configure (-state => 'disabled');
443 $status_t ->delete("0.0", 'end');
444 $status_t -> insert ("0.0", "Reloaded");
445 $status_t->configure(-state =>'disabled');
446
447 });
448$file_m ->command(-label => 'Reload Log Only',
449 -command => sub {
450 if ($gates) {slurp_barelog()}
451 elsif ($saslog) {slurp_saslog()}
452 else {slurp_logfile()}
453 $status_t->configure(-state =>'normal');
454 $status_t ->delete("0.0", 'end');
455 $status_t -> insert ("0.0", "Reloading.. ");
456 $trace_t->configure(-state=>'normal');
457 $trace_t->delete("0.0", 'end');
458 show_trace($trace_t, $status_t, $addr_t, $tid);
459 $trace_t->configure(-state=>'disabled');
460 $state_t -> configure (-state => 'normal');
461 $state_t->delete("0.0", 'end');
462 $state_t -> insert("0.0", show_state($tid,-1));
463 tagstate($state_t, $balloon);
464 tagdelta($state_t);
465 $state_t -> configure (-state => 'disabled');
466 $status_t ->delete("0.0", 'end');
467 $status_t -> insert ("0.0", "Reloaded");
468 $status_t->configure(-state =>'disabled');
469 });
470$file_m ->separator;
471$file_m ->command(-label => 'Save Current [Viewed] Trace ',
472 -command => sub {
473 use Tk::FileSelect;
474 my $tracefile
475 = $main_w->FileSelect(-directory=>"./")->Show;
476 if (defined $tracefile) {
477 open (TF, ">$tracefile") ||
478 warn "Could not open \"$tracefile\" for writing!, $!\n";
479 print TF $trace_t->get("0.0",'end'), "\n";
480 close TF;
481 }
482
483 });
484$file_m ->separator;
485$file_m ->command(-label => 'Quit', -command => sub {exit});
486
487## Thread cascade
488my $tid_m = $main_m -> cascade (-label => '~Thread', -tearoff => 1);
489
490my $cid;
491$tid_m -> radiobutton (-label => 'Merge All', -variable => \$merge,
492 -value => '1',
493 -command => sub {
494 $main_w->Busy;
495 $trace_t->configure(-state =>'normal');
496 $trace_t ->delete ("0.0",'end');
497 show_trace($trace_t, $status_t, $addr_t, $tid);
498 $trace_t->configure(-state=>'disabled');
499 $state_t->configure(-state =>'normal');
500 $state_t ->tagRemove('delta', "1.0", 'end');
501 $state_t ->delete("0.0", 'end');
502 $state_t -> insert("0.0",
503 show_state($tid,-1));
504 tagstate($state_t,$balloon);
505 $state_t->configure(-state=>'disabled');
506 $main_w->Unbusy;
507 });
508foreach $cid (0 .. int(($numthreads-1)/$num_threads_per_core)) {
509 my $anythd = 0;
510 map {$anythd++ if ($state{$cid*$num_threads_per_core+$_})}
511 0..$num_threads_per_core-1;
512 next if (!$anythd);
513 my $cid_m = $tid_m -> cascade (-label => 'C'.$cid, -tearoff => 1);
514 foreach (0 .. 7) {
515 $temp = $cid*$num_threads_per_core+$_;
516 my $state = 'disabled';
517 if (defined $trace{$temp}) {
518 $state = 'normal' ;
519 }
520 $cid_m -> radiobutton (-label => 'T'.$temp, -variable => \$tid,
521 -state => $state,
522 -value => $temp,
523 -command => sub {
524 $main_w->Busy;
525 $merge = 0;
526 $trace_t->configure(-state =>'normal');
527 $trace_t ->delete ("0.0",'end');
528 show_trace($trace_t, $status_t, $addr_t, $tid);
529 $trace_t->configure(-state=>'disabled');
530 $state_t->configure(-state =>'normal');
531 $state_t ->tagRemove('delta', "1.0", 'end');
532 $state_t ->delete("0.0", 'end');
533 $state_t -> insert("0.0",
534 show_state($tid,-1));
535 tagstate($state_t, $balloon);
536 $state_t->configure(-state=>'disabled');
537 $main_w->Unbusy;
538 });
539}
540}
541
542## Step cascade
543my $step_m = $main_m -> command (-label => '~Step' ,
544 -command => sub {my ($mtid, $instr) =
545 which_instr($status_t->get ("0.0", "end"));
546 $instr = get_next_instr ($mtid, $instr);
547 $state_t->configure(-state =>'normal');
548 $state_t ->tagRemove('delta', "1.0", 'end');
549 $state_t ->delete("0.0", 'end');
550 $state_t -> insert("0.0",
551 show_state ($mtid, $instr));
552 tagstate($state_t, $balloon);
553 tagdelta($state_t);
554 $state_t->configure(-state=>'disabled');
555 $status_t->configure(-state =>'normal');
556 $status_t ->delete("0.0", 'end');
557 $status_t
558 ->insert("0.0",$trace{$mtid}{$instr});
559 $status_t->configure(-state =>'disabled');
560 $addr_t->configure(-state =>'normal');
561 $addr_t ->delete("0.0", 'end');
562 $addr_t
563 ->insert("0.0",$offset{$mtid}{$instr});
564 $addr_t->configure(-state =>'disabled');
565 $trace_t->tagRemove('curr', '0.0', 'end');
566 my $index = $trace_t->search($trace{$mtid}{$instr}, '0.0', 'end');
567 $trace_t->tagAdd('curr',
568 $trace_t->index("$index linestart"),
569 $trace_t->index("$index lineend"));
570 $trace_t->see($trace_t->index("$index linestart"));
571 }) ;
572
573## Go To cascade
574my $goto_m = $main_m -> cascade (-label => '~Goto', -tearoff => 1) ;
575$goto_m -> command (-label => 'First', -command => sub {
576 $trace_t->see($trace_t->index("0.0 linestart"));
577 });
578$goto_m -> command (-label => 'Last', -command => sub {
579 my $index = $trace_t->search($trace{$tid}{$last{$tid}}, '0.0','end');
580 $trace_t->see($trace_t->index("$index linestart"));
581 });
582
583## ShowType option menu
584my $showtype_m = $main_m -> cascade (-label => 'Show', -tearoff => 1) ;
585 $showtype_m -> radiobutton (-label => 'Show Expected', -value => '0',
586 -variable => \$statetype,
587 -command => sub { $main_w->Busy;
588 $state_t->configure(-state =>'normal');
589 $state_t ->tagRemove('delta', "1.0", 'end');
590 $state_t ->delete("0.0", 'end');
591 $state_t -> insert("0.0",
592 show_state($tid,$current{$tid}));
593 tagstate($state_t, $balloon);
594 tagdelta($state_t);
595 $state_t->configure(-state=>'disabled');
596 $main_w->Unbusy;
597 });
598 $showtype_m -> radiobutton (-label => 'Show Actual/DUT', -value => '1',
599 -variable => \$statetype,
600 -command => sub { $main_w->Busy;
601 $state_t->configure(-state =>'normal');
602 $state_t ->tagRemove('delta', "1.0", 'end');
603 $state_t ->delete("0.0", 'end');
604 $state_t -> insert("0.0",
605 show_state($tid,$current{$tid}));
606 tagstate($state_t, $balloon);
607 tagdelta($state_t);
608 $state_t->configure(-state=>'disabled');
609 $main_w->Unbusy;
610 });
611
612## View Options (font etc)
613
614my $viewtype_m = $main_m -> cascade (-label => 'View', -tearoff => 0) ;
615$viewtype_m -> command (-label => 'Increase Font' ,
616 -command => sub {
617 my %font = $trace_t -> fontActual($state_t->cget(-font));
618 $font{-size} += 2;
619 $state_t ->configure(-font => [%font]);
620 $trace_t ->configure(-font => [%font]);
621 $addr_t ->configure(-font => [%font]);
622 $status_t ->configure(-font => [%font]);
623 });
624$viewtype_m -> command (-label => 'Decrease Font',
625 -command => sub {
626 my %font = $trace_t -> fontActual($state_t->cget(-font));
627 $font{-size} -= 2;
628 $state_t ->configure(-font => [%font]);
629 $trace_t ->configure(-font => [%font]);
630 $addr_t ->configure(-font => [%font]);
631 $status_t ->configure(-font => [%font]);
632 });
633
634## Tool Options
635
636my $tooltype_m = $main_m -> cascade (-label => 'Tool', -tearoff => 0) ;
637$tooltype_m -> command (-label => 'Launch Regtool' ,
638 -command => sub {system("regtool &")}
639 );
640$tooltype_m -> command (-label => 'Launch Tlbtrace' ,
641 -command => sub {system("tlbtrace &")}
642 );
643
644## Help Cascade
645my $help_m = $main_m -> cascade (-label => '~Help', -tearoff => 0) ;
646$help_m -> command (-label => 'Blurb', -command => sub {helptext ($main_w);});
647
648my $trace_f = $main_w -> Frame
649 -> pack (-padx => '3m', -pady => '1m', -fill => 'both',
650 -expand=> '1');
651$trace_f ->packAdjust();
652
653my $addr_f = $main_w ->Frame
654 -> pack (-padx => '3m', -pady => '1m', -fill => 'both',
655 -expand=> '0');
656
657my $status_f = $main_w ->Frame
658 -> pack (-padx => '3m', -pady => '1m', -fill => 'both',
659 -expand=> '0');
660
661my $state_f = $main_w ->Frame
662 -> pack (-padx => '3m', -pady => '1m', -fill => 'both',
663 -expand=> '1');
664$balloon = $main_w->Balloon(-balloonposition=>'mouse');
665
666#### Trace Panel ####
667$trace_t = $trace_f -> Text (-height => '20', -width => '80',
668 -background => 'white');
669
670if($gates) {
671 $trace_t -> configure (-height => '50');
672}
673$trace_t -> tagConfigure('instr', -foreground => 'darkblue');
674$trace_t -> tagConfigure('curr', -foreground => 'darkgreen');
675$trace_t -> tagConfigure('hot', -foreground => 'red', -relief => "raised",
676 -borderwidth => '2');
677$trace_t -> tagBind('instr', '<Button-1>',
678 sub {$main_w->Busy; my ($text) = @_;
679 $main_w->grabRelease;
680 $state_t->configure(-state =>'normal');
681 $state_t ->delete("0.0", 'end');
682 $state_t ->tagRemove('delta', "1.0", 'end');
683 $state_t -> insert("0.0", show_state(
684 which_instr($text->get (
685 $text->index("current linestart"),
686 $text->index("current lineend")))));
687 tagstate($state_t, $balloon);
688 tagdelta($state_t);
689 $state_t->configure(-state=>'disabled');
690 $status_t->configure(-state =>'normal');
691 $status_t->delete("0.0", 'end');
692 $status_t->insert("0.0", $text->get (
693 $text->index("current linestart"),
694 $text->index("current lineend")));
695 $status_t->configure(-state =>'disabled');
696 $addr_t->configure(-state =>'normal');
697 $addr_t ->delete("0.0", 'end');
698 $addr_t
699 ->insert("0.0",$offset{$tid}{$instr});
700 $addr_t->configure(-state =>'disabled');
701 $text->tagRemove('curr', '0.0', 'end');
702 $text->tagAdd('curr',
703 $text->index("current linestart"),
704 $text->index("current lineend"));
705 $text->see($text->index("current linestart"));
706 $main_w->Unbusy;
707 });
708
709$trace_t -> tagBind('instr', "<Enter>",
710 sub { my ($text) = @_;
711 $last_hover = $text->index("current linestart");
712 $text->tagAdd('hot',
713 $text->index("current linestart"),
714 $text->index("current lineend"));
715 $text->configure(-cursor => "hand2");
716 });
717$trace_t -> tagBind('instr', "<Leave>",
718 sub { my ($text) = @_;
719 $text->tagRemove('hot',
720 $text->index("current linestart"),
721 $text->index("current lineend"));
722 $text->configure(-cursor => "xterm");
723 });
724
725$trace_t -> tagBind('instr', "<Motion>",
726 sub { my ($text) = @_;
727 my $newline = $text->index("current linestart");
728 if ($newline ne $last_hover) {
729 $text->tagRemove('hot', '1.0', 'end');
730 $last_hover = $newline;
731 $text->tagAdd('hot',
732 $text->index("current linestart"),
733 $text->index("current lineend"));
734 }
735 });
736my $trace_sv = $trace_f -> Scrollbar(-command => ['yview', $trace_t] );
737$trace_t -> configure(-yscrollcommand => ['set', $trace_sv]);
738
739$trace_sv -> pack(-side => 'right', -fill => 'y', -expand => 0,
740 -padx => '0m', -pady => '0m');
741
742$trace_t -> pack (-side => 'top', -padx => '1m', -pady => '0m',
743 -fill => "both", -expand => 1);
744
745#### Address Panel ####
746$addr_f -> Label (-text => 'Current Label/Offset') -> pack (-side => 'left');
747$addr_t = $addr_f -> Text (-background => 'white', -height => '1', -width => '60');
748$addr_t -> pack (-side => 'top', -padx => '1m', -pady => '0m', -fill =>'y',
749 -expand => 0);
750$addr_t -> insert ("0.0", $addr_blurb);
751$addr_t->configure(-state=>'disabled');
752
753#### Status Panel ####
754$status_t = $status_f -> Text (-background => 'white', -height => '1', -width => '85');
755$status_t -> pack (-side => 'top', -padx => '1m', -pady => '0m', -fill =>'y',
756 -expand => 0);
757$status_t -> insert ("0.0", $status_blurb);
758$status_t->configure(-state=>'disabled');
759
760$trace_t->configure(-state=>'normal');
761show_trace($trace_t, $status_t, $addr_t, $tid);
762$trace_t->configure(-state=>'disabled');
763
764#### State Panel ####
765$state_t = $state_f -> Text (-background => 'white', -height => '34', -width => '80');
766
767$state_t -> tagConfigure('regname', -foreground => 'darkblue',
768 -underline => 1);
769$state_t -> tagConfigure('delta', -foreground => 'red');
770
771if($gates) {
772 $state_t -> configure (-height => '1', background => 'gray', -foreground => 'gray');
773 $state_t -> tagConfigure('regname', -foreground => 'gray',
774 -underline => 0);
775 $balloon->attach($state_t, -msg=>"No State Information Available!" );
776}
777
778my $state_sv = $state_f -> Scrollbar(-command => ['yview', $state_t] );
779$state_t -> configure(-yscrollcommand => ['set', $state_sv]);
780
781$state_sv -> pack(-side => 'right', -fill => 'y', -expand => 0,
782 -padx => '0m', -pady => '0m');
783
784$state_t -> pack (-side => 'top', -padx => '1m', -pady => '0m', -fill =>"both",
785 -expand => 1);
786
787$state_t -> insert("0.0", show_state($tid,-1));
788tagstate($state_t, $balloon);
789
790$state_t -> configure (-state => 'disabled');
791
792$trace_t -> bind('<4>' => sub {$_[0]->yview('scroll', -3, 'units')});
793$trace_t -> bind('<5>' => sub {$_[0]->yview('scroll', +3, 'units')});
794$state_t -> bind('<4>' => sub {$_[0]->yview('scroll', -3, 'units')});
795$state_t -> bind('<5>' => sub {$_[0]->yview('scroll', +3, 'units')});
796
797
798
799$state_m = $state_t -> menu;
800$search_m = $state_m->cascade(-label=>'Find Delta', -state=>'disabled');
801$search_m ->command(-label =>'Previous', -command =>
802 sub{$instr = previous_delta ($state_t);
803 if ($instr !~ /^[0-9]+$/o) {
804 $status_t->configure(-state =>'normal');
805 $status_t ->delete("0.0", 'end');
806 $status_t
807 ->insert("0.0","\tNo Prev Delta Found for $instr");
808 $status_t->configure(-state =>'disabled');
809 return;
810 }
811 $state_t->configure(-state =>'normal');
812 $state_t ->tagRemove('delta', "1.0", 'end');
813 $state_t ->delete("0.0", 'end');
814 $state_t -> insert("0.0",
815 show_state ($tid, $instr));
816 tagstate($state_t, $balloon);
817 tagdelta($state_t);
818 $state_t->configure(-state=>'disabled');
819 $status_t->configure(-state =>'normal');
820 $status_t ->delete("0.0", 'end');
821 $status_t
822 ->insert("0.0",$trace{$tid}{$instr});
823 $status_t->configure(-state =>'disabled');
824 $addr_t->configure(-state =>'normal');
825 $addr_t ->delete("0.0", 'end');
826 $addr_t
827 ->insert("0.0",$offset{$tid}{$instr});
828 $addr_t->configure(-state =>'disabled');
829 $trace_t->configure(-state =>'normal');
830 my $index = $trace_t->search($trace{$tid}{$instr}, '0.0', 'end');
831 $trace_t->tagRemove('curr', '0.0', 'end');
832 $trace_t->tagAdd('curr',
833 $trace_t->index("$index linestart"),
834 $trace_t->index("$index lineend"));
835 $trace_t->see($trace_t->index("$index linestart"));});
836$search_m ->command(-label =>'Next', -command =>
837 sub{$instr = next_delta ($state_t);
838 if ($instr !~ /^[0-9]+$/o) {
839 $status_t->configure(-state =>'normal');
840 $status_t ->delete("0.0", 'end');
841 $status_t
842 ->insert("0.0","\tNo Next Delta Found for $instr");
843 $status_t->configure(-state =>'disabled');
844 return;
845 }
846 $state_t->configure(-state =>'normal');
847 $state_t ->tagRemove('delta', "1.0", 'end');
848 $state_t ->delete("0.0", 'end');
849 $state_t -> insert("0.0",
850 show_state ($tid, $instr));
851 tagstate($state_t, $balloon);
852 tagdelta($state_t);
853 $state_t->configure(-state=>'disabled');
854 $status_t->configure(-state =>'normal');
855 $status_t ->delete("0.0", 'end');
856 $status_t
857 ->insert("0.0",$trace{$tid}{$instr});
858 $status_t->configure(-state =>'disabled');
859 $addr_t->configure(-state =>'normal');
860 $addr_t ->delete("0.0", 'end');
861 $addr_t
862 ->insert("0.0",$offset{$tid}{$instr});
863 $addr_t->configure(-state =>'disabled');
864 $trace_t->configure(-state =>'normal');
865 my $index = $trace_t->search($trace{$tid}{$instr}, '0.0', 'end');
866 $trace_t->tagRemove('curr', '0.0', 'end');
867 $trace_t->tagAdd('curr',
868 $trace_t->index("$index linestart"),
869 $trace_t->index("$index lineend"));
870 $trace_t->see($trace_t->index("$index linestart"));});
871
872$main_w -> Label (-text => "($ENV{PWD}) $logfile") -> pack();
873MainLoop;
874
875} # }}}
876
877###############################################################################
878# Initialize Non-Zero State for requested threads {{{
879#
880sub init_state {
881 my $tid = shift;
882 $state{$tid}{0}{"PC"} = "0000fffff0000020";
883 $state{$tid}{0}{"NPC"} = "0000fffff0000024";
884 $state{$tid}{0}{"CCR"} = "0000000000000000";
885 $state{$tid}{0}{"FPRS"} = "0000000000000004";
886 $state{$tid}{0}{"VER"} = "003e002410030607";
887 $state{$tid}{0}{"PSTATE"} = "0000000000000014";
888 $state{$tid}{0}{"HPSTATE"} = "0000000000000024";
889 $state{$tid}{0}{"TL"} = "0000000000000006";
890 $state{$tid}{0}{"TT6"} = "0000000000000001";
891 $state{$tid}{0}{"GL"} = "0000000000000003";
892 $state{$tid}{0}{"TICK"} = "8000000000000000";
893} # }}}
894
895###############################################################################
896# Initialize trace structure for requested threads {{{
897#
898sub init_trace {
899 my $tid = shift;
900 $current{$tid} = 0;
901 foreach (@allregs) {
902 $state{$tid}{0}{$_} = "0000000000000000";
903 }
904 foreach my $win (0 .. $maxwin-1) {
905 foreach (@windows) {
906 $cwp{$tid}{$win}{0}{$_} = "0000000000000000";
907 }
908 }
909 foreach my $g (0 .. $maxgl-1) {
910 foreach (@globals) {
911 $gl{$tid}{$g}{0}{$_} = "0000000000000000";
912 }
913 }
914} #}}}
915###############################################################################
916# Read in log file and update database .. {{{
917#
918sub slurp_logfile {
919 my $instr = 1;
920 my $expect = 0;
921 my $actual = 0;
922 my ($ttid, $mtid, $reg, $value);
923
924 if (&have_pas) {
925 $have_pa = 1;
926 }
927 my $fn = (-r $logfile)? $logfile :"gunzip -c $logfile |";
928 open (LOG, "$fn")
929 || usage( "ERROR > Cannot open Log file $logfile, $!\n");
930 print "INFO > Loading logfile \"$logfile\"..\n";
931 if ($only_cores ne "") {
932 print "INFO > Restricted to reading log for core(s) $only_cores\n";
933 }
934 my %temp;
935 while ($line = <LOG>) {
936 next unless ($line =~ /^\<T\d+\>/ || $line =~ /^Dumping\s+remaining/o
937 || $line =~ /Reg did not change/o
938 || $line =~ /^\s*\d+:\s+\w+\[\w+_top.*?\]:\s+@\d+\s+.*?\s+T\d+/o
939 || $line =~ /^\s*\d+:\s+\S+:\s+@\d+\s+\T\d+\s+\w*[Pp]arked/o);
940 # If DUT did not change then last read item is in expect only ..
941 if ($line =~ /DUT Reg did not change/o) {
942 $expdelta{$ttid}{$instr}{$reg} = $temp{$ttid}{$reg};
943 delete $temp{$ttid}{$reg};
944 next;
945 }
946
947 if ($line =~ /^Dumping remaining EXPECTED/o) {
948 $expect = 1; $actual = 0; next;
949 }
950 if ($line =~ /^Dumping remaining ACTUAL/o) {
951 $actual = 1; $expect = 0; next;
952 }
953 if ($line =~ /tb_top(\d+).*\s+T(\d+)/) {
954 my $act_tid = $2 + $1*$num_threads_per_node;
955 $line =~ s/ T\d+/ T$act_tid/;
956 }
957 next if ($line !~ /$only_cores/o);
958 chomp($line);
959 if ($line =~ /^\<T(\d+)\>/o) {
960 $ttid = $1;
961 foreach ($line =~ m/(\w+\s*=\s*\w+)/go) {
962 ($reg,$value) = m/(\w+)\s*=\s*(\w+)/o;
963 if ($expect) {
964 $expdelta{$ttid}{$instr}{$reg} = $value;
965 } elsif ($actual) {
966 $actdelta{$ttid}{$instr}{$reg} = $value;
967 } else {
968 $temp{$ttid}{$reg} = $value;
969 }
970 }
971 next;
972 }
973 if (($mtid)
974 = $line =~ /^\s*\d+:\s+\w+\[\w+_top.*?\]:\s+.*?\s+T(\d+)/o) {
975 $line =~ s/.*\[\w+_top.*?\]:\s+@(\d+)/$1:/;
976 last if ($maxtime && $1 > $maxtime);
977 $instr = int($instr);
978 $line =~ s/(#\d+)*\s+T/ #$instr T/; # Add instr# if not present.
979
980 if (!exists ($state{$mtid}{0})) {
981 init_trace($mtid);
982 init_state($mtid);
983 $numthreads = $mtid+1 if ($numthreads<=$mtid) ;
984 $tid = $mtid if ($mtid < $tid);
985 }
986
987 if ($nosas) {
988 my ($va) = $line =~ m/T\d+\s+(\w+)/o;
989 my $sva = substr($va, -12); # Use 48 bits only
990 $line =~ s/$va/$sva/;
991 if($have_disas) {
992 $line =~ s/\(unchecked.*?\)/$disas{$sva}/i;
993 }
994 }
995 $current{$mtid} = $instr;
996 $trace{$mtid}{$instr} = $line;
997 $fulltrace{$instr} = $line;
998 foreach (keys %{$temp{$ttid}}) {
999 $delta{$mtid}{$instr}{$_} = $temp{$ttid}{$_};
1000 }
1001 %temp=();
1002 if ($ttid!=$mtid) {
1003 $expdelta{$mtid}{$instr}{$reg} =$expdelta{$ttid}{$instr}{$reg} ;
1004 $actdelta{$mtid}{$instr}{$reg} =$actdelta{$ttid}{$instr}{$reg} ;
1005 delete($expdelta{$ttid}{$instr}{$reg});
1006 delete($actdelta{$ttid}{$instr}{$reg});
1007 }
1008 $expect=0;$actual=0;
1009 $instr++;
1010 } elsif (($mtid)
1011 = $line =~ /^\s*\d+:\s+\S+:\s+@\d+\s+\T(\d+)\s+\w*[Pp]arked/o) {
1012 $line =~ s/.*\[.*?\]:\s+@(\d+)/$1:/;
1013 $instr = $instr -1 + 0.1 ;
1014 $line =~ s/(#\d+)*\s+T/ #$instr T/; # Add instr# if not present.
1015
1016 $current{$mtid} = $instr;
1017 $trace{$mtid}{$instr} = $line;
1018 $fulltrace{$instr} = $line;
1019 foreach (keys %{$temp{$ttid}}) {
1020 $delta{$mtid}{$instr}{$_} = $temp{$ttid}{$_};
1021 }
1022 %temp=();
1023 $expect=0;$actual=0;
1024 $instr++;
1025 }
1026 }
1027 close LOG;
1028 foreach (0.. $numthreads-1) {
1029 $last{$_} = $current{$_};
1030 $current{$_} = 0;
1031 }
1032} #}}}
1033###############################################################################
1034# Read in SAS log file and update database .. {{{
1035#
1036sub slurp_saslog {
1037 my $instr = 0;
1038 my $expect = 0;
1039 my $actual = 0;
1040 my %currwin = ();
1041 my ($prevtid, $mtid, $reg, $win, $value, $pc);
1042 my $fn = (-r $logfile)? $logfile :"gunzip -c $logfile |";
1043 open (LOG, "$fn")
1044 || usage( "ERROR > Cannot open Log file $logfile, $!\n");
1045 print "INFO > Loading logfile \"$logfile\"..\n";
1046 if ($cores ne "") {
1047 foreach (split(/,/, $cores)) {
1048 if ($newsasformat) {
1049 $only_cores .= "|^#\d+\s+T$_|STEP:\s+$_\s+";
1050 } else {
1051 $only_cores .= "|^T$_|STEP:\s+$_\s+";
1052 }
1053 }
1054 $only_cores =~ s/^\|//;
1055 print "INFO > Restricted to reading log for core(s) $cores\n";
1056 }
1057 foreach (0..63) {
1058 $currwin{$_} = 0;
1059 }
1060 my %temp; my $first = 1; my $sasline; my $saspcline;
1061
1062 if ($newsasformat) {
1063 $sasline = "^#\\d+\\s+T(\\d+)\\s+|STEP:\\s+(\\d+)";
1064 $saspcline = "T(\\d+).*?\\s+<v:(\\w+)>";
1065 } else {
1066 $sasline = "^T(\\d+)\\s+|STEP:\\s+(\\d+)";
1067 $saspcline = "^T(\\d+).*?PC=0x(\\w+)";
1068 }
1069 while ($line = <LOG>) {
1070 next unless ($line =~ /$sasline/);
1071 next if ($line !~ /$only_cores/);
1072 chomp($line);
1073 if ($line =~ /$saspcline/o) {
1074 if (!$first) {
1075 foreach (keys %{$temp{$mtid}}) {
1076 $delta{$mtid}{$instr}{$_} = $temp{$mtid}{$_};
1077 }
1078 %temp=();
1079 }
1080 $instr++;
1081 ($mtid, $pc) = $line =~ m/$saspcline/o ;
1082 if (!exists ($state{$mtid}{0})) {
1083 init_trace($mtid);
1084 init_state($mtid);
1085 $numthreads = $mtid+1 if ($numthreads<=$mtid) ;
1086 $tid = $mtid if ($mtid < $tid);
1087 }
1088 $pc = substr ($pc, -12);
1089 $pc = sprintf "%012llx", hex($pc);
1090 if ($newsasformat) {
1091 $line =~ s/^#(\d+)\s+(T\d+)\s+<(v:\w+>\s+<p:\w+>)\s+\[(.*?)\]\s+(.*)$/$1: #$1 $2 $pc [ 0x$4 ] $5/;
1092 } else {
1093 $line =~ s/^(T\d+)\s+ic=(\d+)\s+\((#\d+)\)\s+PC=0x(\w+)\s+(\[.*?\])\s+(.*)$/$2: $3 $1 $pc $5 $6/;
1094 }
1095
1096 $current{$mtid} = $instr;
1097 $trace{$mtid}{$instr} = $line;
1098 $fulltrace{$instr} = $line;
1099 $first = 0;
1100 next;
1101 }
1102 if (($mtid) = $line =~ /STEP:\s+(\d+)\s+/) {
1103 if (($reg,$value) = $line =~ /C\s+(\w+).*?\s+(\w+)/) {
1104 if ($reg =~ /^[0-9]+$/) {
1105 $reg = cregname($reg);
1106 }
1107 $temp{$mtid}{$reg} = $value;
1108 if ($reg eq "CWP") {
1109 $currwin{$mtid} = $value;
1110 }
1111 }elsif (($reg,$value) = $line =~ /F\s+(\d+)\s+(\w+)/) {
1112 $temp{$mtid}{"f".$reg} = $value;
1113 }elsif (($reg,$value) = $line =~ /G\s+\d\s+(\d+)\s+(\w+)/) {
1114 $temp{$mtid}{"g".$reg} = $value;
1115 }elsif (($win, $reg, $value) = $line=~ /W\s+(\d)\s+(\d+)\s+(\w+)/) {
1116 $reg = getwinreg($currwin{$mtid}, $win, $reg);
1117 $temp{$mtid}{$reg} = $value;
1118 }
1119 next;
1120 }
1121 }
1122 close LOG;
1123 foreach (0.. $numthreads-1) {
1124 $last{$_} = $current{$_};
1125 $current{$_} = 0;
1126 }
1127} #}}}
1128###############################################################################
1129# Get Regname for window registers {{{
1130#
1131sub getwinreg {
1132 my ($currwin, $win, $reg) = @_ ;
1133 if ($reg >= 8 && $reg <= 15) {
1134 if ($win == $currwin) {
1135 $reg = "o" . ($reg - 8);
1136 } else {
1137 $reg = "i" . ($reg - 8);
1138 }
1139 } else {
1140 $reg = "l" . ($reg - 16) ;
1141 }
1142 return $reg;
1143
1144} #}}}
1145
1146###############################################################################
1147# Find nearest symbol offset {{{
1148# Input va, Output symbol+offset
1149#
1150sub get_symbol_offset {
1151 my $va = shift(@_);
1152 my $nearest_va = 0;
1153 foreach (@sorted_symbols) {
1154 last if (hex($va) < hex($_));
1155 $nearest_va = $_;
1156 }
1157 return (sprintf ("%s+0x%lx",
1158 $symbols{$nearest_va}, hex($va)- hex($nearest_va)));
1159}#}}}
1160###############################################################################
1161# Show trace for specific thread {{{
1162# Inputs Text Widget, TID
1163# Outputs - trace formatted string
1164sub show_trace {
1165 my ($trace_t, $status_t, $addr_t, $tid) = @_;
1166 my %mytrace ;
1167 if (!$merge && !defined $trace{$tid}) {
1168 $trace_t -> insert ('0.0', "\nNo Trace available for thread $tid");
1169 return ;
1170 }
1171 if ($merge) {
1172 %mytrace = %fulltrace;
1173 } else {
1174 %mytrace = %{$trace{$tid}};
1175 }
1176 my $last_va = 0;
1177 my $last_label = '';
1178 foreach (sort {$a <=> $b} keys %mytrace) {
1179 my $line = $mytrace{$_} . "\n";
1180 my ($mtid, $inst, $va);
1181 if ($have_symbols) {
1182 if ($have_pa) {
1183 ($inst,$mtid, $va) = $line =~ /\d+:\s+#(\d+)\s+T(\d+)\s+v:(\w+)/o;
1184 } else {
1185 ($inst,$mtid, $va) = $line =~ /\d+:\s+#(\d+)\s+T(\d+)\s+(\w+)/o;
1186 }
1187 if (defined ($symbols{$va})) {
1188 $trace_t -> insert ('end', "\n$symbols{$va}: \n");
1189 $last_label = $symbols{$va};
1190 $last_va = $va;
1191 }
1192 }
1193 $trace_t -> insert ('end', $line, 'instr');
1194 }
1195 if ($current{$tid}) {
1196 my $index = $trace_t->search($mytrace{$current{$tid}}, '0.0','end');
1197 $trace_t->tagAdd('curr',
1198 $trace_t->index("$index linestart"),
1199 $trace_t->index("$index lineend"));
1200 $trace_t->see($trace_t->index("$index linestart"));
1201 $status_t->configure(-state =>'normal');
1202 $status_t->delete("0.0", 'end');
1203 $status_t->insert("0.0", $mytrace{$current{$tid}});
1204 $status_t->configure(-state =>'disabled');
1205 $addr_t->configure(-state =>'normal');
1206 $addr_t ->delete("0.0", 'end');
1207 $addr_t ->insert("0.0",$offset{$tid}{$current{$tid}});
1208 $addr_t->configure(-state =>'disabled');
1209 } else {
1210 $trace_t->tagRemove('curr', '0.0', 'end');
1211 $trace_t->see($trace_t->index("0.0 linestart"));
1212 $status_t->configure(-state =>'normal');
1213 $status_t->delete("0.0", 'end');
1214 $status_t->insert("0.0", $status_blurb);
1215 $status_t->configure(-state =>'disabled');
1216 $addr_t->configure(-state =>'normal');
1217 $addr_t ->delete("0.0", 'end');
1218 $addr_t ->insert("0.0",$addr_blurb);
1219 $addr_t->configure(-state =>'disabled');
1220 }
1221} # }}}
1222
1223###############################################################################
1224# Show full state for specific instruction {{{
1225#
1226# Inputs - TID, Instr #
1227# Outputs - State display listing -
1228#
1229sub show_state {
1230 ($tid, $instr) = @_;
1231
1232 my $statelist = "";
1233
1234
1235 print "\nINFO > Tracing State for T$tid to Instruction #$instr..\n"
1236 if ($debug);
1237
1238 my $currinstr;
1239 my ($reg, $value);
1240 my ($vtime, $disas);
1241
1242 my ($currwin, $currgl) = current_state($tid, $instr);
1243
1244 # Print State - 4/row
1245 $i = 0;
1246 @delta_index = ();
1247 print "INFO > State for Thread $tid ($vtime : $disas):\n" if ($debug);
1248 $statelist .= " g[".hex($currgl)."] " .
1249 " o[". hex($currwin). "] " .
1250 " l[". hex($currwin). "] " .
1251 " i[". hex($currwin). "] \n";
1252
1253 foreach (0..7) {
1254 $statelist .= "$_ ";
1255 if (defined ($delta{$tid}{$instr}{"g".$_})) {
1256 push (@delta_index, length($statelist),
1257 length($gl{$tid}{hex($currgl)}{$instr}{"g".$_}));
1258 }
1259 $statelist .= sprintf "%16s ",
1260 $gl{$tid}{hex($currgl)}{$instr}{"g".$_};
1261
1262 if (defined ($delta{$tid}{$instr}{"o".$_})) {
1263 push (@delta_index, length($statelist),
1264 length($cwp{$tid}{hex($currwin)}{$instr}{"o".$_}));
1265 }
1266 $statelist .= sprintf "%16s ",
1267 $cwp{$tid}{hex($currwin)}{$instr}{"o".$_};
1268
1269 if (defined ($delta{$tid}{$instr}{"l".$_})) {
1270 push (@delta_index, length($statelist),
1271 length($cwp{$tid}{hex($currwin)}{$instr}{"l".$_}));
1272 }
1273 $statelist .= sprintf "%16s ",
1274 $cwp{$tid}{hex($currwin)}{$instr}{"l".$_};
1275
1276 if (defined ($delta{$tid}{$instr}{"i".$_})) {
1277 push (@delta_index, length($statelist),
1278 length($cwp{$tid}{hex($currwin)}{$instr}{"i".$_}));
1279 }
1280 $statelist .= sprintf "%16s ",
1281 $cwp{$tid}{hex($currwin)}{$instr}{"i".$_} ;
1282 $statelist .= "\n";
1283 }
1284 while ($i < scalar(@allregs)) {
1285 $statelist .= sprintf " %16s %16s %16s %16s\n",
1286 $allregs[$i], $allregs[$i+1], $allregs[$i+2], $allregs[$i+3] ;
1287
1288
1289 if (defined ($delta{$tid}{$instr}{$allregs[$i]})) {
1290 push (@delta_index, length($statelist)+3,
1291 length($state{$tid}{$instr}{$allregs[$i]}));
1292 } elsif ($allregs[$i] =~ /^f(\d+)/) {
1293 if (defined($delta{$tid}{$instr}{"f".($1+1)})) {
1294 push (@delta_index, length($statelist)+3,
1295 length($state{$tid}{$instr}{$allregs[$i]}));
1296 }
1297 }
1298 $statelist .= sprintf " %16s ",
1299 $state{$tid}{$instr}{$allregs[$i]};
1300
1301
1302 if (defined ($delta{$tid}{$instr}{$allregs[$i+1]})) {
1303 push (@delta_index, length($statelist),
1304 length($state{$tid}{$instr}{$allregs[$i+1]}));
1305 } elsif ($allregs[$i+1] =~ /^f(\d+)/) {
1306 if (defined($delta{$tid}{$instr}{"f".($1+1)})) {
1307 push (@delta_index, length($statelist),
1308 length($state{$tid}{$instr}{$allregs[$i+1]}));
1309 }
1310 }
1311 $statelist .= sprintf "%16s ",
1312 $state{$tid}{$instr}{$allregs[$i+1]};
1313
1314
1315 if (defined ($delta{$tid}{$instr}{$allregs[$i+2]})) {
1316 push (@delta_index, length($statelist),
1317 length($state{$tid}{$instr}{$allregs[$i+2]}));
1318 } elsif ($allregs[$i+2] =~ /^f(\d+)/) {
1319 if (defined($delta{$tid}{$instr}{"f".($1+1)})) {
1320 push (@delta_index, length($statelist),
1321 length($state{$tid}{$instr}{$allregs[$i+2]}));
1322 }
1323 }
1324 $statelist .= sprintf "%16s ",
1325 $state{$tid}{$instr}{$allregs[$i+2]};
1326
1327
1328 if (defined ($delta{$tid}{$instr}{$allregs[$i+3]})) {
1329 push (@delta_index, length($statelist),
1330 length($state{$tid}{$instr}{$allregs[$i+3]}));
1331 } elsif ($allregs[$i+3] =~ /^f(\d+)/) {
1332 if (defined($delta{$tid}{$instr}{"f".($1+1)})) {
1333 push (@delta_index, length($statelist),
1334 length($state{$tid}{$instr}{$allregs[$i+3]}));
1335 }
1336 }
1337 $statelist .= sprintf "%16s ",
1338 $state{$tid}{$instr}{$allregs[$i+3]};
1339 $statelist .= "\n";
1340
1341 $i=$i+4;
1342 }
1343 return ($statelist);
1344} # }}}
1345
1346###############################################################################
1347# Parse trace line and return instr, tid {{{
1348#
1349sub which_instr {
1350 my ($line) = @_;
1351 if ($line !~ m/^\s*\d+:\s*#(\d+)\s+T(\d+)/) {
1352 return ($tid, -1);
1353 } else {
1354 my ($instr, $tid) = $line =~ /^\s*\d+:\s*#(\d+)\s+T(\d+)/;
1355 return ($tid, $instr);
1356 }
1357} # }}}
1358
1359###############################################################################
1360# Figure out if valid show_deltas file is present {{{
1361sub have_deltas {
1362 if (!-r $logfile && !-r "$logfile.gz") {
1363 usage( "\nERROR > Could not find file $logfile or $logfile.gz, $!");
1364 }
1365 my $line;
1366 my $cat = (-r $logfile)? "/bin/cat -s " : "/bin/gzcat";
1367 if (!$saslog) {
1368 chomp($line = `$cat $logfile* | head -6000 | /bin/grep 'Show Delta Enabled'`);
1369 } else {
1370 chomp($line = `$cat $logfile* | head -100 | /bin/grep 'STEP:'`);
1371 }
1372 return (length($line));
1373} # }}}
1374
1375###############################################################################
1376# Figure out if PA is displayed in file {{{
1377sub have_pas {
1378 if (!-r $logfile && !-r "$logfile.gz") {
1379 usage( "\nERROR > Could not find file $logfile or $logfile.gz, $!");
1380 }
1381 my $line;
1382 my $cat = (-r $logfile)? "/bin/cat -s " : "/bin/gzcat";
1383 chomp($line = `$cat $logfile* | head -6000 | /bin/grep ': Enabled PA display'`);
1384 return (length($line));
1385} # }}}
1386###############################################################################
1387# Figure out if sas checking is enabled {{{
1388sub no_sascheck {
1389 if (!-r $logfile && !-r "$logfile.gz") {
1390 usage( "\nERROR > Could not find file $logfile or $logfile.gz, $!");
1391 }
1392 my $cat = (-r $logfile)? "/bin/cat -s " : "/bin/gzcat";
1393 chomp(my $line = `$cat $logfile* | head -6000 | /bin/grep 'Nas Checking Disabled'`);
1394 return (length($line));
1395} # }}}
1396
1397###############################################################################
1398# Load symbol table {{{
1399sub slurp_symbols {
1400
1401 my $fn = (-r $symfile)? $symfile :"gunzip -c $symfile |";
1402 open (SYM, "$fn")
1403 || die "ERROR > Cannot open Symbols file $symfile, $!\n";
1404 print "INFO > Loading Symbols \"$symfile\"..\n";
1405 my $count = 0;
1406 while ($line = <SYM>) {
1407 my ($label, $va) = $line =~ m/^(.*?)\s+(\w+)\s+/o;
1408 $va = substr ($va, -12); # use 48 bits only
1409 $symbols{$va} = $label;
1410 $count++;
1411 }
1412 close SYM;
1413 @sorted_symbols = sort {hex($a) <=> hex($b)} keys %symbols ;
1414 print "INFO > Loaded & sorted $count symbols from $symfile..\n";
1415} # }}}
1416
1417###############################################################################
1418# Load disassembly {{{
1419sub slurp_disas {
1420
1421 my $iscomp = 0;
1422 if (! $usedis && ! -r $diagexe && ! -r "$diagexe.gz") {
1423 print "INFO > No Disassembly, (\"$diagexe\" or \"$diagexe.gz\" not found) ..\n";
1424 return;
1425 }
1426 if (!-r $diagexe && -r "$diagexe.gz") {
1427 `cp $diagexe.gz /tmp/$diagexe.$$.gz; gunzip /tmp/$diagexe.$$.gz`;
1428 $diagexe = "/tmp/$diagexe.$$";
1429 $iscomp=1;
1430 }
1431 if (!$usedis) {
1432 open (DIS, "$dis_cmd $diagexe |")
1433 || die "ERROR > Cannot open \"$dis_cmd $diagexe\"for disassembly, $!\n";
1434 print "INFO > Disassembling \"$diagexe\"..($dis_cmd)\n";
1435 } else {
1436 print "INFO > Using existing disassembly \"$usedis\"..\n";
1437 open (DIS, "$usedis") || die "ERROR> Cannot read sepcified disassembly file \"$usedis\" !\n";
1438 }
1439 while ($line = <DIS>) {
1440 next if ( $line !~ /^\s*(\w+):\s+(\w\w\s){4}\s+(.*?)$/);
1441 my ($va,$temp,$dis) = $line =~ m/^\s*(\w+):\s+(\w\w\s){4}\s+(.*)$/o;
1442 $va = substr ($va, -12); # use 48 bits only
1443 $va = "0" x (12-length($va)) . $va;
1444 $dis =~ s/\s+/ /g;
1445 $disas{$va} = "\t".$dis;
1446 }
1447 close DIS;
1448 $have_disas = 1 if (scalar keys %disas);
1449 unlink "$diagexe" if ($iscomp && -r $diagexe);
1450} # }}}
1451
1452###############################################################################
1453# Remove leading 0x0 .. {{{
1454
1455sub rlz {
1456 my $string = @_[0];
1457
1458 $string =~ s/^0+/0/o;
1459 return $string;
1460} # }}}
1461
1462###############################################################################
1463# Find Regnames and create tags {{{
1464# Scan text string for regnames
1465#
1466sub tagstate {
1467
1468 my ($state_t,$balloon) = @_;
1469
1470 my $statestring = $state_t->get('0.0', 'end');
1471
1472 my $regstat = "";
1473
1474
1475 foreach (@allregs) {
1476 my $len = 0; my $regex = '\b'.$_.'\b';
1477 my $index = $state_t->search(-count=>\$len, -regex, $regex, '0.0', 'end');
1478 my ($line, $char) = $index =~ m/(\d+).(\d+)/o; $char += $len;
1479 $state_t->tagAdd('regname', $index, $line.".".$char);
1480 }
1481
1482 foreach (qw(g o l i)) {
1483 my $len = 0;
1484 my $index = $state_t->search(-count=>\$len, -exact, $_, '0.0', '2.0');
1485 my ($line, $char) = $index =~ m/(\d+).(\d+)/o; $char += $len;
1486 $state_t->tagAdd('regname', $index, $line.".".$char);
1487 }
1488 $state_t->tagBind('regname', "<Enter>",
1489 sub { my ($text)=@_;
1490 $regstat=$text->get($text->index("current wordstart"),
1491 $text->index("current wordend"));
1492 if (defined($expandreg{$regstat})) {
1493 $regstat = showbits($regstat);
1494 $balloon->attach($state_t, -msg=>$regstat );
1495 }
1496 $text->menu()->entryconfigure('last', -state => 'disabled');
1497 });
1498 $state_t->tagBind('regname', "<Leave>",
1499 sub { my ($text)=@_;$regstat="";
1500 $balloon->detach($state_t);
1501 });
1502 $state_t->tagBind('regname', "<Button-3>",
1503 sub { my ($text)=@_;
1504 $text->menu()->entryconfigure('last', -state => 'normal');
1505 });
1506
1507
1508} # }}}
1509
1510###############################################################################
1511# Expand state bits for registers {{{
1512#
1513sub showbits {
1514 my $regname = @_[0];
1515 my $regtext = "";
1516 my @regbits
1517 = reverse(split(//, unpack("B*", pack("H16",$state{$tid}{$instr}{$regname}))));
1518 foreach (reverse sort {$a<=>$b} keys %{$expandreg{$regname}}) {
1519 my ($l, $h) = split(/:/,$_);
1520 $regtext .= " ".$expandreg{$regname}{$_}." = ".join('',reverse(@regbits[$l..$h])). " |" ;
1521 }
1522 chop($regtext);
1523 return $regtext;
1524} # }}}
1525###############################################################################
1526# Tag Deltas in state window {{{
1527#
1528sub tagdelta {
1529 my $state_t = @_[0];
1530
1531 $state_t ->tagRemove('delta', "1.0", 'end');
1532 return if (! scalar(@delta_index));
1533
1534 while (scalar(@delta_index)) {
1535 my $st_d = shift (@delta_index);
1536 my $en_d = $st_d + (shift (@delta_index));
1537 $state_t->tagAdd('delta', "1.0 + $st_d chars", "1.0 + $en_d chars");
1538 }
1539} # }}}
1540
1541###############################################################################
1542# Get Next instruction {{{
1543#
1544sub get_next_instr {
1545
1546 my ($tid, $instr) = @_;
1547 foreach (sort {$a <=> $b} keys %{$trace{$tid}}) {
1548 return ($_) if ($_ > $instr);
1549 }
1550}# }}}
1551
1552###############################################################################
1553# Get Prev instruction state {{{
1554#
1555sub get_prev_state {
1556
1557 my ($tid, $instr) = @_;
1558 foreach (reverse sort {$a <=> $b} keys %{$state{$tid}}) {
1559 return ($_) if ($_ < $instr);
1560 }
1561}# }}}
1562
1563###############################################################################
1564# Compress state/win/gl hashes {{{
1565# to keep mem util low when in incr mode
1566#
1567sub compress_to_last_state {
1568
1569 my ($tid) = @_;
1570 my @statelist = reverse sort {$a <=> $b} keys %{$state{$tid}};
1571 foreach (@statelist[1..(scalar(@statelist)-1)]) {
1572 delete ($state{$tid}{$_});
1573 }
1574 foreach my $win (0..$maxwin) {
1575 my @winlist = reverse sort {$a <=> $b} keys %{$cwp{$tid}{$win}};
1576 foreach (@winlist[1..(scalar(@winlist)-1)]) {
1577 delete ($cwp{$tid}{$win}{$_});
1578 }
1579 }
1580 foreach my $g (0..$maxgl) {
1581 my @glist = reverse sort {$a <=> $b} keys %{$gl{$tid}{$g}};
1582 foreach (@glist[1..(scalar(@glist)-1)]) {
1583 delete ($gl{$tid}{$g}{$_});
1584 }
1585 }
1586}# }}}
1587
1588###############################################################################
1589# Help Text {{{
1590#
1591sub helptext {
1592
1593# Subroutine to show help text
1594
1595# Input :
1596# parent window handle,
1597# Output:
1598# window with global help displayed..
1599
1600 my ($main) = @_;
1601
1602 my $help_w = $main -> Toplevel;
1603 $help_w -> title ('A Helping Hand');
1604
1605 my $help_t = $help_w -> Text (-width => '80', -height => '20',
1606 -wrap => 'word')
1607 -> pack (-padx => '0m', -pady => '1m', -side => 'left',
1608 -fill=> 'y');
1609
1610 my $help_s = $help_w -> Scrollbar (-command => ['yview', $help_t] );
1611
1612 $help_t -> configure (-yscrollcommand => ['set', $help_s]);
1613 $help_s -> pack(-side => 'right', -fill => 'y');
1614 $help_t -> insert("0.0", $help);
1615 $help_t -> configure(-state => 'disabled');
1616
1617 $help_w -> Button (-text => 'OK', -command => [$help_w, 'destroy'])
1618 -> pack(-padx => '3m', -pady => '1m', -side => 'bottom');
1619} # }}}
1620
1621###############################################################################
1622# Non GUI trace logging {{{
1623#
1624# Display sorted (instr#) to stdout.
1625# Keep current state for each thread - incrementally update
1626# Add deltas for instruction
1627# Determine %rd, and show %rd value if not in delta.
1628#
1629sub log_trace {
1630
1631
1632
1633 foreach my $currinstr (sort {$a <=> $b} keys %fulltrace) {
1634 my ($currtid, $curraddr, $disas, $junk) ;
1635 if (!$have_pa) {
1636 ($currtid, $curraddr, $disas, $junk) = $fulltrace{$currinstr} =~
1637 m/^\d+:.*#\d+\s+T(\d+)\s+(\w+)\s+(.*?)\s*(OK|FAIL)*$/;
1638 } else {
1639 ($currtid, $curraddr, $disas, $junk) = $fulltrace{$currinstr} =~
1640 m/^\d+:.*#\d+\s+T(\d+)\s+v:(\w+)\s+p:\w+\s+(.*?)\s*(OK|FAIL)*$/;
1641 }
1642 if ($have_symbols && defined ($symbols{$curraddr})) {
1643 print "\n$symbols{$curraddr}:\n";
1644 }
1645 print " $fulltrace{$currinstr}\n";
1646 my $maxcol = 2;
1647 my $col = 0;
1648 my $rd;
1649 my $opcode;
1650 my $fdbl = 0;
1651 my ($freg,$frnum);
1652 if ($disas =~ /(\w+)\s+.*%(\w+)$/) {
1653 $opcode= $1; $rd = $2;
1654 if ($rd eq "fp") {
1655 $rd = "i6";
1656 } elsif ($rd eq "sp") {
1657 $rd = "o6";
1658 }
1659 if ($rd =~ /^[fd](\d+)$/) {
1660 $frnum=$1; $rd =~ s/^d/f/;
1661 if ($opcode =~ /^[f].*d$|^ldd$/) {
1662 $fdbl = 1;
1663 }
1664 }
1665 if (!(defined($delta{$currtid}{$currinstr}{$rd}) ||
1666 defined($delta{$currtid}{$currinstr}{"\U$rd\E"}))) {
1667 my ($win, $gl) = current_state($currtid,$currinstr);
1668 compress_to_last_state($currtid);
1669 if ($rd !~ /^[ilogf]\d+$/o) {
1670 print "\t$rd = ", $state{$currtid}{$currinstr}{"\U$rd\E"};
1671 } elsif ($rd =~ /^f(\d+)$/o) {
1672 # Float state is stored in even reg as 64 bit (Even,Odd)..
1673 if (($frnum%2)) { ## Odd reg
1674 $frnum = $frnum - 1;
1675 $freg = "f".$frnum;
1676 print "\t$rd = 00000000",
1677 join('',(split(//,$state{$currtid}{$currinstr}{$freg}))[8..15]);
1678 } else { # Even
1679 $freg = "f".$frnum;
1680 print "\t$rd = 00000000",
1681 join('',(split(//,$state{$currtid}{$currinstr}{$freg}))[0..7]);
1682 }
1683 } elsif ($rd =~ /^g\d+$/o) {
1684 print "\t$rd = ", $gl{$currtid}{$gl}{$currinstr}{$rd};
1685 } else {
1686 print "\t$rd = ", $cwp{$currtid}{$win}{$currinstr}{$rd};
1687 }
1688 } elsif (defined($delta{$currtid}{$currinstr}{$rd})) {
1689 print "\t$rd = $delta{$currtid}{$currinstr}{$rd}";
1690 } elsif (defined($delta{$currtid}{$currinstr}{"\U$rd\E"})) {
1691 print "\t$rd = ",$delta{$currtid}{$currinstr}{"\U$rd\E"};
1692 }
1693 # For float doubles, print odd reg now (even is printed as rd)
1694 if ($fdbl) {
1695 $freg = "f".($frnum+1);
1696 if (!defined($delta{$currtid}{$currinstr}{$freg})) {
1697 if (!defined($state{$currtid}{$currinstr}{$rd})) {
1698 my ($win, $gl) = current_state($currtid,$currinstr);
1699 compress_to_last_state($currtid);
1700 }
1701 print "\t$freg = 00000000",
1702 join('',(split(//,$state{$currtid}{$currinstr}{$rd}))[8..15]);
1703 } else {
1704 print "\t$freg = ", $delta{$currtid}{$currinstr}{$freg};
1705 }
1706 $col++;
1707 }
1708 $col++;
1709 }
1710 foreach my $reg (reverse sort keys %{$delta{$currtid}{$currinstr}}) {
1711 next if($reg =~ /$rd/i);
1712 next if ($reg =~ /$freg/i);
1713 if ($col == $maxcol) {
1714 print "\n"; $col = 0
1715 }
1716 print "\t$reg = $delta{$currtid}{$currinstr}{$reg}";
1717 $col++;
1718 }
1719 print "\n";
1720 }
1721
1722
1723} # }}}
1724
1725###############################################################################
1726# Incremental state update {{{
1727#
1728# Inputs : TID, current Instr#
1729# Ouputs : Returns Win, GL; Updates %state, %win, %cwp ..
1730# Assumes that state{thread}{instr} is valid for last state updated (or reset)
1731# Routine will scan all instructions between nearest previous instr and
1732# specified instruction and return state hash that can be inserted into state
1733# hash by caller ..
1734
1735sub current_state {
1736 my ($tid, $instr) = @_;
1737
1738 # Update symbol offsets
1739 if ($have_symbols && !defined $offset{$tid}{$instr}) {
1740 $line = $trace{$tid}{$instr};
1741 my $va;
1742 if ($have_pa) {
1743 ($va) = $line =~ /\d+:\s+#\d+\s+T\d+\s+v:(\w+)/o;
1744 } else {
1745 ($va) = $line =~ /\d+:\s+#\d+\s+T\d+\s+(\w+)/o;
1746 }
1747 print "current_state: $tid $instr $va ($line)\n" if ($debug);
1748
1749 if (defined ($symbols{$va})) {
1750 $offset{$tid}{$instr} = $symbols{$va};
1751 } else {
1752 $offset{$tid}{$instr} = get_symbol_offset($va);
1753 }
1754 }
1755
1756 # If Statetype=actual, remove any expected from %delta and insert
1757 # from actual if statetype has changed ..
1758 if ($statetype && (defined ($actdelta{$tid}{$instr}) ||
1759 defined ($expdelta{$tid}{$instr}))) {
1760 if (!$prevstate) {
1761 foreach (keys %{$expdelta{$tid}{$instr}}) {
1762 #print "Deleting $_ $delta{$tid}{$instr}{$_}\n";
1763 delete($delta{$tid}{$instr}{$_});
1764 }
1765 foreach (keys %{$delta{$tid}{$instr}}) {
1766 $expdelta{$tid}{$instr}{$_} = $delta{$tid}{$instr}{$_};
1767 }
1768 }
1769 foreach (keys %{$actdelta{$tid}{$instr}}) {
1770 $delta{$tid}{$instr}{$_} = $actdelta{$tid}{$instr}{$_};
1771 #print "Restoring $_ $delta{$tid}{$instr}{$_}\n";
1772 }
1773 # If Statetype=expected, remove any actual from %delta and insert
1774 # from expected if statetype has changed ..
1775 } elsif (!$statetype && defined ($expdelta{$tid}{$instr})) {
1776 if ($prevstate) {
1777 foreach (keys %{$actdelta{$tid}{$instr}}) {
1778 #print "Deleting $_ $delta{$tid}{$instr}{$_}\n";
1779 delete($delta{$tid}{$instr}{$_});
1780 }
1781 }
1782 foreach (keys %{$expdelta{$tid}{$instr}}) {
1783 $delta{$tid}{$instr}{$_} = $expdelta{$tid}{$instr}{$_};
1784 #print "Restoring $_ $delta{$tid}{$instr}{$_}\n";
1785 }
1786 }
1787 $prevstate = $statetype;
1788
1789 # Find the nearest previous instr # for this thread
1790 my $prev = get_prev_state($tid, $instr);
1791 if ($prev == "" || $prev < 0) {
1792 $prev = 0;
1793 # Get Starting Values
1794 foreach (@allregs) {
1795 $state{$tid}{$instr}{$_} = $state{$tid}{0}{$_};
1796 }
1797 foreach my $win (@windows) {
1798 foreach (0 .. $maxwin-1) {
1799 $cwp{$tid}{$_}{$instr}{$win} = $cwp{$tid}{$_}{0}{$win};
1800 }
1801 }
1802 foreach my $g (@globals) {
1803 foreach (0 .. $maxgl-1) {
1804 $gl{$tid}{$_}{$instr}{$g} = $gl{$tid}{$_}{0}{$g};
1805 }
1806 }
1807 }
1808
1809 # Starting from $prev state, update deltas until $instr
1810
1811 foreach (@allregs) {
1812 $state{$tid}{$instr}{$_} = $state{$tid}{$prev}{$_};
1813 }
1814 foreach my $win (@windows) {
1815 foreach (0 .. $maxwin-1) {
1816 $cwp{$tid}{$_}{$instr}{$win} = $cwp{$tid}{$_}{$prev}{$win};
1817 }
1818 }
1819 foreach my $g (@globals) {
1820 foreach (0 .. $maxgl-1) {
1821 $gl{$tid}{$_}{$instr}{$g} = $gl{$tid}{$_}{$prev}{$g};
1822 }
1823 }
1824
1825 my $currwin = hex($state{$tid}{$prev}{"CWP"});
1826 my $currgl = hex($state{$tid}{$prev}{"GL"});
1827
1828 my ($currinstr,$reg);
1829
1830 # Scan deltas from $prev and update until $instr is reached ..
1831 foreach $currinstr (sort {$a <=> $b} keys %{$trace{$tid}}) {
1832 next if ($currinstr <= $prev);
1833 last if ( $currinstr > $instr);
1834 foreach $reg (sort keys %{$delta{$tid}{$currinstr}}) {
1835 if ($reg =~ /^gl$/i) { # Change currgl
1836 $state{$tid}{$instr}{$reg} = $delta{$tid}{$currinstr}{$reg};
1837 $currgl = $delta{$tid}{$currinstr}{$reg};
1838 } elsif ($reg =~ /^cwp$/i) { # Change currwin
1839 $state{$tid}{$instr}{$reg} = $delta{$tid}{$currinstr}{$reg};
1840 $currwin = $delta{$tid}{$currinstr}{$reg};
1841 } elsif ($reg =~ /^([ilo])(\d+)/) { # Window regs
1842 my ($wreg, $regnum) = ($1, $2);
1843 $cwp{$tid}{hex($currwin)}{$instr}{$reg} =
1844 $delta{$tid}{$currinstr}{$reg};
1845 if ($wreg eq "i") {
1846 $cwp{$tid}{(hex($currwin)-1)%8}{$instr}{"o".$regnum} =
1847 $delta{$tid}{$currinstr}{$reg};
1848 } elsif ($wreg eq "o") {
1849 $cwp{$tid}{(hex($currwin)+1)%8}{$instr}{"i".$regnum} =
1850 $delta{$tid}{$currinstr}{$reg};
1851 }
1852 } elsif ($reg =~ /^g\d+/) { # Globals
1853 $gl{$tid}{hex($currgl)}{$instr}{$reg} =
1854 $delta{$tid}{$currinstr}{$reg};
1855 } elsif ($reg =~ /^f(\d+)/) { # Floats are 32 bit [Even,Odd]
1856 my $freg = $1;
1857 my $fereg = "f".($freg & 0xfe); #regnum
1858 if ($saslog) { # sas stores 32 bits only ..
1859 if (! ($freg%2)) { ## Even reg
1860 $state{$tid}{$instr}{$fereg} =
1861 $delta{$tid}{$currinstr}{$reg} .
1862 substr($state{$tid}{$instr}{$fereg},8,8);
1863 } else { ## Odd reg
1864 $state{$tid}{$instr}{$fereg} =
1865 substr($state{$tid}{$instr}{$fereg},0,8) .
1866 $delta{$tid}{$currinstr}{$reg};
1867 }
1868 } else {
1869 if (! ($freg%2)) { ## Even reg
1870 my $value = join('',
1871 (split(//,$delta{$tid}{$currinstr}{$reg}))[8..15]);
1872 $state{$tid}{$instr}{$fereg} = $value .
1873 substr($state{$tid}{$instr}{$fereg},8,8);
1874 } else { ## Odd reg
1875 my $value = join('',
1876 (split(//,$delta{$tid}{$currinstr}{$reg}))[8..15]);
1877 $state{$tid}{$instr}{$fereg} =
1878 substr($state{$tid}{$instr}{$fereg},0,8) . $value;
1879 }
1880 }
1881 } else {
1882 $state{$tid}{$instr}{$reg} = $delta{$tid}{$currinstr}{$reg};
1883 }
1884 }
1885 }
1886
1887 $current{$tid} = $instr;
1888 return (hex($currwin), hex($currgl));
1889
1890} # }}}
1891
1892###############################################################################
1893# search for previous delta for register under cursor {{{
1894#
1895sub previous_delta {
1896 my ($state_t) = @_;
1897 my $regname = $state_t->get($state_t->index("current wordstart"),
1898 $state_t->index("current wordend"));
1899
1900 foreach my $previnstr (reverse sort {$a<=>$b} keys %{$delta{$tid}}) {
1901 if ($previnstr < $instr && defined ($delta{$tid}{$previnstr}{$regname})) {
1902 return($previnstr);
1903 }
1904 }
1905 return ($regname);
1906}# }}}
1907
1908###############################################################################
1909# search for next delta for register under cursor {{{
1910#
1911sub next_delta {
1912 my ($state_t) = @_;
1913 my $regname = $state_t->get($state_t->index("current wordstart"),
1914 $state_t->index("current wordend"));
1915
1916 foreach my $nextinstr (sort {$a<=>$b} keys %{$delta{$tid}}) {
1917 if ($nextinstr > $instr && defined ($delta{$tid}{$nextinstr}{$regname})) {
1918 return($nextinstr);
1919 }
1920 }
1921 return ($regname);
1922}# }}}
1923
1924###############################################################################
1925
1926###############################################################################
1927# Translate control register number to name {{{
1928#
1929sub cregname {
1930 my $regnum = shift;
1931 if (!defined $regmap{32}) {
1932 %regmap = ( 32 => "PC",
1933 33 => "NPC",
1934 34 => "Y",
1935 35 => "CCR",
1936 36 => "FPRS",
1937 37 => "FSR",
1938 38 => "ASI",
1939 39 => "TICK",
1940 40 => "GSR",
1941 41 => "TICK_CMPR",
1942 42 => "STICK",
1943 43 => "STICK_CMPR",
1944 44 => "PSTATE",
1945 45 => "TL",
1946 46 => "PIL",
1947 47 => "TPC1",
1948 48 => "TPC2",
1949 49 => "TPC3",
1950 50 => "TPC4",
1951 51 => "TPC5",
1952 52 => "TPC6",
1953 57 => "TNPC1",
1954 58 => "TNPC2",
1955 59 => "TNPC3",
1956 60 => "TNPC4",
1957 61 => "TNPC5",
1958 62 => "TNPC6",
1959 67 => "TSTATE1",
1960 68 => "TSTATE2",
1961 69 => "TSTATE3",
1962 70 => "TSTATE4",
1963 71 => "TSTATE5",
1964 72 => "TSTATE6",
1965 77 => "TT1",
1966 78 => "TT2",
1967 79 => "TT3",
1968 80 => "TT4",
1969 81 => "TT5",
1970 82 => "TT6",
1971 87 => "TBA",
1972 88 => "VER",
1973 89 => "CWP",
1974 90 => "CANSAVE",
1975 91 => "CANRESTORE",
1976 92 => "OTHERWIN",
1977 93 => "WSTATE",
1978 94 => "CLEANWIN",
1979 95 => "SOFTINT",
1980 96 => "ECACHE_ERROR_ENABLE",
1981 97 => "ASYNCHRONOUS_FAULT_STATUS",
1982 98 => "ASYNCHRONOUS_FAULT_ADDRESS",
1983 99 => "OUT_INTR_DATA0",
1984 100=> "OUT_INTR_DATA1",
1985 101=> "OUT_INTR_DATA2",
1986 102=> "INTR_DISPATCH_STATUS",
1987 103=> "IN_INTR_DATA0",
1988 104=> "IN_INTR_DATA1",
1989 105=> "IN_INTR_DATA2",
1990 106=> "INTR_RECEIVE",
1991 107=> "GL",
1992 108=> "HPSTATE",
1993 109=> "HTSTATE1",
1994 110=> "HTSTATE2",
1995 111=> "HTSTATE3",
1996 112=> "HTSTATE4",
1997 113=> "HTSTATE5",
1998 114=> "HTSTATE6",
1999 115=> "HTSTATE7",
2000 116=> "HTSTATE8",
2001 117=> "HTSTATE9",
2002 118=> "HTSTATE10",
2003 119=> "HTBA",
2004 120=> "HINTP",
2005 121=> "HSTICK_CMPR",
2006 122=> "MID",
2007 123=> "ISFSR",
2008 124=> "DSFSR",
2009 125=> "DSFAR",
2010 126=> "CTXT_PRIM_0",
2011 127=> "CTXT_SEC_0",
2012 128=> "CTXT_PRIM_1",
2013 129=> "CTXT_SEC_1",
2014 130=> "LSU_CONTROL",
2015 131=> "I_TAG_ACC",
2016 132=> "CTXT_Z_TSB_CFG0",
2017 133=> "CTXT_Z_TSB_CFG1",
2018 134=> "CTXT_Z_TSB_CFG2",
2019 135=> "CTXT_Z_TSB_CFG3",
2020 136=> "CTXT_NZ_TSB_CFG0",
2021 137=> "CTXT_NZ_TSB_CFG1",
2022 138=> "CTXT_NZ_TSB_CFG2",
2023 139=> "CTXT_NZ_TSB_CFG3",
2024 140=> "I_DATA_IN",
2025 141=> "D_TAG_ACC",
2026 142=> "WATCHPOINT_ADDR",
2027 143=> "D_DATA_IN"
2028 );
2029 }
2030 return ($regmap{$regnum});
2031}#}}}
2032
2033# Read in gates log file and update database .. {{{
2034#
2035sub slurp_barelog {
2036 my $instr = 1;
2037 my $expect = 0;
2038 my $actual = 0;
2039 my ($mtid, $reg, $value);
2040
2041 if (&have_pas) {
2042 $have_pa = 1;
2043 }
2044 my $fn = (-r $logfile)? $logfile :"gunzip -c $logfile |";
2045 open (LOG, "$fn")
2046 || usage( "ERROR > Cannot open Log file $logfile, $!\n");
2047 print "INFO > Loading logfile \"$logfile\"..\n";
2048 if ($only_cores ne "") {
2049 print "INFO > Restricted to reading log for core(s) $only_cores\n";
2050 }
2051 while ($line = <LOG>) {
2052 next unless ($line =~ /^\s*\d+:\s+\w+\[\w+_top.*?\]:\s+.*?\s+T\d+/o);
2053
2054 next if ($line !~ /$only_cores/o);
2055 chomp($line);
2056 if (($mtid)
2057 = $line =~ /^\s*\d+:\s+\w+\[\w+_top.*?\]:\s+.*?\s+T(\d+)/o) {
2058 $line =~ /^\s*(\d+):/o;
2059 $line =~ s/.*\[\w+_top.*?\]:\s+@(\d+)/$1:/o;
2060 last if ($maxtime && $1 > $maxtime);
2061 $instr = int($instr);
2062 $line =~ s/(#\d+)*\s+T/ #$instr T/; # Add instr# if not present.
2063
2064 if (!exists ($state{$mtid}{0})) {
2065 init_trace($mtid);
2066 init_state($mtid);
2067 $numthreads = $mtid+1 if ($numthreads<=$mtid) ;
2068 $tid = $mtid if ($mtid < $tid);
2069 }
2070
2071 my ($va) = $line =~ m/T\d+\s+(\w+)/o;
2072 my $sva = substr($va, -12); # Use 48 bits only
2073 $line =~ s/$va/$sva/;
2074 if($have_disas) {
2075 $line .= " " . $disas{$sva};
2076 }
2077 $current{$mtid} = $instr;
2078 $trace{$mtid}{$instr} = $line;
2079 $fulltrace{$instr} = $line;
2080 $instr++;
2081 }
2082 }
2083 close LOG;
2084 foreach (0.. $numthreads-1) {
2085 $last{$_} = $current{$_};
2086 $current{$_} = 0;
2087 }
2088} #}}}
Full OpenSPARC design & verification tarball including full HDL.