crypto/perlasm/arm-xlate.pl

   1 #!/usr/bin/env perl
   2
   3 # ARM assembler distiller by <appro>.
   4
   5 my $flavour = shift;
   6 my $output = shift;
   7 open STDOUT,">$output" || die "can't open $output: $!";
   8
   9 $flavour = "linux32" if (!$flavour or $flavour eq "void");
  10
  11 my %GLOBALS;
  12 my $dotinlocallabels=($flavour=~/linux/)?1:0;
  13
  14 ################################################################
  15 # directives which need special treatment on different platforms
  16 ################################################################
  17 my $arch = sub {
  18     if ($flavour =~ /linux/)    { ".arch\t".join(',',@_); }
  19     else                        { ""; }
  20 };
  21 my $fpu = sub {
  22     if ($flavour =~ /linux/)    { ".fpu\t".join(',',@_); }
  23     else                        { ""; }
  24 };
  25 my $hidden = sub {
  26     if ($flavour =~ /ios/)      { ".private_extern\t".join(',',@_); }
  27     else                        { ".hidden\t".join(',',@_); }
  28 };
  29 my $comm = sub {
  30     my @args = split(/,\s*/,shift);
  31     my $name = @args[0];
  32     my $global = \$GLOBALS{$name};
  33     my $ret;
  34
  35     if ($flavour =~ /ios32/)    {
  36         $ret = ".comm\t_$name,@args[1]\n";
  37         $ret .= ".non_lazy_symbol_pointer\n";
  38         $ret .= "$name:\n";
  39         $ret .= ".indirect_symbol\t_$name\n";
  40         $ret .= ".long\t0";
  41         $name = "_$name";
  42     } else                      { $ret = ".comm\t".join(',',@args); }
  43
  44     $$global = $name;
  45     $ret;
  46 };
  47 my $globl = sub {
  48     my $name = shift;
  49     my $global = \$GLOBALS{$name};
  50     my $ret;
  51
  52     SWITCH: for ($flavour) {
  53         /ios/           && do { $name = "_$name";
  54                                 last;
  55                               };
  56     }
  57
  58     $ret = ".globl      $name" if (!$ret);
  59     $$global = $name;
  60     $ret;
  61 };
  62 my $global = $globl;
  63 my $extern = sub {
  64     &$globl(@_);
  65     return;     # return nothing
  66 };
  67 my $type = sub {
  68     if ($flavour =~ /linux/)    { ".type\t".join(',',@_); }
  69     else                        { ""; }
  70 };
  71 my $size = sub {
  72     if ($flavour =~ /linux/)    { ".size\t".join(',',@_); }
  73     else                        { ""; }
  74 };
  75 my $inst = sub {
  76     if ($flavour =~ /linux/)    { ".inst\t".join(',',@_); }
  77     else                        { ".long\t".join(',',@_); }
  78 };
  79 my $asciz = sub {
  80     my $line = join(",",@_);
  81     if ($line =~ /^"(.*)"$/)
  82     {   ".byte  " . join(",",unpack("C*",$1),0) . "\n.align     2";     }
  83     else
  84     {   "";     }
  85 };
  86
  87 sub range {
  88   my ($r,$sfx,$start,$end) = @_;
  89
  90     join(",",map("$r$_$sfx",($start..$end)));
  91 }
  92
  93 sub expand_line {
  94   my $line = shift;
  95   my @ret = ();
  96
  97     pos($line)=0;
  98
  99     while ($line =~ m/\G[^@\/\{\"]*/g) {
 100         if ($line =~ m/\G(@|\/\/|$)/gc) {
 101             last;
 102         }
 103         elsif ($line =~ m/\G\{/gc) {
 104             my $saved_pos = pos($line);
 105             $line =~ s/\G([rdqv])([0-9]+)([^\-]*)\-\1([0-9]+)\3/range($1,$3,$2,$4)/e;
 106             pos($line) = $saved_pos;
 107             $line =~ m/\G[^\}]*\}/g;
 108         }
 109         elsif ($line =~ m/\G\"/gc) {
 110             $line =~ m/\G[^\"]*\"/g;
 111         }
 112     }
 113
 114     $line =~ s/\b(\w+)/$GLOBALS{$1} or $1/ge;
 115
 116     return $line;
 117 }
 118
 119 while($line=<>) {
 120
 121     if ($line =~ m/^\s*(#|@|\/\/)/)     { print $line; next; }
 122
 123     $line =~ s|/\*.*\*/||;      # get rid of C-style comments...
 124     $line =~ s|^\s+||;          # ... and skip white spaces in beginning...
 125     $line =~ s|\s+$||;          # ... and at the end
 126
 127     {
 128         $line =~ s|[\b\.]L(\w{2,})|L$1|g;       # common denominator for Locallabel
 129         $line =~ s|\bL(\w{2,})|\.L$1|g  if ($dotinlocallabels);
 130     }
 131
 132     {
 133         $line =~ s|(^[\.\w]+)\:\s*||;
 134         my $label = $1;
 135         if ($label) {
 136             printf "%s:",($GLOBALS{$label} or $label);
 137         }
 138     }
 139
 140     if ($line !~ m/^[#@]/) {
 141         $line =~ s|^\s*(\.?)(\S+)\s*||;
 142         my $c = $1; $c = "\t" if ($c eq "");
 143         my $mnemonic = $2;
 144         my $opcode;
 145         if ($mnemonic =~ m/([^\.]+)\.([^\.]+)/) {
 146             $opcode = eval("\$$1_$2");
 147         } else {
 148             $opcode = eval("\$$mnemonic");
 149         }
 150
 151         my $arg=expand_line($line);
 152
 153         if (ref($opcode) eq 'CODE') {
 154                 $line = &$opcode($arg);
 155         } elsif ($mnemonic)         {
 156                 $line = $c.$mnemonic;
 157                 $line.= "\t$arg" if ($arg ne "");
 158         }
 159     }
 160
 161     print $line if ($line);
 162     print "\n";
 163 }
 164
 165 close STDOUT;