OpenCores
URL https://opencores.org/ocsvn/w11/w11/trunk

Subversion Repositories w11

[/] [w11/] [tags/] [w11a_V0.74/] [tools/] [bin/] [xviv_msg_filter] - Blame information for rev 38

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 36 wfjm
#!/usr/bin/perl -w
2
# $Id: xviv_msg_filter 772 2016-06-05 12:55:11Z mueller $
3
#
4
# Copyright 2016- by Walter F.J. Mueller 
5
#
6
# This program is free software; you may redistribute and/or modify it under
7
# the terms of the GNU General Public License as published by the Free
8
# Software Foundation, either version 2, or at your option any later version.
9
#
10
# This program is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY, without even the implied warranty of MERCHANTABILITY
12
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
13
# for complete details.
14
#
15
#  Revision History:
16
# Date         Rev Version  Comment
17
# 2016-06-04   772   1.0    Initial version
18
#
19
 
20
use 5.14.0;                                 # require Perl 5.14 or higher
21
use strict;                                 # require strict checking
22
use FileHandle;
23
 
24
use Getopt::Long;
25
 
26
my %opts = ();
27
 
28
GetOptions(\%opts, "help", "pacc") || exit 1;
29
 
30
sub print_help;
31
sub read_mfs;
32
sub read_log;
33
 
34
my $type   = shift @ARGV;
35
my $mfsnam = shift @ARGV;
36
my $lognam = shift @ARGV;
37
my @flist;
38
my @mlist;
39
my $nackcnt  = 0;
40
my $ackcnt   = 0;
41
my $imisscnt = 0;
42
my $rmisscnt = 0;
43
my $timebad  = 0;
44
my $timegood = 0;
45
 
46
my $retrobase = $ENV{RETROBASE};
47
 
48
autoflush STDOUT 1 if (-p STDOUT);          # autoflush if output into pipe
49
 
50
if (exists $opts{help}) {
51
  print_help;
52
  exit 0;
53
}
54
 
55
if (!defined $type || !defined $mfsnam || !defined $lognam) {
56
  print STDERR "xviv_msg_filter-E: one of 'type mfset log' missing \n\n";
57
  print_help;
58
  exit 1;
59
}
60
 
61
if ($type !~ m{^(syn|imp)$}) {
62
  print STDERR "xviv_msg_filter-E: type must be syn or imp\n";
63
  exit 1;
64
}
65
 
66
if (read_mfs($mfsnam)) {exit 1;}
67
if (read_log($lognam)) {exit 1;}
68
 
69
foreach my $m (@mlist) {
70
  my $msev  = $m->[0];
71
  my $mcode = $m->[1];
72
  my $mtext = $m->[2];
73
  my $msgmatch = 0;
74
 
75
  # check for timing closure
76
  #  bad:  [Route 35-39] The design did not meet timing requirements
77
  #  bad:  [Timing 38-282] The design failed to meet the timing ...
78
  #  good: [Route 35-61] The design met the timing requirement
79
  $timebad  += 1 if $type eq 'imp' && $mcode eq 'Route 35-39';
80
  $timebad  += 1 if $type eq 'imp' && $mcode eq 'Timing 38-282';
81
  $timegood += 1 if $type eq 'imp' && $mcode eq 'Route 35-61';
82
 
83
  foreach my $f (@flist) {
84
    my $fmode = $f->[0];
85
    my $fcode = $f->[1];
86
    my $frege = $f->[2];
87
    if ($frege eq '') {
88
      $msgmatch = $mcode eq $fcode;
89
    } else {
90
      $msgmatch = $mcode eq $fcode && $mtext =~ m{$frege};
91
    }
92
    if ($msgmatch) {
93
      #print "+++m '$fmode' '$fcode' '$frege' : '$mcode' '$mtext'\n";
94
      $f->[3] += 1;
95
      last;
96
    }
97
  }
98
 
99
  $msgmatch = 1 if $msev eq 'INFO';         # accept all INFO
100
 
101
  if ($msgmatch) {
102
    $m->[3] += 1;
103
  } else {
104
    $nackcnt += 1;
105
  }
106
}
107
 
108
if ($nackcnt) {
109
  print "Unexpected messages of type [$type] from $lognam:\n";
110
  foreach my $m (@mlist) {
111
    next if $m->[3];
112
 
113
    # now prety print the message
114
    #   remove $RETROBASE from file names
115
    my $mtext = $m->[2];
116
    $mtext =~ s/${retrobase}/.../g if defined $retrobase;
117
    #   and break it up into 80 character wide lines
118
    my @mwl = split /\s+/,$mtext;
119
    unshift @mwl, '[' . $m->[1] . ']';
120
    unshift @mwl, $m->[0] . ':';
121
    my $pref = '   ';
122
    my $line = ' ';
123
    while (scalar(@mwl)) {
124
      my $word = shift @mwl;
125
      if (length($line) + length($word) + 1 > 80) {
126
        print "$line\n";
127
        $line = $pref;
128
      }
129
      $line .= ' ' . $word;
130
    }
131
    print "$line\n" if $line ne $pref;
132
  }
133
  print "\n";
134
}
135
 
136
foreach my $f (@flist) {
137
  if ($f->[3] != 0) {                       # matches seen
138
    $ackcnt  += 1;
139
  } else {                                  # matches not seen
140
    if ($f->[0] eq 'i') {                     # complain if 'i'
141
      $imisscnt += 1;
142
    } elsif ($f->[0] eq 'r') {                # complain if 'r'
143
      $rmisscnt += 1;
144
    }
145
  }
146
}
147
 
148
if ($ackcnt && exists $opts{pacc}) {
149
  print "Accepted messages for type [$type] from $lognam:\n";
150
  foreach my $f (@flist) {
151
    next if $f->[3] == 0;
152
    printf "%4d: [%s] %s\n", $f->[3], $f->[1], $f->[2];
153
  }
154
  print "\n";
155
}
156
 
157
if ($imisscnt) {
158
  print "Ignore filter rules with no matches for type [$type] from $lognam:\n";
159
  foreach my $f (@flist) {
160
    next if $f->[3] != 0;
161
    printf "%4d: [%s] %s\n", $f->[3], $f->[1], $f->[2] if $f->[0] eq 'i';
162
  }
163
  print "\n";
164
}
165
 
166
if ($rmisscnt) {
167
  print "Missed required messages for type [$type] from $lognam:\n";
168
  foreach my $f (@flist) {
169
    next if $f->[3] != 0;
170
    printf "%4d: [%s] %s\n", $f->[3], $f->[1], $f->[2] if $f->[0] eq 'r';
171
  }
172
  print "\n";
173
}
174
 
175
if ($type eq 'imp' && ($timebad > 0 || $timegood == 0)) {
176
  printf "!! ------------------------------ !!\n";
177
  printf "!! FAILED TO REACH TIMING CLOSURE !!\n";
178
  printf "!! ------------------------------ !!\n";
179
}
180
 
181
#-------------------------------------------------------------------------------
182
sub read_mfs {
183
  my ($fname) = @_;
184
 
185
  if (not -r $fname) {
186
    print STDERR "xviv_msg_filter-E: \'$fname\' not existing or readable\n";
187
    return 1;
188
  }
189
 
190
  my $fh = new FileHandle;
191
  $fh->open($fname)    or die "can't open for read $fname: $!";
192
 
193
  my $intyp = 0;
194
 
195
  while (<$fh>) {
196
    chomp;
197
    s/#.*//;                                # remove comments after #
198
    s/\s+$//;                               # remove trailing blanks
199
    next if /^\s*$/;                        # drop empty lines
200
 
201
    if (/^\@(.+)$/) {                       # @ found
202
      my $rc = read_mfs($1);
203
      return $rc if $rc;
204
      next;
205
    }
206
 
207
    if (m{^\[([a-z]{3})\]$}) {              # [typ] tag found
208
      if ($1 eq $type) {
209
        $intyp = 1;
210
      } else {
211
        $intyp = 0;
212
      }
213
      next;
214
    }
215
 
216
    next unless $intyp;                     # only process relevant lines
217
 
218
    if (/^([iIr])\s+\[(.+?)\]\s*(.*)\s*$/) {
219
      #print "+++0m '$1' '$2' '$3'\n";
220
      my $fmode = $1;
221
      my $fcode = $2;
222
      my $frege = $3;
223
      $frege =~ s/\[/\\\[/g;
224
      $frege =~ s/\]/\\\]/g;
225
      push @flist, [$fmode,$fcode,$frege, 0];
226
    } else {
227
      printf STDERR "xviv_msg_filter-E: bad line in mfset: '%s'\n", $_;
228
    }
229
  }
230
 
231
  $fh->close();
232
 
233
  return 0;
234
}
235
 
236
#-------------------------------------------------------------------------------
237
sub read_log {
238
  my ($fname) = @_;
239
 
240
  if (not -r $fname) {
241
    print STDERR "xviv_msg_filter-E: \'$fname\' not existing or readable\n";
242
    return 1;
243
  }
244
 
245
  open (LFILE, $fname)    or die "can't open for read $fname: $!";
246
 
247
  while () {
248
    chomp;
249
    if (m{^(INFO|WARNING|CRITICAL WARNING|ERROR):\s*\[(.+?)\]\s*(.*)}) {
250
      #print "+++0l '$1' '$2' '$3'\n";
251
      push @mlist, [$1,$2,$3,0];
252
    }
253
  }
254
 
255
  close (LFILE);
256
 
257
  return 0;
258
}
259
 
260
#-------------------------------------------------------------------------------
261
 
262
sub print_help {
263
  print "usage: xviv_msg_filter [options] type mfset log\n";
264
  print "  type   log file type: syn or imp\n";
265
  print "  mfset  message filter set file\n";
266
  print "  log    log file\n";
267
  print "  Options:\n";
268
  print "    --pacc           print summary of accepted messages\n";
269
  print "    --help           this message\n";
270
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.