#!/usr/bin/perl -w
# @(#) $Header: /home/abrown/public_html/first/first2003chs/software/simulator/RCS/pb2c,v 2.16 2006/12/14 19:40:16 abrown Exp $

# ----------------------------------------------------------------
# pb2c - Perl program to translate PBasic source code to C.
#
# Copyright (C) 2002, 2003  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;
  keys(%varlist) = 100;		# This will be a full list of the variables
				# used in the bsx source.
# 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.
  $runcode = 0;			# 0=only vars so far.
				# otherwise, =line number first runcode.

# ================================================================
#	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]);
  keys(%varsize) = 4;
  %varsize = ('word'  => 16,
	      'byte'  => 8,
	      'nib'   => 4,
	      'bit'   => 1);

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

# ----------------------------------------------------------------
# Start the c program.
sub includehead
{
  printf("#include \"pb.h\"\n");
  printf("#include <stdio.h>\n");
  printf("int main()\n");
  printf("{\n");
  printf("  struct pbnumber outword\n");
  printf("		= {&outword.value,0,(pbi)16,(pbi)0,\"outword\"};\n");
  printf("  struct pbnumber outbytehigh\n");
  printf("		= {&outword.value,0,(pbi)8,(pbi)8,\"outbytehigh\"};\n");
  printf("  struct pbnumber outbytelow\n");
  printf("		= {&outword.value,0,(pbi)8,(pbi)0,\"outbytelow\"};\n");

  printf("  struct pbnumber out15\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)15,\"out15\"};\n");
  printf("  struct pbnumber out14\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)14,\"out14\"};\n");
  printf("  struct pbnumber out13\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)13,\"out13\"};\n");
  printf("  struct pbnumber out12\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)12,\"out12\"};\n");
  printf("  struct pbnumber out11\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)11,\"out11\"};\n");
  printf("  struct pbnumber out10\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)10,\"out10\"};\n");
  printf("  struct pbnumber out9\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)9,\"out9\"};\n");
  printf("  struct pbnumber out8\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)8,\"out8\"};\n");
  printf("  struct pbnumber out7\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)7,\"out7\"};\n");
  printf("  struct pbnumber out6\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)6,\"out6\"};\n");
  printf("  struct pbnumber out5\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)5,\"out5\"};\n");
  printf("  struct pbnumber out4\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)4,\"out4\"};\n");
  printf("  struct pbnumber out3\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)3,\"out3\"};\n");
  printf("  struct pbnumber out2\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)2,\"out2\"};\n");
  printf("  struct pbnumber out1\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)1,\"out1\"};\n");
  printf("  struct pbnumber out0\n");
  printf("		= {&outword.value,0,(pbi)1,(pbi)0,\"out0\"};\n");

  printf("  struct pbnumber inword\n");
  printf("		= {&inword.value,0,(pbi)16,(pbi)0,\"inword\"};\n");
  printf("  struct pbnumber inbytehigh\n");
  printf("		= {&inword.value,0,(pbi)8,(pbi)8,\"inbytehigh\"};\n");
  printf("  struct pbnumber inbytelow\n");
  printf("		= {&inword.value,0,(pbi)8,(pbi)0,\"inbytelow\"};\n");

  printf("  struct pbnumber in15\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)15,\"in15\"};\n");
  printf("  struct pbnumber in14\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)14,\"in14\"};\n");
  printf("  struct pbnumber in13\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)13,\"in13\"};\n");
  printf("  struct pbnumber in12\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)12,\"in12\"};\n");
  printf("  struct pbnumber in11\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)11,\"in11\"};\n");
  printf("  struct pbnumber in10\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)10,\"in10\"};\n");
  printf("  struct pbnumber in9\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)9,\"in9\"};\n");
  printf("  struct pbnumber in8\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)8,\"in8\"};\n");
  printf("  struct pbnumber in7\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)7,\"in7\"};\n");
  printf("  struct pbnumber in6\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)6,\"in6\"};\n");
  printf("  struct pbnumber in5\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)5,\"in5\"};\n");
  printf("  struct pbnumber in4\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)4,\"in4\"};\n");
  printf("  struct pbnumber in3\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)3,\"in3\"};\n");
  printf("  struct pbnumber in2\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)2,\"in2\"};\n");
  printf("  struct pbnumber in1\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)1,\"in1\"};\n");
  printf("  struct pbnumber in0\n");
  printf("		= {&inword.value,0,(pbi)1,(pbi)0,\"in0\"};\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\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 C structs to hold all info about a variable.
# A 16 bit word will be declared via pbnumber struct to point to a
# C variable by that name.  Byte fields in that 16 bit word will
# have their own structs, but their vpoint pointer will point to
# the same variable as the 16 bit word that they live in.
#
# Constants need to have a struct created to hold them.  pbconst2var
# decides whether $unknown is a constant or a variables.  If
# it is a constant, it wraps makepbnumber around the constant,
# which converts it into a struct.
sub pbconst2var # ($unknown)
{
  my($unknown);
  $unknown=$_[0];
  my($name) = "pbconst2var";
  my($numbertype) = &isnumber($unknown);
  if( $numbertype == 1 )
  { # Its a number.
    return(sprintf("makepbnumber(0,%s,(pbi)16,(pbi)0,\"%s\")",
		   $unknown, $name));
  } elsif( $numbertype == 2 )
  { # Its a hex number.
    $unknown =~ s/^\$/0x/;
    return(sprintf("makepbnumber(0,%s,(pbi)16,(pbi)0,\"%s\")",
		   $unknown, $name));
  } elsif( $numbertype == 3 )
  { # Its a binary number.
    printf("%s: Binary constants unimplemented.  String '%s' on line %d.\n",
	   $progname, $unknown, $line_n);
    # $unknown =~ s/^%//;
    # Need to convert from binary here.
    return(sprintf("makepbnumber(0,%s,(pbi)16,(pbi)0,\"%s\")",
		   $unknown, $name));
  } else
  {
    return($unknown);
  }
} # pbconst2var

# ----------------------------------------------------------------
# Used to determine if $unknown is
#   a variable with a field qualification: 5
#   a variable: 4
#   strictly numberic, but in pbasic binary: 3
#   strictly numberic, but in pbasic hex: 2
#   strictly numberic: 1
#   something else such as an operator: 0
sub isnumber # ($unknown)
{
  my($unknown);
  $unknown=$_[0];
  if( $unknown =~ /^[0-9][0-9\.]*$/ )
  {
    return(1); # ------ Its a number.
  } elsif( $unknown =~ /^[\$][0-9a-f][0-9a-f]*$/ )
  {
    return(2); # ------ Its a number, but it is in hex, in pbasic format!
  } elsif( $unknown =~ /^[%][01][01]*$/ )
  {
    return(3); # ------ Its a number, but it is in binary, in pbasic format!
  } elsif( $unknown =~ /^[a-zA-Z][0-9a-zA-Z_]*\.[0-9a-zA-Z_]*$/ )
  {
    return(5); # ------ Its a variable in the form var.bit3.
  } elsif( $unknown =~ /^[a-zA-Z][0-9a-zA-Z_]*$/ )
  {
    return(4); # ------ Its just a simple variable.
  } else {
    return(0); # ------ Its not a number or variable.
  }
} # isnumber

# ----------------------------------------------------------------
# vardeclinfo - Return info about a var we are about to declare.
#  in		ref,size,offset		comments
# ----------	-----------------	----------------------
#  t1		"t1",0,0		size=0 means no info
#  word		"",16,0
#  t2.byte0	"t2",8,0
#  t3.bit6	"t3",1,6
sub vardeclinfo # ($qualifier)
{
  my($qualifier);
  $qualifier=$_[0];
  my(@defstring,$ref,$size,$offset);
  @defstring = split('\.', $qualifier);
  if( defined( $defstring[1] ) )
  {
    $ref = $defstring[0];
    # Get $size.
    $size = $defstring[1];
    $size =~ s/[0-9]*$//;
    $size = $varsize{$size};
    if( $size == 0 )
    { # Huh?
      printf("Qualifier not recognized. '%s'\n", $qualifier);
    }
    # Get $offset
    $offset = $defstring[1];
    $offset =~ s/^[a-z]*//;
#    $offset = "" . $offset; # Convert string to number.
    $offset = $offset * $size;
  } else {
    $size = $varsize{$defstring[0]};
    if( ! defined($size) )
    {
      $size = 0;
    }
    if( $size == 0 )
    {
      $ref = $defstring[0];
    } else {
      $ref = "";
    }
    $offset = 0;
  }
#  printf("vardeclinfo: r='%s', s=%d, o=%d/'%s', ds1='%s'.\n",$ref,$size,$offset,$offset,$defstring[1]);
  return($ref,$size,$offset);
} # vardeclinfo

# ----------------------------------------------------------------
# makevar - Declare a var.  It can either be a new location or it
# can be a derived var, in other words a field in an existing var.
# It can be static (declare struct) or dynamic (call makepbnumber).
#Example:
# t2w1 var word			new declaration (initialize)
# t2y1 var t2w1.byte1		field
# t2b1 var t2y1.bit3		sub-field
# t3   var t2w1			alias
#
# t2w1	111111			t2w1.value,0,16,0
#	5432109876543210
# t2y1  76543210		t2w1.value,0,8,8
# t2b1      0			t2w1.value,0,1,11
# t3	111111			t2w1.value,0,16,0
#	5432109876543210
sub makevar # ($varreference,$vartype,$initial,$static)
{
  my($varreference,$vartype,$initial,$static);
  ($varreference,$vartype,$initial,$static)=($_[0],$_[1],$_[2],$_[3]);

  my($varloc,$varsize,$varpoint);
  my($parentname,$parentsize,$parentpoint,$returnval);

  $returnval = "";
  if( defined( $varlist{$varreference} ) )
  {
    printf("Error: var '%s' already defined.\n", $varreference);
    return("");
  } else {
    ($parentname,$varsize,$varpoint) = &vardeclinfo($vartype);
    if( $parentname eq "" )
    {
      $varloc = $varreference . ".value";
    } else {
      $varloc = $varlist{$parentname}[0];
      $parentsize = $varlist{$parentname}[1];
      $parentpoint = $varlist{$parentname}[2];
      if( $varreference eq "" )
      {
	$varreference = $parentname . "_s" . $varsize . "_o" . $varpoint;
      }
      $varpoint = $varpoint + $parentpoint;
      if( $varsize == 0 )
      {
	$varsize = $parentsize;
      }
#printf("pn='%s', vl='%s', ps=%d, pp=%d, vp=%d.\n",$parentname,$varloc,$parentsize,$parentpoint,$varpoint);
    }
    if( $static == 1 )
    {
      $returnval = $returnval . sprintf( "struct pbnumber %s\n", $varreference );
      $returnval = $returnval . sprintf( "\t= {&%s,0,(pbi)%d,(pbi)%d,\"%s\"};\n",
					 $varloc,$varsize,$varpoint,$varreference );
      $varlist{$varreference} = [$varloc,$varsize,$varpoint];
#printf("vr='%s', vl='%s', vs=%d, vp=%d.\n",$varreference,$varloc,$varsize,$varpoint);
    } else {
      $returnval = $returnval . sprintf( "makepbnumber(&%s,0,(pbi)%d,(pbi)%d,\"%s\")",
					 $varloc,$varsize,$varpoint,$varreference );
    }
    return($returnval);
  }
} # makevar

# ----------------------------------------------------------------
# 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 . $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]) >= 1) && (isnumber($_[0]) <= 4) )
    {
      $returna=$returna . pbconst2var($_[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( isnumber($_[0]) == 5 )
    {
      $newstring = &makevar("",$_[0],0,0);
      $returna=$returna . $newstring . $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]) )
    {
      printf("\n%s: Improperly terminated expression at line %d.  Got EOL, expect '%s'. 1-%d\n",
	     $progname, $line_n, $expect, $pbmathdepth );
      printf("    here 3p-%d 0=EOL ex='%s'\n\treta='%s'\n\tretm='%s'\n\tretz='%s'\n",
	     $pbmathdepth, $expect, $returna, $returnm, $returnz );
      $errors = $errors + 1;
      return($returna . $returnm . $returnz);
    }
    elsif( $_[0] eq ')'  ||  $_[0] eq 'then' )
    {
      printf("\n%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;
      return($returna . $returnm . $returnz);
    }
    elsif( defined($operators2{$_[0]}) )
    {
      $function2 = $operators2{$_[0]}[0];
      $precidence2 = $operators2{$_[0]}[1];
      if( $precidencelast >= $precidence2 )
      {
	$returna = $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;
	$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 . $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 . $function1 . "(";
	  $returnm = $_[0];
	  $returnz = ")" . $returnz;
	  shift;
	}
      }
      elsif( isnumber($_[1]) != 0 )
      {
	$returna = $returna . $returnm;
	if( isnumber($_[1]) == 5 )
	{ # Its a field qualified variable.  Need to create it.
	  $returnm = &makevar("",$_[1],0,0);
	} else {
	  $returnm = &pbconst2var($_[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');
keys(%commands3) = 3;
%commands3 = ('serin'	 => ['pbserin',32],
	      'serout'	 => ['pbserout',22],
	      'shiftout' => ['pbshiftout',5]);
$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;
  $action_st = "";
  # --------------------------------------------------------------
  while( $line = <Pb_Src_fh> )
  { # Read every line of the PBasic source file.
    $line_n++;
    chomp( $line );
    $line =~ s/
$//;			# I don't get why this was needed.
    $line =~ s/'%/%/;			# Remove the comment char ' from inline C
    $comment_p = index($line,"'");	# "'"Split the line into two parts: the
    if( $comment_p < 0 )		# action string and the comment string.
    {
      $action_st = $action_st . $line;
#      $comment_st = "";
    } else {
      $action_st = $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
    # Before each line of c code add a c comment containing
    # the PBasic source code that it was derived from.
    # (Heavily indented nevertheless.)
    printf("\t\t\t\t\t// %d: %s\n", $line_n, $line );
    @action_array = split(' ', $action_st);
    # If the line ends in a comma, it is continued on the next line,
    # so don't do this.
    if( ($action_st =~ /^%/) || ($action_st !~ /[\[,]$/) )
    { # Ready to parse.  All token are blank separated.
      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);
	  if( $runcode == 0 ) { $runcode=$line_n }
	}
	elsif( defined($action_array[1])  &&  ($action_array[1] eq 'var') )
	{ # This is a variable declaration.
	  if( $runcode )
	  {
	    printf("Error: var declared after first runcode at %d.\n",
		   $runcode);
	  }
	  $newstring = &makevar($action_array[0],$action_array[2],0,1);
	  printf("%s\n", $newstring);
	}
	elsif( defined($action_array[1])  &&  ($action_array[1] eq 'con') )
	{ # This is a constant declaration
	  my($name) = "constdef";
	  my($constname) = $action_array[0];
	  shift(@action_array); shift(@action_array);
	  printf(
		 "#define %s (%s)\n",
		 $constname, &pbmath('null', @action_array) );
	}
	elsif( defined($action_array[1])  &&  ($action_array[1] eq '=') )
	{ # This is an assignment.
	  my($lvalue)=$action_array[0]; shift(@action_array); shift(@action_array);
	  if( &isnumber($lvalue) == 5 )
	  { # Its a field qualified variable.  Need to create it.
	    printf("\tpblet(\n\t%s", &makevar("",$lvalue,0,0));
	    printf(",%s,\"%s\");\n", &pbmath('null', @action_array), $line_n );
	  } else {
	    printf("\tpblet(%s,%s,\"%s\");\n",
		   $lvalue, &pbmath('null', @action_array), $line_n
		   );
	  }
	  if( $runcode == 0 ) { $runcode=$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) );
	  printf("\t  )\n");
	  while( $action_array[0] ne "then"  &&  defined( $action_array[0] ))
	  {
	    shift(@action_array);
	  }
	  shift(@action_array);
	  if( defined($action_array[0]) )
	  {
	    if( $action_array[0] =~ /:$/ )
	    {
	      $action_array[0] =~ s/:$//;
	      printf("\t  goto %s;\n", $action_array[0]);
	    } else {
	      if( $action_array[1] eq '=' )
	      { # assign in an if
		my($lvalue) = $action_array[0];
		shift(@action_array); shift(@action_array);
		printf("\t{\n");
		if( &isnumber($lvalue) == 5 )
		{ # Its a field qualified variable.  Need to create it.
		  printf("\tpblet(\n\t%s", &makevar("",$lvalue,0,0));
		  printf(",%s,\"%s\");\n", &pbmath('null', @action_array), $line_n );
		} else {
		  printf("\tpblet(%s,%s,\"%s\");\n",
			 $lvalue, &pbmath('null', @action_array), $line_n
			 );
		}
		printf("\t}\n");
	      } else { # who knows what?
		printf("if then something unknown: now what? %d\n", $line_n);
	      }
	    }
	  } else {
	    printf("\t{");
	  }
	  if( $runcode == 0 ) { $runcode=$line_n }
	}
	elsif( $action_array[0] eq 'else' )
	{ # The 'if' has an 'else' clause.
	  printf("\t} else {");
	}
	elsif( $action_array[0] eq 'endif' )
	{ # End of 'if' block.
	  printf("\t}");
	}
	elsif( defined($commands1{$action_array[0]}) )
	{ # This is one of those simple PBasic commands.
	  printf("\t%s(", $commands1{$action_array[0]} );
	  shift(@action_array);
	  printf("%s);\n",&pbmath('null', @action_array) );
	  if( $runcode == 0 ) { $runcode=$line_n }
	}
	elsif( defined($commands3{$action_array[0]}) )
	{ # These are funky PBasic commands.
	  my($command)=$commands3{$action_array[0]}[0];
	  my($argnum)=$commands3{$action_array[0]}[1];
	  my($comma);
	  my($argcnt)=0;
	  if( $command eq 'pbserin' )
	  {
	    printf("    if(\n");
	  }
	  printf("\t%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] eq ',' )
	      {
		$comma = ',';
	      }
	      elsif( $action_array[1] eq ']' )
	      {
		$comma = '';
	      } else {
		printf("Error in parameter parsing %s.\n", $command);
	      }
	      printf("\t    %s%s\n",
		     &pbconst2var($action_array[0]), $comma);
	      $argcnt++;
	    }
	    shift(@action_array);
	  }
	  while($argnum>$argcnt)
	  {
	    printf("\t,makepbnumber(0,0,(pbi)16,(pbi)0,\"%s\")\n",$command);
	    $argcnt++;
	  }
	  if( $command eq 'pbserin' )
	  {
	    printf("\t  )\n    )");
	    printf("    { exit(-4); }\n");
	  } else {
	    printf("\t  );\n");
	  }
	  if( $runcode == 0 ) { $runcode=$line_n }
	}
	elsif( $action_array[0] eq 'put' )
	{
	  my($rvalue);
	  $rvalue = $action_array[3];
	  if( &isnumber($rvalue) == 5 )
	  { # Its a field qualified variable.  Need to create it.
	    printf("\tpb%s(%s,%s);\n",
		   $action_array[0], &pbconst2var($action_array[1]),
		   &makevar("",$rvalue,0,0));
	  } else {
	    printf("\tpb%s(%s,%s);\n",
		   $action_array[0], &pbconst2var($action_array[1]),
		   &pbconst2var($action_array[3]) );
	  }
	  if( $runcode == 0 ) { $runcode=$line_n }
	}
	elsif( $action_array[0] eq 'get' )
	{
	  my($lvalue);
	  $lvalue = $action_array[3];
	  if( &isnumber($lvalue) == 5 )
	  { # Its a field qualified variable.  Need to create it.
	    printf("\tpb%s(%s,%s);\n",
		   $action_array[0], &pbconst2var($action_array[1]),
		   &makevar("",$lvalue,0,0));
	  } else {
	    printf("\tpb%s(%s,%s);\n",
		   $action_array[0], &pbconst2var($action_array[1]),
		   &pbconst2var($action_array[3]) );
	  }
	  if( $runcode == 0 ) { $runcode=$line_n }
	}
	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]);
	  if( $runcode == 0 ) { $runcode=$line_n }
	}
	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 );
	  }
	  if( $runcode == 0 ) { $runcode=$line_n }
	}
	elsif( $action_array[0] eq 'return' )
	{
	  printf("\tgoto gosubreturnc;\n");
	  if( $runcode == 0 ) { $runcode=$line_n }
	}
	elsif( $action_array[0] eq 'debug' )
	{
	  shift(@action_array);
	  $formatstring="DEBUG:";
	  $arguments="";
	  while( defined($action_array[0]) )
	  {
	    if( $action_array[0] eq '"' )
	    {
	      shift(@action_array);
	      while( defined($action_array[0])  &&  $action_array[0] ne '"' )
	      {
		$formatstring=$formatstring . " " . $action_array[0];
		shift(@action_array);
	      }
	      shift(@action_array);
	    } elsif ( $action_array[0] eq 'dec' )
	    {
	      shift(@action_array);
	    } elsif ( $action_array[0] eq 'hex' )
	    {
	      shift(@action_array);
	    } elsif ( $action_array[0] eq ',' )
	    {
	      shift(@action_array);
	    } elsif ( $action_array[0] eq 'cr' )
	    {
	      $formatstring=$formatstring . "\\n";
	      shift(@action_array);
	    } else {
	      $argument="pbstrip(" . &pbmath(',', @action_array) . ")";
	      $arguments=$arguments . "," . $argument . "," . $argument;
	      $formatstring=$formatstring . "%d(0x%x)";
	      while( defined($action_array[0]) && $action_array[0] ne "," )
	      {
		shift(@action_array);
	      }
	      shift(@action_array);
	    } # else
	  } # while
	  printf("printf(\"%s\"%s);\n",$formatstring,$arguments);
	}
	elsif( $action_array[0] eq 'lookup' )
	{ # Basic Stamp Manual p. 183
	  shift(@action_array);
	  my($index) = $action_array[0]; shift(@action_array);
	  my($stripindex) = "pbstrip(" . $index . ")";
	  my($variable) = $action_array[$#action_array];
	  my($constcount) = 1;
	  while( defined($action_array[2])
		 && ($action_array[0] eq ',') || ($action_array[0] eq '[')
		 )
	  {
	    shift(@action_array);
	  }
	  printf("\t{\n\t  pbvalue 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  pblet(%s,\n", $variable );
	  printf("\t\t((%s>=0)&&(%s<%s))\n", $stripindex, $stripindex, $constcount);
	  printf("\t\t  ? makepbnumber(&lookup[(int)%s],0,(pbi)16,(pbi)0,\"lookup\")",
		 $stripindex);
	  printf("\n\t\t  : %s,\n\t\t\"%d\");\n\t}\n", $index, $line_n );
	  if( $runcode == 0 ) { $runcode=$line_n }
	}
	elsif( $action_array[0] eq 'stop' )
	{
	  printf("\tpbstop();\n");
	  if( $runcode == 0 ) { $runcode=$line_n }
	}
	elsif( $action_array[0] eq 'run' )
	{
	  printf("\tpbrun(%s);\n", &pbconst2var($action_array[1]));
	  if( $runcode == 0 ) { $runcode=$line_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);
      $action_st = "";
    }
  } # 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 );
# ================================================================