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