xref: /netbsd-src/external/lgpl3/gmp/dist/mpn/alpha/ev6/slot.pl (revision dd255ccea4286b0c44fa8fd48a9a19a768afe8e1)
1#!/usr/bin/perl -w
2
3# Copyright 2000, 2001, 2003, 2004, 2005, 2011 Free Software Foundation, Inc.
4#
5# This file is part of the GNU MP Library.
6#
7# The GNU MP Library is free software; you can redistribute it and/or modify
8# it under the terms of the GNU Lesser General Public License as published
9# by the Free Software Foundation; either version 3 of the License, or (at
10# your option) any later version.
11#
12# The GNU MP Library is distributed in the hope that it will be useful, but
13# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
14# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
15# License for more details.
16#
17# You should have received a copy of the GNU Lesser General Public License
18# along with the GNU MP Library.  If not, see http://www.gnu.org/licenses/.
19
20
21# Usage: slot.pl [filename.o]...
22#
23# Run "objdump" to produce a disassembly of the given object file(s) and
24# annotate the output with "U" or "L" slotting which Alpha EV6 will use.
25#
26# When an instruction is E (ie. either U or L), an "eU" or "eL" is shown, as
27# a reminder that it wasn't a fixed requirement that gave the U or L, but
28# the octaword slotting rules.
29#
30# If an instruction is not recognised, that octaword does not get any U/L
31# shown, only lower-case "u", "l" or "e" for the instructions which are
32# known.  Add any unknown instructions to %optable below.
33
34
35use strict;
36
37# The U or L which various instructions demand, or E if either.
38#
39my %optable =
40  (
41   'addq'   => 'E',
42   'and'    => 'E',
43   'andnot' => 'E',
44   'beq'    => 'U',
45   'bge'    => 'U',
46   'bgt'    => 'U',
47   'bic'    => 'E',
48   'bis'    => 'E',
49   'blt'    => 'U',
50   'bne'    => 'U',
51   'br'     => 'L',
52   'clr'    => 'E',
53   'cmpule' => 'E',
54   'cmpult' => 'E',
55   'cmpeq'  => 'E',
56   'cmoveq' => 'E',
57   'cmovne' => 'E',
58   'ctpop'  => 'U',
59   'ctlz'   => 'U',
60   'cttz'   => 'U',
61   'extbl'  => 'U',
62   'extlh'  => 'U',
63   'extll'  => 'U',
64   'extqh'  => 'U',
65   'extql'  => 'U',
66   'extwh'  => 'U',
67   'extwl'  => 'U',
68   'jsr'    => 'L',
69   'lda'    => 'E',
70   'ldah'   => 'E',
71   'ldbu'   => 'L',
72   'ldl'    => 'L',
73   'ldq'    => 'L',
74   'ldt'    => 'L',
75   'ret'    => 'L',
76   'mov'    => 'E',
77   'mull'   => 'U',
78   'mulq'   => 'U',
79   'negq'   => 'E',
80   'nop'    => 'E',
81   'not'    => 'E',
82   's8addq' => 'E',
83   's8subq' => 'E',
84   # 'sextb'  => ?
85   # 'sextl'  => ?
86   'sll'    => 'U',
87   'srl'    => 'U',
88   'stq'    => 'L',
89   'subq'   => 'E',
90   'umulh'  => 'U',
91   'unop'   => 'E',
92   'xor'    => 'E',
93  );
94
95# Slottings used for a given pattern of U/L/E in an octaword.  This is as
96# per the "Ebox Slotting" section of the EV6 hardware reference manual.
97#
98my %slottable =
99  (
100   'EEEE' => 'ULUL',
101   'EEEL' => 'ULUL',
102   'EEEU' => 'ULLU',
103   'EELE' => 'ULLU',
104   'EELL' => 'UULL',
105   'EELU' => 'ULLU',
106   'EEUE' => 'ULUL',
107   'EEUL' => 'ULUL',
108   'EEUU' => 'LLUU',
109   'ELEE' => 'ULUL',
110   'ELEL' => 'ULUL',
111   'ELEU' => 'ULLU',
112   'ELLE' => 'ULLU',
113   'ELLL' => 'ULLL',
114   'ELLU' => 'ULLU',
115   'ELUE' => 'ULUL',
116   'ELUL' => 'ULUL',
117
118   'LLLL' => 'LLLL',
119   'LLLU' => 'LLLU',
120   'LLUE' => 'LLUU',
121   'LLUL' => 'LLUL',
122   'LLUU' => 'LLUU',
123   'LUEE' => 'LULU',
124   'LUEL' => 'LUUL',
125   'LUEU' => 'LULU',
126   'LULE' => 'LULU',
127   'LULL' => 'LULL',
128   'LULU' => 'LULU',
129   'LUUE' => 'LUUL',
130   'LUUL' => 'LUUL',
131   'LUUU' => 'LUUU',
132   'UEEE' => 'ULUL',
133   'UEEL' => 'ULUL',
134   'UEEU' => 'ULLU',
135
136   'ELUU' => 'LLUU',
137   'EUEE' => 'LULU',
138   'EUEL' => 'LUUL',
139   'EUEU' => 'LULU',
140   'EULE' => 'LULU',
141   'EULL' => 'UULL',
142   'EULU' => 'LULU',
143   'EUUE' => 'LUUL',
144   'EUUL' => 'LUUL',
145   'EUUU' => 'LUUU',
146   'LEEE' => 'LULU',
147   'LEEL' => 'LUUL',
148   'LEEU' => 'LULU',
149   'LELE' => 'LULU',
150   'LELL' => 'LULL',
151   'LELU' => 'LULU',
152   'LEUE' => 'LUUL',
153   'LEUL' => 'LUUL',
154   'LEUU' => 'LLUU',
155   'LLEE' => 'LLUU',
156   'LLEL' => 'LLUL',
157   'LLEU' => 'LLUU',
158   'LLLE' => 'LLLU',
159
160   'UELE' => 'ULLU',
161   'UELL' => 'UULL',
162   'UELU' => 'ULLU',
163   'UEUE' => 'ULUL',
164   'UEUL' => 'ULUL',
165   'UEUU' => 'ULUU',
166   'ULEE' => 'ULUL',
167   'ULEL' => 'ULUL',
168   'ULEU' => 'ULLU',
169   'ULLE' => 'ULLU',
170   'ULLL' => 'ULLL',
171   'ULLU' => 'ULLU',
172   'ULUE' => 'ULUL',
173   'ULUL' => 'ULUL',
174   'ULUU' => 'ULUU',
175   'UUEE' => 'UULL',
176   'UUEL' => 'UULL',
177   'UUEU' => 'UULU',
178   'UULE' => 'UULL',
179   'UULL' => 'UULL',
180   'UULU' => 'UULU',
181   'UUUE' => 'UUUL',
182   'UUUL' => 'UUUL',
183   'UUUU' => 'UUUU',
184  );
185
186# Check all combinations of U/L/E are present in %slottable.
187sub coverage {
188  foreach my $a ('U', 'L', 'E') {
189    foreach my $b ('U', 'L', 'E') {
190      foreach my $c ('U', 'L', 'E') {
191        foreach my $d ('U', 'L', 'E') {
192          my $x = $a . $b . $c . $d;
193          if (! defined $slottable{$x}) {
194            print "slottable missing: $x\n"
195          }
196        }
197      }
198    }
199  }
200}
201
202# Certain consistency checks for %slottable.
203sub check {
204  foreach my $x (keys %slottable) {
205    my $a = substr($x,0,1);
206    my $b = substr($x,1,1);
207    my $c = substr($x,2,1);
208    my $d = substr($x,3,1);
209    my $es = ($a eq 'E') + ($b eq 'E') + ($c eq 'E') + ($d eq 'E');
210    my $ls = ($a eq 'L') + ($b eq 'L') + ($c eq 'L') + ($d eq 'L');
211    my $us = ($a eq 'U') + ($b eq 'U') + ($c eq 'U') + ($d eq 'U');
212
213    my $got = $slottable{$x};
214    my $want = $x;
215
216    if ($es == 0) {
217
218    } elsif ($es == 1) {
219      # when only one E, it's mapped to whichever of U or L is otherwise
220      # used the least
221      if ($ls > $us) {
222        $want =~ s/E/U/;
223      } else {
224        $want =~ s/E/L/;
225      }
226    } elsif ($es == 2) {
227      # when two E's and two U, then the E's map to L; vice versa for two E
228      # and two L
229      if ($ls == 2) {
230        $want =~ s/E/U/g;
231      } elsif ($us == 2) {
232        $want =~ s/E/L/g;
233      } else {
234        next;
235      }
236    } elsif ($es == 3) {
237      next;
238
239    } else { # $es == 4
240      next;
241    }
242
243    if ($want ne $got) {
244      print "slottable $x want $want got $got\n";
245    }
246  }
247}
248
249sub disassemble {
250  my ($file) = @_;
251
252  open (IN, "objdump -Srfh $file |") || die "Cannot open pipe from objdump\n";
253
254  my (%pre, %post, %type);
255  while (<IN>) {
256    my $line = $_ . "";
257
258    if ($line =~ /(^[ \t]*[0-9a-f]*([0-9a-f]):[ \t]*[0-9a-f][0-9a-f] [0-9a-f][0-9a-f] [0-9a-f][0-9a-f] [0-9a-f][0-9a-f] )\t(([a-z0-9]+).*)/) {
259      my ($this_pre, $addr, $this_post, $opcode) = ($1, $2, $3, $4);
260
261      my $this_type = $optable{$opcode};
262      if (! defined ($this_type)) { $this_type = ' '; }
263
264      $pre{$addr} = $this_pre;
265      $post{$addr} = $this_post;
266      $type{$addr} = $this_type;
267
268      if ($addr eq 'c') {
269        my %slot = ('0'=>' ', '4'=>' ', '8'=>' ', 'c'=>' ');
270
271        my $str = $type{'c'} . $type{'8'} . $type{'4'} . $type{'0'};
272        $str = $slottable{$str};
273        if (defined $str) {
274          $slot{'c'} = substr($str,0,1);
275          $slot{'8'} = substr($str,1,1);
276          $slot{'4'} = substr($str,2,1);
277          $slot{'0'} = substr($str,3,1);
278        }
279
280        foreach my $i ('0', '4', '8', 'c') {
281          if ($slot{$i} eq $type{$i}) { $type{$i} = ' '; }
282          print $pre{$i}, ' ', lc($type{$i}),$slot{$i}, '  ', $post{$i}, "\n";
283        }
284
285        %pre = ();
286        %type = ();
287        %post = ();
288      }
289    }
290  }
291
292  close IN || die "Error from objdump (or objdump not available)\n";
293}
294
295coverage();
296check();
297
298my @files;
299if ($#ARGV >= 0) {
300  @files = @ARGV;
301} else {
302  die
303}
304
305foreach (@files)  {
306    disassemble($_);
307}
308