Merge branch 'mainline'
[pcsx_rearmed.git] / tools / gas-preprocessor.pl
1 #!/usr/bin/env perl
2 # by David Conrad
3 # This code is licensed under GPLv2 or later; go to gnu.org to read it
4 #  (not that it much matters for an asm preprocessor)
5 # usage: set your assembler to be something like "perl gas-preprocessor.pl gcc"
6 use strict;
7
8 # Apple's gas is ancient and doesn't support modern preprocessing features like
9 # .rept and has ugly macro syntax, among other things. Thus, this script
10 # implements the subset of the gas preprocessor used by x264 and ffmpeg
11 # that isn't supported by Apple's gas.
12
13 my @gcc_cmd = @ARGV;
14 my @preprocess_c_cmd;
15
16 my $fix_unreq = $^O eq "darwin";
17
18 if ($gcc_cmd[0] eq "-fix-unreq") {
19     $fix_unreq = 1;
20     shift @gcc_cmd;
21 } elsif ($gcc_cmd[0] eq "-no-fix-unreq") {
22     $fix_unreq = 0;
23     shift @gcc_cmd;
24 }
25
26 if (grep /\.c$/, @gcc_cmd) {
27     # C file (inline asm?) - compile
28     @preprocess_c_cmd = (@gcc_cmd, "-S");
29 } elsif (grep /\.[sS]$/, @gcc_cmd) {
30     # asm file, just do C preprocessor
31     @preprocess_c_cmd = (@gcc_cmd, "-E");
32 } else {
33     die "Unrecognized input filetype";
34 }
35
36 # if compiling, avoid creating an output file named '-.o'
37 if ((grep /^-c$/, @gcc_cmd) && !(grep /^-o/, @gcc_cmd)) {
38     foreach my $i (@gcc_cmd) {
39         if ($i =~ /\.[csS]$/) {
40             my $outputfile = $i;
41             $outputfile =~ s/\.[csS]$/.o/;
42             push(@gcc_cmd, "-o");
43             push(@gcc_cmd, $outputfile);
44             last;
45         }
46     }
47 }
48 @gcc_cmd = map { /\.[csS]$/ ? qw(-x assembler -) : $_ } @gcc_cmd;
49 @preprocess_c_cmd = map { /\.o$/ ? "-" : $_ } @preprocess_c_cmd;
50
51 my $comm;
52
53 # detect architecture from gcc binary name
54 if      ($gcc_cmd[0] =~ /arm/) {
55     $comm = '@';
56 } elsif ($gcc_cmd[0] =~ /powerpc|ppc/) {
57     $comm = '#';
58 }
59
60 # look for -arch flag
61 foreach my $i (1 .. $#gcc_cmd-1) {
62     if ($gcc_cmd[$i] eq "-arch") {
63         if ($gcc_cmd[$i+1] =~ /arm/) {
64             $comm = '@';
65         } elsif ($gcc_cmd[$i+1] =~ /powerpc|ppc/) {
66             $comm = '#';
67         }
68     }
69 }
70
71 # assume we're not cross-compiling if no -arch or the binary doesn't have the arch name
72 if (!$comm) {
73     my $native_arch = qx/arch/;
74     if ($native_arch =~ /arm/) {
75         $comm = '@';
76     } elsif ($native_arch =~ /powerpc|ppc/) {
77         $comm = '#';
78     }
79 }
80
81 if (!$comm) {
82     die "Unable to identify target architecture";
83 }
84
85 my %ppc_spr = (ctr    => 9,
86                vrsave => 256);
87
88 open(ASMFILE, "-|", @preprocess_c_cmd) || die "Error running preprocessor";
89
90 my $current_macro = '';
91 my $macro_level = 0;
92 my %macro_lines;
93 my %macro_args;
94 my %macro_args_default;
95 my $macro_count = 0;
96 my $altmacro = 0;
97
98 my @pass1_lines;
99 my @ifstack;
100
101 my %symbols;
102
103 # pass 1: parse .macro
104 # note that the handling of arguments is probably overly permissive vs. gas
105 # but it should be the same for valid cases
106 while (<ASMFILE>) {
107     # remove all comments (to avoid interfering with evaluating directives)
108     s/(?<!\\)$comm.*//x;
109
110     # comment out unsupported directives
111     s/\.type/$comm.type/x;
112     s/\.func/$comm.func/x;
113     s/\.endfunc/$comm.endfunc/x;
114     s/\.ltorg/$comm.ltorg/x;
115     s/\.size/$comm.size/x;
116     s/\.fpu/$comm.fpu/x;
117     s/\.arch/$comm.arch/x;
118     s/\.object_arch/$comm.object_arch/x;
119
120     # the syntax for these is a little different
121     s/\.global/.globl/x;
122     # also catch .section .rodata since the equivalent to .const_data is .section __DATA,__const
123     s/(.*)\.rodata/.const_data/x;
124     s/\.bss/.data/x;
125     s/\.int/.long/x;
126     s/\.float/.single/x;
127
128     # catch unknown section names that aren't mach-o style (with a comma)
129     if (/.section ([^,]*)$/) {
130         die ".section $1 unsupported; figure out the mach-o section name and add it";
131     }
132
133     parse_line($_);
134 }
135
136 sub eval_expr {
137     my $expr = $_[0];
138     $expr =~ s/([A-Za-z._][A-Za-z0-9._]*)/$symbols{$1}/g;
139     eval $expr;
140 }
141
142 sub handle_if {
143     my $line = $_[0];
144     # handle .if directives; apple's assembler doesn't support important non-basic ones
145     # evaluating them is also needed to handle recursive macros
146     if ($line =~ /\.if(n?)([a-z]*)\s+(.*)/) {
147         my $result = $1 eq "n";
148         my $type   = $2;
149         my $expr   = $3;
150
151         if ($type eq "b") {
152             $expr =~ s/\s//g;
153             $result ^= $expr eq "";
154         } elsif ($type eq "c") {
155             if ($expr =~ /(.*)\s*,\s*(.*)/) {
156                 $result ^= $1 eq $2;
157             } else {
158                 die "argument to .ifc not recognized";
159             }
160         } elsif ($type eq "") {
161             $result ^= eval_expr($expr) != 0;
162         } elsif ($type eq "eq") {
163             $result = eval_expr($expr) == 0;
164         } elsif ($type eq "lt") {
165             $result = eval_expr($expr) < 0;
166         } else {
167             chomp($line);
168             die "unhandled .if varient. \"$line\"";
169         }
170         push (@ifstack, $result);
171         return 1;
172     } else {
173         return 0;
174     }
175 }
176
177 sub parse_line {
178     my $line = @_[0];
179
180     # evaluate .if blocks
181     if (scalar(@ifstack)) {
182         if (/\.endif/) {
183             pop(@ifstack);
184             return;
185         } elsif ($line =~ /\.elseif\s+(.*)/) {
186             if ($ifstack[-1] == 0) {
187                 $ifstack[-1] = !!eval_expr($1);
188             } elsif ($ifstack[-1] > 0) {
189                 $ifstack[-1] = -$ifstack[-1];
190             }
191             return;
192         } elsif (/\.else/) {
193             $ifstack[-1] = !$ifstack[-1];
194             return;
195         } elsif (handle_if($line)) {
196             return;
197         }
198
199         # discard lines in false .if blocks
200         foreach my $i (0 .. $#ifstack) {
201             if ($ifstack[$i] <= 0) {
202                 return;
203             }
204         }
205     }
206
207     if (/\.macro/) {
208         $macro_level++;
209         if ($macro_level > 1 && !$current_macro) {
210             die "nested macros but we don't have master macro";
211         }
212     } elsif (/\.endm/) {
213         $macro_level--;
214         if ($macro_level < 0) {
215             die "unmatched .endm";
216         } elsif ($macro_level == 0) {
217             $current_macro = '';
218             return;
219         }
220     }
221
222     if ($macro_level > 1) {
223         push(@{$macro_lines{$current_macro}}, $line);
224     } elsif ($macro_level == 0) {
225         expand_macros($line);
226     } else {
227         if ($line =~ /\.macro\s+([\d\w\.]+)\s*(.*)/) {
228             $current_macro = $1;
229
230             # commas in the argument list are optional, so only use whitespace as the separator
231             my $arglist = $2;
232             $arglist =~ s/,/ /g;
233
234             my @args = split(/\s+/, $arglist);
235             foreach my $i (0 .. $#args) {
236                 my @argpair = split(/=/, $args[$i]);
237                 $macro_args{$current_macro}[$i] = $argpair[0];
238                 $argpair[0] =~ s/:vararg$//;
239                 $macro_args_default{$current_macro}{$argpair[0]} = $argpair[1];
240             }
241             # ensure %macro_lines has the macro name added as a key
242             $macro_lines{$current_macro} = [];
243
244         } elsif ($current_macro) {
245             push(@{$macro_lines{$current_macro}}, $line);
246         } else {
247             die "macro level without a macro name";
248         }
249     }
250 }
251
252 sub expand_macros {
253     my $line = @_[0];
254
255     # handle .if directives; apple's assembler doesn't support important non-basic ones
256     # evaluating them is also needed to handle recursive macros
257     if (handle_if($line)) {
258         return;
259     }
260
261     if (/\.purgem\s+([\d\w\.]+)/) {
262         delete $macro_lines{$1};
263         delete $macro_args{$1};
264         delete $macro_args_default{$1};
265         return;
266     }
267
268     if ($line =~ /\.altmacro/) {
269         $altmacro = 1;
270         return;
271     }
272
273     if ($line =~ /\.noaltmacro/) {
274         $altmacro = 0;
275         return;
276     }
277
278     $line =~ s/\%([^,]*)/eval_expr($1)/eg if $altmacro;
279
280     if ($line =~ /\.set\s+(.*),\s*(.*)/) {
281         $symbols{$1} = eval_expr($2);
282     }
283
284     if ($line =~ /(\S+:|)\s*([\w\d\.]+)\s*(.*)/ && exists $macro_lines{$2}) {
285         push(@pass1_lines, $1);
286         my $macro = $2;
287
288         # commas are optional here too, but are syntactically important because
289         # parameters can be blank
290         my @arglist = split(/,/, $3);
291         my @args;
292         my @args_seperator;
293
294         my $comma_sep_required = 0;
295         foreach (@arglist) {
296             # allow arithmetic/shift operators in macro arguments
297             $_ =~ s/\s*(\+|-|\*|\/|<<|>>)\s*/$1/g;
298
299             my @whitespace_split = split(/\s+/, $_);
300             if (!@whitespace_split) {
301                 push(@args, '');
302                 push(@args_seperator, '');
303             } else {
304                 foreach (@whitespace_split) {
305                         #print ("arglist = \"$_\"\n");
306                     if (length($_)) {
307                         push(@args, $_);
308                         my $sep = $comma_sep_required ? "," : " ";
309                         push(@args_seperator, $sep);
310                         #print ("sep = \"$sep\", arg = \"$_\"\n");
311                         $comma_sep_required = 0;
312                     }
313                 }
314             }
315
316             $comma_sep_required = 1;
317         }
318
319         my %replacements;
320         if ($macro_args_default{$macro}){
321             %replacements = %{$macro_args_default{$macro}};
322         }
323
324         # construct hashtable of text to replace
325         foreach my $i (0 .. $#args) {
326             my $argname = $macro_args{$macro}[$i];
327             my @macro_args = @{ $macro_args{$macro} };
328             if ($args[$i] =~ m/=/) {
329                 # arg=val references the argument name
330                 # XXX: I'm not sure what the expected behaviour if a lot of
331                 # these are mixed with unnamed args
332                 my @named_arg = split(/=/, $args[$i]);
333                 $replacements{$named_arg[0]} = $named_arg[1];
334             } elsif ($i > $#{$macro_args{$macro}}) {
335                 # more args given than the macro has named args
336                 # XXX: is vararg allowed on arguments before the last?
337                 $argname = $macro_args{$macro}[-1];
338                 if ($argname =~ s/:vararg$//) {
339                     #print "macro = $macro, args[$i] = $args[$i], args_seperator=@args_seperator, argname = $argname, arglist[$i] = $arglist[$i], arglist = @arglist, args=@args, macro_args=@macro_args\n";
340                     #$replacements{$argname} .= ", $args[$i]";
341                     $replacements{$argname} .= "$args_seperator[$i] $args[$i]";
342                 } else {
343                     die "Too many arguments to macro $macro";
344                 }
345             } else {
346                 $argname =~ s/:vararg$//;
347                 $replacements{$argname} = $args[$i];
348             }
349         }
350
351         my $count = $macro_count++;
352
353         # apply replacements as regex
354         foreach (@{$macro_lines{$macro}}) {
355             my $macro_line = $_;
356             # do replacements by longest first, this avoids wrong replacement
357             # when argument names are subsets of each other
358             foreach (reverse sort {length $a <=> length $b} keys %replacements) {
359                 $macro_line =~ s/\\$_/$replacements{$_}/g;
360             }
361             $macro_line =~ s/\\\@/$count/g;
362             $macro_line =~ s/\\\(\)//g;     # remove \()
363             parse_line($macro_line);
364         }
365     } else {
366         push(@pass1_lines, $line);
367     }
368 }
369
370 close(ASMFILE) or exit 1;
371 open(ASMFILE, "|-", @gcc_cmd) or die "Error running assembler";
372 #open(ASMFILE, ">/tmp/a.S") or die "Error running assembler";
373
374 my @sections;
375 my $num_repts;
376 my $rept_lines;
377
378 my %literal_labels;     # for ldr <reg>, =<expr>
379 my $literal_num = 0;
380
381 my $thumb = 0;
382
383 my %thumb_labels;
384 my %call_targets;
385
386 my $in_irp = 0;
387 my @irp_args;
388 my $irp_param;
389
390 # pass 2: parse .rept and .if variants
391 # NOTE: since we don't implement a proper parser, using .rept with a
392 # variable assigned from .set is not supported
393 foreach my $line (@pass1_lines) {
394     # handle .previous (only with regard to .section not .subsection)
395     if ($line =~ /\.(section|text|const_data)/) {
396         push(@sections, $line);
397     } elsif ($line =~ /\.previous/) {
398         if (!$sections[-2]) {
399             die ".previous without a previous section";
400         }
401         $line = $sections[-2];
402         push(@sections, $line);
403     }
404
405     $thumb = 1 if $line =~ /\.code\s+16|\.thumb/;
406     $thumb = 0 if $line =~ /\.code\s+32|\.arm/;
407
408     # handle ldr <reg>, =<expr>
409     if ($line =~ /(.*)\s*ldr([\w\s\d]+)\s*,\s*=(.*)/) {
410         my $label = $literal_labels{$3};
411         if (!$label) {
412             $label = "Literal_$literal_num";
413             $literal_num++;
414             $literal_labels{$3} = $label;
415         }
416         $line = "$1 ldr$2, $label\n";
417     } elsif ($line =~ /\.ltorg/) {
418         $line .= ".align 2\n";
419         foreach my $literal (keys %literal_labels) {
420             $line .= "$literal_labels{$literal}:\n .word $literal\n";
421         }
422         %literal_labels = ();
423     }
424
425     # thumb add with large immediate needs explicit add.w
426     if ($thumb and $line =~ /add\s+.*#([^@]+)/) {
427         $line =~ s/add/add.w/ if eval_expr($1) > 255;
428     }
429
430     # mach-o local symbol names start with L (no dot)
431     $line =~ s/(?<!\w)\.(L\w+)/$1/g;
432
433     if ($thumb and $line =~ /^\s*(\w+)\s*:/) {
434         $thumb_labels{$1}++;
435     }
436
437     if ($line =~ /^\s*((\w+:)?blx?|\.globl)\s+(\w+)/) {
438         $call_targets{$3}++;
439     }
440
441     # @l -> lo16()  @ha -> ha16()
442     $line =~ s/,\s+([^,]+)\@l\b/, lo16($1)/g;
443     $line =~ s/,\s+([^,]+)\@ha\b/, ha16($1)/g;
444
445     # move to/from SPR
446     if ($line =~ /(\s+)(m[ft])([a-z]+)\s+(\w+)/ and exists $ppc_spr{$3}) {
447         if ($2 eq 'mt') {
448             $line = "$1${2}spr $ppc_spr{$3}, $4\n";
449         } else {
450             $line = "$1${2}spr $4, $ppc_spr{$3}\n";
451         }
452     }
453
454     # old gas versions store upper and lower case names on .req,
455     # but they remove only one on .unreq
456     if ($fix_unreq) {
457         if ($line =~ /\.unreq\s+(.*)/) {
458             $line = ".unreq " . lc($1) . "\n";
459             print ASMFILE ".unreq " . uc($1) . "\n";
460         }
461     }
462
463     if ($line =~ /\.rept\s+(.*)/) {
464         $num_repts = $1;
465         $rept_lines = "\n";
466
467         # handle the possibility of repeating another directive on the same line
468         # .endr on the same line is not valid, I don't know if a non-directive is
469         if ($num_repts =~ s/(\.\w+.*)//) {
470             $rept_lines .= "$1\n";
471         }
472         $num_repts = eval($num_repts);
473     } elsif ($line =~ /\.irp\s+([\d\w\.]+)\s*(.*)/) {
474         $in_irp = 1;
475         $num_repts = 1;
476         $rept_lines = "\n";
477         $irp_param = $1;
478
479         # only use whitespace as the separator
480         my $irp_arglist = $2;
481         $irp_arglist =~ s/,/ /g;
482         $irp_arglist =~ s/^\s+//;
483         @irp_args = split(/\s+/, $irp_arglist);
484     } elsif ($line =~ /\.irpc\s+([\d\w\.]+)\s*(.*)/) {
485         $in_irp = 1;
486         $num_repts = 1;
487         $rept_lines = "\n";
488         $irp_param = $1;
489
490         my $irp_arglist = $2;
491         $irp_arglist =~ s/,/ /g;
492         $irp_arglist =~ s/^\s+//;
493         @irp_args = split(//, $irp_arglist);
494     } elsif ($line =~ /\.endr/) {
495         if ($in_irp != 0) {
496             foreach my $i (@irp_args) {
497                 my $line = $rept_lines;
498                 $line =~ s/\\$irp_param/$i/g;
499                 $line =~ s/\\\(\)//g;     # remove \()
500                 print ASMFILE $line;
501             }
502         } else {
503             for (1 .. $num_repts) {
504                 print ASMFILE $rept_lines;
505             }
506         }
507         $rept_lines = '';
508         $in_irp = 0;
509         @irp_args = '';
510     } elsif ($rept_lines) {
511         $rept_lines .= $line;
512     } else {
513         print ASMFILE $line;
514     }
515 }
516
517 print ASMFILE ".text\n";
518 print ASMFILE ".align 2\n";
519 foreach my $literal (keys %literal_labels) {
520     print ASMFILE "$literal_labels{$literal}:\n .word $literal\n";
521 }
522
523 map print(ASMFILE ".thumb_func $_\n"),
524     grep exists $thumb_labels{$_}, keys %call_targets;
525
526 close(ASMFILE) or exit 1;
527 #exit 1