1#!/usr/bin/env perl 2 3use strict; 4use 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#------------------------------------------------------------------ 15my $num_arg = $#ARGV + 1; 16 17if ($num_arg != 3) { 18 die "usage: s390-check-opcodes s390-opcodes.csv s390-opc.txt guest_s390_toIR.c\n"; 19} 20 21my $csv_file = $ARGV[0]; 22my $opc_file = $ARGV[1]; 23my $toir_file = $ARGV[2]; 24 25my %opc_desc = (); 26my %csv_desc = (); 27my %csv_implemented = (); 28my %toir_implemented = (); 29my %toir_decoded = (); 30 31 32#---------------------------------------------------- 33# Read s390-opc.txt (binutils) 34#---------------------------------------------------- 35open(OPC, "$opc_file") || die "cannot open $opc_file\n"; 36while (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} 116close(OPC); 117 118#---------------------------------------------------- 119# Read CSV file (valgrind) 120#---------------------------------------------------- 121open(CSV, "$csv_file") || die "cannot open $csv_file\n"; 122while (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} 174close(CSV); 175 176#---------------------------------------------------- 177# Read s390_guest_toIR.c file. Compile list of implemented opcodes 178#---------------------------------------------------- 179open(TOIR, "$toir_file") || die "cannot open $toir_file\n"; 180while (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} 197close(TOIR); 198 199#---------------------------------------------------- 200# 1) Make sure there are no missing/extra opcodes 201#---------------------------------------------------- 202foreach my $opc (keys %opc_desc) { 203 if (! $csv_desc{$opc}) { 204 print "*** opcode $opc not listed in $csv_file\n"; 205 } 206} 207foreach 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#---------------------------------------------------- 216foreach 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#---------------------------------------------------- 229foreach 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 235foreach 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 247foreach 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 253print "there are " . int(keys %toir_implemented) . " implemented opcodes\n"; 254exit 0 255