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
  31
  32 #----------------------------------------------------
  33 # Read s390-opc.txt (binutils)
  34 #----------------------------------------------------
  35 open(OPC, "$opc_file") || die "cannot open $opc_file\n";
  36 while (my $line = <OPC>) {
  37     chomp $line;
  38     next if ($line =~ "^[ ]*#");   # comments
  39     next if ($line =~ /^\s*$/);    # blank line
  40     my $description = (split /"/,$line)[1];
  41     my ($encoding,$mnemonic,$format) = split /\s+/,$line;
  42
  43     # Ignore opcodes that have wildcards in them ('$', '*')
  44     # Those provide alternate mnemonics for specific instances of this opcode
  45     next if ($mnemonic =~ /\$/);
  46     next if ($mnemonic =~ /\*/);
  47
  48     # Ignore certain opcodes which are special cases of other opcodes
  49     next if ($mnemonic eq "br");    # special case of bcr
  50     next if ($mnemonic eq "nopr");  # special case of bcr
  51     next if ($mnemonic eq "b");     # special case of bc
  52     next if ($mnemonic eq "nop");   # special case of bc
  53     next if ($mnemonic eq "j");     # special case of brc
  54     next if ($mnemonic eq "jg");    # special case of brcl
  55     next if ($mnemonic eq "tmh");   # alternate mnemonic for tmlh
  56     next if ($mnemonic eq "tml");   # alternate mnemonic for tmll
  57     next if ($mnemonic eq "lrdr");  # alternate mnemonic for ldxr
  58     next if ($mnemonic eq "lrer");  # alternate mnemonic for ledr
  59     next if ($mnemonic eq "me");    # alternate mnemonic for mde
  60     next if ($mnemonic eq "mer");   # alternate mnemonic for mder
  61     next if ($mnemonic eq "cuutf"); # alternate mnemonic for cu21
  62     next if ($mnemonic eq "cutfu"); # alternate mnemonic for cu12
  63
  64     next if ($mnemonic eq "cfdbra"); # indistinguishable from cfdbr
  65     next if ($mnemonic eq "cfebra"); # indistinguishable from cfebr
  66     next if ($mnemonic eq "cfxbra"); # indistinguishable from cfxbr
  67     next if ($mnemonic eq "cgdbra"); # indistinguishable from cgdbr
  68     next if ($mnemonic eq "cgebra"); # indistinguishable from cgebr
  69     next if ($mnemonic eq "cgxbra"); # indistinguishable from cgxbr
  70     next if ($mnemonic eq "cdfbra"); # indistinguishable from cdfbr
  71     next if ($mnemonic eq "cefbra"); # indistinguishable from cefbr
  72     next if ($mnemonic eq "cxfbra"); # indistinguishable from cxfbr
  73     next if ($mnemonic eq "cdgbra"); # indistinguishable from cdgbr
  74     next if ($mnemonic eq "cegbra"); # indistinguishable from cegbr
  75     next if ($mnemonic eq "cxgbra"); # indistinguishable from cxgbr
  76     next if ($mnemonic eq "ldxbra"); # indistinguishable from ldxbr
  77     next if ($mnemonic eq "lexbra"); # indistinguishable from lexbr
  78     next if ($mnemonic eq "ledbra"); # indistinguishable from ledbr
  79     next if ($mnemonic eq "cdgtra"); # indistinguishable from cdgtr
  80     next if ($mnemonic eq "cxgtra"); # indistinguishable from cxgtr
  81     next if ($mnemonic eq "cgdtra"); # indistinguishable from cgdtr
  82     next if ($mnemonic eq "cgxtra"); # indistinguishable from cgxtr
  83     next if ($mnemonic eq "fidbra"); # indistinguishable from fidbr
  84     next if ($mnemonic eq "fiebra"); # indistinguishable from fiebr
  85     next if ($mnemonic eq "fixbra"); # indistinguishable from fixbr
  86     next if ($mnemonic eq "adtr");  # indistinguishable from adtra
  87     next if ($mnemonic eq "axtr");  # indistinguishable from axtra
  88     next if ($mnemonic eq "sdtr");  # indistinguishable from sdtra
  89     next if ($mnemonic eq "sxtr");  # indistinguishable from sxtra
  90     next if ($mnemonic eq "ddtr");  # indistinguishable from ddtra
  91     next if ($mnemonic eq "dxtr");  # indistinguishable from dxtra
  92     next if ($mnemonic eq "mdtr");  # indistinguishable from mdtra
  93     next if ($mnemonic eq "mxtr");  # indistinguishable from mxtra
  94
  95     $description =~ s/^[\s]+//g;    # remove leading blanks
  96     $description =~ s/[\s]+$//g;    # remove trailing blanks
  97     $description =~ s/[ ][ ]+/ /g;  # replace multiple blanks with a single one
  98
  99
 100 # Certain opcodes are listed more than once. Let the first description win
 101     if ($opc_desc{$mnemonic}) {
 102         # already there
 103 #        if ($opc_desc{$mnemonic} ne $description) {
 104 #            print "multiple description for opcode $mnemonic\n";
 105 #            print "  old: |" . $opc_desc{$mnemonic} . "|\n";
 106 #            print "  new: |" . $description . "|\n";
 107 #        }
 108     } else {
 109         $opc_desc{$mnemonic} = $description;
 110     }
 111
 112     if ($description =~ /,/) {
 113         print "warning: description of $mnemonic contains comma\n";
 114     }
 115 }
 116 close(OPC);
 117
 118 #----------------------------------------------------
 119 # Read CSV file (valgrind)
 120 #----------------------------------------------------
 121 open(CSV, "$csv_file") || die "cannot open $csv_file\n";
 122 while (my $line = <CSV>) {
 123     chomp $line;
 124     next if ($line =~ "^[ ]*#");   # comments
 125     my ($mnemonic,$description,$status) = split /,/,$line;
 126
 127     $mnemonic    =~ s/"//g;
 128     $description =~ s/"//g;
 129
 130     next if ($mnemonic eq "cfdbra"); # indistinguishable from cfdbr
 131     next if ($mnemonic eq "cfebra"); # indistinguishable from cfebr
 132     next if ($mnemonic eq "cfxbra"); # indistinguishable from cfxbr
 133     next if ($mnemonic eq "cgdbra"); # indistinguishable from cgdbr
 134     next if ($mnemonic eq "cgebra"); # indistinguishable from cgebr
 135     next if ($mnemonic eq "cgxbra"); # indistinguishable from cgxbr
 136     next if ($mnemonic eq "cdfbra"); # indistinguishable from cdfbr
 137     next if ($mnemonic eq "cefbra"); # indistinguishable from cefbr
 138     next if ($mnemonic eq "cxfbra"); # indistinguishable from cxfbr
 139     next if ($mnemonic eq "cegbra"); # indistinguishable from cegbr
 140     next if ($mnemonic eq "cdgbra"); # indistinguishable from cdgbr
 141     next if ($mnemonic eq "cegbra"); # indistinguishable from cegbr
 142     next if ($mnemonic eq "cxgbra"); # indistinguishable from cxgbr
 143     next if ($mnemonic eq "ldxbra"); # indistinguishable from ldxbr
 144     next if ($mnemonic eq "lexbra"); # indistinguishable from lexbr
 145     next if ($mnemonic eq "ledbra"); # indistinguishable from ledbr
 146     next if ($mnemonic eq "cdgtra"); # indistinguishable from cdgtr
 147     next if ($mnemonic eq "cxgtra"); # indistinguishable from cxgtr
 148     next if ($mnemonic eq "cgdtra"); # indistinguishable from cgdtr
 149     next if ($mnemonic eq "cgxtra"); # indistinguishable from cgxtr
 150     next if ($mnemonic eq "fidbra"); # indistinguishable from fidbr
 151     next if ($mnemonic eq "fiebra"); # indistinguishable from fiebr
 152     next if ($mnemonic eq "fixbra"); # indistinguishable from fixbr
 153     next if ($mnemonic eq "adtr");   # indistinguishable from adtra
 154     next if ($mnemonic eq "sdtr");   # indistinguishable from sdtra
 155     next if ($mnemonic eq "ddtr");   # indistinguishable from ddtra
 156     next if ($mnemonic eq "mdtr");   # indistinguishable from mdtra
 157
 158 # Complain about duplicate entries. We don't want them.
 159     if ($csv_desc{$mnemonic}) {
 160         print "$mnemonic: duplicate entry\n";
 161     } else {
 162         $csv_desc{$mnemonic} = $description;
 163     }
 164 # Remember whether it is implemented or not
 165     next if ($line =~ /not\s+implemented/);
 166     next if ($line =~ /N\/A/);
 167     next if ($line =~ /won't do/);
 168     if ($line =~ /implemented/) {
 169         $csv_implemented{$mnemonic} = 1;
 170     } else {
 171         print "*** unknown implementation status of $mnemonic\n";
 172     }
 173 }
 174 close(CSV);
 175
 176 #----------------------------------------------------
 177 # Read s390_guest_toIR.c file. Compile list of implemented opcodes
 178 #----------------------------------------------------
 179 open(TOIR, "$toir_file") || die "cannot open $toir_file\n";
 180 while (my $line = <TOIR>) {
 181     chomp $line;
 182     if ($line =~ /goto\s+unimplemented/) {
 183         # Assume this is in the decoder
 184         if ($line =~ /\/\*\s([A-Z][A-Z0-9]+)\s\*\//) {
 185             my $mnemonic = $1;
 186             $mnemonic =~ tr/A-Z/a-z/;
 187             $toir_decoded{$mnemonic} = 1;
 188 #            print "DECODED: $mnemonic\n";
 189         }
 190     }
 191     next if (! ($line =~ /^s390_irgen_[A-Z]/));
 192     $line =~ /^s390_irgen_([A-Z][A-Z0-9]*)/;
 193     my $op = $1;
 194     $op =~ tr/A-Z/a-z/;
 195     $toir_implemented{$op} = 1;
 196 }
 197 close(TOIR);
 198
 199 #----------------------------------------------------
 200 # 1) Make sure there are no missing/extra opcodes
 201 #----------------------------------------------------
 202 foreach my $opc (keys %opc_desc) {
 203     if (! $csv_desc{$opc}) {
 204         print "*** opcode $opc not listed in $csv_file\n";
 205     }
 206 }
 207 foreach my $opc (keys %csv_desc) {
 208     if (! $opc_desc{$opc}) {
 209         print "*** opcode $opc not listed in $opc_file\n";
 210     }
 211 }
 212
 213 #----------------------------------------------------
 214 # 2) Make sure opcode descriptions are the same
 215 #----------------------------------------------------
 216 foreach my $opc (keys %opc_desc) {
 217     if (defined $csv_desc{$opc}) {
 218         if ($opc_desc{$opc} ne $csv_desc{$opc}) {
 219             print "*** opcode $opc differs:\n";
 220         print "    binutils:    $opc_desc{$opc}\n";
 221             print "    opcodes.csv: $csv_desc{$opc}\n";
 222         }
 223     }
 224 }
 225
 226 #----------------------------------------------------
 227 # 3) Make sure implemented'ness is correct
 228 #----------------------------------------------------
 229 foreach my $opc (keys %toir_implemented) {
 230     if (! $csv_implemented{$opc}) {
 231         print "*** opcode $opc is implemented but CSV file does not say so\n";
 232     }
 233 }
 234
 235 foreach my $opc (keys %csv_implemented) {
 236     if (! $toir_implemented{$opc}) {
 237         print "*** opcode $opc is not implemented but CSV file says so\n";
 238     }
 239 }
 240
 241 #----------------------------------------------------
 242 # 4) Make sure all opcodes are handled by the decoder
 243 #----------------------------------------------------
 244
 245 # We only have to check those for which we don't generate IR.
 246
 247 foreach my $opc (keys %opc_desc) {
 248     if (! $toir_implemented{$opc} && ! $toir_decoded{$opc}) {
 249         print "*** opcode $opc is not handled by the decoder\n";
 250     }
 251 }
 252
 253 print "there are " . int(keys %toir_implemented) . " implemented opcodes\n";
 254 exit 0