auxprogs/s390-check-opcodes.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 #------------------------------------------------------------------
   7 # This script assists in updating s390-opcodes.csv
   8 # It utilizes <binutils>/opcodes/s390-opc.txt and
   9 # <valgrind>/VEX/priv/guest_s390_toIR.c and will
  10 # - identify new opcodes that are present in s390-opc.txt
  11 #   (s390-opc.txt is the golden list)
  12 # - identify opcodes that are implemented in guest_s390_toIR.c
  13 #   but have an out-of-date status in the CSV file.
  14 #------------------------------------------------------------------
  15 my $num_arg = $#ARGV + 1;
  16
  17 my $csv_file;
  18 my $opc_file;
  19 my $toir_file;
  20
  21 if ($num_arg == 0) {
  22     my $cwd = `pwd`;
  23     my ($basedir) = $cwd =~ m|(.*)/valgrind/|;
  24     $csv_file  = "$basedir/valgrind/docs/internals/s390-opcodes.csv";
  25     $opc_file  = "$basedir/binutils-gdb/opcodes/s390-opc.txt";
  26     $toir_file = "$basedir/valgrind/VEX/priv/guest_s390_toIR.c";
  27 } elsif ($num_arg == 3) {
  28     $csv_file  = $ARGV[0];
  29     $opc_file  = $ARGV[1];
  30     $toir_file = $ARGV[2];
  31 } else {
  32     die "usage: s390-check-opcodes s390-opcodes.csv s390-opc.txt guest_s390_toIR.c\n";
  33 }
  34
  35 my %opc_desc = ();
  36 my %csv_desc = ();
  37 my %csv_implemented = ();
  38 my %toir_implemented = ();
  39 my %toir_decoded = ();
  40 my %known_arch = map {($_ => 1)}
  41     qw(g5 z900 z990 z9-109 z9-ec z10 z196 zEC12 z13 arch12 arch13 arch14);
  42
  43 # Patterns for identifying certain extended mnemonics that shall be
  44 # skipped in "s390-opc.txt" and "s390-opcodes.csv".
  45
  46 my @extended_mnemonics = (
  47     "bi",                       # extended mnemonic for bic
  48     'brul?',
  49     'jc',                       # brc
  50     'jasl?',
  51     'jct[gh]?',
  52     'jg?nop',
  53     'jxleg?',
  54     'jxhg?',
  55     'l[de]rv',
  56     'lfi',                      # iilf
  57     'llg[fh]i',                 # llilf, llill
  58     'notg?r',                   # nork, nogrk
  59     'risbgn?z',
  60     'risb[hl]gz',
  61     'r[onx]sbgt',
  62     'st[de]rv',
  63     "va[bhfgq]",
  64     "vacc[bhfgq]",
  65     "vacccq",
  66     "vacq",
  67     "vavgl*[bhfg]",
  68     "vcdl*gb",
  69     'vcfp[sl]',
  70     '[vw]cel?fb',
  71     'vc[sl]fp',
  72     '[vw]cl?feb',
  73     "vceq[bhfg]s*",
  74     "vchl*[bhfg]s*",
  75     "vcl*gdb",
  76     "vc[lt]z[bhfg]",
  77     "vecl*[bhfg]",
  78     "verim[bhfg]",
  79     "verllv*[bhfg]",
  80     "veslv*[bhfg]",
  81     "vesrav*[bhfg]",
  82     "vesrlv*[bhfg]",
  83     "vfaez*[bhfg]s*",
  84     "vfeez*[bhfg]s*",
  85     "vfenez*[bhfg]s*",
  86     "vfce[sd]bs*",
  87     "vfchdbs*",
  88     "vfche[sd]bs*",
  89     "vfchsbs*",
  90     "vfd[sd]b",
  91     "vfa[sd]b",
  92     "vfi[sd]b",
  93     "vfke[sd]bs*",
  94     "vfkhe*[sd]bs*",
  95     "vflc[sd]b",
  96     "vfll[sd]",
  97     "[vw]flr[dx]",
  98     "vfl[np][sd]b",
  99     "vfm[as]*[sd]b",
 100     "vfmax[sd]b",
 101     "vfmin[sd]b",
 102     "vfnm[as][sd]b",
 103     "vfpso[sd]b",
 104     "vfsq*[sd]b",
 105     "vftci[sd]b",
 106     "vgfma*[bhfg]",
 107     "vgm[bhfg]",
 108     "vistr[bhfg]s*",
 109     'vlbr[hfgq]',
 110     'vlbrrep[hfg]',
 111     "vlc[bhfg]",
 112     "[vw]ldeb",
 113     "[vw]ledb",
 114     'vler[hfg]',
 115     "vlgv[bhfg]",
 116     'vllebrz[hfge]',
 117     "vllez[bhfg]",
 118     "vllezlf",
 119     "vlp[bhfg]",
 120     "vlrep[bhfg]",
 121     "vlvg[bhfg]",
 122     "vmal?[eoh][bhfg]",
 123     "vmal(b|hw|f)",
 124     "vml(b|hw|f)",
 125     "vml?(o|e)[bhf]",
 126     "vml?h[bhf]",
 127     "vm[nx]l*[bhfg]",
 128     "vmr[lh][bhfg]",
 129     "vmslg",
 130     "vnot",
 131     "(vone|vzero)",
 132     "vpkl*[bhfg]",
 133     "vpkl*s*[bhfg]s*",
 134     "vpopct[bhfg]",
 135     "vrepi*[bhgf]",
 136     "vs[bhfgq]",
 137     "vsbcbiq",
 138     "vsbiq",
 139     "vscbi[bhfgq]",
 140     "vsch[sdx]p",               # vschp (short/long/extended)
 141     "vseg[bfh]",
 142     'vstbr[hfgq]',
 143     'vster[hfg]',
 144     "vstrcz*[bhf]s*",
 145     'vstrsz?[bhf]',
 146     "vsum(b|gh|gf|h|qf|qg)",
 147     "vuplh[bhf]",
 148     "vuph[bhf]",
 149     "vupl(b|hw|f)",
 150     "vupll[bhf]",
 151     "wcdl*gb",
 152     "wcl*gdb",
 153     "wfa[sdx]b",
 154     "wfch*e*[sdx]bs*",
 155     "wf[cdi][sdx]b",
 156     "wfkh*e*[sdx]bs*",
 157     "wfk[sdx]b",
 158     "wfl[clnp][sdx]b*",
 159     "wfmax[sdx]b",
 160     "wfmin[sdx]b",
 161     "wfm[as]*[sdx]b",
 162     "wfnm[as][sdx]b",
 163     "wfpso[sdx]b",
 164     "wftci[sdx]b",
 165     "wfsq*[sdx]b",
 166     "vl(ed|de)",
 167     "prno"                      # alternate mnemonic for ppno
 168     );
 169
 170 # Compile excluded mnemonics into one regular expression to optimize
 171 # speed.  Also it simplifies the code.
 172
 173 my $extended_mnemonics_pattern = '^(' .
 174     join('|', map "$_", @extended_mnemonics) . ')$';
 175
 176 #----------------------------------------------------
 177 # Read s390-opc.txt (binutils)
 178 #----------------------------------------------------
 179 open(OPC, "$opc_file") || die "cannot open $opc_file\n";
 180 while (my $line = <OPC>) {
 181     chomp $line;
 182     next if ($line =~ "^[ ]*#");   # comments
 183     next if ($line =~ /^\s*$/);    # blank line
 184     my ($encoding,$mnemonic,$format) = $line =~ /^(\S+) (\S+) (\S+)/gc;
 185
 186     # Ignore opcodes that have wildcards in them ('$', '*')
 187     # Those provide alternate mnemonics for specific instances of this opcode
 188     next if ($mnemonic =~ /\$/);
 189     next if ($mnemonic =~ /\*/);
 190
 191     # Ignore certain opcodes which are special cases of other opcodes
 192     next if ($mnemonic eq "br");    # special case of bcr
 193     next if ($mnemonic eq "nopr");  # special case of bcr
 194     next if ($mnemonic eq "b");     # special case of bc
 195     next if ($mnemonic eq "nop");   # special case of bc
 196     next if ($mnemonic eq "j");     # special case of brc
 197     next if ($mnemonic eq "jg");    # special case of brcl
 198     next if ($mnemonic eq "tmh");   # alternate mnemonic for tmlh
 199     next if ($mnemonic eq "tml");   # alternate mnemonic for tmll
 200     next if ($mnemonic eq "lrdr");  # alternate mnemonic for ldxr
 201     next if ($mnemonic eq "lrer");  # alternate mnemonic for ledr
 202     next if ($mnemonic eq "me");    # alternate mnemonic for mde
 203     next if ($mnemonic eq "mer");   # alternate mnemonic for mder
 204     next if ($mnemonic eq "cuutf"); # alternate mnemonic for cu21
 205     next if ($mnemonic eq "cutfu"); # alternate mnemonic for cu12
 206
 207     next if ($mnemonic eq "cfdbra"); # indistinguishable from cfdbr
 208     next if ($mnemonic eq "cfebra"); # indistinguishable from cfebr
 209     next if ($mnemonic eq "cfxbra"); # indistinguishable from cfxbr
 210     next if ($mnemonic eq "cgdbra"); # indistinguishable from cgdbr
 211     next if ($mnemonic eq "cgebra"); # indistinguishable from cgebr
 212     next if ($mnemonic eq "cgxbra"); # indistinguishable from cgxbr
 213     next if ($mnemonic eq "cdfbra"); # indistinguishable from cdfbr
 214     next if ($mnemonic eq "cefbra"); # indistinguishable from cefbr
 215     next if ($mnemonic eq "cxfbra"); # indistinguishable from cxfbr
 216     next if ($mnemonic eq "cdgbra"); # indistinguishable from cdgbr
 217     next if ($mnemonic eq "cegbra"); # indistinguishable from cegbr
 218     next if ($mnemonic eq "cxgbra"); # indistinguishable from cxgbr
 219     next if ($mnemonic eq "ldxbra"); # indistinguishable from ldxbr
 220     next if ($mnemonic eq "lexbra"); # indistinguishable from lexbr
 221     next if ($mnemonic eq "ledbra"); # indistinguishable from ledbr
 222     next if ($mnemonic eq "cdgtr");  # indistinguishable from cdgtra
 223     next if ($mnemonic eq "cxgtra"); # indistinguishable from cxgtr
 224     next if ($mnemonic eq "cgdtra"); # indistinguishable from cgdtr
 225     next if ($mnemonic eq "cgxtra"); # indistinguishable from cgxtr
 226     next if ($mnemonic eq "fidbr");  # indistinguishable from fidbra
 227     next if ($mnemonic eq "fiebr");  # indistinguishable from fiebra
 228     next if ($mnemonic eq "fixbr");  # indistinguishable from fixbra
 229     next if ($mnemonic eq "adtr");   # indistinguishable from adtra
 230     next if ($mnemonic eq "axtr");   # indistinguishable from axtra
 231     next if ($mnemonic eq "sdtr");   # indistinguishable from sdtra
 232     next if ($mnemonic eq "sxtr");   # indistinguishable from sxtra
 233     next if ($mnemonic eq "ddtr");   # indistinguishable from ddtra
 234     next if ($mnemonic eq "dxtr");   # indistinguishable from dxtra
 235     next if ($mnemonic eq "mdtr");   # indistinguishable from mdtra
 236     next if ($mnemonic eq "mxtr");   # indistinguishable from mxtra
 237     next if ($mnemonic =~ /$extended_mnemonics_pattern/);
 238
 239     my ($description) = $line =~ /\G\s+"\s*(.*?)\s*"/gc;
 240     my ($arch) = $line =~ /\G\s+(\S+)/gc;
 241     unless ($known_arch{$arch}) {
 242         unless (exists $known_arch{$arch}) {
 243             print "warning: unsupported arch \"$arch\" in s390-opc.txt\n";
 244             $known_arch{$arch} = 0;
 245         }
 246         next;
 247     }
 248
 249     $description =~ s/\s\s+/ /g; # replace multiple blanks with a single one
 250
 251     # Certain opcodes are listed more than once. Let the first description
 252     # win.
 253     if (exists $opc_desc{$mnemonic}) {
 254         # already there
 255 #        if ($opc_desc{$mnemonic} ne $description) {
 256 #            print "multiple description for opcode $mnemonic\n";
 257 #            print "  old: |" . $opc_desc{$mnemonic} . "|\n";
 258 #            print "  new: |" . $description . "|\n";
 259 #        }
 260     } else {
 261         $opc_desc{$mnemonic} = $description;
 262     }
 263
 264     if ($description =~ /,/) {
 265         print "warning: description of $mnemonic contains comma\n";
 266     }
 267 }
 268 close(OPC);
 269
 270 #----------------------------------------------------
 271 # Read CSV file (valgrind)
 272 #----------------------------------------------------
 273 open(CSV, "$csv_file") || die "cannot open $csv_file\n";
 274 while (my $line = <CSV>) {
 275     chomp $line;
 276     next if ($line =~ "^[ ]*#");   # comments
 277     my ($mnemonic,$description,$status) = split /,/,$line;
 278
 279     $mnemonic    =~ s/"//g;
 280     $description =~ s/"//g;
 281
 282     next if ($mnemonic eq "cfdbra"); # indistinguishable from cfdbr
 283     next if ($mnemonic eq "cfebra"); # indistinguishable from cfebr
 284     next if ($mnemonic eq "cfxbra"); # indistinguishable from cfxbr
 285     next if ($mnemonic eq "cgdbra"); # indistinguishable from cgdbr
 286     next if ($mnemonic eq "cgebra"); # indistinguishable from cgebr
 287     next if ($mnemonic eq "cgxbra"); # indistinguishable from cgxbr
 288     next if ($mnemonic eq "cdfbra"); # indistinguishable from cdfbr
 289     next if ($mnemonic eq "cefbra"); # indistinguishable from cefbr
 290     next if ($mnemonic eq "cxfbra"); # indistinguishable from cxfbr
 291     next if ($mnemonic eq "cegbra"); # indistinguishable from cegbr
 292     next if ($mnemonic eq "cdgbra"); # indistinguishable from cdgbr
 293     next if ($mnemonic eq "cegbra"); # indistinguishable from cegbr
 294     next if ($mnemonic eq "cxgbra"); # indistinguishable from cxgbr
 295     next if ($mnemonic eq "ldxbra"); # indistinguishable from ldxbr
 296     next if ($mnemonic eq "lexbra"); # indistinguishable from lexbr
 297     next if ($mnemonic eq "ledbra"); # indistinguishable from ledbr
 298     next if ($mnemonic eq "cdgtr");  # indistinguishable from cdgtra
 299     next if ($mnemonic eq "cxgtra"); # indistinguishable from cxgtr
 300     next if ($mnemonic eq "cgdtra"); # indistinguishable from cgdtr
 301     next if ($mnemonic eq "cgxtra"); # indistinguishable from cgxtr
 302     next if ($mnemonic eq "fidbr");  # indistinguishable from fidbra
 303     next if ($mnemonic eq "fiebr");  # indistinguishable from fiebra
 304     next if ($mnemonic eq "fixbr");  # indistinguishable from fixbra
 305     next if ($mnemonic eq "adtr");   # indistinguishable from adtra
 306     next if ($mnemonic eq "sdtr");   # indistinguishable from sdtra
 307     next if ($mnemonic eq "ddtr");   # indistinguishable from ddtra
 308     next if ($mnemonic eq "mdtr");   # indistinguishable from mdtra
 309     next if ($mnemonic =~ /$extended_mnemonics_pattern/);
 310
 311     # Complain about duplicate entries. We don't want them.
 312     if ($csv_desc{$mnemonic}) {
 313         print "$mnemonic: duplicate entry\n";
 314     } else {
 315         $csv_desc{$mnemonic} = $description;
 316     }
 317     # Remember whether it is implemented or not
 318     next if ($line =~ /not\s+implemented/);
 319     next if ($line =~ /N\/A/);
 320     next if ($line =~ /won't do/);
 321     if ($line =~ /implemented/) {
 322         $csv_implemented{$mnemonic} = 1;
 323     } else {
 324         print "*** unknown implementation status of $mnemonic\n";
 325     }
 326 }
 327 close(CSV);
 328
 329 #----------------------------------------------------
 330 # Read s390_guest_toIR.c file. Compile list of implemented opcodes
 331 #----------------------------------------------------
 332 open(TOIR, "$toir_file") || die "cannot open $toir_file\n";
 333 while (my $line = <TOIR>) {
 334     chomp $line;
 335     if ($line =~ /goto\s+unimplemented/) {
 336         # Assume this is in the decoder
 337         if ($line =~ /\/\*\s([A-Z][A-Z0-9]*)\s\*\//) {
 338             my $mnemonic = lc $1;
 339             $toir_decoded{$mnemonic} = 1;
 340         }
 341     } elsif ($line =~ /^s390_irgen_([A-Z][A-Z0-9]*)\b/) {
 342         my $mnemonic = lc $1;
 343         $toir_implemented{$mnemonic} = 1;
 344     }
 345 }
 346 close(TOIR);
 347
 348 #----------------------------------------------------
 349 # 1) Make sure there are no missing/extra opcodes
 350 #----------------------------------------------------
 351 foreach my $opc (keys %opc_desc) {
 352     if (! $csv_desc{$opc}) {
 353         print "*** opcode $opc not listed in $csv_file\n";
 354     }
 355 }
 356 foreach my $opc (keys %csv_desc) {
 357     if (! $opc_desc{$opc}) {
 358         print "*** opcode $opc not listed in $opc_file\n";
 359     }
 360 }
 361
 362 #----------------------------------------------------
 363 # 2) Make sure opcode descriptions are the same
 364 #----------------------------------------------------
 365 foreach my $opc (keys %opc_desc) {
 366     if (defined $csv_desc{$opc}) {
 367         if (lc($opc_desc{$opc}) ne lc($csv_desc{$opc})) {
 368             print "*** opcode $opc differs:\n";
 369             print "    binutils:    $opc_desc{$opc}\n";
 370             print "    opcodes.csv: $csv_desc{$opc}\n";
 371         }
 372     }
 373 }
 374
 375 #----------------------------------------------------
 376 # 3) Make sure implemented'ness is correct
 377 #----------------------------------------------------
 378 foreach my $opc (keys %toir_implemented) {
 379     if (! $csv_implemented{$opc}) {
 380         print "*** opcode $opc is implemented but CSV file does not say so\n";
 381     }
 382 }
 383
 384 foreach my $opc (keys %csv_implemented) {
 385     if (! $toir_implemented{$opc}) {
 386         print "*** opcode $opc is not implemented but CSV file says so\n";
 387     }
 388 }
 389
 390 #----------------------------------------------------
 391 # 4) Make sure all opcodes are handled by the decoder
 392 #----------------------------------------------------
 393
 394 # We only have to check those for which we don't generate IR.
 395
 396 foreach my $opc (keys %opc_desc) {
 397     if (! $toir_implemented{$opc} && ! $toir_decoded{$opc}) {
 398         print "*** opcode $opc is not handled by the decoder\n";
 399     }
 400 }
 401
 402 print "there are " . int(keys %toir_implemented) . " implemented opcodes\n";
 403 exit 0