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