2010-05-25 Miguel de Icaza <miguel@novell.com>
[mono.git] / mono / mini / genmdesc.pl
1 #!/usr/bin/perl -w
2
3 # perl replacement of genmdesc.c for use when cross-compiling
4
5 use strict;
6 no locale;
7
8 # must keep in sync with mini.h
9 my @spec_names = qw(dest src1 src2 src3 len clob);
10 sub INST_DEST  () {return 0;}
11 sub INST_SRC1  () {return 1;}
12 sub INST_SRC2  () {return 2;}
13 sub INST_SRC3  () {return 3;}
14 sub INST_LEN   () {return 4;}
15 sub INST_CLOB  () {return 5;}
16 sub INST_NACL  () {return 6;}
17 sub INST_MAX   () {return 7;}
18
19 # this must include all the #defines used in mini-ops.h
20 my @defines = qw (__i386__ __x86_64__ __ppc__ __powerpc__ __ppc64__ __arm__ 
21         __sparc__ sparc __s390__ s390 __ia64__ __alpha__ __mips__);
22 my %table =();
23 my %template_table =();
24 my @opcodes = ();
25
26 sub parse_file
27 {
28         my ($define, $file) = @_;
29         my @enabled = (1);
30         my $i = 0;
31         open (OPS, $file) || die "Cannot open $file: $!";
32         while (<OPS>) {
33                 if (/^\s*#\s*if\s+(.*)/) {
34                         my $defines = $1;
35                         die "fix the genmdesc.pl cpp parser to handle all operators" if /(&&)|([!<>=])/;
36                         unshift @enabled, scalar ($defines =~ /defined\s*\(\s*$define\s*\)/);
37                         next;
38                 }
39                 if (/^\s*#\s*ifdef\s+(\S+)/) {
40                         my $defines = $1;
41                         unshift @enabled, $defines eq $define;
42                         next;
43                 }
44                 if (/^\s*#\s*endif/) {
45                         shift @enabled;
46                         next;
47                 }
48                 next unless $enabled [0];
49                 next unless /MINI_OP3?\s*\(\s*(\S+?)\s*,\s*"(.*?)"/;
50                 my ($sym, $name) = ($1, $2);
51                 push @opcodes, [$sym, $name];
52                 $table{$name} = {num => $i, name => $name};
53                 $i++;
54         }
55         close (OPS);
56 }
57
58 sub load_opcodes
59 {
60         my ($srcdir, $arch) = @_;
61         my $opcodes_def = "$srcdir/../cil/opcode.def";
62         my $i = 0;
63         my $arch_found = 0;
64
65         my $cpp = $ENV{"CPP"};
66         $cpp = "cpp" unless defined $cpp;
67         $cpp .= " -undef ";
68         foreach (@defines) {
69                 $cpp .= " -U$_";
70                 $arch_found = 1 if $arch eq $_;
71         }
72         die "$arch arch is not supported.\n" unless $arch_found;
73
74         my $arch_define = $arch;
75         if ($arch =~ "__i386__") {
76                 $arch_define = "TARGET_X86";
77         }
78         if ($arch =~ " __x86_64__") {
79                 $arch_define = "TARGET_AMD64";
80         }
81         if ($arch =~ "__arm__") {
82                 $arch_define = "TARGET_ARM";
83         }
84
85         parse_file ($arch_define, "$srcdir/mini-ops.h");
86         return;
87         $cpp .= " -D$arch_define $srcdir/mini-ops.h|";
88         #print "Running: $cpp\n";
89         open (OPS, $cpp) || die "Cannot execute cpp: $!";
90         while (<OPS>) {
91                 next unless /MINI_OP3?\s*\(\s*(\S+?)\s*,\s*"(.*?)"/;
92                 my ($sym, $name) = ($1, $2);
93                 push @opcodes, [$sym, $name];
94                 $table{$name} = {num => $i, name => $name};
95                 $i++;
96         }
97         close (OPS);
98 }
99
100 sub load_file {
101         my ($name) = @_;
102         my $line = 0;
103         my $comment = "";
104
105         open (DESC, $name) || die "Cannot open $name: $!";
106         while (<DESC>) {
107                 my $is_template = 0;
108                 $line++;
109                 next if /^\s*$/;
110                 if (/^\s*(#.*)?$/) {
111                         $comment .= "$1\n";
112                         next;
113                 }
114                 my @values = split (/\s+/);
115                 next unless ($values [0] =~ /(\S+?):/);
116                 my $name = $1;
117                 my $desc;
118                 if ($name eq "template") {
119                         $is_template = 1;
120                         $desc = {};
121                 } else {
122                         $desc = $table {$name};
123                         die "Invalid opcode $name at line $line\n" unless defined $desc;
124                         die "Duplicated opcode $name at line $line\n" if $desc->{"desc"};
125                 }
126                 shift @values;
127                 $desc->{"desc"} = $_;
128                 $desc->{"comment"} = $comment;
129                 $desc->{"spec"} = {};
130                 $comment = "";
131                 #print "values for $name: " . join (' ', @values) . " num: " . int(@values), "\n";
132                 for my $val (@values) {
133                         if ($val =~ /(\S+):(.*)/) {
134                                 if ($1 eq "name") {
135                                         die "name tag only valid in templates at line $line\n" unless $is_template;
136                                         die "Duplicated name tag in template $desc->{'name'} at line $line\n" if defined $desc->{'name'};
137                                         die "Duplicated template $2 at line $line\n" if defined $template_table {$2};
138                                         $desc->{'name'} = $2;
139                                         $template_table {$2} = $desc;
140                                 } elsif ($1 eq "template") {
141                                         my $tdesc = $template_table {$2};
142                                         die "Invalid template name $2 at line $line\n" unless defined $tdesc;
143                                         $desc->{"spec"} = {%{$tdesc->{"spec"}}};
144                                 } else {
145                                         $desc->{"spec"}->{$1} = $2;
146                                 }
147                         }
148                 }
149                 die "Template without name at line $1" if ($is_template && !defined ($desc->{'name'}));
150         }
151         close (DESC);
152 }
153
154 sub build_spec {
155         my ($spec) = shift;
156         my %spec = %{$spec};
157         my @vals = ();
158         foreach (@spec_names) {
159                 my $val = $spec->{$_};
160                 if (defined $val) {
161                         push @vals, $val;
162                 } else {
163                         push @vals, undef;
164                 }
165         }
166         #print "vals: " . join (' ', @vals) . "\n";
167         my $res = "";
168         for (my $i = 0; $i < @vals; ++$i) {
169                 if (defined $vals [$i]) {
170                         if ($i == INST_LEN) {
171                                 $res .= sprintf ("\\x%x\" \"", +$vals [$i]);
172                         } else {
173                                 if ($vals [$i] =~ /^[a-zA-Z0-9]$/) {
174                                         $res .= $vals [$i];
175                                 } else {
176                                         $res .= sprintf ("\\x%x\" \"", $vals [$i]);
177                                 }
178                         }
179                 } else {
180                         $res .= "\\x0\" \"";
181                 }
182         }
183         return $res;
184 }
185
186 sub build_table {
187         my ($fname, $name) = @_;
188         my $i;
189         my $idx;
190         my $idx_array = "const guint16 ${name}_idx [] = {\n";
191
192         open (OUT, ">$fname") || die "Cannot open file $fname: $!";
193         print OUT "/* File automatically generated by genmdesc, don't change */\n\n";
194         print OUT "const char $name [] = {\n";
195         print OUT "\t\"" . ("\\x0" x INST_MAX) . "\"\t/* null entry */\n";
196         $idx = 1;
197
198         for ($i = 0; $i < @opcodes; ++$i) {
199                 my $name = $opcodes [$i]->[1];
200                 my $desc = $table {$name};
201                 my $spec = $desc->{"spec"};
202                 if (defined $spec) {
203                         print OUT "\t\"";
204                         print OUT build_spec ($spec);
205                         print OUT "\"\t/* $name */\n";
206                         my $pos = $idx * INST_MAX;
207                         $idx_array .= "\t$pos,\t/* $name */\n";
208                         ++$idx;
209                 } else {
210                         $idx_array .= "\t0,\t/* $name */\n";
211                 }
212         }
213         print OUT "};\n\n";
214         print OUT "$idx_array};\n\n";
215         close (OUT);
216 }
217
218 sub usage {
219         die "genmdesc.pl arch srcdir output name desc [desc2 ...]\n";
220 }
221
222 my $arch = shift || usage ();
223 my $srcdir = shift || usage ();
224 my $output = shift || usage ();
225 my $name = shift || usage ();
226 usage () unless @ARGV;
227 my @files = @ARGV;
228
229 load_opcodes ($srcdir, $arch);
230 foreach my $file (@files) {
231         load_file ($file);
232 }
233 build_table ($output, $name);
234