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