auxprogs/s390-check-opcodes.pl

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