File Coverage

blib/lib/Text/Cadenceparser.pm
Criterion Covered Total %
statement 238 270 88.1
branch 79 98 80.6
condition 29 42 69.0
subroutine 25 28 89.2
pod 9 9 100.0
total 380 447 85.0


line stmt bran cond sub pod time code
1 4     4   3668 use strict;
  4         9  
  4         170  
2 4     4   22 use warnings;
  4         9  
  4         142  
3 4     4   107 use 5.012;
  4         13  
  4         139  
4 4     4   4649 use autodie;
  4         99298  
  4         30  
5              
6             package Text::Cadenceparser;
7             {
8             $Text::Cadenceparser::VERSION = '1.12';
9             }
10              
11 4     4   25159 use Carp qw/croak carp/;
  4         11  
  4         338  
12 4     4   12970 use Data::Dumper;
  4         21220  
  4         316  
13              
14 4     4   34 use constant DEBUG => $ENV{TEXT_CADENCEPARSER_DEBUG};
  4         6  
  4         329  
15 4         17280 use constant DEBUG1 =>
16 4     4   20 $ENV{TEXT_CADENCEPARSER_DEBUG1}; # more verbose debugging info
  4         7  
17              
18              
19             sub new {
20 11     11 1 8719 my ( $pkg, %p ) = @_;
21              
22 11         73 my $self = bless {
23             _msg => {}, # Internal message hash, will store the report results
24             _files_parsed => 0, # Number of files parsed
25             %p
26             }, $pkg;
27              
28 11 100       61 if ( defined $self->{folder} ) {
29              
30             # When folder is defined, then we need to produce a synthesis report synopsis
31 3         10 $self->{_files_parsed} = $self->_read_logfiles(); # Gather the data
32             } else {
33              
34             # Gather file info for displaying area/power
35              
36             # First check the input parameters
37             # Key is required
38 8 50 66     90 if (
      33        
      33        
39             !defined $self->{key}
40             || ( $self->{key} ne 'area'
41             && $self->{key} ne 'active'
42             && $self->{key} ne 'leakage' )
43             )
44             {
45 0         0 croak
46             "'key' is a required input parameter and should be 'area', 'active' or 'leakage'";
47             }
48              
49             # Threshold not, defaults to 1 if it is not defined
50 8   100     43 $self->{threshold} = $self->{threshold} || 1;
51              
52             # Sanity check on input files based on the sort key
53 8 50 66     90 if ( $self->{key} eq 'area' && ( !defined $self->{area_rpt} ) ) {
54 0         0 croak
55             "Please specify an area report file if you want to sort according to area";
56             }
57              
58 8 50 66     63 if ( ( $self->{key} eq 'active' || $self->{key} eq 'leakage' )
      66        
59             && ( !defined $self->{power_rpt} ) )
60             {
61 0         0 croak
62             "Please specify a power report file if you want to sort according to power numbers";
63             }
64              
65             # Read the reports
66 8         23 $self->{_files_parsed} = $self->_read_reports();
67              
68             # And sort the results
69 7         48 $self->_sort_data();
70             }
71              
72 10         93 return $self;
73              
74             }
75              
76              
77 2     2 1 995 sub files_parsed { shift->{_files_parsed} }
78              
79             sub count {
80 3     3 1 1554 my ( $self, $type ) = @_;
81 3         5 my $count = keys %{ $self->{_msg}->{$type} };
  3         12  
82 3         7 return $count;
83             }
84              
85              
86             sub overview {
87 0     0 1 0 my ( $self, $type ) = @_;
88              
89             # Report slack
90 0 0       0 if ( $self->{_slack}->{_negative} ) {
91 0         0 print "ERROR: ";
92             }
93              
94 0         0 foreach my $clock ( keys %{ $self->{_slack} } ) {
  0         0  
95 0 0       0 next if ( $clock eq '_negative' ); # Skip housekeeping variable
96 0         0 my $slack = $self->{_slack}->{$clock}->{slack};
97 0   0     0 my $violators = $self->{_slack}->{$clock}->{violators} || 'no';
98 0         0 say "Clock '$clock' slack is $slack ps. (# $violators nets);";
99             }
100              
101 0         0 say "-------------";
102              
103             # Report info/warning/errors
104 0         0 my @types = ( 'info', 'warning', 'error' );
105              
106 0         0 foreach my $type (@types) {
107 0         0 my $count = keys %{ $self->{_msg}->{$type} };
  0         0  
108 0         0 say "$count '$type' messages found";
109             }
110              
111 0         0 say "-------------";
112              
113             }
114              
115             sub get {
116 36     36 1 1721 my ( $self, $type ) = @_;
117              
118 36 50       191 return $self->{_msg}->{$type} if ( $type ~~ [qw(info warning error)] );
119 36 100       912 return $self->{_data}->{root}->{$type}->{total}
120             if ( $type ~~ [qw(area active leakage)] );
121 2         6 return $self->{$type}; # Enable self-checking of parameters in tests
122             }
123              
124             sub list {
125 0     0 1 0 my ( $self, $type ) = @_;
126              
127 0         0 my $messages = $self->get($type);
128              
129 0 0       0 say "* Detected $type messages:" if ( keys %{$messages} );
  0         0  
130              
131 0         0 foreach my $key ( keys %{$messages} ) {
  0         0  
132 0         0 $self->_nice_print( $key, $messages->{$key} );
133             }
134             }
135              
136             sub slack {
137 1     1 1 489 my ( $self, $clock ) = @_;
138              
139 1         5 return $self->{_slack}->{$clock}->{slack};
140              
141             }
142              
143             sub report {
144 5     5 1 8307 my ( $self, %p ) = @_;
145              
146 5         14 my $data = $self->{_data};
147              
148             # First report the totals
149 5 100       13 say "Total area : " . $self->get('area') . " um2"
150             if ( $self->get('area') );
151 5 100       21 say "Total active : " . $self->get('active') . " mW"
152             if ( $self->get('active') );
153 5 100       21 say "Total leakage: " . $self->get('leakage') . " mW"
154             if ( $self->get('leakage') );
155              
156 5         33 say "% : " . $self->_format_str("Name") . "\tArea\tActive\tLeakage ";
157 5         16 say " " . $self->_format_str("") . "\t(um2)\t(mW)\t(mW)";
158 5         137 say "----------------------------------------------------------------";
159              
160 5         11 foreach my $procent ( sort { $b <=> $a } keys %{$data->{detail}} ) {
  55         84  
  5         39  
161 30         40 foreach my $item ( sort keys %{$data->{detail}->{$procent}} ) {
  30         256  
162 234         620 my $leaf = $data->{detail}->{$procent}->{$item};
163 234   100     604 my $area = $leaf->{area} || '--';
164 234   100     633 my $active = $leaf->{active} || '--';
165 234   100     650 my $leak = $leaf->{leakage} || '--';
166              
167 234         465 say $self->_format_int($procent) . " : "
168             . $self->_format_str( $leaf->{name} )
169             . "\t$area\t$active\t$leak";
170             }
171             }
172              
173             # Output formatting in case the value is zero (file not read)
174 5   100     43 my $stash_area = $data->{stash}->{area} || '--';
175 5   100     29 my $stash_active = $data->{stash}->{active} || '--';
176 5   100     25 my $stash_leakage = $data->{stash}->{leakage} || '--';
177              
178 5         20 say $self->_format_int( $data->{stash}->{percent} ) . " : "
179             . $self->_format_str('')
180             . "\t$stash_area\t$stash_active\t$stash_leakage";
181              
182             }
183              
184             sub get_final {
185 3     3 1 1076 my ( $self, $key) = @_;
186              
187 3         14 return $self->{_final}->{$key};
188              
189             }
190              
191             # Private function to display a single message to STDOUT
192             sub _nice_print {
193 0     0   0 my ( $self, $key, $message ) = @_;
194              
195 0         0 my $count = $message->{count};
196 0         0 my $msg = $message->{message};
197              
198 0         0 printf "%s\t%4i %s\n", $key, $count, $msg;
199              
200             }
201              
202             # Internal function to read the logfiles from the source folder and place the
203             # messages into the data hash
204             sub _read_logfiles {
205              
206 3     3   7 my ( $self, %p ) = @_;
207              
208             # Glob all relevant logfiles (=gather their names)
209 3         6 my $foldername = $self->{folder};
210              
211 3 50       136 if ( !-e $foldername ) {
212 0         0 croak "Result folder '$foldername' does not exist";
213             }
214              
215 3         381 my @files = glob( $foldername . "/*.summary" );
216              
217 3         8 print "Going to parse files from folder '$foldername': \n" . Dumper(@files)
218             if DEBUG1;
219              
220             # Go over the files one by one and extract info
221 3         9 foreach my $file (@files) {
222 6         16 $self->_gather_entries($file);
223             }
224              
225 3         5 print "Found: \n" . Dumper( $self->{_msg} ) if DEBUG;
226              
227 3         146 my @timing_logs = glob( $foldername . "/report_qor_map_*" );
228              
229             # Go over the files one by one and extract slack info
230 3         10 foreach my $file (@timing_logs) {
231 1         4 $self->_gather_slack($file);
232 1         4 push @files, $file;
233             }
234              
235 3         8 my $final_file = $foldername . "/final.rpt";
236              
237 3 100       51 if (-e $foldername . "/final.rpt") {
238 2         6 $self->_gather_final($final_file);
239 2         4 push @files, $final_file;
240             }
241              
242 3         12 return scalar @files;
243              
244             }
245              
246             # Internal function to read the power/area reports
247             sub _read_reports {
248 8     8   19 my ( $self, %p ) = @_;
249              
250 8         12 my @files;
251              
252 8 100       37 push @files, $self->_parse_area() if ( defined $self->{area_rpt} );
253 8 100       52 push @files, $self->_parse_power() if ( defined $self->{power_rpt} );
254              
255 7         36 return @files;
256             }
257              
258             # Parse the area log report, expecting Encounter RTL compiler file
259             sub _parse_area {
260 6     6   11 my ( $self, %p ) = @_;
261              
262 6         13 my $filename = $self->{area_rpt};
263              
264 6 50       305 open my $fh, "<", $filename
265             or die "Could not open $filename: $!";
266              
267 6         1176 say "Parsing area report $filename";
268              
269 6         14 my $line;
270              
271             # Skip until we enter the 'data' zone
272 6         164 while (<$fh>) {
273 90         96 $line = $_;
274 90 100       265 if ( $line =~ /\-{5}/ ) {
275 6         12 last;
276             }
277             }
278              
279             # Now parse :-)
280 6         11 my $regexp = '(\w+)\s+\w+\s+\d+\s+(\d+)';
281              
282 6         24 while (<$fh>) {
283 8496         10857 $line = $_;
284 8496 100       29183 if ( $line =~ /^$regexp/ ) {
285              
286             #say "root: $1 \t$2";
287 6         32 $self->{_data}->{root}->{name} = $1;
288 6         24 $self->{_data}->{root}->{area}->{total} = $2;
289 6         19 $self->{_data}->{root}->{area}->{sum_leaves} = 0;
290             }
291 8496 100       48268 if ( $line =~ /^\s\s$regexp/ ) {
292 654         1061 my $partial_area = $2;
293 654         4025 $self->{_data}->{leaf}->{$1}->{area} = $partial_area;
294 654         3255 $self->{_data}->{root}->{area}->{sum_leaves} += $partial_area;
295             }
296             }
297              
298 6         136 close $fh;
299              
300 6         60 return $filename;
301              
302             }
303              
304             # Parse the power log report, expecting Encouter output file
305             sub _parse_power {
306 7     7   19 my ( $self, %p ) = @_;
307              
308 7         16 my $filename = $self->{power_rpt};
309              
310 7 50       342 open my $fh, "<", $filename
311             or die "Could not open $filename: $!";
312              
313 7         1157 say "Parsing power report $filename";
314              
315 7         18 my $line;
316              
317 7         14 my $file_type = 'normal';
318              
319             # Skip until we enter the 'data' zone
320 7         146 while (<$fh>) {
321 75         90 $line = $_;
322              
323             # Detect if we're reading a file in normal output mode or in verbose mode
324 75 100       154 $file_type = 'verbose' if (/Leakage\s+Internal\s+Net/);
325              
326 75 100       230 if ( $line =~ /\-{5}/ ) {
327 6         10 last;
328             }
329             }
330              
331             # Now parse :-)
332             # Regexp for normal mode parsing
333 7         16 my $regexp = '(\w+)\s+\w+\s+\d+\s+([0-9]*\.?[0-9]+)\s+([0-9]*\.?[0-9]+)';
334              
335             # In case the file is verbose mode output then we need another regexp!
336 7 100       20 $regexp = '(\w+)\s+\w+\s+\d+\s+([0-9]*\.?[0-9]+)\s+[0-9]*\.?[0-9]+\s+[0-9]*\.?[0-9]+\s+([0-9]*\.?[0-9]+)' if ($file_type eq 'verbose');
337              
338 7         30 while (<$fh>) {
339 5676         6636 $line = $_;
340 5676 100       18980 if ( $line =~ /^$regexp/ ) {
341              
342             # TODO check for same root name here as a test to see if area and power reports match.
343             #say "root: $1 \t$2";
344 6         29 $self->{_data}->{root}->{name} = $1;
345 6         32 $self->{_data}->{root}->{leakage}->{total} = $2;
346 6         25 $self->{_data}->{root}->{active}->{total} = $3;
347 6         19 $self->{_data}->{root}->{active}->{sum_leaves} = 0;
348              
349             }
350              
351 5676 100       29792 if ( $line =~ /^\s\s$regexp/ ) {
352 442         1833 $self->{_data}->{leaf}->{$1}->{leakage} = $2;
353 442         1593 $self->{_data}->{leaf}->{$1}->{active} = $3;
354 442         1116 $self->{_data}->{root}->{leakage}->{sum_leaves} += $2;
355 442         2222 $self->{_data}->{root}->{active}->{sum_leaves} += $3;
356             }
357             }
358              
359 7         90 close $fh;
360              
361 7 100       86 croak "Power input report '$filename' was empty, please check it." if (!defined $self->{_data}->{root}->{active}->{total});
362              
363 6         46 return $filename;
364              
365             }
366              
367             # This function gathers the entries from a single logfile and
368             # puts them in the $msg hash
369             sub _gather_entries {
370 6     6   14 my ( $self, $fname ) = @_;
371              
372 6         7 print "Gathering messages in file '$fname'\n" if DEBUG;
373              
374 6 50       660 open my $fh, '<', $fname
375             or croak "Could not open file '$fname' for reading: $!";
376              
377 6         12 my $type;
378             my $code;
379              
380 6         69 SKIP_HEADER: while (<$fh>) {
381 28 100       91 last if (/-----/);
382             }
383              
384 6         26 PARSE_ENTRIES: while ( my $line = <$fh> ) {
385              
386             # Typical line we're looking for looks like this:
387             # ' 2 Warning ENC-6 Problems detected during configuration file'
388 90 100       381 if ( $line =~ /^\s*(\d+)\s(\w+)\s([-\w]+)\s+(.+\S)\s+/ ) {
389              
390             # When we encounter such line, make a new entry in the message hash
391 20         39 my $count = $1;
392 20         35 $type = lc($2);
393 20         35 $code = $3;
394 20         28 my $message = $4;
395 20         24 print "$count -- $type -- $code -- $message\n" if DEBUG1;
396 20         72 $self->{_msg}->{$type}->{$code}->{message} = $message;
397 20         52 $self->{_msg}->{$type}->{$code}->{count} = $count;
398 20         68 next;
399             }
400              
401 70 100       254 if ( $line =~ /\s*(\S.+\S)\s+/ ) {
402 67 50       116 croak "Parsing error: found text before info line in '$fname'"
403             if ( !defined $type );
404              
405             # Append other lines to the last seen message
406 67         328 $self->{_msg}->{$type}->{$code}->{message} .= " $1";
407             }
408              
409             }
410              
411 6         75 close $fh;
412             }
413              
414             # This function gathers the slack entries from a single logfile and
415             # puts them in the $msg hash
416             sub _gather_slack {
417 1     1   3 my ( $self, $fname ) = @_;
418              
419 1         2 print "Gathering messages in file '$fname'\n" if DEBUG;
420              
421 1 50       34 open my $fh, '<', $fname
422             or croak "Could not open file '$fname' for reading: $!";
423              
424 1         13 SKIP_HEADER: while (<$fh>) {
425 24 100       59 last if (/Slack/);
426             }
427              
428             # Skip next line
429 1         2 my $line = <$fh>;
430              
431             # Next one is the one we need
432 1         2 $line = <$fh>;
433              
434             # PARSE_ENTRIES: while ( $line = <$fh> ) {
435 1 50       7 if ( $line =~ /\w+\s+(\w+)\s+(-?\d+.?\d*)\s+(\d*)\s/ ) {
436 1         28 my $group = $1;
437 1         3 my $slack = $2;
438 1         2 my $nr_paths = $3;
439              
440 1         5 $self->{_slack}->{$group}->{slack} = $slack;
441 1         5 $self->{_slack}->{$group}->{violators} = $nr_paths;
442              
443 1 50       9 if ( $slack < 0 ) {
444 1         7 $self->{_slack}->{_negative} = 1;
445             }
446             } else {
447 0         0 carp "Warning: could not extract slack information from logfiles";
448             }
449              
450             # }
451              
452 1         15 close $fh;
453              
454             }
455              
456             # Extract the information from the final.rpt file
457             sub _gather_final {
458 2     2   4 my ( $self, $fname ) = @_;
459              
460 2         4 print "Gathering messages in file '$fname'\n" if DEBUG;
461              
462 2 50       80 open my $fh, '<', $fname
463             or croak "Could not open file '$fname' for reading: $!";
464              
465 2         3 my $match_col;
466              
467             my $line;
468              
469             # We want to know in what column the total ('final') data is present.
470             # We need to autodetect this because it differes depending on the flow type that was run
471 2         41 DETECT_COLUMN: while ($line = <$fh>) {
472 12 100       40 if ($line =~ /Metric/) {
473 2         12 my @columns = split /\s+/, $line;
474             # Use an index hash to find what the index is of the column we're looking for
475 2         4 my %indhash;
476 2         17 @indhash{@columns} = (0 .. $#columns);
477              
478 2         5 $match_col = $indhash{'final'};
479              
480 2         7 last;
481             }
482             }
483              
484             # Data begins until next empty line
485 2         18 FETCH_DATA : while ($line = <$fh>) {
486 62 100       151 if ($line =~ /====/) {
    100          
487             # Skip separator lines
488 6         24 next;
489             } elsif ($line eq "\n") {
490             # Stop processing on empty line beacuse we need to switch the handling of the data from here on (other format)
491 2         3 last;
492             } else {
493             # Data -> process it
494             # First the metric (everything before the :)
495 54         136 my @data = split /:/, $line;
496 54         91 my $metric = $data[0];
497              
498             # Remove leading spaces in the metric;
499 54         96 $metric =~ s/^\s+//;
500              
501             # Then the values
502 54         175 my @columns = split /\s+/, $data[1];
503              
504 54         78 my $value = $columns[$match_col];
505              
506 54         270 $self->{_final}->{$metric} = $value;
507             }
508             }
509              
510             # TODO Check if we need to strip the untis from the metric and put them on another place in the hash.
511              
512             # skip 3 lines
513             #$line = <$fh>;
514             #$line = <$fh>;
515             #$line = <$fh>;
516              
517             # TODO Fetch the totals and store them too.
518             #PARSE_TOTALS: while ($line = <$fh>) {
519             # if ($line =~ /^([^:]):\s+(\.+)/) {
520             # $self->{_final}->{$1} = $2;
521             # }
522             #}
523              
524 2         35 close $fh;
525             }
526              
527             # Nicely print a string
528             sub _format_str {
529 249     249   340 my ( $self, $val ) = @_;
530 249         360 my $len = $self->{_presentation}->{namelength};
531 249         13110 return sprintf( "%-" . $len . "s", $val );
532             }
533              
534             # nicely print an int
535             sub _format_int {
536 239     239   350 my ( $self, $val ) = @_;
537 239   100     1021 $val = $val || 0; # Catch cases where the val is not initialized
538 239         960 return sprintf( "%2i", $val );
539             }
540              
541             # Sort the data according to the passed key
542             sub _sort_data {
543              
544 7     7   21 my ( $self, %p ) = @_;
545              
546 7         19 my $key = $self->{key};
547 7         16 my $threshold = $self->{threshold};
548              
549 7         35 my $total = $self->get($key);
550 7         35 my $threshold_abs = $total * $threshold / 100;
551              
552 7 100       31 my $unit = $self->{key} eq 'area' ? 'um2' : 'mW';
553              
554 7         1945 say "Sorting on '$key'";
555              
556 7         40 $self->{_presentation}->{namelength} = 0;
557              
558             # Insert an entry for the toplevel so that it get reported if required
559 7         12 my ($top_area, $top_active, $top_leakage);
560 7 100       54 $top_area = $self->{_data}->{root}->{area}->{total} - $self->{_data}->{root}->{area}->{sum_leaves} if (defined $self->{_data}->{root}->{area});
561 7 100       51 $top_active = $self->{_data}->{root}->{active}->{total} - $self->{_data}->{root}->{active}->{sum_leaves} if (defined $self->{_data}->{root}->{active});
562 7 100       45 $top_leakage = $self->{_data}->{root}->{leakage}->{total} - $self->{_data}->{root}->{leakage}->{sum_leaves} if (defined $self->{_data}->{root}->{leakage});
563              
564             # Ensure the right format is used
565 7 100       47 $top_area = sprintf("%d", $top_area) if (defined $top_area);
566 7 100       91 $top_active = sprintf("%1.3f", $top_active) if (defined $top_active);
567 7 100       36 $top_leakage = sprintf("%1.3f", $top_leakage) if (defined $top_leakage);
568              
569 7         32 $self->{_data}->{leaf}->{'toplevel'}->{area} = $top_area;
570 7         100 $self->{_data}->{leaf}->{'toplevel'}->{active} = $top_active;
571 7         22 $self->{_data}->{leaf}->{'toplevel'}->{leakage} = $top_leakage;
572              
573 7         12 foreach my $entry ( keys %{$self->{_data}->{leaf}} ) {
  7         109  
574 558         1045 my $value = $self->{_data}->{leaf}->{$entry}->{$key};
575 558         739 my $percentage = $value / $total * 100;
576              
577 558 100       815 if ( $percentage >= $threshold ) {
578              
579             # Store in the 'to be printed with details' hash
580 258         237 $percentage = int($percentage);
581 258         477 $self->{_data}->{leaf}->{$entry}->{name} = $entry;
582 258         801 $self->{_data}->{detail}->{$percentage}->{$entry} = $self->{_data}->{leaf}->{$entry};
583              
584             # Update the length of the name for printing later
585 258         254 my $namelength = length($entry);
586 258 100       634 $self->{_presentation}->{namelength} = $namelength
587             if ( $self->{_presentation}->{namelength} < $namelength );
588             } else {
589 300         424 $self->{_data}->{stash}->{percent} += $percentage;
590 300   50     825 $self->{_data}->{stash}->{area} +=
591             $self->{_data}->{leaf}->{$entry}->{area} || 0;
592 300   50     855 $self->{_data}->{stash}->{active} +=
593             $self->{_data}->{leaf}->{$entry}->{active} || 0;
594 300   50     976 $self->{_data}->{stash}->{leakage} +=
595             $self->{_data}->{leaf}->{$entry}->{leakage} || 0;
596             }
597             }
598              
599             }
600             1;
601              
602             # ABSTRACT: Perl module to parse Cadence synthesis tool logfiles
603              
604             __END__