| #!/usr/bin/perl |
| |
| # ********************************************************** |
| # Copyright (c) 2014-2020 Google, Inc. All rights reserved. |
| # ********************************************************** |
| |
| # Redistribution and use in source and binary forms, with or without |
| # modification, are permitted provided that the following conditions are met: |
| # |
| # * Redistributions of source code must retain the above copyright notice, |
| # this list of conditions and the following disclaimer. |
| # |
| # * Redistributions in binary form must reproduce the above copyright notice, |
| # this list of conditions and the following disclaimer in the documentation |
| # and/or other materials provided with the distribution. |
| # |
| # * Neither the name of Google, Inc. nor the names of its contributors may be |
| # used to endorse or promote products derived from this software without |
| # specific prior written permission. |
| # |
| # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
| # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
| # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
| # ARE DISCLAIMED. IN NO EVENT SHALL VMWARE, INC. OR CONTRIBUTORS BE LIABLE |
| # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
| # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
| # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
| # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
| # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
| # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
| # DAMAGE. |
| |
| # Pass this the file with the op_instr[] encoding chain starting points |
| # array along with headers containing the table shortcuts and the files |
| # containing the decoding table files to chain. |
| # If -o OP_<opc> is passed it will only consider that opcode; else it will |
| # process all opcodes. |
| # It will construct each encoding chain and in-place edit the table files. |
| # It has assumptions on the precise format of the decoding table |
| # and of the op_instr* starting point array. |
| # |
| # To run on one A32 opcode: |
| # |
| # tools/arm_table_chain.pl -v -o <opc> core/ir/arm/table_{private,encode,a32}*.[ch] |
| # |
| # To run on all A32 opcodes: |
| # |
| # tools/arm_table_chain.pl core/ir/arm/table_{private,encode,a32}*.[ch] |
| # |
| # To run on one T32 opcode: |
| # |
| # tools/arm_table_chain.pl -v -o <opc> core/ir/arm/table_{private,encode,t32}*.[ch] |
| # |
| # To run on all T32 opcodes for outside of IT blocks: |
| # |
| # tools/arm_table_chain.pl core/ir/arm/table_{private,encode,t32}*.[ch] |
| # |
| # To run on all T32 opcodes for inside of IT blocks: |
| # |
| # tools/arm_table_chain.pl -it core/ir/arm/table_{private,encode,t32}*.[ch] |
| # |
| # Assuming the .n format are always first and thus always the entries, |
| # we can run arm_table_chain.pl twice for inside and outside of IT blocks |
| # with T32 tables without affecting the in-table chaining. |
| |
| |
| my $verbose = 0; |
| |
| die "Usage: $0 [-o OP_<opcode>] [-it] <table-files>\n" if ($#ARGV < 1); |
| my $single_op = ''; |
| while ($ARGV[0] eq '-v') { |
| shift; |
| $verbose++; |
| } |
| if ($ARGV[0] eq '-o') { |
| shift; |
| $single_op = shift; |
| } |
| if ($ARGV[0] eq '-it') { |
| $it_block = 1; |
| shift; |
| } |
| my @allfiles = @ARGV; |
| my $table = ""; |
| my $shape = ""; |
| my $major = 0; |
| my $minor = 0; |
| my $instance = 0; |
| my $t32 = 0; |
| my @infiles; |
| |
| # Remove table_t32_16.c or table_t32_16_it.c |
| foreach $infile (@allfiles) { |
| if ($it_block) { |
| push(@infiles, $infile) if ($infile !~/t32_16\.c/); |
| } else { |
| push(@infiles, $infile) if ($infile !~/t32_16_it\.c/); |
| } |
| } |
| |
| # Must process headers first |
| @infiles = sort({return -1 if($a =~ /\.h$/);return 1 if($b =~ /\.h$/); return 0;} |
| @infiles); |
| |
| foreach $infile (@infiles) { |
| print "Processing $infile\n" if ($verbose > 0); |
| $t32 = 1 if ($infile =~ /_t32_/); |
| |
| open(INFILE, "< $infile") || die "Couldn't open $file\n"; |
| while (<INFILE>) { |
| print "xxx $_\n" if ($verbose > 2); |
| if (/^#define (\w+)\s+\(ptr_int_t\)&(\w+)/) { |
| $shorthand{$2} = $1; |
| print "shorthand for $2 = $1\n" if ($verbose > 1); |
| } |
| if (/^const instr_info_t (\w+)([^=]+)=/) { |
| $table = $1; |
| $shape = $2; |
| $major = -1; |
| $minor = 0; |
| } |
| if (/{\s*\/\*\s*(\d+)\s*\*\/\s*$/) { |
| $major++; |
| $minor = 0; |
| } |
| if (/^\s*{(OP_\w+)[ ,]/ && ($single_op eq '' || $single_op eq $1) && |
| $1 ne 'OP_CONTD') { |
| my $opc = $1; |
| $instance{$opc} = 0 if (!defined($instance{$opc})); |
| |
| # Ignore duplicate encodings |
| my $is_new = 1; |
| my $instance_next = $instance{$opc} + 1; |
| my $encoding = extract_encoding($_); |
| my $hex = extract_hex($_); |
| for (my $i = 0; $i < @{$entry{$opc}}; $i++) { |
| if ($encoding eq $entry{$opc}[$i]{'encoding'}) { |
| $is_new = 0; |
| $dup{$opc}{$encoding} = 1; |
| # We must place the entry with the fewest required bits into the |
| # encoding chain, to allow for entries to set distinguishing |
| # immed and other varying bits on duplicate entries (e.g., b vs f |
| # for the SIMD D bit) for easier decode table reading. |
| if (hex($hex) < hex($hex{$opc}{$encoding})) { |
| $hex{$opc}{$encoding} = $hex; |
| # Replace the stored instance with this one |
| $is_new = 1; |
| $instance_next = $instance{$opc} + 1; |
| $instance{$opc} = $i; |
| } |
| print "Duplicate $hex $encoding => $hex{$opc}{$encoding}\n" |
| if ($verbose > 1); |
| last; |
| } |
| } |
| goto dup_line if (!$is_new); |
| |
| $entry{$opc}[$instance{$opc}]{'line'} = $_; |
| $entry{$opc}[$instance{$opc}]{'encoding'} = $encoding; |
| $entry{$opc}[$instance{$opc}]{'hex'} = $hex; |
| $hex{$opc}{$encoding} = $hex; |
| die "Error: no shorthand for $table\n" if ($shorthand{$table} eq ''); |
| if ($shape =~ /\d/) { |
| $entry{$opc}[$instance{$opc}]{'addr_short'} = |
| sprintf "$shorthand{$table}\[$major][0x%02x]", $minor; |
| $entry{$opc}[$instance{$opc}]{'addr_long'} = |
| sprintf "$table\[$major][0x%02x]", $minor; |
| } else { |
| $entry{$opc}[$instance{$opc}]{'addr_short'} = |
| sprintf "$shorthand{$table}\[0x%02x]", $minor; |
| $entry{$opc}[$instance{$opc}]{'addr_long'} = |
| sprintf "$table\[0x%02x]", $minor; |
| } |
| # Order for sorting: |
| # + Prefer no-shift over shift |
| # + Prefer shift via immed over shift via reg |
| # + Prefer P=1 and U=1 |
| # + Prefer 8-byte over 16-byte and over 4-byte |
| my $priority = $instance{$opc}; |
| $priority-=10 if (/sh2, i/); |
| $priority-=10 if (/sh2, R/); |
| $priority-=10 if (/xop_shift/); |
| $priority+=10 if (/, [in]/); |
| $priority+=10 if (/, M.\d/); |
| $priority-=10 if (/, M.S/); |
| $priority+=50 if (/PUW=1../); |
| $priority+=100 if (/PUW=1.0/); |
| $priority+=10 if (/PUW=.1./); |
| $priority+=10 if (/[VW][ABC]q,/); |
| $priority-=50 if (/[VW][ABC]d,/); |
| # exop must be final member of chain |
| $priority-=1000 if (/exop\[\w+\]},/); |
| # + Prefer 16-bit Thumb code over 32-bit Thumb code |
| $priority+=500 if (/0x([\da-f]){4},/); |
| $priority+=10 if (/\bSPw\b|\bPCw\b/); |
| $priority+=10 if (/\bMSPP8w\b|\bMPCP8w\b/); |
| $priority+=10 if (/\bMSPDBl\b|\bMSPl\b/); |
| # + We have to take PC special-case first, b/c in some cases |
| # it has a larger immed which conflicts w/ other bits in non-PC |
| # (e.g., T32 OP_ldr with MPCN12w opnd). I don't think this |
| # generalization of that one known case as any negatives. |
| $priority+=200 if ($table =~ /PC$/); |
| |
| $entry{$opc}[$instance{$opc}]{'priority'} = $priority; |
| if ($verbose > 0) { |
| my $tmp = $entry{$opc}[$instance{$opc}]{'addr_long'}; |
| print "$priority $tmp $_"; |
| } |
| $instance{$opc} = $instance_next; |
| } |
| dup_line: |
| $minor++ if (/^\s*{[A-Z]/); |
| } |
| close(INFILE); |
| } |
| |
| foreach my $opc (keys %entry) { |
| @{$entry{$opc}} = sort({$b->{'priority'} <=> $a->{'priority'}} @{$entry{$opc}}); |
| if ($verbose > 1) { |
| print "Sorted:\n"; |
| for (my $i = 0; $i < @{$entry{$opc}}; $i++) { |
| my $tmp = $entry{$opc}[$i]{'addr_long'}; |
| my $pri = $entry{$opc}[$i]{'priority'}; |
| print "$pri $tmp\n"; |
| } |
| } |
| } |
| |
| # Now edit the files in place |
| $^I = '.bak'; |
| foreach $infile (@infiles) { |
| @ARGV = ($infile); |
| while (<>) { |
| my $encoding = extract_encoding($_); |
| my $hex = extract_hex($_); |
| my $handled = 0; |
| if (/^\s+\/\* (OP_\w+)[ ,]/ && ($single_op eq '' || $single_op eq $1)) { |
| my $opc = $1; |
| if (defined($entry{$opc}[0]{'addr_long'})) { |
| my $start = $entry{$opc}[0]{'addr_long'}; |
| if ($t32) { |
| if ($it_block) { |
| # Assuming the .n format are always first and thus always |
| # the entries, we can implement here for IT block and |
| # not inside the in-table chaining. |
| if ($opc !~ /OP_cps/ && $opc !~ /OP_setend$/) { |
| # OP_cps* and OP_setend are not permitted in IT block. |
| # We exclude OP_cps* and OP_setend to avoid creating |
| # separate table for T32.32 IT block instructions. |
| s/{(&.*,\s*&.*,\s*)&.*}/{\1&$start}/; |
| } |
| } else { |
| s/{(&.*,\s*)&.*(,\s*&.*)}/{\1&$start\2}/; |
| } |
| } else { |
| s/{&.*,(\s*&.*\s*&.*)}/{&$start,\1}/; |
| } |
| } |
| } |
| if (/^\s*{(OP_\w+)[ ,]/ && ($single_op eq '' || $single_op eq $1) && |
| $1 ne 'OP_CONTD') { |
| my $opc = $1; |
| if (defined($dup{$opc}{$encoding})) { |
| # Keep the one with the fewest bits, to allow for optional bits |
| # (e.g., immeds or reg bits) to be set to make the tables easier to |
| # read. |
| # For duplicate hex values, take 1st one. |
| if ($hex eq $hex{$opc}{$encoding} && |
| !defined($printed_dup{$opc}{$encoding})) { |
| $printed_dup{$opc}{$encoding} = 1; |
| if (@{$entry{$opc}} == 1) { |
| s/, *[\w\[\]_]+},/, END_LIST},/ unless /exop\[\w+\]},/; |
| $handled = 1; |
| } |
| } else { |
| s/, *[\w\[\]_]+},/, DUP_ENTRY},/ unless /exop\[\w+\]},/; |
| $handled = 1; |
| } |
| } |
| if (!$handled) { |
| for (my $i = 0; $i < @{$entry{$opc}}; $i++) { |
| if ($_ eq $entry{$opc}[$i]{'line'}) { |
| if ($i == @{$entry{$opc}} - 1) { |
| s/, *[\w\[\]_]+},/, END_LIST},/ unless /exop\[\w+\]},/; |
| } else { |
| if (/exop\[\w+\]},/) { |
| print STDERR |
| "ERROR: exop must be final element in chain: $_\n"; |
| } else { |
| my $chain = $entry{$opc}[$i+1]{'addr_short'}; |
| s/, *[\w\[\]_]+},/, $chain},/; |
| } |
| } |
| last; |
| } |
| } |
| } |
| } |
| print; |
| } |
| } |
| |
| sub extract_encoding($) |
| { |
| my ($line) = @_; |
| |
| # Remove up through opcode name (to remove encoding hexes) and |
| # final field and comments |
| $line =~ s/^[^"]+"/"/; |
| $line =~ s/,[^,]+}.*$//; |
| $line =~ s/\s*$//; |
| return $line; |
| } |
| |
| sub extract_hex($) |
| { |
| my ($line) = @_; |
| if ($line =~ /{OP_\w+,\s*0x([0-9a-fA-F]+),/) { |
| return $1; |
| } else { |
| return "not found"; |
| } |
| } |
