%{
/*
 * mglparse.y  -  Parser for Bootrom Menu Generation Language
 *
 * Copyright (C) 1997-2007 Gero Kuhlmann   <gero@gkminix.han.de>
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  any later version.
 *
 *  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., 675 Mass Ave, Cambridge, MA 02139, USA.
 *
 * $Id: mglparse.y,v 1.21 2007/01/06 18:31:28 gkminix Exp $
 */

#include "mknbi.h"
#include "mgl.h"
#include "gencode.h"



/*
 *****************************************************************************
 *
 * Global variables
 */
int curlevel = 0;			/* Current nesting level */
struct typesdef *typetab = NULL;	/* Types table */



/*
 *****************************************************************************
 *
 * Local variables
 */
static int inargdef = FALSE;		/* TRUE when defining proc args */
static int inexcept = FALSE;		/* TRUE when in except block */
static int reclevel = 0;		/* Current level within a record def */
static varclass curclass = CLASS_LOCAL;	/* Current storage class for args */
static struct sym *procstack[MAX_LEVELS + 1];     /* Sym stack for proc nesting */
static struct typesdef *recstack[MAX_LEVELS + 1]; /* Sym stack for rec nesting */



/*
 *****************************************************************************
 *
 * Forward declarations
 */
static void procargassign __P((struct sym *proc));
static void assignvartype __P((struct typesdef *tp, struct symlist *symlist));
static int checkassign __P((struct typesdef *type1, struct typesdef *type2));
static int checkexpr __P((struct expr *e1, struct expr *e2, int binary));
static int checkvar __P((struct expr *ep));
static struct typesdef *recordcreate __P((void));
static struct typesdef *enumcreate __P((struct symlist *slist));
static struct typesdef *arraycreate __P((struct typesdef *index, struct typesdef *base));
static struct typesdef *ptrcreate __P((struct typesdef *base));
static struct typesdef *getptrbase __P((struct typesdef *ptr));
static struct expr *makeboolexpr __P((struct expr *ep));
static struct expr *setprocexpr __P((struct sym *sp, struct expr *ep));
static struct expr *genrtvar __P((int id));
static struct expr *genrtfunc __P((int id,
					struct expr *ep1,
					struct expr *ep2,
					struct expr *ep3));



/*
 *****************************************************************************
 *
 * Make life simpler using preprocessor defines:
 */
#define newexpr()	((struct expr *)nbmalloc(sizeof(struct expr)))
#define newtype()	((struct typesdef *)nbmalloc(sizeof(struct typesdef)))
#define newtypelist()	((struct typelist *)nbmalloc(sizeof(struct typelist)))
#define newvarinfo()	((struct varinfo *)nbmalloc(sizeof(struct varinfo)))



/*
 *****************************************************************************
 *
 * Print an error message. This routine is for internal use by the yacc
 * parser only.
 */

/* YYERROR_VERBOSE specifies if the parser prints verbose error messages */
#ifdef YYBISON
# ifndef YYERROR_VERBOSE
#  define YYERROR_VERBOSE 1
# endif
#else
# ifndef YYERROR_VERBOSE
#  define YYERROR_VERBOSE 0
# endif
#endif

/* Specify our own yyerror() routine to avoid to depend on any runtime lib */
#ifdef yyerror
# undef yyerror
# define yyerror(msg)	error(msg, TRUE)
#else
static inline void yyerror __F((msg), const char *msg)
{
#if YYERROR_VERBOSE
  /*
   * If the parser is verbose already, we don't need to print the offending
   * token.
   */
#ifdef YYBISON
  if (strstr(msg, "unexpected ID") != NULL)
	error(msg, TRUE);
  else
	error(msg, FALSE);
#else
  error(msg, FALSE);
#endif
#else
  error(msg, TRUE);
#endif
}
#endif


/* Bison doesn't call yyerror() with the YYERROR macro, so we do it instead */
#ifdef YYBISON
# define YYERRPARSE(msg)	do {					\
					yyerror("parse error, " msg);	\
					YYERROR;			\
				} while(0)
#else
# define YYERRPARSE(msg)	YYERROR
#endif


/* Print an error message if a certain ID name has been expected */
#define YYEXPECT(id, exp)	if (!issymname((id), (exp))) \
					YYERRPARSE("'" exp "' expected")


/* Bison defines YYRECOVERING as a function, other yacc's don't */
#ifdef YYBISON
# define isrecovering()	YYRECOVERING()
#else
# define isrecovering()	YYRECOVERING
#endif



/*
 *****************************************************************************
 *
 * Redirect any bison printing routines so that they print using the
 * nblib log file facility.
 */
#ifdef YYBISON
# if YYDEBUG
#  ifdef YYFPRINTF
#   undef YYFPRINTF
#  endif
#  define YYFPRINTF yyfprintf

#  if defined(HAVE_ANSI_CC)
static void yyfprintf(FILE *fd, const char *msg, ...)
#  else
static void yyfprintf(va_list) va_dcl
#  endif
{
  va_list args;
#  if !defined(HAVE_ANSI_CC)
  FILE *fd;
  char *msg;
#  endif
  size_t len;
  char *buf;

  /* Startup variadic argument handling */
#  if defined(HAVE_ANSI_CC)
  va_start(args, msg);
#  else
  va_start(args);
  fd = va_arg(args, FILE *);
  msg = va_arg(args, char *);
#  endif
  if (msg == NULL)
	return;

  /* When the parser wants to print to stderr, it is an error message */
  if (fd == stderr) {
	len = strlen(msg);
	if (len > 0 && msg[len - 1] == '\n')
		len--;
	if (len > 0) {
		buf = (char *)nbmalloc(len + 1);
		strncpy(buf, msg, len);
		buf[len] = '\0';
		prnverr(msg, args);
	}
	return;
  }

  /* For stdout we just print into the log file */
  if (fd == stdout) {
	prnvlog(LOGLEVEL_NOTICE, msg, args);
	return;
  }

  /* Otherwise we have to print into a file */
  (void)vfprintf(fd, msg, args);
}
# endif
#endif
%}



	/*
	 *********************************************************************
	 *
	 * Return type for lexer and parser states
	 */
%union {
	struct symlist  *symlist;	/* List of symbols in variable decl */
	struct typelist *typelist;	/* List of types in array decl */
	struct typesdef *type;		/* Expression type */
	struct sym      *symbol;	/* Pointer to symbol */
	struct expr     *expr;		/* expression tree */
	byte_t          *ipaddr;	/* IP address */
	byte_t          *string;	/* string buffer */
	byte_t           chrarg;	/* character argument */
	int              intarg;	/* integer argument */
	int              op;		/* arithmetic operation */
}



	/*
	 *********************************************************************
	 *
	 * Tokens returned by lexer
	 */
%token <string> QSTRING
%token <intarg> NUM
%token <ipaddr> IPADDR
%token <symbol> ID
%token <chrarg> CHR
%token <op> ADDOP MULOP COMPARISON OROP ANDOP NOTOP
%token VAR CONST TYPE PROCEDURE FUNCTION ARRAY RECORD
%token RETURN RESTART PRINT SELECT IF ELSE FOR TO DOWNTO
%token LOAD GET REPEAT UNTIL AT WITH TRY EXCEPT RAISE
%token THEN WHILE DO BREAK ASSIGN OF LABEL GOTO NEW DISPOSE
%token CBEGIN END DOTS PROGRAM



	/*
	 *********************************************************************
	 *
	 * Types of non-terminal rules
	 */
%type <intarg> string_length
%type <expr> expr func expressions exprlist timeout assignment
%type <expr> const_expr const_value const_id const_binaryop const_unaryop
%type <expr> binaryop unaryop constant inetaddr
%type <expr> variable var_id var_array var_record var_pointer
%type <expr> for_name for_direction from gateway print_expr item_list
%type <type> type_spec type_single type_array type_record type_pointer
%type <symbol> prog_id
%type <symlist> id_list
%type <typelist> index_list



	/*
	 *********************************************************************
	 *
	 * Precendeces
	 */
%nonassoc THEN_PREC
%nonassoc ELSE

%left OROP
%left ANDOP
%left NOTOP
%left COMPARISON
%left ADDOP
%left MULOP
%nonassoc UMINUS

%%



	/*
	 *********************************************************************
	 *
	 * Layout of program
	 */
mgl:
        prog_header blocks proc_begin commands proc_end '.'
		{
#ifdef PARANOID
			if (curlevel != 0)
				interror(123, "invalid program level");
#endif
			startadr = getlabel(procstack[curlevel]->loc.label);
			YYACCEPT;
		}
    ;


prog_header:
        PROGRAM prog_id
		{
			struct sym *sp;

			curlevel = 0;
			if ($2 == NULL) {
				error("program identifier expected", FALSE);
				sp = addsym(NULL, SYMBOL_NOREF);
			} else
				sp = newsym($2, SYMBOL_NOREF);
			sp->type = programsym;
			sp->loc.label = LABEL_NULL;
			sp->def.f.retaddr = 0;
			sp->def.f.varsize = 0;
			sp->def.f.opcode = CMD_NONE;
			sp->def.f.argnum = 0;
			sp->def.f.labels = NULL;
			sp->def.f.ret = NULL;
			sp->def.f.args = NULL;
			procstack[curlevel] = sp;
		}
    ;


eol:
        ';'
    |   error		{ yyerrok; }
    ;


prog_id:
	ID eol		{ $$ = $1; }
    |   error eol	{ $$ = NULL; yyerrok; }
    ;


blocks:
        /* empty */
    |   block_multiple
    ;


block_multiple:
        block_single
    |   block_multiple block_single
    ;


block_single:
        VAR vardecls eol
    |	CONST constdecls eol
    |	TYPE typedecls eol
    |   LABEL labeldecls eol
    |   procedure eol
    ;



	/*
	 *********************************************************************
	 *
	 * General rules to declare a symbol list
	 */
id_list:
        ID
		{
			ref_t ref;

			/* Determine symbol reference value */
			if (reclevel > 0)
				ref = (ref_t)(recstack[reclevel]);
			else if (inargdef)
				ref = (ref_t)(procstack[curlevel]);
			else
				ref = SYMBOL_NOREF;

			/* Create new symbol list */
			$$ = NULL;
			if (($1 = newsym($1, ref)) == NULL)
				error("identifier already defined", TRUE);
			else
				addsymlist(&($$), $1);
		}
    |   id_list ',' ID
		{
			ref_t ref;

			/* Determine symbol reference value */
			if (reclevel > 0)
				ref = (ref_t)(recstack[reclevel]);
			else if (inargdef)
				ref = (ref_t)(procstack[curlevel]);
			else
				ref = SYMBOL_NOREF;

			/* Add symbol to symbol list */
			if (($3 = newsym($3, ref)) == NULL)
				error("identifier already defined", TRUE);
			else
				addsymlist(&($1), $3);
			$$ = $1;
		}
    |   id_list ',' error
		{
			$$ = $1;
		}
    |   error
		{
			$$ = NULL;
		}
    ;




	/*
	 *********************************************************************
	 *
	 * Label declaration section
	 */
labeldecls:
        id_list
		{
			struct sym *sp;
			struct symlist *slp;

			if ($1 == NULL)
				error("one or more labels expected", FALSE);
			else for (slp = $1; slp != NULL; slp = slp->next) {
				sp = slp->sym;
				sp->type = labelsym;
				sp->loc.label = LABEL_NULL;
				docmd(CODE_LABEL, sp, NULL, NULL);
				addsymlist(&(procstack[curlevel]->def.f.labels), sp);
			}
			delsymlist($1, FALSE);
		}
    ;




	/*
	 *********************************************************************
	 *
	 * Constant declaration section
	 */
constdecls:
        const_declaration
   |    constdecls ';' const_declaration
   ;


const_declaration:
        ID COMPARISON const_expr
		{
			if (($3 = reorg($3)) == NULL)
				break;
			else if ($2 != CMD_EQ)
				YYERRPARSE("missing equal sign in constant declaration");
			else if (!isconst($3))
				error("expression not constant", FALSE);
			else if (exprtype($3) != EXPR_NUM &&
			         exprtype($3) != EXPR_STRING &&
			         exprtype($3) != EXPR_CHAR &&
			         exprtype($3) != EXPR_BOOL &&
			         exprtype($3) != EXPR_IPADDR)
				error("invalid constant expression type", FALSE);
			else if (($1 = newsym($1, SYMBOL_NOREF)) == NULL)
				error("name of constant already defined", FALSE);
			else {
				$1->type = constsym;
				$1->def.c = $3->spec.cval;
				$1->def.c.t = $3->type;
				if (exprtype($3) == EXPR_STRING) {
					$1->def.c.val.s =
						copy_string($3->spec.cval.val.s);
				}
			}
			delexpr($3);
		}
    |   error
		{
			if (!isrecovering())
				error("constant declaration expected", FALSE);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Type declaration section
	 */
typedecls:
        type_declaration
   |    typedecls ';' type_declaration
   ;


type_declaration:
        ID COMPARISON type_spec
		{
			if ($2 != CMD_EQ)
				YYERRPARSE("missing equal sign in type declaration");
			else if (($1 = newsym($1, SYMBOL_NOREF)) == NULL)
				error("name of type already defined", FALSE);
			else if ($3 == NULL)
				error("type specification expected", FALSE);
			else {
				$1->type = typesym;
				$1->def.t = $3;
			}
		}
    |   error
		{
			if (!isrecovering())
				error("type declaration expected", FALSE);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Variable declarations section
	 */
vardecls:
        var_declaration
    |   vardecls ';' var_declaration
    ;


var_declaration:
        id_list ':' type_spec
		{
			if ($1 == NULL)
				error("missing variable name(s)", FALSE);
			else if ($3 == NULL)
				error("type specification expected", TRUE);
			else
				assignvartype($3, $1);
		}
    |   error
		{
			if (!isrecovering())
				error("variable declaration expected", FALSE);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Specify and enter a new type into the type list
	 */
type_spec:
        type_single	{ $$ = $1; }
    |   type_array	{ $$ = $1; }
    |   type_record	{ $$ = $1; }
    |   type_pointer	{ $$ = $1; }
    |   error		{ $$ = NULL; }
    ;



	/*
	 *********************************************************************
	 *
	 * Specification of a single type, i.e. not an array, record or pointer
	 */
type_single:
        ID string_length
		{
			struct typesdef *tp;

			tp = NULL;
			if ($1 == NULL || isnosym($1))
				error("unknown type identifier", FALSE);
			else if (!istypesym($1))
				error("identifier is not a type", FALSE);
			else if ($1->def.t->type == EXPR_NONE)
				error("invalid type identifier", FALSE);
			else if (!isstring($1->def.t)) {
				/* Assign non-string type */
				if ($2 != 0)
					error("length specification not allowed", FALSE);
				else
					tp = $1->def.t;
			} else if ($1->ref != SYMBOL_SYSREF) {
				/* Assign user defined string type */
				if ($2 != 0)
					error("cannot redeclare string type", FALSE);
				else
					tp = $1->def.t;
			} else {
				/*
				 * Strings are a bit special because different
				 * sizes are actually different types. There-
				 * fore we have to create a new type with the
				 * required size.
				 */
				tp = newstrtype($2);
			}
			$$ = tp;
		}
    |   const_value DOTS const_value
		{
			/* Find a subclass specification of a scalar */

			int submin, submax;
			struct typesdef *tp;

			tp = NULL;
			if (($1 = reorg($1)) == NULL ||
			    ($3 = reorg($3)) == NULL)
				goto label1;
			else if (!isconst($1) || !isconst($3))
				error("subclass specification has to be constant", FALSE);
			else if (!isscalar($1->type) || !isscalar($3->type))
				error("subclass specification has to be scalar", FALSE);
			else if (exprtype($1) != exprtype($3) ||
			         $1->type->def.s.min != $3->type->def.s.min ||
			         $3->type->def.s.max != $3->type->def.s.max)
				error("subclass involves different types", FALSE);
			else {
				submin = getord($1);
				submax = getord($3);
				if (submin > submax ||
				    submin < $1->type->def.s.min ||
				    submax > $1->type->def.s.max)
					error("invalid subclass range", FALSE);
				else {
					/* See if we have the type already */
					for (tp = typetab; tp != NULL;
								tp = tp->next)
						if (tp->type == exprtype($1) &&
						    tp->def.s.min == submin &&
						    tp->def.s.max == submax)
							break;

					if (tp == NULL) {
						/* No, make a new one */
						tp = newtype();
						tp->size = exprsize($1);
						tp->type = exprtype($1);
						tp->def.s.min = submin;
						tp->def.s.max = submax;
						tp->def.s.boundaddr = -1;
						tp->next = typetab;
						typetab = tp;
					}
				}
			}

		label1:
			delexpr($1);
			delexpr($3);
			$$ = tp;
		}
    |   '(' id_list ')'
		{
			$$ = NULL;
			if ($2 == NULL)
				error("missing names in enumeration", FALSE);
			else
				$$ = enumcreate($2);
		}
    ;


string_length:
        /* empty */
		{
			$$ = 0;
		}
    |   '[' const_expr ']'
		{
			$$ = 0;
			if (($2 = reorg($2)) == NULL)
				break;
			else if (exprtype($2) != EXPR_NUM)
				error("length must be a number", FALSE);
			else if (!isconst($2))
				error("length must be constant", FALSE);
			else if ($2->spec.cval.val.i < 1 ||
			         $2->spec.cval.val.i > MAX_STR_LEN)
				error("invalid length", FALSE);
			else
				$$ = $2->spec.cval.val.i;
			delexpr($2);
		}
    |   '[' error ']'
		{
			$$ = 0;
			if (!isrecovering())
				error("number expected", FALSE);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Rules for defining an array
	 */
type_array:
        ARRAY '[' index_list ']' OF type_spec
		{
			struct typesdef *tp;
			struct typelist *tlp1, *tlp2;

			tp = $6;
			if ($3 == NULL)
				error("index type for array missing", FALSE);
			else if (tp == NULL)
				error("base type for array missing", FALSE);
			else for (tlp1 = $3; tlp1 != NULL; tlp1 = tlp1->next) {
				tp = arraycreate(tlp1->t, tp);
				if (tp == NULL)
					break;
			}
			tlp1 = $3;
			while (tlp1 != NULL) {
				tlp2 = tlp1->next;
				free(tlp1);
				tlp1 = tlp2;
			}
			$$ = tp;
		}
    ;


index_list:
        type_single
		{
			struct typelist *tlp;

			tlp = NULL;
			if ($1 != NULL) {
				tlp = newtypelist();
				tlp->t = $1;
				tlp->next = NULL;
			}
			$$ = tlp;
		}
    |   index_list ',' type_single
		{
			struct typelist *tlp;

			tlp = NULL;
			if ($3 != NULL) {
				tlp = newtypelist();
				tlp->t = $3;
				tlp->next = $1;
			}
			$$ = tlp;
		}
    |   index_list error
		{
			struct typelist *tlp1, *tlp2;

			for (tlp1 = $1; tlp1 != NULL; tlp1 = tlp1->next) {
				tlp2 = tlp1->next;
				free(tlp1);
				tlp1 = tlp2;
			}
			$$ = NULL;
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Rules for declaring a record type
	 */
type_record:
        record_name record_decls END
		{
			struct typesdef *tp;

			tp = NULL;
			if (reclevel > 0) {
				if (recstack[reclevel] != NULL) {
					tp = recordcreate();
					recstack[reclevel] = NULL;
				}
				reclevel--;
			}
			$$ = tp;
		}
    |   record_name error END
		{
			if (reclevel > 0) {
				if (recstack[reclevel] != NULL) {
					delsymbols((ref_t)(recstack[reclevel]));
					free(recstack[reclevel]);
					recstack[reclevel] = NULL;
				}
				reclevel--;
			}
			$$ = NULL;
		}
    ;


record_name:
        RECORD
		{
			struct typesdef *tp;

			/* Create a new temporary record type */
			tp = newtype();
			tp->type = EXPR_RECORD;
			tp->size = 0;
			tp->def.r.elementnum = 0;
			tp->def.r.elements = NULL;
			tp->next = NULL;

			/* Save record type into symbol stack */
			reclevel++;
			recstack[reclevel] = tp;
		}
    ;


record_decls:
        record_declaration
    |   record_decls ';' record_declaration
    ;


record_declaration:
         /* empty */
    |   id_list ':' type_spec
		{
			if ($1 == NULL)
				error("missing record element name(s)", FALSE);
			else if ($3 == NULL)
				error("type specification expected", TRUE);
			else
				assignvartype($3, $1);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Rules for declaring a pointer type
	 */
type_pointer:
        '^' ID
		{
			struct typesdef *tp = NULL;

			if ($2 == NULL)
				error("pointer type expected", TRUE);
			else if (istypesym($2))
				tp = ptrcreate($2->def.t);
			else if (!isnosym($2))
				error("invalid pointer type", FALSE);
			else {
				/* Make new unknown pointer */
				tp = newtype();
				tp->size = pointer_type.size;
				tp->type = EXPR_POINTER;
				tp->def.p.basetype = NULL;
				tp->def.p.unknownsym = $2;
				tp->next = typetab;
				typetab = tp;
			}
			$$ = tp;
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Procedure/function definition
	 */
procedure:
        proc_def blocks proc_begin commands proc_end
    ;


proc_def:
        PROCEDURE proc_name proc_args eol
		{
			procstack[curlevel]->def.f.ret = NULL;
		}
    |   FUNCTION proc_name proc_args ':' type_spec eol
		{
			if ($5 == NULL)
				error("missing function type", FALSE);
			procstack[curlevel]->def.f.ret = $5;
		}
    |   PROCEDURE error eol
		{
			inargdef = FALSE;
			curclass = CLASS_LOCAL;
			yyerrok;
		}
    |   FUNCTION error eol
		{
			inargdef = FALSE;
			curclass = CLASS_LOCAL;
			yyerrok;
		}
    ;


proc_args:
        /* empty */
    |   '(' { inargdef = TRUE; } proc_arg_block { inargdef = FALSE; } ')'
    ;


proc_arg_block:
        proc_arg_decl
    |   proc_arg_block ';' proc_arg_decl
    ;


proc_arg_decl:
        arg_declaration
    |   VAR { curclass = CLASS_REF; } arg_declaration { curclass = CLASS_LOCAL; }
    |   CONST { curclass = CLASS_CONST; } arg_declaration { curclass = CLASS_LOCAL; }
    ;


arg_declaration:
        id_list ':' type_spec
		{
			if ($1 == NULL)
				error("missing argument name(s)", FALSE);
			else if ($3 == NULL)
				error("type specification expected", TRUE);
			else
				assignvartype($3, $1);
		}
    ;


proc_name:
        ID
		{
			if (($1 = newsym($1, SYMBOL_NOREF)) != NULL) {
				if (curlevel >= MAX_LEVELS)
					error("too many nesting levels", FALSE);
				else {
					curlevel++;
					curclass = CLASS_LOCAL;
					procstack[curlevel] = $1;
					$1->type = funcsym;
					$1->def.f.varsize = 0;
					$1->def.f.argsize = 0;
					$1->def.f.opcode = CMD_USERFUNC;
					$1->def.f.argnum = 0;
					$1->def.f.args = NULL;
					$1->def.f.labels = NULL;
					$1->def.f.ret = NULL;
				}
			} else
				error("invalid procedure/function identifier", TRUE);
		}
    ;


proc_begin:
        CBEGIN
		{
			struct sym *sp = procstack[curlevel];

			/*
			 * Count all arguments to the procedure and reverse
			 * the order of the arguments.
			 */
			procargassign(sp);

			/*
			 * For functions care for space for the return value,
			 * if we have a scalar type. Otherwise the space has
			 * to be provided by the caller, and it's address
			 * pushed onto the stack before calling.
			 */
			if (sp->def.f.ret != NULL) {
				if (isscalar(sp->def.f.ret)) {
					sp->def.f.varsize += 2;
					sp->def.f.retaddr = -(sp->def.f.varsize);
				} else {
					sp->def.f.argsize += 4;
					sp->def.f.retaddr = sp->def.f.argsize;
				}
			} else
				sp->def.f.retaddr = 0;
			sp->level = curlevel - 1;
			sp->loc.label = LABEL_NULL;
			docmd(CODE_PROC_START, sp, NULL, NULL);
		}
    ;


proc_end:
        END
		{
			/* Remove any temporary variables */
			procstack[curlevel]->def.f.varsize += freetmpvars();

			/* Delete any labels */
			delsymlist(procstack[curlevel]->def.f.labels, FALSE);

			/* Delete all symbols defined in this nesting level */
			if (curlevel > 0) {
				delsymbols(SYMBOL_ANYREF);
				curlevel--;
				curclass = CLASS_LOCAL;
			}

			/* Return to caller */
			docmd(CODE_PROC_END, NULL, NULL, NULL);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Command definitions
	 */
commandblock:
        command
    |   label ':' command
    |	CBEGIN commands END
    ;


commands:
        command
    |   label ':' command
    |   commands ';' command
    |   commands ';' label ':' command
    ;


label:
        ID
		{
			if (!islabelsym($1))
				error("symbol is not a label", TRUE);
			else
				docmd(CODE_LABEL, $1, NULL, NULL);
		}
    |   error
		{
			if (!isrecovering())
				error("label identifier expected", FALSE);
		}
    ;


command:
        /* empty */
    |   RESTART		{ docmd(CODE_RESTART, NULL, NULL, NULL); }
    |   RETURN		{ docmd(CODE_RETURN, NULL, NULL, NULL); }
    |   BREAK		{ docmd(CODE_BREAK, NULL, NULL, NULL); }
    |   assignment	{ delexpr($1); }
    |   callproc
    |   tryblock
    |   print
    |   select
    |   get
    |   goto
    |   if
    |   while
    |   for
    |   repeat
    |   load
    |   raise
    |   ptrops
    |   error
    ;



	/*
	 *********************************************************************
	 *
	 * Assignment command
	 */
assignment:
        variable ASSIGN expr
		{
			/* Check for various error conditions */
			if (($3 = reorg($3)) == NULL)
				goto label2;
			if (!checkvar($1))
				goto label2;
			if (!checkassign($1->type, $3->type))
				error("variable type doesn't match expression", FALSE);
			else {
				if (isscalar($1->type) &&
				    isconst($3) &&
				    !isconstrange($3, $1->type))
					warning("subclass range exceeded in scalar assignment");
				docmd(CODE_ASSIGN, NULL, $1, $3);
			}

		label2:
			delexpr($3);
			$$ = $1;
		}
    |   ID '(' '$' '[' expr ']' ')' ASSIGN expr
		{
			if (($5 = reorg($5)) == NULL)
				goto label3;
			else if (($9 = reorg($9)) == NULL)
				goto label3;
			else if (exprtype($5) != EXPR_NUM)
				error("invalid BOOTP index type", FALSE);
			else if (!istypesym($1))
				error("missing or invalid BOOTP type", FALSE);
			else if (!checkassign($1->def.t, $9->type))
				error("BOOTP type doesn't match expression", FALSE);
			else {
				struct expr *ep;

				ep = newexpr();
				ep->type = &int_type;
				ep->opcode = CMD_CONST;
				ep->exprnum = 0;
				ep->spec.cval.t = ep->type;
				ep->spec.cval.val.i =
					exprtype($9) == EXPR_STRING ? 1 : 0;
				ep = genrtfunc(RTCMD_PUTBOOTP, $5, $9, ep);
				docmd(CODE_CALL_PROC, NULL, ep, NULL);
				delexpr(ep);
				break;
			}

		label3:
			delexpr($5);
			delexpr($9);
			$$ = NULL;
		}
    |   error ASSIGN expr
		{
			if (!isrecovering())
				error("variable identifier expected", FALSE);
			delexpr($3);
			$$ = NULL;
		}
    |   variable ASSIGN error
		{
			if (!isrecovering())
				error("expression expected", FALSE);
			$$ = $1;
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Call a user procedure
	 */
callproc:
        ID '(' expressions ')'
		{
			if (!isfuncsym($1) || $1->def.f.ret != NULL)
				error("symbol is not a procedure", FALSE);
			else if ($3 != NULL &&
			         ($3 = setprocexpr($1, $3)) != NULL)
				docmd(CODE_CALL_PROC, NULL, $3, NULL);
			delexpr($3);
		}
    |   ID
		{
			/* Special case for procedures without arguments */
			struct expr *ep;

			ep = newexpr();
			ep->exprnum = 0;
			if (!isfuncsym($1) || $1->def.f.ret != NULL)
				error("symbol is not a procedure", FALSE);
			else if ((ep = setprocexpr($1, ep)) != NULL)
				docmd(CODE_CALL_PROC, NULL, ep, NULL);
			delexpr(ep);
		}
    |   ID '(' error ')'
		{
			if (!isrecovering())
				error("invalid procedure arguments", FALSE);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Print command
	 */
print:
        PRINT print_coordinates
    |   PRINT print_expr print_coordinates
		{
			struct expr *ep;
			int symnum = -1;
			int isipaddr = FALSE;
			int i;

			if ($2 == NULL ||
			    $2->type != NULL ||
			    $2->opcode != CMD_NONE) {
				error("expression list expected", TRUE);
				delexpr($2);
				break;
			}

			for (i = 0; i < $2->exprnum; i++) {
				ep = $2->exprlist[i];
				$2->exprlist[i] = NULL;
				if ((ep = reorg(ep)) == NULL)
					continue;

				switch (exprtype(ep)) {
					case EXPR_NUM:
						symnum = RTCMD_PRINTINT;
						break;
					case EXPR_IPADDR:
						isipaddr = TRUE;
						/* fall through */
					case EXPR_STRING:
						symnum = RTCMD_PRINTSTR;
						break;
					case EXPR_CHAR:
						symnum = RTCMD_PRINTCHR;
						break;
					default:
						break;
				}

				if (symnum < 0)
					error("invalid expression in print command", FALSE);
				else {
					if (isipaddr) {
						ep = genrtfunc(RTCMD_IP2STR,
								ep, NULL, NULL);
						ep = reorg(ep);
					}
					ep = genrtfunc(symnum, ep, NULL, NULL);
					docmd(CODE_CALL_PROC, NULL, ep, NULL);
				}
				delexpr(ep);
			}
			delexpr($2);
		}
    |   PRINT error
		{
			if (!isrecovering())
				error("expression expected in print command", FALSE);
		}
    ;


print_expr:
        expr
		{
			$$ = newexpr();
			$$->type = NULL;
			$$->opcode = CMD_NONE;
			$$->exprnum = 1;
			$$->exprlist[0] = $1;
		}
    |   print_expr ',' expr
		{
			if ($1 == NULL ||
			    $1->type != NULL ||
			    $1->opcode != CMD_NONE)
				error("expression list expected", TRUE);
			else if ($1->exprnum >= MAX_EXPRS)
				error("too many print expressions", FALSE);
			else {
				$$ = $1;
				$$->exprlist[$$->exprnum++] = $3;
				break;
			}
			delexpr($1);
			delexpr($3);
		}
    |   print_expr error
		{
			delexpr($1);
			if (!isrecovering())
				error("expression list expected", FALSE);
		}
    ;


print_coordinates:
        /* empty */
    |   AT coordinates		{ /* everything handled in coordinates */ }
    ;



	/*
	 *********************************************************************
	 *
	 * Select command
	 */
select:
        select_name OF select_items END
		{
			docmd(CODE_ENDNEST, NULL, NULL, NULL);
		}
    |   select_name error END
    ;


select_name:
        SELECT print_coordinates timeout
		{
			docmd(CODE_SELECT, NULL, NULL, NULL);
			if ($3 == NULL)
				error("timeout value expected with select statement", FALSE);
			else {
				struct expr *ep;

				ep = genrtfunc(RTCMD_SELECT, $3, NULL, NULL);
				docmd(CODE_CALL_PROC, NULL, ep, NULL);
				delexpr(ep);
				break;
			}
			delexpr($3);
		}
    ;


select_items:
        /* empty */
    |   item_number commandblock
    |   select_items ';' item_number commandblock
    ;


item_number:
        item_list ':'
		{
			if ($1 != NULL && $1->exprnum > 0)
				docmd(CODE_ITEM, NULL, $1, NULL);
			delexpr($1);
		}
    |   ELSE
		{
			struct expr ep;

			memzero(&ep, sizeof(ep));
			ep.opcode = CMD_NONE;
			ep.exprnum = 1;
			ep.exprlist[0] = newexpr();
			ep.exprlist[0]->type = &int_type;
			ep.exprlist[0]->opcode = CMD_CONST;
			ep.exprlist[0]->exprnum = 0;
			ep.exprlist[0]->spec.cval.t = ep.type;
			ep.exprlist[0]->spec.cval.val.i = -1;
			docmd(CODE_ITEM, NULL, &ep, NULL);
			delexpr(ep.exprlist[0]);
		}
    ;



item_list:
        const_expr
		{
			$$ = NULL;
			if (($1 = reorg($1)) == NULL)
				break;
			else if (exprtype($1) != EXPR_NUM)
				error("numerical value required for item number", FALSE);
			else if (!isconst($1))
				error("constant value required for item number", FALSE);
			else if ($1->spec.cval.val.i < 0 ||
			         $1->spec.cval.val.i > 9)
				error("item identifier out of range", FALSE);
			else {
				struct expr *ep;

				ep = newexpr();
				ep->opcode = CMD_NONE;
				ep->exprnum = 1;
				ep->exprlist[0] = $1;
				$$ = ep;
				break;
			}
			delexpr($1);
		}
    |   const_expr ',' item_list
		{
			$$ = $3;
			if (($1 = reorg($1)) == NULL)
				break;
			else if (exprtype($1) != EXPR_NUM)
				error("numerical value required for item number", FALSE);
			else if (!isconst($1))
				error("constant value required for item number", FALSE);
			else if ($1->spec.cval.val.i < 0 ||
			         $1->spec.cval.val.i > 9)
				error("item identifier out of range", FALSE);
			else if ($3->exprnum >= MAX_EXPRS)
				error("too many print expressions", FALSE);
			else {
				$$->exprlist[$$->exprnum++] = $1;
				break;
			}
			delexpr($1);
		}
    |   const_expr ',' error
		{
			struct expr *ep;

			ep = newexpr();
			ep->opcode = CMD_NONE;
			ep->exprnum = 1;
			ep->exprlist[0] = $1;
			$$ = ep;
		}
    |   error ',' item_list
		{
			$$ = $3;
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Read command
	 */
get:
        GET variable print_coordinates timeout
		{
			int symnum = -1;

			/* Check that we really have a variable */
			if (!checkvar($2))
				goto label9;

			/* Determine name of function to call */
			switch (exprtype($2)) {
				case EXPR_NUM:
					if (checkassign($2->type, &int_type))
						symnum = RTCMD_GETINT;
					break;
				case EXPR_IPADDR:
				case EXPR_STRING:
					if (checkassign($2->type, &string_type))
						symnum = RTCMD_GETSTR;
					break;
				case EXPR_CHAR:
					if (checkassign($2->type, &char_type))
						symnum = RTCMD_GETCHR;
					break;
				default:
					break;
			}

			/* Check for various error conditions and call 'get' */
			if (symnum < 0)
				error("invalid type in get command", FALSE);
			else {
				struct expr *ep;

				ep = genrtfunc(symnum, $4, NULL, NULL);
				if (exprtype($2) == EXPR_IPADDR)
					ep = genrtfunc(RTCMD_STR2IP, ep, NULL, NULL);
				docmd(CODE_ASSIGN, NULL, $2, ep);
				delexpr(ep);
				$4 = NULL;
			}

		label9:
			delexpr($2);
			delexpr($4);
		}
    |   GET error
		{
			if (!isrecovering())
				error("variable expected in get command", FALSE);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Goto command
	 */
goto:
        GOTO ID
		{
			if (!islabelsym($2))
				error("symbol is not a label", TRUE);
			else if ($2->level != curlevel)
				error("jump outside of current block", FALSE);
			else
				docmd(CODE_GOTO, $2, NULL, NULL);
		}
    |   GOTO error
		{
			if (!isrecovering())
				error("jump label expected", TRUE);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Raise command
	 */
raise:
        RAISE
		{
			struct expr *ep;

			if (!inexcept)
				YYERRPARSE("expression expected");
			else {
				ep = newexpr();
				ep->type = &int_type;
				ep->opcode = CMD_CONST;
				ep->exprnum = 0;
				ep->spec.cval.t = ep->type;
				ep->spec.cval.val.i = 0;
				ep = genrtfunc(RTCMD_RAISE, ep, NULL, NULL);
				docmd(CODE_CALL_PROC, NULL, ep, NULL);
				delexpr(ep);
			}
		}
    |   RAISE expr
		{
			struct expr *ep;

			if (($2 = reorg($2)) == NULL)
				break;
			else if (exprtype($2) != EXPR_NUM)
				error("exception must be a number", FALSE);
			else {
				ep = genrtfunc(RTCMD_RAISE, $2, NULL, NULL);
				docmd(CODE_CALL_PROC, NULL, ep, NULL);
				delexpr(ep);
				break;
			}
			delexpr($2);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * try...except...end commands
	 */
tryblock:
	try_name commands except_name commands { inexcept = FALSE; } END
		{
			struct expr *ep;

			/* End try...except nesting */
			docmd(CODE_ENDNEST, NULL, NULL, NULL);

			/* Generate code to delete any exception info */
			ep = genrtfunc(RTCMD_ENDEXCEPT, NULL, NULL, NULL);
			docmd(CODE_CALL_PROC, NULL, ep, NULL);
			delexpr(ep);
		}
    ;


try_name:
	TRY
		{
			struct expr *ep1, *ep2;

			/* Create constant zero */
			ep1 = newexpr();
			ep1->type = &int_type;
			ep1->opcode = CMD_CONST;
			ep1->exprnum = 0;
			ep1->spec.cval.t = ep1->type;
			ep1->spec.cval.val.i = 0;

			/*
			 * Create expression to check the return value of
			 * handletry function against 0.
			 */
			ep2 = newexpr();
			ep2->type = &bool_type;
			ep2->opcode = CMD_EQ;
			ep2->exprnum = 2;
			ep2->left = genrtfunc(RTCMD_HANDLETRY,
							NULL, NULL, NULL);
			ep2->right = ep1;

			/* Generate appropriate code */
			if ((ep2 = reorg(ep2)) != NULL) {
				docmd(CODE_IF, NULL, ep2, NULL);
				delexpr(ep2);
			}
		}
    ;


except_name:
        EXCEPT
		{
			docmd(CODE_ELSE, NULL, NULL, NULL);
			inexcept = TRUE;
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Pointer operation commands
	 */
ptrops:
        NEW '(' variable ')'
		{
			struct expr *ep;

			if (!checkvar($3))
				goto label10;

			if (exprtype($3) != EXPR_POINTER ||
			    $3->type == NULL ||
			    getptrbase($3->type) == NULL)
				error("pointer variable expected", FALSE);
			else {
				/* Create expression to allocate memory */
				ep = newexpr();
				ep->opcode = CMD_CONST;
				ep->type = &int_type;
				ep->exprnum = 0;
				ep->spec.cval.t = ep->type;
				ep->spec.cval.val.i =
						getptrbase($3->type)->size;
				ep = genrtfunc(RTCMD_MALLOC, ep, NULL, NULL);

				/* Assign memory address to pointer */
				docmd(CODE_ASSIGN, NULL, $3, ep);
				delexpr(ep);
			}

		label10:
			delexpr($3);
		}
    |   DISPOSE '(' variable ')'
		{
			struct expr *ep;

			if (!checkvar($3))
				goto label11;

			if (exprtype($3) != EXPR_POINTER)
				error("pointer variable expected", FALSE);
			else {
				/* Create expression to free memory */
				ep = genrtfunc(RTCMD_FREE, $3, NULL, NULL);
				docmd(CODE_CALL_PROC, NULL, ep, NULL);
				delexpr(ep);
				break;
			}

		label11:
			delexpr($3);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * If command
	 */
if:
        if_name THEN commandblock	%prec THEN_PREC
		{
			docmd(CODE_ENDNEST, NULL, NULL, NULL);
		}
    |   if_name THEN commandblock else
		{
			docmd(CODE_ENDNEST, NULL, NULL, NULL);
		}
    ;


if_name:
        IF expr
		{
			$2 = makeboolexpr($2);
			docmd(CODE_IF, NULL, $2, NULL);
			delexpr($2);
		}
    ;


else:
        ELSE { docmd(CODE_ELSE, NULL, NULL, NULL); } commandblock
    ;



	/*
	 *********************************************************************
	 *
	 * While command
	 */
while:
        while_name DO commandblock
		{
			docmd(CODE_ENDNEST, NULL, NULL, NULL);
		}
    ;


while_name:
        WHILE expr
		{
			$2 = makeboolexpr($2);
			docmd(CODE_WHILE, NULL, $2, NULL);
			delexpr($2);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Repeat command
	 */
repeat:
        repeat_name commands UNTIL expr
		{
			$4 = makeboolexpr($4);
			docmd(CODE_ENDNEST, NULL, $4, NULL);
			delexpr($4);
		}
    ;


repeat_name:
        REPEAT
		{
			docmd(CODE_REPEAT, NULL, NULL, NULL);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * For command
	 */
for:
        for_name DO commandblock
		{
			struct expr *ep;

			/*
			 * The for_name action passes us a dummy expression
			 * which contains sub-expressions necessary for termi-
			 * nating the loop.
			 */
			if ($1 == NULL)
				break;

			/* Create the increment/decrement command */
			ep = newexpr();
			*ep = *($1->exprlist[0]);
			$1->exprlist[1]->type = $1->type;
			$1->exprlist[1]->exprnum = 1;
			$1->exprlist[1]->exprlist[0] = ep;
			docmd(CODE_ASSIGN, NULL, $1->exprlist[0],
							$1->exprlist[1]);
			free(ep);
			$1->exprlist[1]->exprnum = 0;
			$1->exprlist[1]->exprlist[0] = NULL;

			/* Terminate the while-loop */
			docmd(CODE_ENDNEST, NULL, NULL, NULL);

			/*
			 * This will delete everything, including releasing
			 * any temporary variables.
			 */
			delexpr($1);
		}
    ;


for_name:
        FOR assignment for_direction expr
		{
			struct expr *ep1, *ep2;

			$$ = NULL;
			if ($2 == NULL || !isscalar($2->type))
				error("scalar variable expected in for command", FALSE);
			else if (!isvariable($2))
				error("variable expected in for command", FALSE);
			else if (($4 = reorg($4)) == NULL)
				goto label4;
			else if (!isscalar($4->type))
				error("scalar expression expected as end value", FALSE);
			else if (!checkassign($2->type, $4->type))
				error("type of end value doesn't match variable type", FALSE);
			else {
				/* Create assignment of end value to temp variable */
				ep1 = NULL;
				if (!isconst($4)) {
					ep1 = createtmpvar($2->type,
							procstack[curlevel]);
					docmd(CODE_ASSIGN, NULL, ep1, $4);
				} else if (!isconstrange($4, $2->type))
					warning("subclass range exceeded in scalar end value");

				/* Create beginning of while loop */
				ep2 = newexpr();
				ep2->type = &bool_type;
				ep2->opcode = ($3->opcode == CMD_SUCC ?
								CMD_LE : CMD_GE);
				ep2->exprnum = 2;
				ep2->left = $2;
				ep2->right = (ep1 == NULL ? $4 : ep1);
				docmd(CODE_WHILE, NULL, ep2, NULL);

				/* Dummy expression to pass everything down */
				ep2->type = $2->type;
				ep2->opcode = CMD_NONE;
				ep2->exprnum = (ep1 == NULL ? 2 : 3);
				ep2->exprlist[0] = $2;
				ep2->exprlist[1] = $3;
				ep2->exprlist[2] = ep1;
				delexpr($4);
				$$ = ep2;
				break;
			}

		label4:
			delexpr($2);
			delexpr($3);
			delexpr($4);
		}
    ;


for_direction:
        TO
		{
			$$ = newexpr();
			$$->opcode = CMD_SUCC;
		}
    |   DOWNTO
		{
			$$ = newexpr();
			$$->opcode = CMD_PRED;
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Load command
	 */
load:
        LOAD expr from gateway
		{
			if (($2 = reorg($2)) == NULL)
				goto label5;
			else if (exprtype($2) != EXPR_STRING)
				error("string value expected as filename", FALSE);
			else {
				struct expr *ep;

				if ($3 == NULL)
					$3 = genrtvar(RTVAR_TFTP);
				if ($4 == NULL)
					$4 = genrtvar(RTVAR_GATEWAY);
				ep = genrtfunc(RTCMD_LOAD, $2, $3, $4);
				docmd(CODE_CALL_PROC, NULL, ep, NULL);
				delexpr(ep);
				break;
			}

		label5:
			delexpr($2);
			delexpr($3);
			delexpr($4);
		}
    |   LOAD error
		{
			if (!isrecovering())
				error("filename expected in load command", FALSE);
		}
    ;


from:
        /* empty */
		{
			$$ = NULL;
		}
    |   ID { YYEXPECT($1, "from"); } inetaddr
		{
			$$ = $3;
		}
    |   ID { YYEXPECT($1, "from"); } error
		{
			$$ = NULL;
			if (!isrecovering())
				error("IP address expected", TRUE);
		}
    ;


gateway:
        /* empty */
		{
			$$ = NULL;
		}
    |   WITH ID { YYEXPECT($2, "gateway"); } inetaddr
		{
			$$ = $4;
		}
    |   WITH ID { YYEXPECT($2, "gateway"); } error
		{
			$$ = NULL;
			if (!isrecovering())
				error("IP address expected", TRUE);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Expression rules
	 */
expr:
        ID '(' '$' '[' expr ']' ')'
		{
			$$ = NULL;
			if (($5 = reorg($5)) == NULL)
				break;
			else if (exprtype($5) != EXPR_NUM)
				error("invalid BOOTP index type", FALSE);
			else if (!istypesym($1))
				error("missing or invalid BOOTP type", FALSE);
			else {
				struct expr *ep;

				ep = newexpr();
				ep->type = &int_type;
				ep->opcode = CMD_CONST;
				ep->exprnum = 0;
				ep->spec.cval.t = ep->type;
				ep->spec.cval.val.i =
						isstring($1->def.t) ? 1 : 0;
				$$ = genrtfunc(RTCMD_GETBOOTP, $5, ep, NULL);
				$$->type = $1->def.t;
				break;
			}
			delexpr($5);
		}
    |   '(' expr ')'	{ $$ = $2; }
    |   binaryop	{ $$ = $1; }
    |   unaryop		{ $$ = $1; }
    |   variable	{ $$ = $1; }
    |   func		{ $$ = $1; }
    |   constant	{ $$ = $1; }
    ;



	/*
	 *********************************************************************
	 *
	 * Rules for binary operations
	 */
binaryop:
        expr ANDOP expr
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($1, $3, TRUE))
				break;
			if (!checkassign($1->type, $3->type) ||
			    (exprtype($1) != EXPR_NUM &&
			     exprtype($1) != EXPR_BOOL)) {
				error("invalid operation", FALSE);
				delexpr($1);
				delexpr($3);
			} else {
				ep = newexpr();
				ep->type = (exprtype($1) == EXPR_NUM ?
							&int_type : &bool_type);
				ep->exprnum = 2;
				ep->opcode = $2;
				ep->left = $1;
				ep->right = $3;
				$$ = ep;
			}
		}
    |   expr OROP expr
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($1, $3, TRUE))
				break;
			if (!checkassign($1->type, $3->type) ||
			    (exprtype($1) != EXPR_NUM &&
			     exprtype($1) != EXPR_BOOL)) {
				error("invalid operation", FALSE);
				delexpr($1);
				delexpr($3);
			} else {
				ep = newexpr();
				ep->type = (exprtype($1) == EXPR_NUM ?
							&int_type : &bool_type);
				ep->exprnum = 2;
				ep->opcode = $2;
				ep->left = $1;
				ep->right = $3;
				$$ = ep;
			}
		}
    |   expr ADDOP expr
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($1, $3, TRUE))
				break;
			if ($2 == '+' &&
			    ((exprtype($1) == EXPR_CHAR ||
			      exprtype($1) == EXPR_STRING) &&
			     (exprtype($3) == EXPR_CHAR ||
			      exprtype($3) == EXPR_STRING))) {
				int cmdcode;

				if (exprtype($1) == EXPR_CHAR &&
				    exprtype($3) == EXPR_CHAR)
					cmdcode = RTCMD_STRCATCC;
				else if (exprtype($1) == EXPR_CHAR &&
				         exprtype($3) == EXPR_STRING)
					cmdcode = RTCMD_STRCATCS;
				else if (exprtype($1) == EXPR_STRING &&
				         exprtype($3) == EXPR_CHAR)
					cmdcode = RTCMD_STRCATSC;
				else
					cmdcode = RTCMD_STRCAT;
				$$ = genrtfunc(cmdcode, $1, $3, NULL);
			} else if (!checkassign($1->type, $3->type) ||
			           exprtype($1) != EXPR_NUM) {
				error("invalid operation", FALSE);
				delexpr($1);
				delexpr($3);
			} else {
				ep = newexpr();
				ep->type = &int_type;
				ep->exprnum = 2;
				ep->opcode = $2;
				ep->left = $1;
				ep->right = $3;
				$$ = ep;
			}
		}
    |   expr MULOP expr
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($1, $3, TRUE))
				break;
			if ($2 == '*' &&
			    exprtype($1) == EXPR_CHAR &&
			    exprtype($3) == EXPR_NUM)
				$$ = genrtfunc(RTCMD_STRSET, $1, $3, NULL);
			else if (!checkassign($1->type, $3->type) ||
			           exprtype($1) != EXPR_NUM) {
				error("invalid operation", FALSE);
				delexpr($1);
				delexpr($3);
			} else {
				ep = newexpr();
				ep->type = &int_type;
				ep->exprnum = 2;
				ep->opcode = $2;
				ep->left = $1;
				ep->right = $3;
				$$ = ep;
			}
		}
    |   expr COMPARISON expr
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($1, $3, TRUE))
				break;
			if (!checkassign($1->type, $3->type) ||
			    (isnonscalar($1->type) &&
			     exprtype($1) != EXPR_STRING) ||
			    (isnonscalar($3->type) &&
			     exprtype($3) != EXPR_STRING)) {
				error("invalid comparison", FALSE);
				delexpr($1);
				delexpr($3);
			} else if (exprtype($1) == EXPR_STRING &&
			           exprtype($3) == EXPR_STRING) {
				ep = newexpr();
				ep->type = &int_type;
				ep->opcode = CMD_CONST;
				ep->exprnum = 0;
				ep->spec.cval.t = ep->type;
				ep->spec.cval.val.i = mapcmp((int)$2);
				$$ = genrtfunc(RTCMD_STRCMP, $1, $3, ep);
			} else if (isnonscalar($1->type) ||
			           isnonscalar($3->type)) {
				if ($2 != CMD_EQ && $2 != CMD_NE) {
					error("invalid non-scalar comparison", FALSE);
					$2 = CMD_EQ;
				}
				ep = newexpr();
				ep->type = &int_type;
				ep->opcode = CMD_CONST;
				ep->exprnum = 0;
				ep->spec.cval.t = ep->type;
				ep->spec.cval.val.i = mapcmp((int)$2);
				$$ = genrtfunc(RTCMD_MEMCMP, $1, $3, ep);
			} else {
				if ((ispointer($1->type) ||
				     ispointer($3->type)) &&
				    ($2 != CMD_EQ && $2 != CMD_NE)) {
					error("invalid pointer comparison", FALSE);
					$2 = CMD_EQ;
				}
				ep = newexpr();
				ep->type = &bool_type;
				ep->exprnum = 2;
				ep->opcode = $2;
				ep->left = $1;
				ep->right = $3;
				$$ = ep;
			}
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Rules for unary operations
	 */
unaryop:
        NOTOP expr
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($2, NULL, FALSE))
				break;
			if (exprtype($2) != EXPR_BOOL &&
			    exprtype($2) != EXPR_NUM) {
				error("NOT operation not allowed", FALSE);
				delexpr($2);
			} else {
				ep = newexpr();
				ep->type = (exprtype($2) == EXPR_NUM ?
							&int_type : &bool_type);
				ep->exprnum = 1;
				ep->opcode = $1;
				ep->left = $2;
				$$ = ep;
			}
		}
    |   ADDOP expr %prec UMINUS
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($2, NULL, FALSE))
				break;
			if (exprtype($2) != EXPR_NUM) {
				error("unary operation not allowed", FALSE);
				delexpr($2);
			} else if ($1 == '-') {
				ep = newexpr();
				ep->type = &int_type;
				ep->exprnum = 1;
				ep->opcode = $1;
				ep->left = $2;
				$$ = ep;
			} else if ($1 == '+') {
				$$ = $2;
			}
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Rules for variable values
	 */
variable:
        var_id		{ $$ = $1; }
    |   var_array	{ $$ = $1; }
    |   var_record	{ $$ = $1; }
    |   var_pointer     { $$ = $1; }
    ;


var_id:
        ID
		{
			struct expr *ep;
			struct typesdef *tp;
			struct varinfo *vp;

			$$ = NULL;
			if ($1 == NULL)
				error ("missing variable name", FALSE);
			else if (inexcept && issymname($1, "exception"))
				$$ = genrtvar(RTVAR_EXCEPTION);
			else if (isnosym($1))
				error("symbol not defined", TRUE);
			else if (isconstsym($1)) {
				ep = newexpr();
				ep->opcode = CMD_CONST;
				ep->exprnum = 0;
				ep->type = $1->def.c.t;
				ep->spec.cval = $1->def.c;
				if (isstring($1->def.c.t))
					ep->spec.cval.val.s =
						copy_string($1->def.c.val.s);
				$$ = ep;
			} else if (!isvarsym($1) && !isfuncsym($1))
				error("symbol is not a variable or function", TRUE);
			else if (isfuncsym($1) && $1->def.f.ret == NULL)
				error("cannot use a procedure in expression", TRUE);
			else if (isfuncsym($1) && $1 != procstack[curlevel]) {
				ep = newexpr();
				ep->exprnum = 0;
				$$ = setprocexpr($1, ep);
			} else {
				tp = isvarsym($1) ? $1->def.v.t : $1->def.f.ret;
				vp = newvarinfo();
				vp->cmd = basevar;
				vp->vartype = tp;
				vp->spec.basesym = $1;
				vp->next = NULL;
				ep = newexpr();
				ep->opcode = CMD_VAR;
				ep->exprnum = 0;
				ep->type = tp;
				ep->spec.var = vp;
				$$ = ep;
			}
		}
    ;


var_array:
        variable '[' expr ']'
		{
			struct typesdef *tp;
			struct varinfo *vp;

			$$ = NULL;
			if (($3 = reorg($3)) == NULL)
				error("invalid array index", FALSE);
			else if ($1 == NULL || !isvariable($1) ||
			         $1->spec.var == NULL ||
			         (exprtype($1) != EXPR_ARRAY &&
			          exprtype($1) != EXPR_STRING))
				error("array or string variable expected", FALSE);
			else if (!isscalar($3->type))
				error("scalar type expected for array index", FALSE);
			else if (!checkassign($1->type->def.a.indextype,
								$3->type))
				error("invalid scalar type for array index", FALSE);
			else {
				tp = $1->type->def.a.basetype;
				vp = $1->spec.var;
				while (vp->next != NULL)
					vp = vp->next;
				vp->next = newvarinfo();
				vp = vp->next;
				vp->cmd = arrayindex;
				vp->vartype = tp;
				vp->spec.index = $3;
				vp->next = NULL;
				$1->type = tp;
				$$ = $1;
				break;
			}
			delexpr($1);
			delexpr($3);
		}
    |   variable '[' expr ',' expr ']'
		{
			$$ = NULL;
			if (($3 = reorg($3)) == NULL ||
			    ($5 = reorg($5)) == NULL)
				error("invalid string subrange indices", FALSE);
			else if ($1 == NULL ||
			         !isvariable($1) ||
			         exprtype($1) != EXPR_STRING)
				error("string variable expected", FALSE);
			else if (exprtype($3) != EXPR_NUM ||
			         exprtype($5) != EXPR_NUM)
				error("string subrange indices have to be numerical", FALSE);
			else {
				$$ = genrtfunc(RTCMD_STRSUB, $1, $3, $5);
				break;
			}
			delexpr($1);
			delexpr($3);
			delexpr($5);
		}
    ;


var_record:
        variable '.' ID
		{
			struct sym *sp;
			struct varinfo *vp;

			/* Check that we have a variable */
			$$ = NULL;
			if ($1 == NULL || !isvariable($1) ||
			    $1->spec.var == NULL) {
				error("variable expected", FALSE);
				goto label7;
			}

			/* Find last variable info record */
			vp = $1->spec.var;
			while (vp->next != NULL)
				vp = vp->next;

			/* Handle string length specially */
			if (exprtype($1) == EXPR_STRING &&
			    issymname($3, "len")) {
				/* Generate string length variable */
				struct expr *ep;

				ep = newexpr();
				ep->opcode = CMD_CONST;
				ep->type = &int_type;
				ep->exprnum = 0;
				ep->spec.cval.t = ep->type;
				ep->spec.cval.val.i = 0;

				vp->next = newvarinfo();
				vp = vp->next;
				vp->cmd = arrayindex;
				vp->vartype = &strlength_type;
				vp->spec.index = ep;
				vp->next = NULL;

				$1->type = &strlength_type;
				$$ = $1;
				break;
			}

			/* Now handle ordinary records */
			if (exprtype($1) != EXPR_RECORD) {
				error("record variable expected", FALSE);
				goto label7;
			}
			if ($3 == NULL) {
				error("record variant expected", FALSE);
				goto label7;
			}

			/* Find the symbol in the record item list */
			if ($3->ref == (ref_t)($1->type))
				sp = $3;
			else
				sp = findsym($3->name, (ref_t)($1->type));
			if (sp == NULL) {
				error("record variant unknown", FALSE);
				goto label7;
			}
#ifdef PARANOID
			if (!isrecsym(sp))
				interror(102, "invalid symbol list in record specification");
#endif

			/* Generate a new variable info record */
			vp->next = newvarinfo();
			vp = vp->next;
			vp->cmd = recordelement;
			vp->vartype = sp->def.v.t;
			vp->spec.recsym = sp;
			vp->next = NULL;
			$1->type = sp->def.v.t;
			$$ = $1;
			break;

		label7:
			delexpr($1);
		}
    ;


var_pointer:
        variable '^'
		{
			struct typesdef *tp;
			struct varinfo *vp;

			/* Check that we have a pointer variable */
			$$ = NULL;
			if ($1 == NULL || !isvariable($1) ||
			    $1->spec.var == NULL ||
			    exprtype($1) != EXPR_POINTER) {
				error("pointer variable expected", FALSE);
				goto label6;
			}

			/* Determine the type of the variable */
			tp = getptrbase($1->type);
			if (tp == NULL) {
				error("unknown pointer type", FALSE);
				goto label6;
			}
			if (isanytype(tp)) {
				error("pointer has no type", FALSE);
				goto label6;
			}

			/* Generate a new variable info record */
			vp = $1->spec.var;
			while (vp->next != NULL)
				vp = vp->next;
			vp->next = newvarinfo();
			vp = vp->next;
			vp->cmd = ptrderef;
			vp->vartype = tp;
			vp->next = NULL;
			$1->type = tp;
			$$ = $1;
			break;

		label6:
			delexpr($1);
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Rules for constant values passed from the lexer
	 */
constant:
        NUM
		{
			struct expr *ep;

			ep = newexpr();
			ep->opcode = CMD_CONST;
			ep->type = &int_type;
			ep->exprnum = 0;
			ep->spec.cval.t = ep->type;
			ep->spec.cval.val.i = $1;
			$$ = ep;
		}
    |   QSTRING
		{
			struct expr *ep;

			ep = newexpr();
			ep->opcode = CMD_CONST;
			ep->type = &string_type;
			ep->exprnum = 0;
			ep->spec.cval.t = ep->type;
			ep->spec.cval.val.s = $1;
			$$ = ep;
		}
    |   CHR
		{
			struct expr *ep;

			ep = newexpr();
			ep->opcode = CMD_CONST;
			ep->type = &char_type;
			ep->exprnum = 0;
			ep->spec.cval.t = ep->type;
			ep->spec.cval.val.c = $1;
			$$ = ep;
		}
    |   IPADDR
		{
			struct expr *ep;

			ep = newexpr();
			ep->opcode = CMD_CONST;
			ep->type = &ipaddr_type;
			ep->exprnum = 0;
			ep->spec.cval.t = ep->type;
			ep->spec.cval.val.a = $1;
			$$ = ep;
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Rules for calling a function. If the function has no arguments, it's
	 * call is handled in the var_id rule.
	 */
func:
        ID '(' expressions ')'
		{
			$$ = NULL;
			if (isnosym($1)) {
				error("function not defined", FALSE);
				delexpr($3);
			} else if (!isfuncsym($1)) {
				error("symbol in expression is not a function", FALSE);
				delexpr($3);
			} else if (!iscmdscalar(&($1->def.f))) {
				/* Handle normal function call */
				if ($3 == NULL)
					error("missing function arguments", FALSE);
				else
					$$ = setprocexpr($1, $3);
			} else if ($3 == NULL || $3->exprnum != 1) {
				error("invalid number of arguments", FALSE);
				delexpr($3);
			} else if (!isscalar($3->left->type)) {
				error("scalar expression required", FALSE);
				delexpr($3);
			} else {
				/*
				 * General scalar operations need special
				 * handling because they can operate on a
				 * variety of data types. By using the
				 * checks 'iscmdscalar' and 'isscalar' we
				 * should be pretty sure that we have a
				 * correct function call.
				 */
				$3->type = $1->def.f.opcode == CMD_ORD ?
						&int_type : $3->left->type;
				$3->opcode = $1->def.f.opcode;
				$3->spec.func = $1;
				$$ = $3;
			}
		}
    |   ID '(' error ')'
		{
			if (!isrecovering())
				error("invalid function arguments", FALSE);
			$$ = NULL;
		}
    ;


expressions:
        /* empty */
		{
			struct expr *ep;

			ep = newexpr();
			ep->exprnum = 0;
			$$ = ep;
		}
    |   exprlist
		{
			$$ = $1;
		}
    ;


exprlist:
        expr
		{
			struct expr *ep;

			ep = newexpr();
			ep->exprnum = 1;
			ep->exprlist[0] = $1;
			$$ = ep;
		}
    |   expr ',' exprlist
		{
			if ($3->exprnum >= MAX_EXPRS)
				error("Too many function arguments", FALSE);
			else {
				$3->exprlist[$3->exprnum] = $1;
				$3->exprnum++;
			}
			$$ = $3;
		}
    |   expr ',' error
		{
			struct expr *ep;

			ep = newexpr();
			ep->exprnum = 1;
			ep->exprlist[0] = $1;
			$$ = ep;
		}
    |   error ',' exprlist
		{
			$$ = $3;
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Rules for constant expressions
	 */
const_expr:
        '(' const_expr ')'	{ $$ = $2; }
    |   const_binaryop		{ $$ = $1; }
    |   const_unaryop		{ $$ = $1; }
    |   const_id		{ $$ = $1; }
    |   constant		{ $$ = $1; }
    ;


	/* This is necessary for type definitions */
const_value:
        const_id		{ $$ = $1; }
    |   constant		{ $$ = $1; }
    ;


const_id:
        ID
		{
			struct expr *ep;

			$$ = NULL;
			if (isnosym($1) || $1 == NULL)
				error("symbol not defined", TRUE);
			else if (!isconstsym($1))
				error("constant symbol expected", TRUE);
			else {
				ep = newexpr();
				ep->opcode = CMD_CONST;
				ep->exprnum = 0;
				ep->type = $1->def.c.t;
				ep->spec.cval = $1->def.c;
				if (isstring($1->def.c.t))
					ep->spec.cval.val.s =
						copy_string($1->def.c.val.s);
				$$ = ep;
			}
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Rules for constant binary operations
	 */
const_binaryop:
        const_expr ANDOP const_expr
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($1, $3, TRUE))
				break;
			if (!checkassign($1->type, $3->type) ||
			    (exprtype($1) != EXPR_NUM &&
			     exprtype($1) != EXPR_BOOL)) {
				error("invalid operation", FALSE);
				delexpr($1);
				delexpr($3);
			} else {
				ep = newexpr();
				ep->type = (exprtype($1) == EXPR_NUM ?
							&int_type : &bool_type);
				ep->exprnum = 2;
				ep->opcode = $2;
				ep->left = $1;
				ep->right = $3;
				$$ = ep;
			}
		}
    |   const_expr OROP const_expr
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($1, $3, TRUE))
				break;
			if (!checkassign($1->type, $3->type) ||
			    (exprtype($1) != EXPR_NUM &&
			     exprtype($1) != EXPR_BOOL)) {
				error("invalid operation", FALSE);
				delexpr($1);
				delexpr($3);
			} else {
				ep = newexpr();
				ep->type = (exprtype($1) == EXPR_NUM ?
							&int_type : &bool_type);
				ep->exprnum = 2;
				ep->opcode = $2;
				ep->left = $1;
				ep->right = $3;
				$$ = ep;
			}
		}
    |   const_expr ADDOP const_expr
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($1, $3, TRUE))
				break;
			if ($2 == '+' &&
			    ((exprtype($1) == EXPR_CHAR ||
			      exprtype($1) == EXPR_STRING) &&
			     (exprtype($3) == EXPR_CHAR ||
			      exprtype($3) == EXPR_STRING))) {
				int cmdcode;

				if (exprtype($1) == EXPR_CHAR &&
				    exprtype($3) == EXPR_CHAR)
					cmdcode = RTCMD_STRCATCC;
				else if (exprtype($1) == EXPR_CHAR &&
				         exprtype($3) == EXPR_STRING)
					cmdcode = RTCMD_STRCATCS;
				else if (exprtype($1) == EXPR_STRING &&
				         exprtype($3) == EXPR_CHAR)
					cmdcode = RTCMD_STRCATSC;
				else
					cmdcode = RTCMD_STRCAT;
				$$ = genrtfunc(cmdcode, $1, $3, NULL);
			} else if (!checkassign($1->type, $3->type) ||
			           exprtype($1) != EXPR_NUM) {
				error("invalid operation", FALSE);
				delexpr($1);
				delexpr($3);
			} else {
				ep = newexpr();
				ep->type = &int_type;
				ep->exprnum = 2;
				ep->opcode = $2;
				ep->left = $1;
				ep->right = $3;
				$$ = ep;
			}
		}
    |   const_expr MULOP const_expr
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($1, $3, TRUE))
				break;
			if ($2 == '*' &&
			    exprtype($1) == EXPR_CHAR &&
			    exprtype($3) == EXPR_NUM)
				$$ = genrtfunc(RTCMD_STRSET, $1, $3, NULL);
			else if (!checkassign($1->type, $3->type) ||
			           exprtype($1) != EXPR_NUM) {
				error("invalid operation", FALSE);
				delexpr($1);
				delexpr($3);
			} else {
				ep = newexpr();
				ep->type = &int_type;
				ep->exprnum = 2;
				ep->opcode = $2;
				ep->left = $1;
				ep->right = $3;
				$$ = ep;
			}
		}
    |   const_expr COMPARISON const_expr
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($1, $3, TRUE))
				break;
			if (!checkassign($1->type, $3->type)) {
				error("invalid comparison", FALSE);
				delexpr($1);
				delexpr($3);
			} else if (exprtype($1) == EXPR_STRING &&
			           exprtype($3) == EXPR_STRING) {
				ep = newexpr();
				ep->type = &int_type;
				ep->opcode = CMD_CONST;
				ep->exprnum = 0;
				ep->spec.cval.t = ep->type;
				ep->spec.cval.val.i = mapcmp((int)$2);
				$$ = genrtfunc(RTCMD_STRCMP, $1, $3, ep);
			} else if (isnonscalar($1->type) ||
			           isnonscalar($3->type)) {
				if ($2 != CMD_EQ && $2 != CMD_NE) {
					error("invalid non-scalar comparison", FALSE);
					$2 = CMD_EQ;
				}
				ep = newexpr();
				ep->type = &int_type;
				ep->opcode = CMD_CONST;
				ep->exprnum = 0;
				ep->spec.cval.t = ep->type;
				ep->spec.cval.val.i = mapcmp((int)$2);
				$$ = genrtfunc(RTCMD_MEMCMP, $1, $3, ep);
			} else {
				if ((ispointer($1->type) ||
				     ispointer($3->type)) &&
				    ($2 != CMD_EQ && $2 != CMD_NE)) {
					error("invalid pointer comparison", FALSE);
					$2 = CMD_EQ;
				}
				ep = newexpr();
				ep->type = &bool_type;
				ep->exprnum = 2;
				ep->opcode = $2;
				ep->left = $1;
				ep->right = $3;
				$$ = ep;
			}
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Rules for constant unary operations
	 */
const_unaryop:
        NOTOP const_expr
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($2, NULL, FALSE))
				break;

			if (exprtype($2) != EXPR_BOOL &&
			    exprtype($2) != EXPR_NUM) {
				error("NOT operation not allowed", FALSE);
				delexpr($2);
			} else {
				ep = newexpr();
				ep->type = (exprtype($2) == EXPR_NUM ?
							&int_type : &bool_type);
				ep->exprnum = 1;
				ep->opcode = $1;
				ep->left = $2;
				$$ = ep;
			}
		}
    |   ADDOP const_expr %prec UMINUS
		{
			struct expr *ep;

			$$ = NULL;
			if (!checkexpr($2, NULL, FALSE))
				break;

			if (exprtype($2) != EXPR_NUM) {
				error("unary operation not allowed", FALSE);
				delexpr($2);
			} else if ($1 == '-') {
				ep = newexpr();
				ep->type = &int_type;
				ep->exprnum = 1;
				ep->opcode = $1;
				ep->left = $2;
				$$ = ep;
			} else if ($1 == '+') {
				$$ = $2;
			}
		}
    ;



	/*
	 *********************************************************************
	 *
	 * Miscellaneous rules
	 */
coordinates:
        '[' expr ',' expr ']'
		{
			if (($2 = reorg($2)) == NULL ||
			    ($4 = reorg($4)) == NULL)
				goto label8;
			else if (exprtype($2) != EXPR_NUM ||
			         exprtype($4) != EXPR_NUM)
				error("coordinate values have to be numerical", FALSE);
			else {
				struct expr *ep;

				ep = genrtfunc(RTCMD_GOTOXY, $2, $4, NULL);
				docmd(CODE_CALL_PROC, NULL, ep, NULL);
				delexpr(ep);
				break;
			}

		label8:
			delexpr($2);
			delexpr($4);
		}
    ;


timeout:
        /* empty */
		{
			struct expr *ep;

			ep = newexpr();
			ep->opcode = CMD_CONST;
			ep->type = &int_type;
			ep->exprnum = 0;
			ep->spec.cval.t = ep->type;
			ep->spec.cval.val.i = 0;
			$$ = ep;
		}
    |   WITH ID { YYEXPECT($2, "timeout"); } expr
		{
			$$ = NULL;
			if (($4 = reorg($4)) == NULL)
				break;
			else if (exprtype($4) != EXPR_NUM) {
				error("timeout value has to be a number", FALSE);
				delexpr($4);
			} else
				$$ = $4;
		}
    |   WITH ID { YYEXPECT($2, "timeout"); } error
		{
			$$ = NULL;
			if (!isrecovering())
				error("expression expected for timeout value", FALSE);
		}
    ;


inetaddr:
        expr
		{
			$$ = NULL;
			if (($1 = reorg($1)) == NULL)
				break;
			else if (exprtype($1) == EXPR_STRING) {
				$$ = genrtfunc(RTCMD_STR2IP, $1, NULL, NULL);
				break;
			} else if (exprtype($1) == EXPR_IPADDR) {
				$$ = $1;
				break;
			} else {
				error("IP address expected", FALSE);
				delexpr($1);
			}
		}
    ;

%%


/*
 *****************************************************************************
 *
 * Check that both parts of a binary expression are available
 */
static int checkexpr __F((e1, e2, binary),
				struct expr *e1 AND
				struct expr *e2 AND
				int binary)
{
  if (e1 == NULL || (e2 == NULL && binary)) {
	if (e1 != NULL)
		delexpr(e1);
	if (e2 != NULL && binary)
		delexpr(e2);
	return(FALSE);
  }
  return(TRUE);
}



/*
 *****************************************************************************
 *
 * Check if an expression is boolean, and make it a boolean constant if
 * it's not. This check is used by the conditional operators to maintain
 * nesting consistency in case of error.
 */
static struct expr *makeboolexpr __F((ep), struct expr *ep)
{
  /* Check that the expression is boolean */
  ep = reorg(ep);
  if (ep != NULL && exprtype(ep) != EXPR_BOOL) {
	error("boolean expression expected", FALSE);
	delexpr(ep);
	ep = NULL;
  }

  /* If it's not boolean, make it a boolean constant */
  if (ep == NULL) {
	ep = newexpr();
	ep->type = &bool_type;
	ep->opcode = CMD_CONST;
	ep->exprnum = 0;
	ep->spec.cval.t = ep->type;
	ep->spec.cval.val.b = FALSE;
  }
  return(ep);
}



/*
 *****************************************************************************
 *
 * Scan through the current symbol list and assign a variable type to
 * all symbols.
 */
static void assignvartype __F((tp, symlist),
				struct typesdef *tp AND
				struct symlist *symlist)
{
  struct sym *sp;
  struct symlist *slp;
  addr_t varsize;

  /* Scan thorugh symbol list and process each symbol */
  for (slp = symlist; slp != NULL; slp = slp->next) {
	if ((sp = slp->sym) == NULL)
		continue;
	sp->type = varsym;
	sp->def.v.t = tp;
	varsize = tp->size;
	if (reclevel > 0) {
		/*
		 * We are preparing a record definition. This has to come
		 * before any procedure argument list handling!
		 */
		sp->type = recsym;
		sp->level = -1;		/* required for code generator */
		sp->loc.addr = recstack[reclevel]->size;
		recstack[reclevel]->size += varsize;
		recstack[reclevel]->def.r.elementnum++;
		addsymlist(&(recstack[reclevel]->def.r.elements), sp);
		sp->def.v.class = CLASS_STATIC;
	} else if (inargdef) {
		/*
		 * We are preparing an argument list to a function or
		 * procedure. There, non-scalars get always passed as
		 * pointers. If they have to be passed by value, the
		 * caller has to provide a copy of the argument value
		 * on the stack before calling the procedure.
		 * Additionally, when a string gets passed by reference,
		 * not only the address but also the string size gets
		 * pushed onto the stack.
		 * We use sp->loc.addr to temporarily save the size of the
		 * argument on the stack. A positive value of sp->loc.addr
		 * marks this as an argument to a function.
		 */
		if (curclass == CLASS_REF)
			sp->loc.addr = (isstring(tp) || isanytype(tp) ? 4 : 2);
		else
			sp->loc.addr = (isscalar(tp) || ispointer(tp) ?
					(varsize + 1) & 0xfffe : 2);
		sp->def.v.class = curclass;
	} else if (curlevel > 0) {
		/*
		 * We are preparing a list of variables local to a
		 * procedure or function.
		 */
		procstack[curlevel]->def.f.varsize += (varsize + 1) & 0xfffe;
		sp->loc.addr = -(procstack[curlevel]->def.f.varsize);
		sp->def.v.class = CLASS_LOCAL;
	} else {
		/*
		 * We are preparing a global variable.
		 */
		sp->loc.addr = dataptr;
		dataptr += varsize;
		sp->def.v.class = CLASS_STATIC;
	}
  }

  /* Finally delete the symbol list, but not the symbols */
  delsymlist(symlist, FALSE);
}



/*
 *****************************************************************************
 *
 * Return a pointer to an enumeration type which has the elements listed
 * in the current symbol list.
 */
static struct typesdef *enumcreate __F((slist), struct symlist *slist)
{
  struct symlist *slp;
  struct typesdef *tp = newtype();

  /* Prepare all symbols for constant values */
  for (slp = slist; slp != NULL; slp = slp->next) {
	slp->sym->type = constsym;
	slp->sym->def.c.t = tp;
	slp->sym->def.c.val.e = slp->num;
  }

  /* Create the new enumeration type */
  tp->type = EXPR_ENUM;
  tp->def.s.boundaddr = -1;
  tp->def.s.min = 0;
  tp->def.s.max = slist->num;
  tp->size = int_type.size;
  tp->next = typetab;
  typetab = tp;

  /* Release the symbol list and return the new enumeration type */
  delsymlist(slist, FALSE);
  return(tp);
}



/*
 *****************************************************************************
 *
 * Return a pointer to an array type.
 */
static struct typesdef *arraycreate __F((index, base),
				struct typesdef *index AND
				struct typesdef *base)
{
  struct typesdef *tp;
  int elementnum;
  addr_t size;

  /* Just for safety */
  if (index == NULL || base == NULL)
	return(NULL);

  /* Find out the number of elements in the array */
  if (!isscalar(index)) {
	error("scalar type required for array index", FALSE);
	return(NULL);
  }
  elementnum = index->def.s.max - index->def.s.min + 1;
#ifdef PARANOID
  if (elementnum < 1)
	interror(3, "number of elements in array < 1");
#endif

  /* Determine the total size of the new array type */
  size = elementnum * base->size;
  if (size > MAX_ARRAY_SIZE) {
	error("array size too large", FALSE);
	return(NULL);
  }

  /* We can now safely create a new enumeration type */
  tp = newtype();
  tp->type = EXPR_ARRAY;
  tp->def.a.indextype = index;
  tp->def.a.basetype = base;
  tp->size = size;
  tp->next = typetab;
  typetab = tp;
  return(tp);
}



/*
 *****************************************************************************
 *
 * Create a record type
 */
static struct typesdef *recordcreate __F_NOARGS
{
  /* Just for safety */
  if (recstack[reclevel] == NULL)
	return(NULL);

  /* Check for some errors */
  if (recstack[reclevel]->def.r.elements == NULL ||
      recstack[reclevel]->def.r.elementnum == 0) {
	error("no elements defined in record definition", FALSE);
	goto recdelete;
  }
  if (recstack[reclevel]->size > MAX_REC_SIZE) {
	error("record too large", FALSE);
	goto recdelete;
  }

  /* We can now insert the new record type into the types list */
  recstack[reclevel]->next = typetab;
  typetab = recstack[reclevel];
  return(recstack[reclevel]);

recdelete:
  delsymlist(recstack[reclevel]->def.r.elements, TRUE);
  free(recstack[reclevel]);
  return(NULL);
}



/*
 *****************************************************************************
 *
 * Return a pointer to a pointer type.
 */
static struct typesdef *ptrcreate __F((base), struct typesdef *base)
{
  struct typesdef *tp;

  /* See if we have the pointer type already */
  for (tp = typetab; tp != NULL; tp = tp->next)
	if (getptrbase(tp) == base)
		break;

  /* No, make a new one */
  if (tp == NULL) {
	tp = newtype();
	tp->size = pointer_type.size;
	tp->type = EXPR_POINTER;
	tp->def.p.basetype = base;
	tp->def.p.unknownsym = NULL;
	tp->next = typetab;
	typetab = tp;
  }
  return(tp);
}



/*
 *****************************************************************************
 *
 * Determine the base type of a pointer. This is not as easy as it looks
 * because pointers can have a forward type reference. Therefore, if a
 * base type has not been defined for a pointer, we look at the symbol by
 * which the pointer has been defined, and if that's defined, we can
 * use it's type.
 */
static struct typesdef *getptrbase __F((ptr), struct typesdef *ptr)
{
  struct sym *sp;

  /* Check that we have a pointer at all */
  if (!ispointer(ptr))
	return(NULL);

  /* Get the base type from the pointer type record if available */
  if (ptr->def.p.basetype != NULL)
	return(ptr->def.p.basetype);

  /* Get the base type from the definition symbol */
  sp = ptr->def.p.unknownsym;
  if (sp == NULL || !istypesym(sp) || sp->def.t == NULL)
	return(NULL);
  ptr->def.p.basetype = sp->def.t;
  ptr->def.p.unknownsym = NULL;
  return(sp->def.t);
}



/*
 *****************************************************************************
 *
 * Lookup the symbol table and assign all symbols, which are arguments to
 * the current procedure or function, to that procedure. It returns the
 * total size of the arguments on the stack.
 */
static void procargassign __F((proc), struct sym *proc)
{
  struct symlist *slp, *arglist;
  addr_t argsize, argptr;
  int argnum, i;

  /*
   * Count all arguments to the procedure. This will also reverse the
   * order of the arguments.
   */
  argsize = 0;
  arglist = createsymlist((ref_t)proc);
  for (slp = arglist, i = 0; slp != NULL; slp = slp->next)
	if (isvarsym(slp->sym) && slp->sym->loc.addr > 0) {
		argsize += slp->sym->loc.addr;
		i++;
	}

  /* Check the number of arguments */
  argnum = i;
  if (argnum > MAX_EXPRS) {
	error("Too many function arguments", FALSE);
	argnum = MAX_EXPRS;
  }

  /*
   * Update the procedure symbol definition and the offsets to the procedure
   * arguments.
   */
  proc->def.f.args = NULL;
  proc->def.f.argnum = argnum;
  proc->def.f.argsize = argsize;
  if (i > 0) {
	argptr = argsize + 4;
	proc->def.f.args = (struct vardef *)nbmalloc(sizeof(struct vardef) * i);
	for (slp = arglist, i = 0; slp != NULL && i < argnum; slp = slp->next)
		if (isvarsym(slp->sym) && slp->sym->loc.addr > 0) {
			argptr -= slp->sym->loc.addr;
			slp->sym->loc.addr = argptr;
			proc->def.f.args[i] = slp->sym->def.v;
			i++;
		}
  }

  /* Finally delete the symbol list, but not the symbols themselves */
  delsymlist(arglist, FALSE);
}



/*
 *****************************************************************************
 *
 * Check if two types are assignable to each other
 */
static int checkassign __F((type1, type2),
				struct typesdef *type1 AND
				struct typesdef *type2)
{
  /* This is just for safety */
  if (type1 == NULL || type2 == NULL)
	return(FALSE);

  /*
   * If the types are exactly the same, we can always assign. Also, if the
   * destination type is EXPR_ANY, we can always assign (EXPR_ANY is only
   * used for runtime functions).
   */
  if (type1 == type2 || isanytype(type1))
	return(TRUE);

  /* Enumerations have to be exactly the same */
  if (isenum(type1) || isenum(type2))
	return(type1 == type2);

  /*
   * With pointers, each type the pointers point to have to be assignable.
   * A pointer with any type is always assignable.
   */
  if (ispointer(type1) && ispointer(type2)) {
	struct typesdef *bp1 = getptrbase(type1);
	struct typesdef *bp2 = getptrbase(type2);

	if (isanytype(bp2))
		return(TRUE);
	return(checkassign(bp1, bp2));
  }

  /*
   * With scalars, the types have to be the same, and the ranges must not
   * be disjunct.
   */
  if (isscalar(type1) && isscalar(type2) &&
      type1->type == type2->type &&
      type1->def.s.min < type2->def.s.max &&
      type1->def.s.max > type2->def.s.min)
	return(TRUE);

  /*
   * Strings are always possible regardless of sizes, because the runtime
   * module will care for the sizes and truncate if necessary.
   */
  if (isstring(type1) && isstring(type2))
	return(TRUE);

  /* In all other cases, assignment is not possible */
  return(FALSE);
}



/*
 *****************************************************************************
 *
 * Check if an expression is a valid variable with a given class
 */
static int checkvar __F((ep), struct expr *ep)
{
  varclass myclass;

  /* Check if we have a variable expression */
  if (ep == NULL || !isvariable(ep) ||
      ep->spec.var == NULL ||
      ep->spec.var->cmd != basevar ||
      ep->spec.var->spec.basesym == NULL ||
      (!isvarsym(ep->spec.var->spec.basesym) &&
       !isfuncsym(ep->spec.var->spec.basesym))) {
	error("variable expected", FALSE);
	return(FALSE);
  }

  /* Check for valid class */
  myclass = ep->spec.var->spec.basesym->def.v.class;
  if (myclass == CLASS_CONST) {
	error("cannot assign to variable declared constant", FALSE);
	return(FALSE);
  }
  if (myclass == CLASS_STATICRO) {
	error("cannot assign to variable declared read-only", FALSE);
	return(FALSE);
  }
  return(TRUE);
}



/*
 *****************************************************************************
 *
 * Check that an expression has the correct subexpressions for a function
 * or procedure call, and reorder the subexpressions correctly.
 */
static struct expr *setprocexpr __F((sp, ep),
				struct sym *sp AND
				struct expr *ep)
{
  struct expr *tmpexpr;
  int i, j, maketmp;

  if (!isfuncsym(sp))
	error("unknown procedure or function", FALSE);
  else if (sp->def.f.argnum == ep->exprnum) {
	/* Reverse the expression order */
	j = sp->def.f.argnum - 1;
	for (i = 0; i < (sp->def.f.argnum / 2); i++, j--) {
		tmpexpr = ep->exprlist[i];
		ep->exprlist[i] = ep->exprlist[j];
		ep->exprlist[j] = tmpexpr;
	}

	/* Reorganize all subtrees and check for correct arguments */
	for (i = 0; i < sp->def.f.argnum; i++) {
		varclass argclass = sp->def.f.args[i].class;
		struct typesdef *argtype = sp->def.f.args[i].t;
		struct expr *curarg;

		ep->exprlist[i] = curarg = reorg(ep->exprlist[i]);
		if (curarg == NULL)
			break;
		if (!checkassign(argtype, curarg->type)) {
			error("invalid type for argument in function call", FALSE);
			break;
		}
		if (isscalar(argtype) &&
		    isconst(curarg) &&
		    !isconstrange(curarg, argtype))
			warning("subclass range exceeded in function argument");

		/*
		 * It is not allowed to pass anything not a variable by variable
		 * reference (except for EXPR_ANY arguments).
		 */
		if (argclass == CLASS_REF &&
		    !isanytype(argtype) &&
		    !checkvar(curarg))
			break;

		/*
		 * We have to provide a temporary variable in the following
		 * cases:
		 *
		 *  1.) The parameter gets passed by value and is non-scalar
		 *  2.) The parameter gets passed by constant reference and is
		 *      not a variable and not a stored-constant
		 *  3.) The parameter gets passed by variable reference and is
		 *      not a variable and not a stored-constant for EXPR_ANY
		 *      arguments (these are only used by the runtime library)
		 *
		 * Note: stored-constants are those constants which are stored
		 * in the constant data area. This is true for all non-scalars,
		 * while scalars are usually kept in registers.
		 */
		maketmp =
			/* Handle case 1.) */
			(argclass == CLASS_LOCAL &&
			 isnonscalar(curarg->type)) ||

			/* Handle case 2.) */
			(argclass == CLASS_CONST &&
			 !(isvariable(curarg) ||
			   (isconst(curarg) &&
			    isnonscalar(curarg->type)))) ||

			/* Handle case 3.) */
			(argclass == CLASS_REF && isanytype(argtype) &&
			 !(isvariable(curarg) ||
			   (isconst(curarg) &&
			    isnonscalar(curarg->type))));
		if (maketmp) {
			tmpexpr = createtmpvar(sp->def.f.args[i].t,
							procstack[curlevel]);
			docmd(CODE_ASSIGN, NULL, tmpexpr, curarg);
			delexpr(curarg);
			ep->exprlist[i] = curarg = tmpexpr;
		}
	}

	/* If no error occurred, set the resulting expression correctly */
	if (i >= sp->def.f.argnum) {
		ep->type = sp->def.f.ret;
		ep->opcode = sp->def.f.opcode;
		ep->spec.func = sp;
		return (ep);
	}
  } else
	error("invalid number of arguments to function/procedure call", FALSE);

  /* In case of error delete all expression subtrees */
  delexpr(ep);
  return(NULL);
}



/*
 *****************************************************************************
 *
 * Generate an expression to call a runtime function
 */
static struct expr *genrtfunc __F((id, ep1, ep2, ep3),
				int id AND
				struct expr *ep1 AND
				struct expr *ep2 AND
				struct expr *ep3)
{
  int num;
  struct sym *sp = rtsymbols[id];
  struct expr *ep = newexpr();

  num = 0;
  ep->exprlist[0] = NULL;
  if (ep3 != NULL) {
	ep->exprlist[num++] = ep3;
	ep->exprlist[num] = NULL;
  }
  if (ep2 != NULL) {
	ep->exprlist[num++] = ep2;
	ep->exprlist[num] = NULL;
  }
  if (ep1 != NULL) {
	ep->exprlist[num++] = ep1;
	ep->exprlist[num] = NULL;
  }
  ep->exprnum = num;
  if ((ep = setprocexpr(sp, ep)) == NULL) {
	prnerr("invalid runtime function %s", sp->name);
	nbexit(EXIT_MGL_RUNTIME);
  }
  return(ep);
}



/*
 *****************************************************************************
 *
 * Generate an expression to access a runtime variable
 */
static struct expr *genrtvar __F((id), int id)
{
  struct sym *sp = rtsymbols[id];
  struct expr *ep = newexpr();
  struct varinfo *vp = newvarinfo();

#ifdef PARANOID
  if (!isvarsym(sp))
	interror(117, "invalid runtime variable");
#endif

  vp->cmd = basevar;
  vp->vartype = sp->def.v.t;
  vp->spec.basesym = sp;
  vp->next = NULL;
  ep->opcode = CMD_VAR;
  ep->exprnum = 0;
  ep->type = sp->def.v.t;
  ep->spec.var = vp;
  return(ep);
}

