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