Anonymous user
Compiler/code generator: Difference between revisions
→{{header|Phix}}
(Add COBOL) |
|||
Line 2,515:
REPEAT DROP R> DROP ;
GENERATE EMIT BYE</lang>
Passes all tests.
=={{header|Perl}}==
Tested with perl v5.26.1
<lang 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;</lang>
Passes all tests.
| |||