| Description: |
The SCORBOT is a robot for laboratory and training applications. This program allows a student to try out programs written for the SCORBOT using "acl" (Advanced Control Language).
The script takes an "acl" file and translates it to Perl, and then (optionally) executes it.
Only the program logic and user interaction are implemented. The parts of the language that deal with hardware will be implemented in a GUI (not included here) - something like a "virtual robot".
To run an "acl" program:
$ ./acl test.acl
To show the Perl program that was generated:
$ ./acl --perl test.acl
This is the sample ACL program I used for testing:
*** ACL test ***
global k l m
program teste2
define x
for x=1 to 10
print "["
print k
print "]"
delay 10
endfor
end
program teste
define x y
set x = 10
set k = x + 1
print "k="
println k
for x=1 to 2
for y=5 to 4
print x
print " "
println y
if y = 4
andif x = 1
println " y = 4 && x = 1 "
else
println " ... "
endif
set k = k + 1
delay 10
endfor
endfor
stop teste2
goto 1
println "nada"
label 1
end
run teste2
gosub teste
gosub teste
read "type a value" k
println k
stop
run teste2
println "end"
|
#!/usr/bin/perl
use strict;
use threads;
use threads::shared;
$|=1;
use Getopt::Long;
{
my $debug = 0;
my $preprocess = 0;
my $help = 0;
my $result = GetOptions (
"debug" => \$debug, "perl" => \$preprocess, "help" => \$help );
my $source_name = shift;
my $source;
open ( $source, '<', $source_name )
or die "$!";
my $program;
sub _val { ( $_[0] =~ /^[a-z]/ ) ? "\$@_" : "@_" }
sub _op { local $_ = shift; s/^=$/==/; $_ }
my %_interpreta = (
'' => sub { },
'*' => sub { },
quiet => sub { },
if => sub { "if ( ( " . join( ' ', map { _op(_val($_)) } @_ )
+ . " )" },
andif => sub { " && ( " . join( ' ', map { _op(_val($_)) } @_ )
+ . " )" },
orif => sub { " || ( " . join( ' ', map { _op(_val($_)) } @_ )
+ . " )" },
__fi => sub { " ) {\n" },
else => sub { "} else {" },
endif => sub { "}" },
program => sub { $program = $_[0]; "sub @_ {"; },
end => sub { undef $program; "}"; },
gosub => sub { "undef \$thread{$_[0]}; @_();" },
run => sub { 'undef $thread{' . $_[0] . '}; threads->new(\&' .
+ $_[0] . ');' },
priority => sub { "" },
label => sub { "L@_: ;" },
goto => sub { "goto L@_;" },
print => sub { 'print ' . _val(@_) . ";" },
println => sub { 'print ' . _val(@_) . ', "\n"' . ";" },
define => sub {
"my (" . join( ",", map { _val($_) } @_ ) . ");\n" .
join( "\n", map { _val($_) . " = 0;" } @_ )
},
global => sub {
"use vars qw(" . join( " ", map { _val($_) } @_ ) . ");\n" .
join( "\n", map { _val($_) . " = 0;" } @_ ) . "\n" .
join( "\n", map { "share(" . _val($_) . ");" } @_ )
},
set => sub { join( ' ', map { _val($_) } @_ ) . ";" },
delay => sub { 'select( undef, undef, undef, ' . _val(@_) . "/10
+0.0 );" },
for => sub {
my ( $nome, $igual, $ini, $to, $end ) = @_;
$nome = _val( $nome );
$ini = _val( $ini );
$end = _val( $end );
"for ( $nome = $ini; " .
"( $ini <= $end ? $nome <= $end : $nome >= $end ); " .
"$nome += ( $ini <= $end ? 1 : -1 ) ) {";
},
endfor => sub { "}"; },
read => sub {
join( "\n", map {
/^[a-z]/ ?
'print " > ";' . "\n" . _val($_) . " = <>; chomp " . _val
+($_) . ";" :
'print ' . _val($_) . ";"
} @_ )
},
stop => sub {
return "\$thread{$_[0]} = 1;" if $_[0];
'$thread{$_} = 1 for keys %thread;'
}
);
if ( $help )
{
print "acl - interpreter for the ACL (Advanced Control Language) r
+obot control language\n";
print "\n";
print " ./acl [--perl] [--debug] program.acl\n";
print "\n";
print " ACL commands:\n";
print " " . $_ . "\n" for grep { $_ ne '' && $_ !~ /_/ } sort k
+eys %_interpreta;
exit;
}
my $out = <<'EOT';
#!/usr/bin/perl
use strict;
use threads;
use threads::shared;
$|=1;
use vars qw( %thread );
share( %thread );
EOT
my $if = 0;
while (<$source>)
{
chomp;
my $src = $_;
lc;
$_ =~ s/([=\*])/ $1 /;
s/^\s+|\s+$//g;
# perlfaq - How can I split a [character] delimited string ...
my @t;
push(@t, defined($1) ? $1:$3)
while m/("[^"\\]*(\\.[^"\\]*)*")|([^\s]+)/g;
my $cmd = shift @t;
die "Unknown command $cmd" unless exists $_interpreta{$cmd};
if ( $if && $cmd ne 'andif' && $cmd ne 'orif' ) {
$if = 0;
$out .= $_interpreta{__fi}();
}
$if = 1 if $cmd eq 'if';
$out .= $_interpreta{$cmd}(@t);
$out .= " return if \$thread{$program};" if $program && $cmd && !
+$if;
$out .= " \t# $src" if $cmd && $debug;
$out .= "\n";
}
$out .= <<'EOT';
foreach my $thr (threads->list) {
# Don't join the main thread or ourselves
if ($thr->tid && !threads::equal($thr, threads->self))
+{
$thr->join;
}
}
EOT
close ( $source );
print $out if $preprocess;
print STDERR $out if $debug && ! $preprocess;
if ( ! $preprocess )
{
eval {
eval $out or die "$!";
};
if ( $@ )
{
print STDERR "Run time error: $@\n"
unless $@ =~ /ioctl/;
}
}
}
__END__
=head1 NAME
acl - interpreter for the ACL (Advanced Control Language) robot contro
+l language
=head1 SYNOPSIS
Run a program
$ ./acl test.acl
Show how Perl would execute a program
$ ./acl --perl test.acl
=head1 AUTHOR
Flavio S. Glock <fglock@pucrs.br>
=head1 COPYRIGHT
Copyright (c) 2005 Flavio S. Glock. All rights reserved. This
program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
