fd185e9c1f366ae9b00e2d27f8a4861f7a21e25a
[openssl.git] / 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;