41 lines
1.7 KiB
Perl
41 lines
1.7 KiB
Perl
#!/usr/bin/perl
|
|
|
|
use strict; # gen.pl - flatAST to stack machine code
|
|
use warnings; # http://www.rosettacode.org/wiki/Compiler/code_generator
|
|
|
|
my $stringcount = my $namecount = my $pairsym = my $pc = 0;
|
|
my (%strings, %names);
|
|
my %opnames = qw( Less lt LessEqual le Multiply mul Subtract sub Divide div
|
|
GreaterEqual ge Equal eq Greater gt NotEqual ne Negate neg );
|
|
|
|
sub tree
|
|
{
|
|
my ($A, $B) = ( '_' . ++$pairsym, '_' . ++$pairsym ); # labels for jumps
|
|
my $line = <> // return '';
|
|
(local $_, my $arg) = $line =~ /^(\w+|;)\s+(.*)/ or die "bad input $line";
|
|
/Identifier/ ? "fetch [@{[ $names{$arg} //= $namecount++ ]}]\n" :
|
|
/Sequence/ ? tree() . tree() :
|
|
/Integer/ ? "push $arg\n" :
|
|
/String/ ? "push @{[ $strings{$arg} //= $stringcount++ ]}\n" :
|
|
/Assign/ ? join '', reverse tree() =~ s/fetch/store/r, tree() :
|
|
/While/ ? "$A:\n@{[ tree() ]}jz $B\n@{[ tree() ]}jmp $A\n$B:\n" :
|
|
/If/ ? tree() . "jz $A\n@{[ !<> . # !<> skips second 'If'
|
|
tree() ]}jmp $B\n$A:\n@{[ tree() ]}$B:\n" :
|
|
/;/ ? '' :
|
|
tree() . tree() . ($opnames{$_} // lc) . "\n";
|
|
}
|
|
|
|
$_ = tree() . "halt\n";
|
|
|
|
s/^jmp\s+(\S+)\n(_\d+:\n)\1:\n/$2/gm; # remove jmp next
|
|
s/^(?=[a-z]\w*(.*))/ # add locations
|
|
(sprintf("%4d ", $pc), $pc += $1 ? 5 : 1)[0] /gem;
|
|
my %labels = /^(_\d+):(?=(?:\n_\d+:)*\n *(\d+) )/gm; # pc addr of labels
|
|
s/^ *(\d+) j(?:z|mp) *\K(_\d+)$/ (@{[ # fix jumps
|
|
$labels{$2} - $1 - 1]}) $labels{$2}/gm;
|
|
s/^_\d+.*\n//gm; # remove labels
|
|
|
|
print "Datasize: $namecount Strings: $stringcount\n";
|
|
print "$_\n" for sort { $strings{$a} <=> $strings{$b} } keys %strings;
|
|
print;
|