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 255
