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 $globl = sub {
  22     my $name = shift;
  23     my $global = \$GLOBALS{$name};
  24     my $ret;
  25
  26     SWITCH: for ($flavour) {
  27         /ios/           && do { $name = "_$name";
  28                                 last;
  29                               };
  30     }
  31
  32     $ret = ".globl      $name" if (!$ret);
  33     $$global = $name;
  34     $ret;
  35 };
  36 my $global = $globl;
  37 my $extern = sub {
  38     &$globl(@_);
  39     return;     # return nothing
  40 };
  41 my $type = sub {
  42     if ($flavour =~ /linux/)    { ".type\t".join(',',@_); }
  43     else                        { ""; }
  44 };
  45 my $size = sub {
  46     if ($flavour =~ /linux/)    { ".size\t".join(',',@_); }
  47     else                        { ""; }
  48 };
  49 my $inst = sub {
  50     if ($flavour =~ /linux/)    { ".inst\t".join(',',@_); }
  51     else                        { ".long\t".join(',',@_); }
  52 };
  53 my $asciz = sub {
  54     my $line = join(",",@_);
  55     if ($line =~ /^"(.*)"$/)
  56     {   ".byte  " . join(",",unpack("C*",$1),0) . "\n.align     2";     }
  57     else
  58     {   "";     }
  59 };
  60
  61 sub range {
  62   my ($r,$sfx,$start,$end) = @_;
  63
  64     join(",",map("$r$_$sfx",($start..$end)));
  65 }
  66
  67 sub parse_args {
  68   my $line = shift;
  69   my @ret = ();
  70
  71     pos($line)=0;
  72
  73     while (1) {
  74         if ($line =~ m/\G\[/gc) {
  75             $line =~ m/\G([^\]]+\][^,]*)\s*/g;
  76             push @ret,"[$1";
  77         }
  78         elsif ($line =~ m/\G\{/gc) {
  79             $line =~ m/\G([^\}]+\}[^,]*)\s*/g;
  80             my $arg = $1;
  81             $arg =~ s/([rdqv])([0-9]+)([^\-]*)\-\1([0-9]+)\3/range($1,$3,$2,$4)/ge;
  82             push @ret,"{$arg";
  83         }
  84         elsif ($line =~ m/\G([^,]+)\s*/g) {
  85             push @ret,$1;
  86         }
  87
  88         last if ($line =~ m/\G$/gc);
  89
  90         $line =~ m/\G,\s*/g;
  91     }
  92
  93     map {my $s=$_;$s=~s/\b(\w+)/$GLOBALS{$1} or $1/ge;$s} @ret;
  94 }
  95
  96 while($line=<>) {
  97
  98     $line =~ s|/\*.*\*/||;      # get rid of C-style comments...
  99     $line =~ s|^\s+||;          # ... and skip white spaces in beginning...
 100     $line =~ s|\s+$||;          # ... and at the end
 101
 102     {
 103         $line =~ s|[\b\.]L(\w+)|L$1|g;  # common denominator for Locallabel
 104         $line =~ s|\bL(\w+)|\.L$1|g     if ($dotinlocallabels);
 105     }
 106
 107     {
 108         $line =~ s|(^[\.\w]+)\:\s*||;
 109         my $label = $1;
 110         if ($label) {
 111             printf "%s:",($GLOBALS{$label} or $label);
 112         }
 113     }
 114
 115     if ($line !~ m/^#/o) {
 116         $line =~ s|^\s*(\.?)(\S+)\s*||o;
 117         my $c = $1; $c = "\t" if ($c eq "");
 118         my $mnemonic = $2;
 119         my $opcode;
 120         if ($mnemonic =~ m/([^\.]+)\.([^\.]+)/o) {
 121             $opcode = eval("\$$1_$2");
 122         } else {
 123             $opcode = eval("\$$mnemonic");
 124         }
 125
 126         my @args=parse_args($line);
 127
 128         if (ref($opcode) eq 'CODE') {
 129                 $line = &$opcode(@args);
 130         } elsif ($mnemonic)         {
 131                 $line = $c.$mnemonic;
 132                 $line.= "\t".join(',',@args) if ($#args>=0);
 133         }
 134     }
 135
 136     print $line if ($line);
 137     print "\n";
 138 }
 139
 140 close STDOUT;