Dan/All --
> Keen! And I added a little_languages subdir to hold compilers of this sort.
> (And checked in jako while I was at it...)
Thanks! I've enhanced the compiler a bit and fixed a bug in the
handling of while(){}. I've also added some features and rewritten
the fibo.pasm example program as fibo.jako.
I'm attaching jako.diff and fibo.jako, and also the compiler output
fibo.pasm. Until my CVS write access is turned on, I'll need someone
else to apply the compiler patch and check in fibo.jako.
The new compiler also handles if(){}, but I'm not certain it does so
correctly.
Also, the current assembler doesn't do a few opcode qualifier
inferences that I think it should (noted with TODOs in the compiler
code).
Anyway, there's more to come...
Regards,
-- Gregor
_____________________________________________________________________
/ perl -e 'srand(-2091643526); print chr rand 90 for (0..4)' \
Gregor N. Purdy [EMAIL PROTECTED]
Focus Research, Inc. http://www.focusresearch.com/
8080 Beckett Center Drive #203 513-860-3570 vox
West Chester, OH 45069 513-860-3579 fax
\_____________________________________________________________________/
Index: little_languages/jako_compiler.pl
===================================================================
RCS file: /home/perlcvs/parrot/little_languages/jako_compiler.pl,v
retrieving revision 1.1
diff -u -r1.1 jako_compiler.pl
--- little_languages/jako_compiler.pl 2001/09/14 14:58:51 1.1
+++ little_languages/jako_compiler.pl 2001/09/14 16:13:48
@@ -158,26 +158,38 @@
#
-# begin_while()
+# begin_while_block()
#
-# TODO: Support more than just register-to-register '==' and '!='.
-#
-sub begin_while
+sub begin_while_block
{
my ($cond) = @_;
$block_count++;
- my $prefix = "L_$block_count";
- push @block_stack, { NEXT => $line, PREFIX => $prefix };
+ my $prefix = "_W$block_count";
+ push @block_stack, { TYPE => 'while', NEXT => $line, PREFIX => $prefix };
+
+ #
+ # TODO: Note that the assembler wasn't inferring the opcode qualifiers, so we had
+ # to code them explicitly. We should remove the qualifiers as soon as the
+ # assembler is fixed.
+ #
if ($cond =~ m/^(.*)\s*==\s*(.*)$/) {
my @args = map_args($1, $2);
- printf "%-12s %-8s %s\n", "${prefix}_NEXT:", "eq", "$args[0], $args[1],
${prefix}_REDO, ${prefix}_LAST";
+ printf "%-12s %-8s %s\n", "${prefix}_NEXT:", "eq_i_ic", "$args[0], $args[1],
+${prefix}_REDO, ${prefix}_LAST";
printf "%s_REDO:\n", $prefix;
} elsif ($cond =~ m/^(.*)\s*!=\s*(.*)$/) {
+ my @args = map_args($1, $2);
+ printf "%-12s %-8s %s\n", "${prefix}_NEXT:", "ne_i_ic", "$args[0], $args[1],
+${prefix}_REDO, ${prefix}_LAST";
+ printf "%s_REDO:\n", $prefix;
+ } elsif ($cond =~ m/^(.*)\s*<=\s*(.*)$/) {
+ my @args = map_args($1, $2);
+ printf "%-12s %-8s %s\n", "${prefix}_NEXT:", "le_i_ic", "$args[0], $args[1],
+${prefix}_REDO, ${prefix}_LAST";
+ printf "%s_REDO:\n", $prefix;
+ } elsif ($cond =~ m/^(.*)\s*>=\s*(.*)$/) {
my @args = map_args($1, $2);
- printf "%-12s %-8s %s\n", "${prefix}_NEXT:", "ne", "$args[0], $args[1],
${prefix}_REDO, ${prefix}_LAST";
+ printf "%-12s %-8s %s\n", "${prefix}_NEXT:", "ge_i_ic", "$args[0], $args[1],
+${prefix}_REDO, ${prefix}_LAST";
printf "%s_REDO:\n", $prefix;
} else {
printf(STDERR "jako: Syntax error. Unrecognized condition in while on line
%d.\n", $line);
@@ -186,25 +198,167 @@
#
-# end_while()
+# begin_if_block()
#
-sub end_while
+sub begin_if_block
{
- my $prefix = "L_$block_count";
+ my ($cond) = @_;
+
+ $block_count++;
+ my $prefix = "_I$block_count";
+ push @block_stack, { TYPE => 'if', NEXT => $line, PREFIX => $prefix };
+ #
+ # TODO: Note that the assembler wasn't inferring the opcode qualifiers, so we had
+ # to code them explicitly. We should remove the qualifiers as soon as the
+ # assembler is fixed.
+ #
+
+ if ($cond =~ m/^(.*)\s*==\s*(.*)$/) {
+ my @args = map_args($1, $2);
+ printf "%-12s %-8s %s\n", "${prefix}_NEXT:", "eq_i_ic", "$args[0], $args[1],
+${prefix}_REDO, ${prefix}_LAST";
+ printf "%s_REDO:\n", $prefix;
+ } elsif ($cond =~ m/^(.*)\s*!=\s*(.*)$/) {
+ my @args = map_args($1, $2);
+ printf "%-12s %-8s %s\n", "${prefix}_NEXT:", "ne_i_ic", "$args[0], $args[1],
+${prefix}_REDO, ${prefix}_LAST";
+ printf "%s_REDO:\n", $prefix;
+ } elsif ($cond =~ m/^(.*)\s*<=\s*(.*)$/) {
+ my @args = map_args($1, $2);
+ printf "%-12s %-8s %s\n", "${prefix}_NEXT:", "le_i_ic", "$args[0], $args[1],
+${prefix}_REDO, ${prefix}_LAST";
+ printf "%s_REDO:\n", $prefix;
+ } elsif ($cond =~ m/^(.*)\s*>=\s*(.*)$/) {
+ my @args = map_args($1, $2);
+ printf "%-12s %-8s %s\n", "${prefix}_NEXT:", "ge_i_ic", "$args[0], $args[1],
+${prefix}_REDO, ${prefix}_LAST";
+ printf "%s_REDO:\n", $prefix;
+ } else {
+ printf(STDERR "jako: Syntax error. Unrecognized condition in while on line
+%d.\n", $line);
+ }
+}
+
+
+#
+# end_block()
+#
+
+sub end_block
+{
unless (@block_stack) {
printf(STDERR "jako: Syntax error. Closing brace without open block on line
%d.\n", $line);
return;
}
- pop @block_stack;
+ my $block = pop @block_stack;
+ my $prefix = $block->{PREFIX};
+ #
+ # TODO: Note that the assembler wasn't inferring the opcode qualifiers, so we had
+ # to code them explicitly. We should remove the qualifiers as soon as the
+ # assembler is fixed.
+ #
+
+ if ($block->{TYPE} eq 'while') {
+ printf("%-12s %-8s %s\n", '', 'branch_ic', "${prefix}_NEXT", );
+ # TODO: Is there a better unconditional jump (branch_ic)?
+ }
+
printf "%s_LAST:\n", $prefix;
}
#
+# do_next()
+#
+
+sub do_next
+{
+ #
+ # TODO: Note that the assembler wasn't inferring the opcode qualifiers, so we had
+ # to code them explicitly. We should remove the qualifiers as soon as the
+ # assembler is fixed.
+ #
+
+ foreach (reverse @block_stack) {
+ if ($_->{TYPE} eq 'while') {
+ my $prefix = $_->{PREFIX};
+ printf("%-12s %-8s %s\n", '', 'branch_ic', "${prefix}_NEXT", );
+ last;
+ }
+ }
+}
+
+
+#
+# do_last()
+#
+
+sub do_last
+{
+ #
+ # TODO: Note that the assembler wasn't inferring the opcode qualifiers, so we had
+ # to code them explicitly. We should remove the qualifiers as soon as the
+ # assembler is fixed.
+ #
+
+ foreach (reverse @block_stack) {
+ if ($_->{TYPE} eq 'while') {
+ my $prefix = $_->{PREFIX};
+ printf("%-12s %-8s %s\n", '', 'branch_ic', "${prefix}_LAST", );
+ # TODO: Is there a better unconditional jump (branch_ic)?
+ last;
+ }
+ }
+}
+
+
+#
+# do_redo()
+#
+
+sub do_redo
+{
+ #
+ # TODO: Note that the assembler wasn't inferring the opcode qualifiers, so we had
+ # to code them explicitly. We should remove the qualifiers as soon as the
+ # assembler is fixed.
+ #
+
+ foreach (reverse @block_stack) {
+ if ($_->{TYPE} eq 'while') {
+ my $prefix = $_->{PREFIX};
+ printf("%-12s %-8s %s\n", '', 'branch_ic', "${prefix}_REDO", );
+ # TODO: Is there a better unconditional jump (branch_ic)?
+ last;
+ }
+ }
+}
+
+
+#
+# do_add()
+#
+
+sub do_add
+{
+ my ($dest, $a, $b) = @_;
+
+ printf("%-12s %-8s %s\n", '', 'add', join(", ", map_args($dest, $a, $b)));
+}
+
+
+#
+# do_inc()
+#
+
+sub do_inc
+{
+ my ($dest, $amount) = @_;
+
+ printf("%-12s %-8s %s\n", '', 'inc', join(", ", map_args($dest, 1)));
+}
+
+
+#
# parse_args()
#
@@ -290,12 +444,42 @@
}
if (m/^while\s*\(\s*(.*)\s*\)\s*{$/) {
- begin_while($1);
+ begin_while_block($1);
+ next;
+ }
+
+ if (m/^if\s*\(\s*(.*)\s*\)\s*{$/) {
+ begin_if_block($1);
next;
}
if (m/^}$/) {
- end_while();
+ end_block();
+ next;
+ }
+
+ if (m/^next$/) {
+ do_next();
+ next;
+ }
+
+ if (m/^last$/) {
+ do_last();
+ next;
+ }
+
+ if (m/^redo$/) {
+ do_redo();
+ next;
+ }
+
+ if
+(m/([A-Za-z][A-Za-z0-9]*)\s*=\s*([A-Za-z][A-Za-z0-9_]*)\s*[+]\s*([A-Za-z][A-Za-z0-9_]*)/)
+ {
+ do_add($1, $2, $3);
+ next;
+ }
+
+ if (m/([A-Za-z][A-Za-z0-9_]*)\s*[+][+]$/) {
+ do_inc($1, 1);
next;
}
@@ -304,7 +488,7 @@
next;
}
- print "jako: Syntax error on line $line: '$_'.\n";
+ print STDERR "jako: Syntax error on line $line: '$_'.\n";
}
exit 0;
#
# fibo.jako
#
# Adapted from fibo.pasm by [EMAIL PROTECTED]
#
# Copyright (C) 2001 Gregor N. Purdy. All rights reserved.
# This program is free software. It is subject to the same
# license as Perl itself.
#
n is int;
i is int;
a is int;
b is int;
f is int;
n = 24;
print("Algorithm F (Fibonacci's function)\n");
print(" Calculating fib(");
print(n);
print(") = ...\n");
a = 1;
b = 1;
f = 1;
i = 3;
while (i <= n) {
f = a + b;
a = b;
b = f;
i++;
}
print(" ... = ");
print(f);
print("\n");
end;
# This file produced by the Jako Compiler
#
# fibo.jako
#
# Adapted from fibo.pasm by [EMAIL PROTECTED]
#
# Copyright (C) 2001 Gregor N. Purdy. All rights reserved.
# This program is free software. It is subject to the same
# license as Perl itself.
#
# n: I1
# i: I2
# a: I3
# b: I4
# f: I5
set I1, 24
print "Algorithm F (Fibonacci's function)\n"
print " Calculating fib("
print I1
print ") = ...\n"
set I3, 1
set I4, 1
set I5, 1
set I2, 3
_W1_NEXT: le_i_ic I2, I1, _W1_REDO, _W1_LAST
_W1_REDO:
add I5, I3, I4
set I3, I4
set I4, I5
inc I2, 1
branch_ic _W1_NEXT
_W1_LAST:
print " ... = "
print I5
print "\n"
end
