#!/usr/bin/perl -w
# @(#) $Header: /home/abrown/public_html/first/first2002chs/software2002/simulator/RCS/pb2c,v 1.25 2006/12/14 21:19:03 abrown Exp $
# Allen Brown  date="20061214 13:18:07"

# ----------------------------------------------------------------
# pb2c - Perl program to translate PBasic source code to C.
#
# Copyright (C) 2002  Allen Brown
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 as
# published by the Free Software Foundation.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the
#   Free Software Foundation, Inc.
#   59 Temple Place, Suite 330
#   Boston, MA  02111-1307  USA
# 
# To contact the author of this software:
#   Allen Brown
#   PO Box J
#   Corvallis, OR
# 
#   http://brown.armoredpenguin.com/~abrown/contact.html
#
# ----------------------------------------------------------------
# PBasic observations:
#   It is really unfortunate that the BASIC programming language
#   is still used in the year 2002.  The language lacks many
#   amenities that make structured programming possible.  As such
#   BASIC forces poor programming practices and results in
#   programs that are difficult to debug and worse to maintain.
#
#   PBasic is a particularly disgusting implementation of BASIC.
#   To see just how bad it is, see the FAQs from the
#   http://www.parallaxinc.com/html_files/downloads/download_documentation.htm
#   site.  On page 20, where "arithmetic expressions" and
#   "signed numbers" are discussed, it is clear just how
#   little thought was invested into this language.
#
#   Note: the PBasic manual says that it does not implement
#   operator precidence.  This is false.  It just doesn't
#   implement precidence on +, -, *, /.  Precidence is
#   implemented for conditionals and for logicals.
#
#   To summarize, PBasic is a heap of inconsistencies.
#   This makes programming difficult and simulation worse.
#
#   But the FIRST robot competition specifies that we *must*
#   use the controller that is Basic Stamp based.  And the
#   Basic Stamp is programmed only in PBasic.  So we are
#   stuck.  I only hope the students exposed to this abomination
#   are not excessively scarred by the experience.
#
#   This compiler/simulator translates some of the PBasic
#   language to C for simulation so the software can be
#   validated separately from the controller.
#
#   I particularly want to point out why gosub was not
#   implemented as a function call.  In BASIC the only way
#   you know you are returning from a gosub is that you
#   run into a return statement.  You could as easily goto
#   out.  Worse, when reading the code there is simply no
#   way of knowing where a subroutine begins.  You can gosub
#   from one point in main and goto from another to the same
#   address!  You can goto out or you can return out.
#
# Bugs:
#   - This simulation implements the subset of the PBasic language
#     used by the CHS team in 2002.
#   - Currently only byte variables are supported.
#   - Some programs which will compile in this simulator will
#     not load on the basic stamp.
#   - Poorly tested and is likely to have discrepencies with the
#     PBasic language of the BasicStampII.
#
# References:
#   http://www.parallaxinc.com/html_files/downloads/download_documentation.htm
# ----------------------------------------------------------------
# Global variables:
  $usage = "[-h] {<pb_src>}";
  $progname = __FILE__;  $progname =~ s%.*/%%;
  $programmer = "abrown\@peak.org";
  $errors = 0;

# Defaults
  $pb_src_f = "-";		# PBasic source file.
  $verbose = 0;
  $debug = 0;
  $done = 0;
  $pbmathdepth = 0;		# Keep track of the () and operator
				# operator precedence in pbmath().
  $gosubcount = 0;		# Gosubs are implemented as a stack.

# ================================================================
#	Parsing constants.
  $bytetype = "pbword8";
  $constdecl = "pbconst";
  $funcdecl = "pbfunc";
  $assign = "pblet";
#	Parsing arrays:
  keys(%operators1) = 3;
  %operators1 = ('abs' => ['pbabs',3],
		 '~'   => ['pbbnot',2],
		 'not' => ['pblnot',1]);
  keys(%operators2) = 31;
  %operators2 = ('+' => ['pbadd',3],
		'-'   => ['pbsub',3],
		'*'   => ['pbmul',3],
		'/'   => ['pbdiv',3],
		'\\'  => ['pbmod',3],
		'<<'  => ['pbshl',3],
		'>>'  => ['pbshr',3],
		'max' => ['pbmax',3],
		'min' => ['pbmin',3],
		'='   => ['pbeq',2],
		'<>'  => ['pbne',2],
		'>'   => ['pbgt',2],
		'<'   => ['pblt',2],
		'>='  => ['pbge',2],
		'<='  => ['pble',2],
		'and' => ['pbland',1],
		'or'  => ['pblor',1],
		'xor' => ['pblxor',1],
		'&'   => ['pbband',3],
		'|'   => ['pbbor',3],
		'^'   => ['pbbxor',3]);

# ================================================================
#       Subroutines:

# ----------------------------------------------------------------
# Start the c program.
sub includehead
{
  printf("#include \"pb.h\"\n");
  printf("#include <stdio.h>\n");
  printf("int main()\n");
  printf("{\n");
  printf("  pbword8_t outbytehigh=0, outbytelow=0, inbytehigh=0, inbytelow=0;\n");
  printf("  int gosubreturna[4] = {-1,-1,-1,-1};\n");
  printf("  int gosubcount=0;\n");
} # includehead

# ----------------------------------------------------------------
# End the c program.
sub includetail
{
  printf("  exit(0);\n");

  printf("  gosubreturnc:\n");
  printf("    gosubcount--;\n");
  printf("    printf(\"\treturn%%d count=%%d\\n\",
	gosubreturna[gosubcount], gosubcount );\n");
  printf("    fflush( stdout );\n");
  printf("    switch( gosubreturna[gosubcount] )\n");
  printf("    {\n");
  for( $returns=0; $returns<$gosubcount; $returns++ )
  {
    printf("      case %d: goto return%0d;\n", $returns, $returns);
  }
  printf("    }\n");
  printf("    printf(\"ERROR: gosub %%d out of range at %%d.\\n\",\n");
  printf("      gosubcount, gosubreturna[gosubcount]);\n");
  printf("    fflush( stdout );\n");
  printf("    exit(1);\n");
  printf("}\n");
} # includetail

# ----------------------------------------------------------------
# The simulator uses number pairs.  PBasic variable names are
# declared in c as macros which expand to a number pair.
# Constants need to have that second number added.  pbnumber
# decides whether $unknown is a constant or a variables.  If
# it is a constant, it wraps $constdecl around the constant,
# which converts it into a number pair.
sub pbnumber # ($unknown)
{
  my($unknown);
  $unknown=$_[0];
  if( $unknown !~ /^[0-9][0-9\.]*$/ )
  {
    return($unknown);
  } else
  { # Its a number.
    return(sprintf("%s(%s)",$constdecl,$unknown));
  }
} # pbnumber

# ----------------------------------------------------------------
# Used to determine if $unknown is
#   a variable: 2
#   strictly numberic: 1
#   something else such as an operator: 0
sub isnumber # ($unknown)
{
  my($unknown);
  $unknown=$_[0];
  if( $unknown !~ /^[0-9][0-9\.]*$/ )
  {
    if( $unknown !~ /^[a-zA-Z][0-9\.a-zA-Z_]*$/ )
    {
      return(0);
    } else {
      return(2);
    }
  } else
  { # Its a number
    return(1);
  }
} # isnumber

# ----------------------------------------------------------------
# This is the workhorse for the compiler.  It parses all expressions.
# pbmath handles parenthesis via recursion.
sub pbmath # (@_)
{
  my($returna)=""; # start
  my($returnm)=""; # middle
  my($returnz)=""; # end
  my($expect)=$_[0]; shift; # Expected end of pbmath
  my($parendcount);
  my($function1)="";
  my($function2)="";
  my($precidence1)=0;
  my($precidence2)=0;
  my($precidencelast)=3;
  $pbmathdepth = $pbmathdepth + 1;

  if( $debug > 2 )
  {
    printf("//    here 1-%d [0]='%s'/%d  [1]='%s'/%d  [2]='%s'/%d ex='%s'.\n",
      $pbmathdepth, $_[0], defined($_[0]), $_[1], defined($_[1]),
	   $_[2], defined($_[2]), $expect);
  }

  # ..............................................................
  # Initial pbmath loop
  INITIAL: while( 1 )
  {
##    if( !defined($_[0]) ) { printf "this shouldn't happen\n"; }
    if( defined($operators1{$_[0]}) )
    {
      $function1 = $operators1{$_[0]}[0];
      $precidence1 = $operators1{$_[0]}[1];
#      if( $debug > 2 )
#      {
#	printf("//    here 2oa-%d op='%s' 0='%s' 1='%s'\n",
#	       $pbmathdepth, $function1, $_[0], $_[1]);
#      }
      shift;
      $returna=$returna . $funcdecl . "(" . $function1 . "(";
      $returnz="))" . $returnz;
      if( $debug > 2 )
      {
	printf("//    here 2oz-%d 0='%s' 1='%s'\n//\treta='%s'\n//\tretm='%s'\n//\tretz='%s'\n",
	       $pbmathdepth, $_[0], $_[1], $returna, $returnm, $returnz );
      }
    }
    elsif( isnumber($_[0]) )
    {
      $returna=$returna . pbnumber($_[0]) . $returnm . $returnz;
      $returnm = "";
      $returnz = "";
      if( $debug > 2 )
      {
	printf("//    here 2n-%d 0='%s' << 1='%s'\n//\treta='%s'\n//\tretm='%s'\n//\tretz='%s'\n",
	       $pbmathdepth, $_[0], $_[1], $returna, $returnm, $returnz );
      }
      shift;
      last INITIAL;
    }
    elsif( $_[0] eq '(' )
    {
      if( $debug > 2 )
      {
	printf("//    here 2pa-%d 0='%s' 1='%s' ex='%s'\n//\treta='%s'\n//\tretm='%s'\n//\tretz='%s'\n",
		 $pbmathdepth, $_[0], $_[1], $expect, $returna, $returnm, $returnz );
      }
      shift;
      $returna=$returna . &pbmath(')', @_) . $returnm . $returnz;
      $returnm = "";
      $returnz = "";
      $parendcount=1;
      while( $parendcount )
      {
	if( $_[0] eq '(' )
	{
	  $parendcount = $parendcount+1;
	}
	if( $_[0] eq ')' )
	{
	  $parendcount = $parendcount-1;
	}
	shift
      }
      if( $debug > 2 )
      {
	printf("//    here 2pz-%d 0='%s' 1='%s' ex='%s'\n//\treta='%s'\n//\tretm='%s'\n//\tretz='%s'\n",
		 $pbmathdepth, $_[0], $_[1], $expect, $returna, $returnm, $returnz );
      }
      last INITIAL;
    } else {
      printf("%s: Missing or incomplete expression at line %d between '%s' and '%s'. 1\n",
	   $progname, $line_n, $_[0], $_[1] );
      printf("%s:   Parsed '%s', '%s', and '%s'.\n",
	     $progname, $returna, $returnm, $returnz );
      shift; last INITIAL;
      $errors = $errors + 1;
    }
     
  }
  # ..............................................................
  # Main pbmath loop
  MAIN: while( 1 )
  {
    if( (!defined($_[0]) && ($expect eq 'null'))
	|| 
	(defined($_[0]) && ($_[0] eq $expect)) )
    {
      if( $debug > 2 )
      {
	printf("//    here 3z-%d 0='%s' 1='%s' ex='%s'\n//\treta='%s'\n//\tretm='%s'\n//\tretz='%s'\n",
		 $pbmathdepth, $_[0], $_[1], $expect, $returna, $returnm, $returnz );
      }
      shift;
      $pbmathdepth = $pbmathdepth - 1;
      return($returna . $returnm . $returnz);
    }
    if( ! defined($_[0])  ||  $_[0] eq ')'  ||  $_[0] eq 'then' )
    {
      printf("%s: Improperly terminated expression at line %d.  Got '%s', expect '%s'. 1-%d\n",
	     $progname, $line_n, $_[0], $expect, $pbmathdepth );
      printf("    here 3p-%d 0='%s' 1='%s' ex='%s'\n\treta='%s'\n\tretm='%s'\n\tretz='%s'\n",
	     $pbmathdepth, $_[0], $_[1], $expect, $returna, $returnm, $returnz );
      $errors = $errors + 1;
    }
    elsif( defined($operators2{$_[0]}) )
    {
      $function2 = $operators2{$_[0]}[0];
      $precidence2 = $operators2{$_[0]}[1];
      if( $precidencelast >= $precidence2 )
      {
	$returna = $funcdecl . "(" . $function2 . "(" . $returna
	  . $returnm . $returnz . ",";
	$returnm = "";
	$returnz = "))";
	if( $debug > 2 )
	{
	  printf("//    here 3os-%d 0='%s' 1='%s' %d->%d\n",
		 $pbmathdepth, $_[0], $_[1], $precidencelast, $precidence2 );
	  printf("//\treta='%s'\n//\tretm='%s'\n//\tretz='%s'\n",
		 $returna, $returnm, $returnz );
	}
      } else {
	$returna = $returna . $funcdecl . "("; 
	$returnm = $function2 . "(" . $returnm . ",";
	$returnz = "))" . $returnz;
	if( $debug > 2 )
	{
	  printf("//    here 3oi-%d 0='%s' 1='%s' %d->%d\n",
		 $pbmathdepth, $_[0], $_[1], $precidencelast, $precidence2 );
	  printf("//\treta='%s'\n//\tretm='%s'\n//\tretz='%s'\n",
		 $returna, $returnm, $returnz );
	}
      }
      $precidencelast = $precidence2;

      if( defined($operators1{$_[1]}) )
      {
        $function1 = $operators1{$_[1]}[0];
	$precidence1 = $operators1{$_[1]}[1];
	if( $debug > 2 )
	{
	  printf("//    here 4a-%d 0='%s' 1='%s'\n//\treta='%s'\n//\tretm='%s'\n//\tretz='%s'\n",
		 $pbmathdepth, $_[0], $_[1], $returna, $returnm, $returnz );
	}
	shift; shift;
	if( $_[0] eq '(' )
	{
	  shift;
	  $returna = $returna . $returnm .  $funcdecl . "(" . $function1 . "(";
	  $returnm = &pbmath(')', @_);
	  $returnz = "))" . $returnz;
	  $parendcount=1;
	  while( $parendcount )
	  {
	    if( $_[0] eq '(' )
	    {
	      $parendcount = $parendcount+1;
	    }
	    if( $_[0] eq ')' )
	    {
	      $parendcount = $parendcount-1;
	    }
	    shift;
	  }
	} else {
	  $returna = $returna . $returnm .  $funcdecl . "(" . $function1 . "(";
	  $returnm = $_[0];
	  $returnz = "))" . $returnz;
	  shift;
	}
      }
      elsif( isnumber($_[1]) )
      {
	$returna = $returna . $returnm;
	$returnm = pbnumber($_[1]);
	$returnz = $returnz;
	if( $debug > 2 )
	{
	  printf("//    here 4n-%d 0='%s' 1='%s'\n//\treta='%s'\n//\tretm='%s'\n//\tretz='%s'\n",
		 $pbmathdepth, $_[0], $_[1], $returna, $returnm, $returnz );
	}
	shift; shift;
      }
      elsif( $_[1] eq '(' )
      {
	if( $debug > 2 )
	{
	  printf("//    here 4pa-%d 0='%s' 1='%s' 2='%s'\n//\treta='%s'\n//\tretm='%s'\n//\tretz='%s'\n",
		 $pbmathdepth, $_[0], $_[1], $_[2], $returna, $returnm, $returnz );
	}
	shift; shift;
	$returna = $returna . $returnm . &pbmath(')', @_);
	$returnm = "";
	$returnz = $returnz;
	$parendcount=1;
	while( $parendcount )
	{
	  if( $_[0] eq '(' )
	  {
	    $parendcount = $parendcount+1;
	  }
	  if( $_[0] eq ')' )
	  {
	    $parendcount = $parendcount-1;
	  }
	  shift;
	}
	if( $debug > 2 )
	{
	  printf("//    here 4pz-%d 0='%s' 1='%s'\n//\treta='%s'\n//\tretm='%s'\n//\tretz='%s'\n",
		 $pbmathdepth, $_[0], $_[1], $returna, $returnm, $returnz );
	}
      }
      else
      {
	printf("%s: Missing or incomplete expression at line %d between '%s', '%s', and '%s'. 2\n",
	  $progname, $line_n, $_[0], $_[1], $_[2] );
	shift;
	$errors = $errors + 1;
      }
    }
    elsif( 0 == defined($_[0])  ||  $_[0] eq '' )
    {
      if( $debug > 2 )
      {
	printf("//    here 3z-%d 0='%s' 1='%s'\n//\treta='%s'\n//\tretm='%s'\n//\tretz='%s'\n",
	       $pbmathdepth, $_[0], $_[1], $returna, $returnm, $returnz );
      }
      if( $expect ne "" )
      {
	printf("%s: Improperly terminated expression at line %d.  Got '%s', expect '%s'. 2-%d\n",
	       $progname, $line_n, $_[0], $expect, $pbmathdepth );
	printf("    here 3z-%d 0='%s' 1='%s'\n\treta='%s'\n\tretm='%s'\n\tretz='%s'\n",
	       $pbmathdepth, $_[0], $_[1], $returna, $returnm, $returnz );
	$errors = $errors + 1;
      }
      $pbmathdepth = $pbmathdepth - 1;
      return($returna . $returnm . $returnz);
    }
    else
    {
      printf("%s: Missing or incomplete expression at line %d between '%s' and '%s'. 3\n",
	$progname, $line_n, $_[0], $_[1] );
      shift;
      $errors = $errors + 1;
    }
  }
  # ..............................................................
  $pbmathdepth = $pbmathdepth - 1;
#  printf("    here end '%s' '%s'\n", $_[1], $function2);
#  return($returna . $returnm . $returnz);
} # pbmath

# ================================================================
#               Phase 2: Parse the command line options
# ================================================================
while( (! $done) && ($#ARGV >= 0) )
{
  $arg = $ARGV[0];
#  if( $arg eq "-s" )
#  { # Strip off extra info from P/F fields.
#    $strip = 1;
#    shift;
#  } # --------- Don't insert new options below this point -----
#  elsif( $arg eq "--" )
#  { # End of options.
#    shift;
#    $done = 1;
#  }
  if( $arg eq "-v" )
  { # Verbose mode.
    shift;
    $verbose = 1;
  }
  elsif( $arg eq "-d" )
  { # Debug mode.
    $debug = $ARGV[1];
    shift; shift;
  }
  elsif( $arg =~ /^-[h?]$/ )
  { # Help!
    $errors++;
    shift;
  }
  elsif( $arg =~ /^[-+].+$/ )
  { # Huh?
    print( STDERR $progname, ": Unrecognized option '", $arg, "'.\n" );
    $errors++;
    shift;
  }
  else
  { # Its not an option.  It must be a filename.
    $done = 1;
  }
}

if( $errors )
{
  print( STDERR "Usage: ", $progname, " ", $usage, "\n" );
  exit($errors);
}
if( $debug )
{
  select((select(STDOUT), $| = 1)[0] ); # Flush immediately.
}

# ================================================================
#               Phase 2: Read the pb_src.  Print the translation.
# ================================================================

keys(%commands1) = 16;
%commands1 = ('input'  => 'pbinput',
	      'output' => 'pboutput',
	      'high'   => 'pbhigh',
	      'low'    => 'pblow',
	      'toggle' => 'pbtoggle');
$done = 0;
&includehead();
while(! $done)
{
  if( ($#ARGV >= 0) )
  {
    $pb_src_f = $ARGV[0];
    shift;
  }

  if($debug) {print( STDOUT "// processing ", $pb_src_f, "...\n" );}
  open( Pb_Src_fh, $pb_src_f ) ||
    (
      print( STDERR $progname, ": ", $!, " '", $pb_src_f, "'.\n" ),
      exit(-3)
    );
  $line_n = 0;

  # --------------------------------------------------------------
  while( $line = <Pb_Src_fh> )
  { # Read every line of the PBasic source file.
    $line_n++;
    chomp( $line );
    # Split the line into two parts: the action string and the comment string.
    $comment_p = index($line,"'");
    if( $comment_p < 0 )
    {
      $action_st = $line;
      $comment_st = "";
    } else {
      $action_st = substr($line,0,$comment_p);
      $comment_st = substr($line,$comment_p);
      $comment_st =~ s/[ 	]*$//;
    }
    $action_st = lc($action_st);		# Lower case
    $action_st =~ s/([-\\\+\*<>=,\(\)\/\[\]~])/ $1 /g; # Make operator parsing easy
    $action_st =~ s/[ 	]+/ /g;			# Remove redundant white space
    $action_st =~ s/([<>]) ([<>=])/$1$2/g;	# Repair <<, <=, etc.
    $action_st =~ s/^ *//;			# Remove leading white space
    $action_st =~ s/ *$//;			# Remove trailing white space
    # Ready to parse.  All token are blank separated.
    @action_array = split(' ', $action_st);
    if( defined($action_array[0]) )
    { # This is not merely a comment line.
      if( $action_array[0] =~ /^%/ )
      { # C Command Passthru: Don't modify the line.
	# Obviously this is an extension to PBasic.  It is only for debug.
	$line =~ s/%//;
	printf("  %s\n", $line);
      }
      elsif( defined($action_array[1])  &&  ($action_array[1] eq 'var') )
      { # This is a variable declaration.
	if( $action_array[2] eq 'byte' )
	{ # Declare a simple byte.
	  printf("    %s_t %s_w8=0;\n", $bytetype, $action_array[0] );
	  printf("#define %s %s_w8,%s\n",
	    $action_array[0], $action_array[0], $bytetype );
	} else
	{ # Declare a bit in an existing byte.
	  @variable = split('\.', $action_array[2]);
	  printf("#define %s %s_w8,%s\n",
	    $action_array[0], $variable[0], $variable[1] );
	}
      }
      elsif( defined($action_array[1])  &&  ($action_array[1] eq 'con') )
      { # This is a constant declaration
	printf("#define %s %s(%s)\n",
	  $action_array[0], $constdecl, $action_array[2] );
      }
      elsif( defined($action_array[1])  &&  ($action_array[1] eq '=') )
      { # This is an assignment.
        my($lvalue)=$action_array[0]; shift(@action_array); shift(@action_array);
	printf("\t%s(&%s,%s,\"%s\",\"%s\");\n",
	  $assign, $lvalue, &pbmath('null', @action_array), $lvalue, $line_n );
      }
      elsif( $action_array[0] eq 'if' )
      { # This is an 'if'.
        shift(@action_array);
	printf("\tif(\n\t    pbstrip(%s)\n", &pbmath('then', @action_array) );
	while( $action_array[0] ne "then"  &&  defined( $action_array[0] ))
	{
	  shift(@action_array);
	}
	$action_array[1] =~ s/:$//;
	printf("\t  ) goto %s;\n", $action_array[1]);
      }
      elsif( defined($commands1{$action_array[0]}) )
      { # This is one of those simple PBasic commands.
	printf("\t%s(%s);\n",
	       $commands1{$action_array[0]}, $action_array[1] );
      }
      elsif( $action_array[0] eq 'serin'
	     ||  $action_array[0] eq 'serout' 
	     || $action_array[0] eq 'shiftout'
	   )
      { # These are funky PBasic commands.
	my($command)=$action_array[0];
	my($pointer,$comma);
	if( $command eq 'serin' )
	{
	  printf("    if(\n");
	}
	printf("\tpb%s(\n", $command);
	while( defined($action_array[0])  &&  $action_array[0] ne '[' )
	{
	  shift(@action_array);
	}
	shift(@action_array);
	while( defined($action_array[0])  &&  $action_array[0] ne ']' )
	{
	  if( $action_array[0] ne ',' )
	  {
	    if( $action_array[1] ne ']' )
	    {
	      $comma = ',';
	    } else {
	      $comma = '';
	    }
	    if( $command eq 'serin' )
	    {
	      $pointer = '&';
	    } else {
	      $pointer = '';
	    }
	    printf("\t    %s%s%s\n",
		   $pointer, &pbnumber($action_array[0]), $comma);
	  }
	  shift(@action_array);
	}
	if( $command eq 'serin' )
	{
	  printf("\t  )\n    )");
	  printf("    { exit(-4); }\n");
	} else {
	  printf("\t  );\n");
	}
      }
      elsif( $action_array[0] eq 'put' )
      {
	printf("\tpb%s(%s,%s);\n",
	  $action_array[0], &pbnumber($action_array[1]),
	  &pbnumber($action_array[3]) );
      }
      elsif( $action_array[0] eq 'get' )
      { # It may have been a bad idea, but I changed the order of the params.
	printf("\tpb%s(&%s,%s);\n",
	  $action_array[0], &pbnumber($action_array[3]),
	  &pbnumber($action_array[1]) );
      }
      elsif( $action_array[0] =~ /:$/ )
      { # This is a line label.  Nothing else is allowed on the line.
	# I don't know if that is a PBasic restriction, but the
	# Corvallis HS robot program followed this pattern.
	$action_array[0] =~ s/:$//;
	printf("  %s:\n", $action_array[0]);
      }
      elsif( $action_array[0] eq 'goto' )
      {
	$action_array[1] =~ s/:$//;
	printf("\tgoto %s;\n", $action_array[1]);
      }
      elsif( $action_array[0] eq 'gosub' )
      {
	$action_array[1] =~ s/:$//;
	printf("    printf(\"\tgosub from %d(return%d) to %s count=%%d\\n\", gosubcount );\n",
	       $line_n, $gosubcount, $action_array[1] );
	printf("\tgosubreturna[gosubcount++]=%d;\n", $gosubcount);
	printf("\tgoto %s;\n", $action_array[1]);
	printf("  return%0d:\n", $gosubcount);
	$gosubcount = $gosubcount+1;
	if( $gosubcount > 40 )
	{
	  printf("%s: There are %d, more than 40 gosubs.\n", $gosubcount );
	}
      }
      elsif( $action_array[0] eq 'return' )
      {
	printf("\tgoto gosubreturnc;\n");
      }
      elsif( $action_array[0] eq 'debug' )
      { # Debug syntax would be a pain to implement, so I ignored it.
      }
      elsif( $action_array[0] eq 'lookup' )
      { # We actually used this!
	shift(@action_array);
	my($index) = "pbstrip(" . $action_array[0] . ")"; shift(@action_array);
	my($variable) = $action_array[$#action_array] . "_w8";
	my($constcount) = 1;
	while( defined($action_array[2])
	       && ($action_array[0] eq ',') || ($action_array[0] eq '[')
	     )
	{
	  shift(@action_array);
	}
	printf("\t{\n\t  int lookup[] ={ %s", $action_array[0]);
	shift(@action_array);
	while( defined($action_array[2]) )
	{
	  if( ($action_array[0] ne ',') && ($action_array[0] ne ']') )
	  {
	    if( 0 == ($constcount % 10) )
	    {
	      printf(",\n\t\t\t  %s", $action_array[0]);
	    } else {
	      printf(",%s", $action_array[0]);
	    }
	    $constcount = $constcount + 1;
	  }
	  shift(@action_array);
	}
	printf("\n\t\t\t};");
	printf("\n\t  %s=((%s>=0)&&(%s<%s))\n\t\t? lookup[%s]\n\t\t: %s;\n\t}\n",
	       $variable, $index, $index, $constcount, $index, $index );
      }
      elsif( $action_array[0] eq 'stop' )
      {
	printf("\tpbstop();\n");
      }
      else
      { # If you get to this you either have a syntax error
	# or this simulator needs to be extended.
	printf("%s: Unimplemented command at line %d.  '%s'\n",
	       $progname, $line_n, $action_array[0]);
      }
    } # if( defined( $action_array[0] ) )
#    printf("line=%d, com=%d, line=%%%s%%, act=%%%s%%\n",
#	    $line_n, $comment_p, $line, $comment_st);
    # After each line of c code add a c comment containing
    # the PBasic source code that it was derived from.
    # (Heavily intended nevertheless.)
    printf("\t\t\t\t\t// %d: %s\n", $line_n, $line )
  } # while( $line = <Pb_Src_fh> )

  # --------------------------------------------------------------
  close( Pb_Src_fh ) ||
    (
      print( STDERR $progname, ": cannot close '", $pb_src_f, "'.\n" ),
      exit(-5)
    );

  shift(@ARGV);
  if( !($#ARGV >= 0) ){ $done = 1;}
} # while(! $done)
&includetail();
printf("// Translated from '%s' by %s, a simulator by %s.\n",
       $pb_src_f, $progname, $programmer );
printf("// lines=%d, errors=%d\n",$line_n,$errors);
exit( $errors );
# ================================================================