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     elsif ($flavour =~ /ios32/) { if (join(',',@_) =~ /(\w+),%function/) {
  70                                         "#ifdef __thumb2__\n".
  71                                         ".thumb_func    $1\n".
  72                                         "#endif";
  73                                   }
  74                                 }
  75     else                        { ""; }
  76 };
  77 my $size = sub {
  78     if ($flavour =~ /linux/)    { ".size\t".join(',',@_); }
  79     else                        { ""; }
  80 };
  81 my $inst = sub {
  82     if ($flavour =~ /linux/)    { ".inst\t".join(',',@_); }
  83     else                        { ".long\t".join(',',@_); }
  84 };
  85 my $asciz = sub {
  86     my $line = join(",",@_);
  87     if ($line =~ /^"(.*)"$/)
  88     {   ".byte  " . join(",",unpack("C*",$1),0) . "\n.align     2";     }
  89     else
  90     {   "";     }
  91 };
  92
  93 sub range {
  94   my ($r,$sfx,$start,$end) = @_;
  95
  96     join(",",map("$r$_$sfx",($start..$end)));
  97 }
  98
  99 sub expand_line {
 100   my $line = shift;
 101   my @ret = ();
 102
 103     pos($line)=0;
 104
 105     while ($line =~ m/\G[^@\/\{\"]*/g) {
 106         if ($line =~ m/\G(@|\/\/|$)/gc) {
 107             last;
 108         }
 109         elsif ($line =~ m/\G\{/gc) {
 110             my $saved_pos = pos($line);
 111             $line =~ s/\G([rdqv])([0-9]+)([^\-]*)\-\1([0-9]+)\3/range($1,$3,$2,$4)/e;
 112             pos($line) = $saved_pos;
 113             $line =~ m/\G[^\}]*\}/g;
 114         }
 115         elsif ($line =~ m/\G\"/gc) {
 116             $line =~ m/\G[^\"]*\"/g;
 117         }
 118     }
 119
 120     $line =~ s/\b(\w+)/$GLOBALS{$1} or $1/ge;
 121
 122     return $line;
 123 }
 124
 125 while($line=<>) {
 126
 127     if ($line =~ m/^\s*(#|@|\/\/)/)     { print $line; next; }
 128
 129     $line =~ s|/\*.*\*/||;      # get rid of C-style comments...
 130     $line =~ s|^\s+||;          # ... and skip white spaces in beginning...
 131     $line =~ s|\s+$||;          # ... and at the end
 132
 133     {
 134         $line =~ s|[\b\.]L(\w{2,})|L$1|g;       # common denominator for Locallabel
 135         $line =~ s|\bL(\w{2,})|\.L$1|g  if ($dotinlocallabels);
 136     }
 137
 138     {
 139         $line =~ s|(^[\.\w]+)\:\s*||;
 140         my $label = $1;
 141         if ($label) {
 142             printf "%s:",($GLOBALS{$label} or $label);
 143         }
 144     }
 145
 146     if ($line !~ m/^[#@]/) {
 147         $line =~ s|^\s*(\.?)(\S+)\s*||;
 148         my $c = $1; $c = "\t" if ($c eq "");
 149         my $mnemonic = $2;
 150         my $opcode;
 151         if ($mnemonic =~ m/([^\.]+)\.([^\.]+)/) {
 152             $opcode = eval("\$$1_$2");
 153         } else {
 154             $opcode = eval("\$$mnemonic");
 155         }
 156
 157         my $arg=expand_line($line);
 158
 159         if (ref($opcode) eq 'CODE') {
 160                 $line = &$opcode($arg);
 161         } elsif ($mnemonic)         {
 162                 $line = $c.$mnemonic;
 163                 $line.= "\t$arg" if ($arg ne "");
 164         }
 165     }
 166
 167     print $line if ($line);
 168     print "\n";
 169 }
 170
 171 close STDOUT;