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

Subversion Repositories w11

[/] [w11/] [tags/] [w11a_V0.6/] [tools/] [bin/] [asm-11_expect] - Blame information for rev 24

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 19 wfjm 
#!/usr/bin/perl -w
2 
# $Id: asm-11_expect 501 2013-03-30 13:53:39Z mueller $
3 
#
4 
# Copyright 2013- 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 
# 2013-03-29   500   1.0    Initial version
18 
# 2013-03-24   499   0.1    First draft
19 
#
20 
 
21 
use 5.10.0;                                 # require Perl 5.10 or higher
22 
use strict;                                 # require strict checking
23 
use FileHandle;
24 
 
25 
use Getopt::Long;
26 
 
27 
my %opts = ();
28 
 
29 
GetOptions(\%opts, "help",
30 
                   "tline", "tcheck"
31 
          )
32 
  or exit 1;
33 
 
34 
sub do_help;
35 
sub print_help;
36 
 
37 
my $errcnt;                                 # total error count
38 
 
39 
autoflush STDOUT 1 if (-p STDOUT);          # autoflush if output into pipe
40 
 
41 
if (exists $opts{help}) {
42 
  print_help;
43 
  exit 0;
44 
}
45 
 
46 
if (scalar(@ARGV) == 0) {
47 
  print STDERR "asm-11_expect-F: no input files specified, quiting..\n";
48 
  print_help;
49 
  exit 1;
50 
}
51 
 
52 
foreach my $fname (@ARGV) {
53 
  do_file($fname);
54 
}
55 
 
56 
exit 1 if $errcnt > 0;
57 
exit 0;
58 
 
59 
#-------------------------------------------------------------------------------
60 
#
61 
#; Input file list:
62 
#    1    6                              ; comment
63 
#    1   17 000000                       zero:
64 
#    1   23 002000 000101                w0:     .word   101
65 
#    1   17 001011 377                           .byte   ^c0
66 
#    1   70 001206 046374 001234 001234          bic     1234(r3),@1234(r4)
67 
#    1   24 001036 067527 066162 020544          .word   "Wo,"rl,"d!,0
68 
#                  000000
69 
#EEfnolinno dot... word1. word2. word2.
70 
#
71 
#          1         2         3
72 
#0123456789012345678901234567890123456789
73 
#
74 
 
75 
sub do_file {
76 
  my ($fname) = @_;
77 
  my $fh;
78 
  if ($fname eq "-") {
79 
    $fh = *STDIN;
80 
  } else {
81 
    if (not -r $fname) {
82 
      print STDERR "asm-11_expect-F: '$fname' not found or readable. EXIT\n";
83 
      exit 1;
84 
    }
85 
    $fh = new FileHandle;
86 
    $fh->open($fname) or die "failed to open '$fname'";
87 
  }
88 
 
89 
  my @errmsg;                               # error message list
90 
  my $echeck = 0;
91 
  my $c_string;
92 
  my $c_pend;
93 
 
94 
  while (<$fh>) {
95 
    chomp;
96 
    next if m/^;/;
97 
 
98 
    print "$_\n" if $opts{tline};
99 
 
100 
    my $line = $_;
101 
    my $rest = $_;
102 
    my $err;
103 
    if (substr($rest,2,1) =~ m/^[A-Z]$/) {
104 
      $rest =~ m/^([A-Z]+)$/;
105 
      $err  = $1;
106 
      $rest = $';
107 
    } else {
108 
      $err  = substr($rest,0,2);
109 
      $err  =~ s/\s//g;
110 
      $rest = substr($rest,2);
111 
    }
112 
 
113 
    my $fileno;
114 
    my $lineno;
115 
 
116 
    if (substr($rest,0,8) =~ m/^\s+(\d+)\s+(\d+)$/) {
117 
      $fileno = int($1);
118 
      $lineno = int($2);
119 
      $rest = substr($rest,8);
120 
    } else {
121 
      next;
122 
    }
123 
 
124 
    my $dot;
125 
    if (substr($rest,0,7) eq '       ') {
126 
      $rest = substr($rest,7);
127 
    } elsif (substr($rest,0,7) =~ m/^\s([0-7]{6})/) {
128 
      $dot = oct($1);
129 
      $rest = substr($rest,7);
130 
    } else {
131 
      next;
132 
    }
133 
 
134 
    my @dat;
135 
    my $isbyte;
136 
 
137 
    # words ?
138 
    if ($rest =~ m/^(\s([0-7]{6})){1,3}/) {
139 
      for (my $i=0; $i<3; $i++) {
140 
        last unless substr($rest,1,6) =~ m/[0-7]{6}/;
141 
        push @dat, oct(substr($rest,1,6));
142 
        $rest = substr($rest,7);
143 
      }
144 
    # bytes ?
145 
    } elsif ($rest =~ m/^(\s([0-7]{3})){1,5}/) {
146 
      for (my $i=0; $i<5; $i++) {
147 
        last unless substr($rest,1,3) =~ m/[0-7]{3}/;
148 
        $isbyte = 1;
149 
        push @dat, oct(substr($rest,1,3));
150 
        $rest = substr($rest,4);
151 
      }
152 
      $rest = substr($rest,1);
153 
    }
154 
 
155 
    # look for expect condition (unless one is pending)
156 
    if ($c_pend) {
157 
      $c_pend = undef;
158 
    } else {
159 
      if ($rest =~ m/;;!!(.*)$/) {
160 
        $c_string = $1;
161 
        if ($rest =~ m/^\s*;;!!/) {
162 
          $c_pend = 1;
163 
          next;
164 
        }
165 
      }
166 
    }
167 
 
168 
    # no expect condition defined: look for unexpected etags
169 
    unless (defined $c_string) {
170 
      if ($err ne '') {
171 
        push @errmsg,
172 
          {msg  => sprintf("unexpected error '%s'", $err),
173 
           line => $line};
174 
      }
175 
      next;
176 
    }
177 
 
178 
    # expect condition defined: parse it
179 
    my $c_err;
180 
    my $c_dot;
181 
    my @c_dat;
182 
 
183 
    my $c_rest = $c_string;
184 
    if ($c_rest =~ m/^\s*([A-Z]+)/) {
185 
      $c_err  = $1;
186 
      $c_rest = $';
187 
    }
188 
    if ($c_rest =~ m/^\s*([0-7]{6}:)/) {
189 
      $c_dot  = oct($1);
190 
      $c_rest = $';
191 
    }
192 
    while (length($c_rest)) {
193 
      last unless $c_rest =~ m/^\s*([0-7]+)/;
194 
      push @c_dat, oct($1);
195 
      $c_rest = $';
196 
    }
197 
 
198 
    unless ($c_rest =~ m/^\s*$/) {
199 
      push @errmsg,
200 
        {msg  => sprintf("can't parse expect, rest='%s'", $c_rest),
201 
         line => ';;!! ' . $c_string};
202 
      $c_string = undef;
203 
      next;
204 
    }
205 
 
206 
    if ($opts{tcheck}) {
207 
      print  "exp: ";
208 
      printf " err=%s",    $c_err if defined $c_err;
209 
      printf " dot=%6.6o", $c_dot if defined $c_dot;
210 
      if (scalar(@c_dat)) {
211 
        print " dat=";
212 
        foreach (@c_dat) {
213 
          printf "%6.6o ", $_;
214 
        }
215 
      }
216 
      print "\n";
217 
    }
218 
 
219 
    if (defined $c_err) {
220 
      if ($c_err ne $err) {
221 
        push @errmsg,
222 
          {msg  => sprintf("error mismatch: found='%s', expect='%s'",
223 
                           $err, $c_err),
224 
           line => $line};
225 
      }
226 
    }
227 
 
228 
    if (defined $c_dot) {
229 
      if (defined $dot) {
230 
        if ($c_dot != $dot) {
231 
          push @errmsg,
232 
            {msg  => sprintf(". mismatch: found=%6.6o, expect=%6.6o",
233 
                             $dot, $c_dot),
234 
             line => $line};
235 
        }
236 
      } else {
237 
        push @errmsg,
238 
          {msg  => sprintf(". check miss: nothing found, expect=%6.6o",
239 
                           $c_dot),
240 
           line => $line};
241 
      }
242 
    }
243 
 
244 
    if (scalar(@c_dat)) {
245 
      my $nc = scalar(@c_dat);
246 
      $nc = scalar(@dat) if $nc < scalar(@dat);
247 
      for (my $i=0; $i<$nc; $i++) {
248 
        if (defined $c_dat[$i] && defined $dat[$i]) {
249 
          if ($c_dat[$i] != $dat[$i]) {
250 
            push @errmsg,
251 
              {msg  => sprintf("data %d mismatch: found=%6.6o, expect=%6.6o",
252 
                               $i, $dat[$i], $c_dat[$i]),
253 
               line => $line};
254 
          }
255 
        } elsif (defined $c_dat[$i] && ! defined $dat[$i]) {
256 
          push @errmsg,
257 
            {msg  => sprintf("data %d mismatch: nothing found, expected=%6.6o",
258 
                             $i, $c_dat[$i]),
259 
             line => $line};
260 
        } elsif (! defined $c_dat[$i] && defined $dat[$i]) {
261 
          push @errmsg,
262 
            {msg  => sprintf("data %d mismatch: found=%6.6o, nothing expected",
263 
                             $i, $dat[$i]),
264 
             line => $line};
265 
        }
266 
      }
267 
    }
268 
 
269 
    # trace expects
270 
    if ($opts{tcheck} && $echeck != scalar(@errmsg)) {
271 
      $echeck = scalar(@errmsg);
272 
      printf "FAIL: %s\n", $errmsg[-1]{msg};
273 
   }
274 
 
275 
    # invalidate expect condition
276 
    $c_string = undef;
277 
  }
278 
 
279 
  # done with file
280 
  my $verdict = scalar(@errmsg) ? 'FAILED' : 'OK';
281 
  printf "asm-11_expect: %s %s\n", $fname, $verdict;
282 
  foreach (@errmsg) {
283 
    printf "  FAIL: %s\n    in: %s\n", $$_{msg}, $$_{line};
284 
  }
285 
 
286 
  $errcnt += scalar(@errmsg);
287 
 
288 
  return;
289 
}
290 
 
291 
#-------------------------------------------------------------------------------
292 
 
293 
sub print_help {
294 
  print "usage: asm-11_expect \n";
295 
  print "  --tline       trace input lines\n";
296 
  print "  --tcheck      trace expect checks\n";
297 
  return;
298 
}

powered by: WebSVN 2.1.0

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