Repatch (from linux) of OSX IRAF

1 files changed, 2108 insertions, 0 deletions

diff --git a/pkg/vocl/grammar.y b/pkg/vocl/grammar.y
new file mode 100644
index 00000000..b6c56656
--- /dev/null
+++ b/pkg/vocl/grammar.y
@@ -0,0 +1,2108 @@
+%{
+
+#define import_spp
+#define import_libc
+#define import_stdio
+#define import_ctype
+#include <iraf.h>
+
+#include "config.h"
+#include "mem.h"
+#include "operand.h"
+#include "param.h"
+#include "grammar.h"
+#include "opcodes.h"
+#include "clmodes.h"
+#include "task.h"
+#include "construct.h"
+#include "errs.h"
+
+
+/* CL parser, written as a yacc grammar:
+ *   build up an (rpn) instruction sequence begining at the base of the
+ *   operand stack as the grammar is recognized.
+ *
+ * The parser may be called during parameter initialization (initiated by
+ * the CALL meta-code instruction), and to parse the executable portion
+ * (from the EXEC instruction).
+ *
+ * CONSTANT's are put on the dictionary by addconst() rather than the operand
+ *   stack to avoid conflict with the code being created.  They are accessed
+ *   by using the yylval of IDENT and CONSTANT as dictionary indices that
+ *   point to struct operands.  This is facilitated with the stkop() macro.
+ *   Make sure that topd and topcs are restored on return to discard these
+ *   temporaries.
+ * When building offsets for branches, such as BIFF and GOTO, allow
+ *   for the advancement of the pc by the size of the instruction (in ints).
+ *   See opcodes.c for the code executed by the branch instructions.
+ */
+
+extern	int cldebug;
+#define	lint			/* turns off sccsid in Yacc parser	*/
+
+/* shorthand way to get at operands in dictionary. x will be values returned
+ * from addconst() by way of $n's from CONSTANT and IDENT tokens; see gram.c
+ * and its uses in grammar.l. also see pushop() for a description of the stack.
+ */
+#define	stkop(x)	(reference (operand, (x)))
+
+int	dobkg 		= 0;	/* set when want to do code in bkground	*/
+int	npipes 		= 0;	/* number of pipes in a command		*/
+XINT	pipe_pc		= 0;	/* pc of last ADDPIPE instruction	*/
+int	posit 		= 0;	/* positional argument count		*/
+int	inarglist 	= 0;	/* set when in argument list		*/
+int	parenlevel 	= 0;	/* level of paren nesting in command	*/
+int 	in_iferr 	= 0;	/* in an iferr block			*/
+int	cl_level	= 0;	/* CL calling level			*/
+
+int	index_cnt;		/* Index counter in array ref's		*/
+char	curr_param[SZ_FNAME];	/* Parameter name of ref's		*/
+char	curr_task[SZ_FNAME];	/* ltaskname of command 		*/
+XINT	stmt_pc;		/* PC at beginning of current statement */
+int	varlist;		/* Declaration is list directed.	*/
+int	vartype;		/* Type of declaration.			*/
+int	do_params;		/* Are param definitions legal here?	*/
+int	errcnt;			/* Syntax error count.			*/
+int	inited;			/* Was variable already initialized.	*/
+struct	param *pp;		/* Pointer to param being compiled.	*/
+int	n_aval;			/* Number of array init values.		*/
+int	lastref;		/* Was last ref an array?		*/
+int	for_expr;		/* Was there an expression in FOR?	*/
+char	*ifseen;		/* Have we just processed an IF?	*/
+char	*errmsg;		/* Syntax error message.		*/
+
+/* context-sensitive switches. technique is ok, but beware of nesting!
+ */
+static	int absmode 	= 0;	/* set by first absolute mode arg in cmd*/
+static	int newstdout 	= 0;	/* set if stdout redirected in arg	*/
+static	int bracelevel 	= 0;	/* set while in s_list to inhibit &	*/
+static	int tbrace 	= 0;	/* fake braces for declarations		*/
+static	int dobrace 	= 0;	/* handling braces.			*/
+static	int sawnl 	= 0;	/* set when EOST was \n, else 0		*/
+static	int printstmt 	= 0;	/* set when parsing FPRINT statement	*/
+static	int scanstmt 	= 0;	/* set when parsing SCAN statement	*/
+static	int iferr_tok 	= 0;	/* iferr/ifnoerr token type seen	*/
+
+/* printf-format error messages.
+ */
+char *arrdeferr   = "Error in array initialization for `%s'.";
+char *badparm     = "Parameter definition of `%s' is illegal here.";
+char *inval_arr   = "Invalid array type for `%s'.";
+char *inv_index   = "Invalid index definition for `%s'.";
+char *twoinits    = "Two initializations for parameter `%s'.";
+
+char *exlimits    = "Explicit range required for loop in external param.";
+char *illegalvar  = "Illegal variable declarations.";
+char *locallist   = "Local list variables are not permitted.";
+char *nestediferr = "Nested iferr not allowed in test or handler block.";
+char *posfirst    = "All positional arguments must be first";
+
+
+extern	char	cmdblk[SZ_CMDBLK+1];	/* Command buffer in history.c */
+extern	char	*ip_cmdblk;		/* Pointer to current char in command.*/
+extern	char	*err_cmdblk;		/* ip_cmdblk when error detected. */
+
+char	*index();
+struct	param *initparam();
+struct	label *getlabel(), *setlabel();
+
+/* arbitrary large number for bracelevel in a procedure script 
+ */
+#define MAX_ERR    10
+#define EYYERROR  { err_cmdblk = ip_cmdblk; YYERROR; }
+
+%}
+
+%token	Y_SCAN Y_SCANF Y_FSCAN Y_FSCANF Y_OSESC 
+%token	Y_APPEND Y_ALLAPPEND Y_ALLREDIR Y_GSREDIR Y_ALLPIPE
+%token	D_D D_PEEK
+%token	Y_NEWLINE Y_CONSTANT Y_IDENT
+%token	Y_WHILE Y_IF Y_ELSE
+%token  Y_FOR Y_BREAK Y_NEXT
+%token  Y_SWITCH Y_CASE Y_DEFAULT
+%token	Y_RETURN Y_GOTO
+%token	Y_PROCEDURE Y_BEGIN Y_END 
+%token	Y_BOOL Y_INT Y_REAL Y_STRING Y_FILE Y_STRUCT
+%token	Y_GCUR Y_IMCUR Y_UKEY Y_PSET
+%token	Y_IFERR Y_IFNOERR Y_THEN
+
+%right	'=' YOP_AOADD YOP_AOSUB YOP_AOMUL YOP_AODIV YOP_AOCAT
+%left	YOP_OR
+%left	YOP_AND
+%left	YOP_EQ YOP_NE 
+%left	'<' '>' YOP_LE YOP_GE
+%left	YOP_CONCAT
+%left	'+' '-'
+%left	'*' '/' '%'
+%left	YOP_NOT UMINUS		/* supplies precedence for unary minus	*/
+%left	YOP_POW
+
+%start	block
+
+%%
+
+block	:	/* empty */ {
+		    /* Done once on entry but after at least one call to
+		     * yylex().  Good for initing parser flags.
+		     * Note: this does not get called in procedure scripts.
+		     */
+		    if (cldebug)
+			eprintf ("parse init (block)...\n");
+
+		    errcnt     = 0;
+		    err_cmdblk = 0;
+		    dobkg      = 0;
+		    inarglist  = 0;
+		    parenlevel = 0;
+		    bracelevel = 0;
+		    tbrace     = 0;
+		    dobrace    = 0;
+		    in_iferr   = 0;
+		    do_params  = YES;
+		    last_parm  = NULL;
+		    ifseen     = NULL;
+		    label1     = NULL;
+		    errmsg     = NULL;
+		    parse_pfile= currentask->t_pfp;
+		}
+
+	|	'.' NL {
+		    /* Prepare to rerun whatever was compiled last.
+		     * Does not work for the debug commands builtin here.
+		     */
+		    if (parse_state != PARSE_FREE) {
+			errmsg = "Illegal parser state.";
+			EYYERROR;
+		    }
+		    rerun();
+		    YYACCEPT;
+		}
+
+	|	block {
+		    if (parse_state == PARSE_PARAMS) {
+			errmsg = "Illegal parser state.";
+			EYYERROR;
+		    }
+		}
+		debug xstmt {
+		    if (sawnl && bracelevel == 0) {
+			if (!errcnt)
+			    compile (END);
+			if (ifseen) {
+			    /* Simulate an unput of what has been read
+			     * from the current line.
+			     */
+			    ip_cmdblk = ifseen;
+			}
+			YYACCEPT;
+		    }
+		}
+
+	|	script_params {
+		    /* Parse the parameters in a script file.  This will
+		     * normally be done on a call by pfileread().
+		     */
+		    if (parse_state != PARSE_PARAMS) {
+			eprintf ("Illegal parser state.\n");
+			errcnt++;
+		    }
+		    YYACCEPT;
+		}
+
+	|	script_body {
+		    /* Parse the executable statements in a script.
+		     */
+		    if (parse_state != PARSE_BODY) {
+			eprintf ("Illegal parser state.\n");
+			errcnt++;
+		    }
+		    if (!errcnt)
+			compile (END);
+		    YYACCEPT;
+		}
+
+	|	error NL {
+		    /* This catches errors that the two other error lines
+		     * can't get, e.g. a missing `}' at the end of a script, 
+		     * or errors occuring in interactive input.
+		     */
+		    yyerrok;
+
+		    /* Discard everything and compile a null statement.
+		     */
+		    if (!errcnt) {
+			do_params = YES;
+			pc = currentask->t_bascode;
+			if (parse_state != PARSE_PARAMS)
+			    compile (END);
+
+			topd = currentask->t_topd;
+			topcs = currentask->t_topcs;
+
+			/* Unlink any added parms.  Resetting of topd will
+			 * already have reclaimed space.
+			 */
+			if (last_parm) {
+			    last_parm->p_np = NULL;
+			    currentask->t_pfp->pf_lastpp = last_parm;
+			    last_parm = NULL;
+			}
+	 	    }
+
+		    /* Print cmdblk and show position of error.
+		     */
+		    p_position();
+		    if (currentask->t_flags & T_SCRIPT) 
+			cl_error (E_UERR, "syntax error, line %d",
+			    currentask->t_scriptln);
+		    else
+			cl_error (E_UERR, "syntax error");
+
+		    YYACCEPT;
+		}
+	;
+
+debug	:	/* empty */
+	|	D_XXX EOST {
+		    /* debug are those debugging functions that
+		     * should be run directly and not through a
+		     * builtin task due to stack or other changes,
+		     * ie, don't change what we are trying to show.
+		     */
+		    printf ("\n");
+		} debug
+	;
+
+D_XXX	:	D_D {
+		    d_d(); /* show dictionary/stack pointers */
+		}
+	|	D_PEEK Y_CONSTANT { /* show a dictionary location	*/
+		    if (stkop($2)->o_type & OT_INT) {
+			int	idx;
+			idx = stkop($2)->o_val.v_i;
+			eprintf ("%d:\t%d (0%o)\n", idx, stack[idx],
+				stack[idx]);
+		    } else
+			eprintf ("usage: D_PEEK <d. index>\n");
+		}
+	|	'~' {
+		    d_stack (pc, 0, 0);		/* show compiled code	*/
+		}
+	;
+
+script_params :	proc_stmt
+		var_decls
+		begin_stmt { 
+			/* Check for required params.
+			 */
+			if (!errcnt)
+			    proc_params(n_procpar);
+		}
+	;
+
+script_body:	begin_stmt {
+			/* Initialize parser for procedure body.
+			 */
+			if (cldebug)
+			    eprintf ("parse init (script_body)...\n");
+
+			errcnt     = 0;
+			err_cmdblk = 0;
+			dobkg      = 0;
+			inarglist  = 0;
+			parenlevel = 0;
+		        in_iferr   = 0;
+			dobrace    = 0;
+			bracelevel = PBRACE; /* disable lexmodes; force "end" */
+			tbrace     = 0;
+ 			do_params  = NO;
+			last_parm  = NULL;
+			ifseen     = NULL;
+			label1     = NULL;
+			parse_pfile= currentask->t_pfp;
+		}
+		s_list
+		opnl
+		end_stmt
+	;
+
+proc_stmt:	Y_PROCEDURE {  
+			/* Initialize parser for procedure parameters.
+			 */
+			if (cldebug)
+			    eprintf ("parse init (proc_stmt)...\n");
+
+			errcnt     = 0;
+			err_cmdblk = 0;
+			dobkg      = 0;
+			inarglist  = 0;
+			parenlevel = 0;
+			bracelevel = PBRACE;
+			tbrace     = 0;
+		        dobrace    = 0;
+		        in_iferr   = 0;
+			do_params  = YES;
+		        last_parm  = NULL;
+			label1     = NULL;
+		}
+		param bparam_list EOST
+	;
+
+bparam_list:	/* Nothing at all, not even parens. */
+		{
+		    n_procpar = 0;
+		}
+	|	LP param_list RP
+	;
+
+/* The definition of the parameter list excludes lists of the 
+ * form  a,,b
+ */
+param_list:	/* empty */ {
+		    n_procpar = 0;
+		}
+	|	xparam_list
+	;
+
+xparam_list:	param { 
+		    n_procpar = 1;
+		    if (!errcnt)
+			push (stkop($1));
+		}
+	|	xparam_list DELIM param {
+		    n_procpar++;
+		    if (!errcnt)
+			push (stkop($3));
+		}
+	;
+
+var_decls:	/* No params. */
+	|	var_decl_block
+	;
+
+var_decl_block:	var_decl_line
+	|	var_decl_block var_decl_line
+	;
+
+var_decl_line:	EOST	/* Blank. */
+	|	var_decl_stmt
+	|	error NL {
+		    /* This catches errors in the parameter declarations
+		     * of a procedure script.
+		     */
+		    yyerrok;
+
+		    /* Discard everything and compile a null statement.
+		     */
+		    if (!errcnt) {
+			do_params = YES;
+			pc = currentask->t_bascode;
+			if (parse_state != PARSE_PARAMS)
+			    compile (END);
+
+			topd = currentask->t_topd;
+			topcs = currentask->t_topcs;
+
+			/* Unlink any added parms.  Resetting of topd will
+			 * already have reclaimed space.
+			 */
+			if (last_parm) {
+			    last_parm->p_np = NULL;
+			    currentask->t_pfp->pf_lastpp = last_parm;
+			    last_parm = NULL;
+			}
+	 	    }
+
+		    /* Print cmdblk and show position of error.  We know
+		     * we're parsing a procedure script, so print the line
+		     * number too.
+		     */
+		    p_position();
+		    cl_error (E_UERR, "syntax error, line %d", 
+			currentask->t_scriptln);
+		}
+	;
+
+var_decl_stmt:	typedefs {
+	 	        /* For in-line definitions we don't want
+			 * to freeze stuff on the dictionary, so
+			 * only allow additions if the dictionary
+			 * is the same as at the beginning of the task.
+			 */
+			if (!errcnt) {
+			    if (parse_state != PARSE_PARAMS) {
+				if (currentask->t_topd != topd)
+				    cl_error (E_UERR, illegalvar);
+				last_parm = currentask->t_pfp->pf_lastpp;
+			    }
+			}
+
+		        /* Increment bracelevel temporarily to defeat command
+			 * mode, in case this is an in-line declaration and
+			 * lexmodes=yes.
+			 */
+			bracelevel += PBRACE;
+			tbrace++;
+
+		} var_decl_list EOST {
+		      	/* Update dictionary to include these definitions.
+			 */
+			if (!errcnt) {
+			    if (parse_state != PARSE_PARAMS) {
+				currentask->t_topd = topd;
+				last_parm = 0;
+			    }
+			}
+
+			/* Restore command mode */
+			bracelevel -= PBRACE;
+			tbrace--;
+		}
+	;
+
+typedefs:	Y_BOOL		{ vartype = V_BOOL; }
+	|	Y_STRING	{ vartype = V_STRING; }
+	|	Y_REAL		{ vartype = V_REAL; }
+	|	Y_FILE		{ vartype = V_FILE; }
+	|	Y_GCUR		{ vartype = V_GCUR; }
+	|	Y_IMCUR		{ vartype = V_IMCUR; }
+	|	Y_UKEY		{ vartype = V_UKEY; }
+	|	Y_PSET		{ vartype = V_PSET; }
+	|	Y_INT		{ vartype = V_INT; }
+	|	Y_STRUCT	{ vartype = V_STRUCT; }
+	;
+
+var_decl_list:	var_decl_plus
+	|	var_decl_plus DELIM var_decl_list
+	;
+
+var_decl_plus:	var_decl {
+			if (!errcnt) {
+			    if (pp != NULL) {
+				if (n_aval > 1)
+				    pp->p_type |= PT_ARRAY;
+
+				if (pp->p_type & PT_ARRAY)
+				    do_arrayinit (pp, n_aval, index_cnt);
+		      		else
+		 		    do_scalarinit (pp, inited);
+			    }
+			}
+		}
+
+		/* Semi-colon in following rule is not input by user, but
+		 * rather by lexical analyzer to help close compound
+		 * statements.
+		 */
+	|	var_decl '{' options_list ';' '}'  {
+			if (!errcnt) {
+			    if (pp != NULL) {
+				if (!do_params)
+				    cl_error (E_UERR, badparm, pp->p_name);
+
+				if (n_aval > 1)
+				    pp->p_type |= PT_ARRAY;
+
+				if (pp->p_type & PT_ARRAY)
+				    do_arrayinit (pp, n_aval, index_cnt);
+		      		else
+		 		    do_scalarinit (pp, n_aval);
+			    }
+			}
+		}
+	;
+
+var_decl:	var_def {
+			inited = NO;
+			n_aval = 0;
+		}
+	|	var_def '=' {
+			n_aval = 0;
+		}
+		init_list {
+			inited = YES;
+		}
+	;
+
+var_def	:	var_name {
+		    index_cnt = 0;
+		    if (!errcnt)
+			pp = initparam (stkop($1), do_params, vartype, varlist);
+		}
+	|	var_name {
+		    int  itemp;
+
+		    if (!errcnt) {
+			pp = initparam (stkop($1), do_params, vartype, varlist);
+
+			if (pp != NULL) {
+			    itemp = (pp->p_type & OT_BASIC) == pp->p_type;
+			    itemp = itemp && !varlist;
+			    if (itemp)
+				pp->p_type |= PT_ARRAY;
+			    else
+				cl_error (E_UERR, inval_arr, pp->p_name);
+			}
+		    }
+		}
+		'[' init_index_list ']'
+	;
+
+var_name:	param {
+			varlist = NO;
+			index_cnt = 0;
+		}
+	|	'*' param {
+			if (!do_params) {
+			    errmsg = locallist;
+			    EYYERROR;
+			}
+			varlist = YES;
+			index_cnt = 0;
+			$$ = $2;
+		}
+	;
+
+init_index_list:
+		/* A null index list means get the length of the array 
+		 * from the initializer.
+		 */
+	|	init_index_range
+	|	init_index_list DELIM init_index_range
+	;
+
+init_index_range:
+		const {
+		    if (!errcnt) {
+			if (pp != NULL) {
+			    if (stkop($1)->o_type == OT_INT) {
+				push (stkop($1)->o_val.v_i);
+				push (1);
+			    } else if (maybeindex) {
+				/* Confusion between sexagesimal and index
+				 * range.  Maybeindex is set only when operand
+				 * is real.
+			 	 */
+				int  i1,i2;
+				sexa_to_index (stkop($1)->o_val.v_r, &i1, &i2);
+				push (i2-i1+1);
+				push (i1);
+			    } else {
+				eprintf (inv_index, pp->p_name);
+				EYYERROR;
+			    }
+			    index_cnt++;
+			}
+		    }
+		}
+	|	const ':' const {
+			if (!errcnt) {
+			    if (pp != NULL) {
+				if (stkop($1)->o_type != OT_INT  ||
+				    stkop($3)->o_type != OT_INT)
+				    cl_error (E_UERR, inv_index, pp->p_name);
+				else {
+				    push (stkop($3)->o_val.v_i -
+				          stkop($1)->o_val.v_i + 1);
+				    push (stkop($1)->o_val.v_i);
+			        }
+			        index_cnt++;
+			    }
+			}
+		}
+	;
+
+init_list:	init_elem
+	|	init_list DELIM	init_elem
+	;
+
+init_elem:	const {
+			if (!errcnt) {
+			    if (pp != NULL) {
+				push (stkop($1) );
+				n_aval++;
+			    }
+			}
+		}
+	|	Y_CONSTANT LP const RP  /* PL/I notation. */
+		{
+			int   cnt;
+			
+			if (!errcnt)
+			    if (pp != NULL) {
+			    	if (stkop($1)->o_type != OT_INT)
+				    cl_error (E_UERR, arrdeferr, pp->p_name);
+
+			        cnt = stkop($1)->o_val.v_i;
+			        if (cnt <= 0)
+				    cl_error (E_UERR, arrdeferr, pp->p_name);
+
+			        while (cnt-- > 0) {
+				    push (stkop($3));
+				    n_aval++;
+			        }
+			    }
+		}
+	;
+
+const	:	Y_CONSTANT
+	|	number
+	;
+
+/* The parser and lexical analyzer don't see negative numbers as an
+ * entity.  So we must join signs to their constants.
+ */
+number	:	sign Y_CONSTANT {
+		      	if (stkop($2)->o_type == OT_INT) {
+			    stkop($2)->o_val.v_i *= $1;
+			    $$ = $2;
+			} else if (stkop($2)->o_type == OT_REAL) {
+			    stkop($2)->o_val.v_r *= $1;
+			    $$ = $2;
+			} else {
+			    errmsg = "Invalid constant in declaration.";
+			    EYYERROR;
+			}
+		}
+	;
+
+sign	:	'+'	{ $$ =  1; }
+	|	'-'	{ $$ = -1; }
+
+options_list:	init_list DELIM options {
+			/* Check if we already had an initialization. 
+			 */
+		      	if (!errcnt) {
+			    if (inited && pp != NULL) {
+				eprintf (twoinits, pp->p_name);
+				EYYERROR;
+			    }
+			}
+		}
+	|	init_list {
+		      	if (!errcnt) {
+			    if (inited && pp != NULL) {
+			        eprintf (twoinits, pp->p_name);
+				EYYERROR;
+			    }
+			}
+		}
+	|	options
+	;
+
+options	:	option
+	|	options DELIM option
+	;
+
+option	:	Y_IDENT '=' const {
+			if (!errcnt)
+			    if (pp != NULL)
+			    	do_option (pp, stkop($1), stkop($3));
+		}
+	;
+
+begin_stmt:	Y_BEGIN NL
+	;
+
+/* In normal expressions, a param means the name of a parameter, but in
+ * command line arguments, it may be a string constant.  Pull out param
+ * from expr to let the arg rule deal with it specially.
+ */
+
+expr	:	expr0
+	|	ref {
+		    if (!errcnt)
+		        compile (PUSHPARAM, stkop($1)->o_val.v_s);
+		}
+	;
+
+/* EXPR0 is everything but a simple parameter.  This is needed for argument
+ * lists so that a simple parameter may be treated as a special case of a
+ * string constant.  EXPR1 also excludes constants.  This is needed
+ * to eliminate ambiguities in the grammar which would arise from
+ * the handling of the lexical ambiguity of sexagesimal constants
+ * and array index ranges.
+ */
+expr0	:	expr1
+	|	Y_CONSTANT {
+		    if  (!errcnt)
+		        compile (PUSHCONST, stkop($1));
+		}
+	|	Y_GCUR {
+		    /* "gcur" is both a keyword and a CL global parameter,
+		     * and must be built into the grammar here to permit
+		     * reference of the parameter in expressions.
+		     */
+		    if (!errcnt)
+			compile (PUSHPARAM, "gcur");
+		}
+	|	Y_IMCUR {
+		    if (!errcnt)
+			compile (PUSHPARAM, "imcur");
+		}
+	|	Y_UKEY {
+		    if (!errcnt)
+			compile (PUSHPARAM, "ukey");
+		}
+	|	Y_PSET {
+		    if (!errcnt)
+			compile (PUSHPARAM, "pset");
+		}
+	;
+
+expr1	:	LP expr RP
+
+	|	expr '+' opnl expr {
+		    if (!errcnt)
+			compile (ADD);
+		}
+	|	expr '-' opnl expr {
+		    if (!errcnt)
+			compile (SUB);
+		}
+	|	expr '*' opnl expr {
+		    if (!errcnt)
+			compile (MUL);
+		}
+	|	expr '/' opnl expr {
+		    if (!errcnt)
+			compile (DIV);
+		}
+	|	expr YOP_POW opnl expr {
+		    if (!errcnt)
+			compile (POW);
+		}
+	|	expr '%' opnl expr {
+		    struct	operand o;
+		    if (!errcnt) {
+			o.o_type = OT_INT;
+			o.o_val.v_i = 2;
+			compile (PUSHCONST, &o);
+			compile (INTRINSIC, "mod");
+		    }
+		}
+	|	expr YOP_CONCAT opnl expr {
+		    if (!errcnt)
+			compile (CONCAT);
+		}
+	|	expr '<' opnl expr {
+		    if (!errcnt)
+			compile (LT);
+		}
+	|	expr '>' opnl expr {
+		    if (!errcnt)
+			compile (GT);
+		}
+	|	expr YOP_LE opnl expr {
+		    if (!errcnt)
+			compile (LE);
+		}
+	|	expr YOP_GE opnl expr {
+		    if (!errcnt)
+			compile (GE);
+		}
+	|	expr YOP_EQ opnl expr {
+		    if (!errcnt)
+			compile (EQ);
+		}
+	|	expr YOP_NE opnl expr {
+		    if (!errcnt)
+			compile (NE);
+		}
+	|	expr YOP_OR opnl expr {
+		    if (!errcnt)
+			compile (OR);
+		}
+	|	expr YOP_AND opnl expr {
+		    if (!errcnt)
+			compile (AND);
+		}
+	|	YOP_NOT expr {
+		    if (!errcnt)
+			compile (NOT);
+		}
+	|	'-' expr %prec UMINUS {
+		    if (!errcnt)
+			compile (CHSIGN);
+		}
+
+	|	Y_SCAN LP {
+		    /* Free format scan. */
+		    if (!errcnt)
+			push (0);	/* use control stack to count args */
+		} scanarg RP {
+		    if (!errcnt) {
+			struct	operand o;
+			o.o_type = OT_INT;
+		        o.o_val.v_i = pop();	/* get total number of args*/
+			compile (PUSHCONST, &o);
+			compile (SCAN);
+		    }
+		}
+	|	Y_SCANF LP {
+		    /* Formatted scan. */
+		    if (!errcnt)
+			push (0);	/* use control stack to count args */
+		} scanfmt DELIM scanarg RP {
+		    if (!errcnt) {
+			struct	operand o;
+
+			/* Compile number of arguments. */
+			o.o_type = OT_INT;
+		        o.o_val.v_i = pop();
+			compile (PUSHCONST, &o);
+
+			compile (SCANF);
+		    }
+		}
+
+	|	Y_FSCAN LP {
+		    /* Free format scan from a parameter.  */
+		    if (!errcnt)
+			push (0);	/* use control stack to count args */
+		} scanarg RP {
+		    if (!errcnt) {
+			struct	operand o;
+			o.o_type = OT_INT;
+			o.o_val.v_i = pop();	/* get total number of args*/
+			compile (PUSHCONST, &o);
+			compile (FSCAN);
+		    }
+		}
+
+	|	Y_FSCANF LP Y_IDENT DELIM {
+		    /* Formatted scan from a parameter.
+		     * fscanf (param, format, arg1, ...)
+		     */
+		    if (!errcnt) {
+			compile (PUSHCONST, stkop ($3));
+		        push (1);	/* use control stack to count args */
+		    }
+		} scanfmt DELIM scanarg RP {
+		    if (!errcnt) {
+			struct	operand o;
+
+			/* Compile number of arguments. */
+			o.o_type = OT_INT;
+			o.o_val.v_i = pop();
+			compile (PUSHCONST, &o);
+
+			compile (FSCANF);
+		    }
+		}
+
+	|	intrinsx LP {
+		    if (!errcnt)
+			push (0);	/* use control stack to count args */
+		} intrarg RP {
+		    if (!errcnt) {
+			struct	operand o;
+			o.o_type = OT_INT;
+			o.o_val.v_i = pop();
+			compile (PUSHCONST, &o);
+			compile (INTRINSIC, stkop($1)->o_val.v_s);
+		    }
+		}
+	;
+
+/* Variable types are keywords, so any types which are also intrinsic
+ * functions are added here.
+ */
+intrinsx:	intrins
+	|	Y_INT {
+			/* The YACC value of this must match normal intrinsics
+			 * so we must generate an operand with the proper
+			 * string. 
+			 */
+			if (!errcnt)
+			    $$ = addconst ("int", OT_STRING);
+		}
+	|	Y_REAL {
+			if (!errcnt)
+			    $$ = addconst ("real", OT_STRING);
+		}
+	;
+
+scanfmt	:	expr {
+		    if (!errcnt) {
+		        push (pop() + 1);		/* inc num args	*/
+		    }
+		}
+	;
+
+scanarg	:	/* empty.  This is bad for scan but we don't want to
+		 * generate a cryptic syntax error.  See also intrarg.
+		 * This rule reduces the strings from right to left.
+		 * Note the lexical analyzer strips optional newlines
+		 * after comma delimiters, so we don't need an opnl here.
+		 */
+	|	Y_IDENT {
+                    if (!errcnt) {
+                        compile (PUSHCONST, stkop ($1));
+                        push (pop() + 1);               /* inc num args */
+                    }
+		}
+	|	Y_IDENT DELIM scanarg {
+                    if (!errcnt) {
+                        compile (PUSHCONST, stkop ($1));
+                        push (pop() + 1);               /* inc num args */
+                    }
+		}
+	;
+
+intrarg	:	/* empty. this is to allow () but it also allows
+		 * (x,,x). may want to prune this out.
+		 */
+	|	expr {
+		    if (!errcnt)
+			push (pop() + 1);		/* inc num args	*/
+		}
+	|	intrarg DELIM expr {
+		    if (!errcnt)
+			push (pop() + 1);		/* inc num args	*/
+		}
+	;
+
+
+/* Statements. */
+
+stmt	:	c_stmt
+	|	assign	EOST
+	|	cmdlist EOST
+	|	immed	EOST
+	|	inspect	EOST
+	|	osesc	EOST
+	|	popstk	EOST
+	|	if
+	|	ifelse
+	|	iferr
+	|	iferr_else
+	|	while
+	|	for
+	|	switch
+	|	case
+	|	default
+	|	next	EOST
+	|	break	EOST
+	|	goto	EOST
+	|	return	EOST
+	|	label_stmt
+	|	nullstmt
+	;
+
+		/* A compound statement may be followed by zero or one 
+		 * newlines.
+		 */
+c_stmt	:	c_blk
+	|	c_blk NL
+	;
+
+c_blk	:	'{' {
+		    bracelevel++;
+		} s_list opnl {
+		    --bracelevel;
+		} '}'
+	;
+
+s_list	:	/* empty */
+	|	s_list opnl xstmt
+	;
+
+/* Put "implicit" parentheses around right hand side of assignments to
+ * permit easy arithmetic even with lexmodes=yes.
+ */
+assign	:	ref equals expr0 {
+			--parenlevel;
+ 			if (!errcnt)
+		      	    compile (ASSIGN, stkop($1)->o_val.v_s);
+		}
+	|	ref equals ref {
+			/* Old code pushed a constant rather than a param
+			 * when not within braces.  This doesn't seem
+			 * to be what most people want.
+			 */
+			--parenlevel;
+			if (!errcnt) {
+			    compile (PUSHPARAM, stkop($3)->o_val.v_s);
+		            compile (ASSIGN, stkop($1)->o_val.v_s);
+		    	}
+		}
+	|	ref {
+			parenlevel++;
+		}
+		assign_oper expr {
+		      	--parenlevel;
+			if (!errcnt)
+		  	    compile ($3, stkop($1)->o_val.v_s);
+		}
+	;
+
+	/* Breaking out the '=' avoids grammar ambiguities.
+	 */
+equals	:	'=' {
+			parenlevel++;
+		}
+	;
+
+assign_oper:	YOP_AOADD 	{ $$ = ADDASSIGN; }
+	|	YOP_AOSUB 	{ $$ = SUBASSIGN; }
+	|	YOP_AOMUL 	{ $$ = MULASSIGN; }
+	|	YOP_AODIV 	{ $$ = DIVASSIGN; }	
+	|	YOP_AOCAT 	{ $$ = CATASSIGN; }	
+	;
+
+cmdlist	:	command {
+		    npipes = 0;
+		} cmdpipe {
+		    if (!errcnt) {
+			compile (EXEC);
+			if (npipes > 0)
+			    compile (RMPIPES, npipes);
+		    }
+		}
+	;
+
+cmdpipe	:	/* empty */
+	|	cmdpipe pipe {
+		    /* Pipefiles must be allocated at run time using a stack
+		     * to permit pipe commands within loops, and to permit
+		     * scripts called in a pipe to themselves contain pipe
+		     * commands.  ADDPIPE allocates a new pipefile on the
+		     * pipe stack and pushes its name on the operand stack.
+		     * GETPIPE pushes the pipefile at the top of the pipe
+		     * stack onto the operand stack.  RMPIPES removes N pipes
+		     * from the pipe stack, and deletes the physical pipefiles.
+		     */
+
+		    if (!newstdout) {
+			/* When the runtime code creates the pipe it needs to
+			 * know the identity of the two tasks sharing the pipe
+			 * to determine what type of pipe to create (text or
+			 * binary).  Save the pc of the ADDPIPE instruction
+			 * so that we can backpatch it below with a pointer to
+			 * the name of the second task in the pipe (ADDPIPE
+			 * will be called during startup of the first task
+			 * hence will know its name).
+			 */
+			pipe_pc = compile (ADDPIPE, NULL);
+
+			if ($2 == 1)
+			    compile (REDIR);
+			else
+			    compile (ALLREDIR);
+			compile (EXEC);
+
+		    } else {
+			eprintf ("multiple redirection\n");
+			YYERROR;
+		    }
+
+		} command {
+		    /* Compile the GETPIPE instruction with the name of the
+		     * second task in the current pipe, and backpatch the
+		     * matching ADDPIPE instruction with the PC of the GETPIPE.
+		     */
+		    (coderef(pipe_pc))->c_args = compile (GETPIPE, curr_task);
+		    compile (REDIRIN);
+		    npipes++;		/* Overflow checking is in ADDPIPE */
+		}
+	;
+
+pipe	:	'|' opnl {
+		    $$ = 1;
+		}
+	|	Y_ALLPIPE opnl {
+		    $$ = 2;
+		}
+	;
+
+command	:	tasknam {
+		    char    *ltname;
+
+		    ltname = stkop($1)->o_val.v_s;
+		    compile (CALL, ltname);
+		    strcpy (curr_task, ltname);
+
+		    /* The FPRINT task is special; the first arg
+		     * is the destination and must be compiled as
+		     * a string constant no matter what.  Set flag
+		     * so that 'arg' compiles PUSHCONST.
+		     */
+		    printstmt = (strcmp (ltname, "fprint") == 0);
+
+		    /* Ditto with SCAN; all the arguments are call by
+		     * reference and must be compiled as string constants.
+		     */
+		    scanstmt = (strcmp (ltname, "scan") == 0 ||
+				strcmp (ltname, "scanf") == 0);
+
+		    absmode = 0;
+		    posit = 0;
+		    newstdout = 0;
+		    parenlevel = 0;
+		} BARG {
+		    inarglist = 1;
+		} args EARG {
+		    extern char *onerr_handler;
+
+		    inarglist = 0;
+		    parenlevel = 0;
+		    scanstmt = 0;
+		}
+	;
+
+args	:	DELIM {
+		    /* (,x) equates to nargs == 2.  Call posargset with
+		     * negative dummy argument to bump nargs.
+		     */
+		    if (!errcnt) {
+			compile (POSARGSET, -1);
+			posit++;
+			printstmt = 0;
+			scanstmt = 0;
+		    }
+		} arglist	
+	|	arglist
+	;
+
+arglist	:	arg 
+	|	arglist DELIM arg
+	;
+
+arg	:	/* nothing - compile a null posargset to bump nargs */
+		{
+		    if (!errcnt) {
+			if (posit > 0) {		/* not first time */
+			    compile (POSARGSET, -posit);
+			    printstmt = 0;
+			    scanstmt = 0;
+			}
+			posit++;
+		    }
+		}
+	|	expr0 {
+		    if (absmode) {
+			errmsg = posfirst;
+			EYYERROR;
+		    } else
+			if (!errcnt)
+			    compile (POSARGSET, posit++);
+		}
+	|	ref {
+		    if (absmode) {
+			errmsg = posfirst;
+			EYYERROR;
+		    } else if (!errcnt) {
+			if (scanstmt) {
+			    char    pname[SZ_FNAME];
+			    char    *pk, *t, *p, *f;
+			    struct  pfile *pfp;
+			    struct  operand o;
+
+			    /* If no task name specified check the pfile for
+			     * the task containing the scan statement for the
+			     * named parameter.
+			     */
+			    breakout (stkop($1)->o_val.v_s, &pk, &t, &p, &f);
+			    pfp = currentask->t_pfp;
+			    if (*pk == NULL && *t == NULL &&
+				pfp && paramfind(pfp,p,0,1)) {
+
+				sprintf (pname, "%s.%s",
+				    currentask->t_ltp->lt_lname, p);
+				if (*f) {
+				    strcat (pname, ".");
+				    strcat (pname, f);
+				}
+			    } else
+				strcpy (pname, stkop($1)->o_val.v_s);
+
+			    o = *(stkop($1));
+			    o.o_val.v_s = pname;
+			    compile (PUSHCONST, &o);
+			    compile (INDIRPOSSET, posit++);
+
+			} else if (parenlevel == 0 || printstmt) {
+			    compile (PUSHCONST, stkop($1));
+			    compile (INDIRPOSSET, posit++);
+			    /* only first arg of fprint stmt is special. */
+			    printstmt = 0;
+
+			} else {
+			    compile (PUSHPARAM, stkop($1)->o_val.v_s);
+			    compile (POSARGSET, posit++);
+			}
+		    }
+		}
+	|	ref '=' expr0 {
+		    absmode++;
+		    if (!errcnt)
+			compile (ABSARGSET, stkop($1)->o_val.v_s); 
+		}
+	|	ref '=' ref {
+		    absmode++;
+		    if (!errcnt) {
+			if (parenlevel == 0) {
+			    compile (PUSHCONST, stkop($3));
+			    compile (INDIRABSSET, stkop($1)->o_val.v_s); 
+			} else {
+			    compile (PUSHPARAM, stkop($3)->o_val.v_s);
+			    compile (ABSARGSET, stkop($1)->o_val.v_s);
+			}
+		    }
+		}
+	|	param '+' {
+		    absmode++;
+		    if (!errcnt)
+			compile (SWON, stkop($1)->o_val.v_s);
+		}
+	|	param '-' {
+		    absmode++;
+		    if (!errcnt)
+			compile (SWOFF, stkop($1)->o_val.v_s);
+		}
+	|	'<' file {
+		    if (!errcnt)
+			compile (REDIRIN);
+		}
+	|	'>' file {
+		    newstdout++;
+		    if (!errcnt)
+			compile (REDIR);
+		}
+	|	Y_ALLREDIR file {
+		    newstdout++;
+		    if (!errcnt)
+			compile (ALLREDIR);
+		}
+	|	Y_APPEND file {
+		    newstdout++;
+		    if (!errcnt)
+			compile (APPENDOUT);
+		}
+	|	Y_ALLAPPEND file {
+		    newstdout++;
+		    if (!errcnt)
+			compile (ALLAPPEND);
+		}
+	|	Y_GSREDIR file {
+		    if (!errcnt)
+			compile (GSREDIR, stkop($1)->o_val.v_s);
+		}
+	;
+
+file	:	expr0 {
+		    absmode++;
+		    /* constant already pushed by expr0.
+		     */
+		}
+	|	param {
+		    absmode++;
+		    if (!errcnt) {
+			if (parenlevel == 0)
+			    compile (PUSHCONST, stkop($1));
+			else
+			    compile (PUSHPARAM, stkop($1)->o_val.v_s);
+			}
+		}
+	;
+
+immed	:	equals expr0 {
+			--parenlevel;
+			if (!errcnt)
+			    compile (IMMED);
+		}
+	|	equals ref {
+		      	--parenlevel;
+			if (!errcnt)
+			    compile (INSPECT, stkop($2)->o_val.v_s);
+		}
+	;
+
+inspect	:	ref equals {
+			--parenlevel;
+			if (!errcnt)
+			    compile (INSPECT, stkop($1)->o_val.v_s);
+		}
+	;
+
+osesc	:	Y_OSESC {
+		    if (!errcnt)
+			compile (OSESC, stkop($1)->o_val.v_s);
+		}
+	;
+
+popstk	:	equals {
+		    --parenlevel;
+		    if (!errcnt)
+			compile (IMMED);
+		}
+	;
+
+/* IFERR checking code.
+ */
+
+iferr: 		iferr_stat {
+		    /* pop BIFF addr and set branch to just after statement */
+		    if (!errcnt) {
+		        XINT   biffaddr = pop();
+		    	coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+		    }
+		    in_iferr = 0;
+		}
+	;
+
+iferr_stat:	iferr_tok {
+		    if (++in_iferr > 1) { 
+			errmsg = nestediferr; 
+			EYYERROR; 
+		    } 
+		    compile (CALL, "_errpsh");
+		    compile (EXEC);
+
+		} c_blk {
+		    if (!errcnt) {
+			struct	operand o;
+
+			o.o_type = OT_INT;
+			o.o_val.v_i = 0;
+			compile (PUSHCONST, &o);       /* if (_errpop() != 0) */
+			compile (INTRINSIC, "_errpop");
+			compile (PUSHCONST, &o);
+			compile (((iferr_tok == 0) ? NE : EQ));
+			push (compile (BIFF, 0));
+		    }
+		} op_then opnl xstmt {
+		    in_iferr--;
+		} 
+	;
+
+iferr_else : 	iferr_stat Y_ELSE {
+		    if (!errcnt) {
+			/* Pop and save BIFF address, compile and push addr 
+			 * of GOTO, and set BIFF branch to just after GOTO.
+			 */
+			XINT  biffaddr = pop();
+			push (compile (GOTO, 0));
+			coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+		    }
+
+		} opnl xstmt {
+		    if (!errcnt) {
+			/* Pop GOTO addr and set branch to just after statement
+			 */
+		    	XINT  gotoaddr = pop();
+			coderef (gotoaddr)->c_args = pc - gotoaddr - SZ_CE;
+		    }
+		}
+	;
+
+iferr_tok:	Y_IFERR   { iferr_tok = 0; }
+	|	Y_IFNOERR { iferr_tok = 1; }
+	;
+
+op_then:	/* empty */
+	|	Y_THEN
+	;
+
+/* END IFERR checking rules.
+ */
+
+
+if	:	if_stat {
+		    /* pop BIFF addr and set branch to just after statement
+		     */
+		    XINT   biffaddr;
+		    if (!errcnt) {
+			biffaddr = pop();
+		    	coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+		    }
+		} 
+	;
+
+if_stat	:	Y_IF LP expr RP {
+			/* save BIFF addr so branch can be filled in 
+			 */
+			if (!errcnt)
+			    push (compile (BIFF, 0));
+		} opnl xstmt {
+			/* The shift/reduce conflict in the IF-IF/ELSE
+			 * construct can cause errors in compilation
+			 * because the IF statement can also be a
+			 * terminal symbol, i.e. it may be all that
+			 * is parsed in one call to the parser.
+			 * The parser must look ahead one token
+			 * to find if there is an else statement
+			 * following.  If there is no following
+			 * token an EOF may be detected prematurely.
+			 * When the IF statement is being parsed not
+			 * inside any braces, then when the next token
+			 * is not an ELSE care must be taken that this
+			 * token is seen on a subsequent invocation
+			 * of the parser.  The `ifseen' flag is
+			 * used within the support for the lexical
+			 * analyzer located in `history.c'.
+			 */
+			if (cldebug) 
+			    eprintf ("ytab: setting ifseen=yes\n");
+
+			if (currentask->t_flags & T_INTERACTIVE)
+			    ifseen = ip_cmdblk;
+			else
+			    ifseen = cmdblk;
+		}
+	;
+
+ifelse	:	if_stat Y_ELSE {
+		    XINT  biffaddr;
+
+		    ifseen = NULL;
+		    if (!errcnt) {
+			/* Pop and save BIFF address, compile and push addr 
+			 * of GOTO, and set BIFF branch to just after GOTO.
+			 */
+			biffaddr = pop();
+			push (compile (GOTO, 0));
+			coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+		    }
+		} opnl xstmt {
+		    XINT  gotoaddr;
+		    if (!errcnt) {
+			/* Pop GOTO addr and set branch to just after statement
+			 */
+			gotoaddr = pop();
+			coderef (gotoaddr)->c_args = pc - gotoaddr - SZ_CE;
+		    }
+		}
+	;
+
+while	:	Y_WHILE LP {
+		    /* Save starting addr of while expression.
+		     */
+		    if (!errcnt) {
+			push (pc);
+			loopincr();
+		    }
+		} expr RP {
+		    /* Save BIFF addr so branch can be filled in.
+		     */
+		    if (!errcnt)
+			push (compile (BIFF, 0));
+		} opnl xstmt {
+		    XINT  biffaddr;
+
+		    if (!errcnt) {
+			/* Pop and save addr of BIFF instruction.	   */
+			biffaddr = pop();
+			/* Pop addr of expression and build a goto there.  */
+			compile (GOTO, pop() - pc - SZ_CE);
+			/* Now can set BIFF branch to just after statement.*/
+			coderef (biffaddr)->c_args = pc - biffaddr - SZ_CE;
+			loopdecr();
+		    }
+		}
+	;
+
+	/* The line of code:
+	 *
+	 *	for (e1, e2, e3) stmt
+	 *
+	 * is compiled into:
+	 *
+	 *		e1
+	 *   loop1: 	if (!e2) goto end
+	 *		goto loop3
+	 *   loop2: 	e3
+	 *		goto loop1
+	 *   loop3: 	stmt
+	 *		goto loop2
+	 *     end:
+	 *
+	 * Note that e1 and e3 are assignments while e2 is an expression.
+	 */
+
+for	:	Y_FOR LP opnl xassign ';' opnl {
+			if (!errcnt)
+			    push(pc);				/* Loop1: */
+		} 
+		xexpr ';' opnl {
+			if (!errcnt) {
+			    if (for_expr)
+				ppush (compile(BIFF, 0));	/* if (!e2) */
+
+			    /* Add SZ_CE to skip following GOTO. 
+			     */
+			    ppush (pc+SZ_CE);			/* Loop2: */
+			    ppush (compile(GOTO,0));		/* goto Loop3 */
+
+			    /* Save current location as the destination
+			     * for NEXT statements.
+			     */
+			    loopincr();
+			}
+		}
+		xassign RP opnl {
+			XINT  stmtaddr;
+
+			if (!errcnt) {
+			    stmtaddr = pop();
+			    compile (GOTO, stmtaddr-pc-SZ_CE); 	/* Goto loop1 */
+			    stmtaddr = pop();
+			    coderef(stmtaddr)->c_args = pc - stmtaddr - SZ_CE;
+			}
+		}
+		stmt {
+			XINT  stmtaddr;
+
+			if (!errcnt) {
+			    stmtaddr = pop();
+			    compile (GOTO, stmtaddr-pc-SZ_CE); /* goto loop2 */
+
+			    if (for_expr) {
+				stmtaddr = pop();
+				coderef(stmtaddr)->c_args = pc-stmtaddr-SZ_CE;
+			    }
+			    loopdecr();
+			}
+		}
+	;
+
+/* The following allow skipping of fields in the FOR statement.
+ */
+
+xassign	:	assign
+	|	/* empty */
+	;
+
+xexpr	:	expr {
+			for_expr = YES;
+		}
+	|	/* empty */ {
+			for_expr = NO;
+		}
+	;
+
+	/* The compiled code for the switch statement
+	 * consists of a SWITCH, followed by a series of
+	 * CASE and DEFAULT blocks, followed by a jump table.
+	 * The first operand in each CASE and DEFAULT block
+	 * is a CASE or DEFAULT operand which is never
+	 * executed, but is used to store the values which
+	 * will enter this block.  Executable statements
+	 * follow.
+	 *
+	 * The jump table consists of the addresses of the
+	 * CASE and DEFAULT blocks.  The DEFAULT block
+	 * comes first, and is 0 if no default has
+	 * been given.  The list of addresses is terminated
+	 * by a 0 address.
+	 *
+	 * The last statement of each CASE and DEFAULT
+	 * statement is a branch back to a GOTO following
+	 * the SWITCH.  This GOTO points to after the jumptable.
+	 */
+
+switch	:	Y_SWITCH opnl LP opnl expr opnl RP opnl
+		{
+			if (!errcnt) {
+			    push (compile(SWITCH));
+
+			    /* Compile GOTO which will branch past end of
+			     * switch.  This is needed if there is no DEFAULT.
+			     */
+			    compile (GOTO, 0);
+			}
+		} xstmt {
+			/* Set up jumptable and pop space on stack.
+			 */
+			if (!errcnt)
+			    setswitch();
+		}
+	;
+
+case	:	Y_CASE {
+			if (!errcnt) {
+			    ncaseval = 0;
+			    if (!in_switch()) {
+				errmsg = "Improper CASE statement.";
+				EYYERROR;
+			    }
+			}
+		} const_expr_list ':' opnl {
+			XINT  pcase;
+
+			if (!errcnt) {
+			    pcase = compile (CASE, ncaseval);
+
+			    /* Fill in argument list. 
+			     */
+			    caseset (&(coderef(pcase)->c_args), ncaseval);
+			    push (pcase);
+			}
+		} xstmt {
+			/* Branch to end of switch block 
+			 */
+			if (!errcnt)
+			    push (compile(GOTO, 0));
+		}
+	;
+
+default	:	Y_DEFAULT ':' opnl {
+		      	/* Compile an operand to store the current PC.
+			 */
+			if (!errcnt) {
+			    if (!in_switch()) {
+				errmsg = "Improper DEFAULT statement.";
+				EYYERROR;
+			    }
+			    push (compile(DEFAULT));
+			}
+		} xstmt {
+		      	/* Branch past jump table. 
+			 */
+			if (!errcnt)
+			    push (compile(GOTO, 0));
+		}
+	;	
+
+next	:	Y_NEXT {
+			/* All NEXT statements are backward references,
+			 * so we simply store the addresses in an array.
+			 */
+			if (!errcnt) {
+			    if (nestlevel)
+				compile (GOTO, nextdest[nestlevel-1]-pc-SZ_CE);
+			    else {
+				errmsg = "NEXT outside of loop.";
+				EYYERROR;
+			    }
+			}
+		}
+	;
+
+break	:	Y_BREAK {
+			/* Each BREAK is a forward reference.  For the
+			 * first BREAK in each loop we compile a
+			 * GOTO statement which will be the object of
+			 * all BREAK statements within the loop.  When
+			 * the loop is terminated the target of this
+			 * GOTO will be set.
+			 */
+			int  dest;
+
+			if (!errcnt) {
+			    if (!nestlevel) {
+				errmsg = "Break outside of loop.";
+				EYYERROR;
+			    } else if ((dest = brkdest[nestlevel-1]) != 0)
+		    		compile (GOTO, dest-pc-SZ_CE);
+			    else {
+				brkdest[nestlevel-1] = pc;
+				compile (GOTO, 0);
+			    }
+			}
+		}
+	;
+
+return	:	Y_RETURN {
+			if (!errcnt)
+			    compile (END);
+		}
+	|	Y_RETURN expr {
+			/* Return values currently not implemented.
+			 */
+			eprintf ("Warning: return value ignored.\n");
+			if (!errcnt)
+			    compile (END);
+		}
+	;
+
+	/* Require end to terminate with a new-line, because
+	 * it should be at the end of the file.
+	 */
+end_stmt:	Y_END NL {
+			bracelevel -= PBRACE;
+			if (bracelevel < 0) {
+			    errmsg = "Too few left braces.";
+			    EYYERROR;
+			} else if (bracelevel > 0) {
+			    errmsg = "Too few right braces.";
+			    EYYERROR;
+			}
+		}
+	;
+
+label_stmt:	Y_IDENT ':' opnl {
+			/* Put symbol in table in dictionary and
+			 * process indirect references if present.
+			 */
+			struct label *l;
+
+			if (!errcnt) {
+			    l = getlabel (stkop($1));
+
+			    if (l == NULL) {
+				l = setlabel (stkop($1));
+				l->l_loc = pc;
+			    } else if (l->l_defined) {
+			        errmsg = "Identical labels.";
+				EYYERROR;
+			    } else {
+				/* Get this GOTO out of the
+				 * indirect list so we can use
+				 * the argument as the destination
+				 */
+				XINT  gotopc;
+				gotopc = l->l_loc;
+				unsetigoto (gotopc);
+
+				/* Fix the indirect reference. 
+				 */
+				coderef(gotopc)->c_args = pc - gotopc - SZ_CE;
+			    }
+			    (l->l_defined)++;
+			}
+		}
+		xstmt
+	;
+
+goto	:	Y_GOTO Y_IDENT {
+			/* Get the address corresponding to the label.
+			 */
+			struct label *l;
+
+			if (!errcnt) {
+			    l = getlabel (stkop($2));
+
+			    if (l != NULL)
+				compile (GOTO, l->l_loc - pc - SZ_CE);
+			    else {
+				/* Ready for indirect GOTO 
+				 */
+				l = setlabel (stkop($2));
+				l->l_loc = pc;
+				setigoto (compile(GOTO, 0));
+				l->l_defined = 0;
+			    }
+			}
+		}
+	;
+
+nullstmt:	';'
+	|	';' NL
+	;
+
+/* xstmt is defined so that to handle implicit do loops created by
+ *  open array references e.g. a[*,3]=a[3,*].
+ */
+
+xstmt	:	/* empty */ { 
+			/* Save pc before compiling statement for loop back
+			 */
+			stmt_pc = pc;
+			n_oarr = 0;
+			i_oarr = 0;
+			ifseen = NULL;
+		}
+		stmt {
+		      	/* If there was an open reference compile the
+			 * loop increment and goback.
+			 */
+			XINT push_pc;
+
+			if (!errcnt) {
+			    if (n_oarr) {
+				compile (INDXINCR, stmt_pc-pc-4, 2*n_oarr+1);
+
+				/* We are going to store initialization
+				 * info for the implicit loop here.
+				 * It is loopincr's responsibility to 
+				 * branch around it.  This data is what
+				 * should be pointed to by the special
+				 * PUSHINDEX compiled at the first open
+				 * array reference.
+				 */
+				push_pc = pop();  /* Location of PUSHINDEX */
+				coderef(push_pc)->c_args = pc - push_pc - SZ_CE;
+
+				stack[pc++] = n_oarr;
+				for (i_oarr=0; i_oarr<n_oarr; i_oarr++) {
+				    stack[pc++] = oarr_beg[i_oarr];
+				    stack[pc++] = oarr_end[i_oarr];
+				}
+
+				/* Clear n_oarr.  This must be done here
+				 * because we may have the end of a compound
+				 * statement following on the heels of the
+				 * end of the simple statement with the
+				 * implicit loop.
+				 */
+				n_oarr = 0;
+				i_oarr = 0;
+			    }
+			}
+		}
+	|	var_decl_stmt
+	|	error NL {
+		    /* This should get most errors in executable statements
+		     * or in the local variable declarations in a script.
+		     */
+		    yyerrok;
+
+		    /* Get rid of any fake braces.
+		     */
+		    bracelevel -= tbrace;
+
+		    /* Discard everything and compile a null statement.
+		     */
+		    if (!errcnt) {
+			do_params = YES;
+			pc = currentask->t_bascode;
+			if (parse_state != PARSE_PARAMS)
+			    compile (END);
+
+			topd = currentask->t_topd;
+			topcs = currentask->t_topcs;
+
+			/* Unlink any added parms.  Resetting of topd will
+			 * already have reclaimed space.
+			 */
+			if (last_parm) {
+			    last_parm->p_np = NULL;
+			    currentask->t_pfp->pf_lastpp = last_parm;
+			    last_parm = NULL;
+			}
+ 		    }
+
+		    /* Tell user about the syntax error, printing the 
+		     * offending line and position if possible.
+		     */
+		    if (currentask->t_flags & T_SCRIPT) {
+		        if (errmsg != NULL) {
+			    eprintf ("** Syntax error, line %d: %s\n",
+			        currentask->t_scriptln, errmsg);
+			} else {
+			    eprintf ("** Syntax error, line %d\n",
+			        currentask->t_scriptln);
+			}
+		    } else
+			eprintf ("** Syntax error\n");
+		    p_position();
+
+		    if (!(currentask->t_flags & T_SCRIPT)) {
+			/* If interactive, we're finished if not within braces.
+			 */
+			if (!bracelevel)
+			    YYACCEPT;
+		    }
+
+		    /* Note that we do not call cl_error() here to abort, but
+		     * continue on parsing the script for more syntax errors.
+		     */
+		    if (++errcnt > MAX_ERR)
+			cl_error (E_UERR, "Too many syntax errors.");
+		}
+	;
+
+const_expr_list	:	const_expr
+		|	const_expr DELIM const_expr_list
+		;
+
+const_expr	:	const {
+				if (!errcnt) {
+				    push(stkop($1)) ; 
+				    ncaseval++;
+				}
+			}
+		;
+
+	/* Use opnl when blank lines are permitted,
+	 * or where a statement may be broken into more
+	 * than one line.  The lexical analyzer (actually
+	 * get_command in history.c) ensures that all blank
+	 * lines are deleted.  So we don't have to use
+	 * a recursive definition here.
+	 */
+
+opnl	:	/* empty */
+	|	NL
+	;
+
+ref	:	param {
+			int  dim, d, i1, i2, mode;
+
+			/*  In command arguments, when not in parentheses
+			 *  we just pass the param as a string constant.
+			 */
+			if (!errcnt) {
+			    lastref = NO;
+			    if (!inarglist || parenlevel) {
+				i_oarr = 0;
+				index_cnt = 0;
+
+				strncpy (curr_param, stkop($1)->o_val.v_s, 
+					SZ_FNAME);
+
+				/* If a '.' is found in the name we have a 
+				 * reference to an external task, or to a 
+				 * specific field.  In these cases we don't 
+				 * want implicit looping.
+				 */
+				if (index (curr_param, '.') == NULL) {
+				    if ((dim = get_dim (curr_param)) > 0) {
+					lastref = YES;
+			        	for (d = 0; d < dim; d++) {
+					    getlimits (curr_param, d, &i1, &i2);
+					    mode = make_imloop (i1, i2);
+					    if (mode)
+						compile (PUSHINDEX, -1);
+					    else
+						push (compile(PUSHINDEX, 0));	
+					}
+			    		n_oarr = dim;
+				    }
+				}
+			    }
+			}
+		}
+	|	param {
+		    if (!errcnt) {
+			strncpy (curr_param, stkop($1)->o_val.v_s, SZ_FNAME);
+			index_cnt = 0;
+		    }
+		}
+		'[' index_list ']' 
+		{
+		    if (i_oarr > 0  &&  n_oarr == 0)
+			n_oarr = i_oarr;
+		    i_oarr = 0;
+		    lastref = YES;
+		}
+	;
+
+index_list:	index {
+			index_cnt = 1;
+		}
+	|	index {
+			index_cnt++;
+		}
+		DELIM index_list
+	;
+
+index	:	expr1 {
+			if (!errcnt)
+			    compile (PUSHINDEX, 0);
+		}
+	|	ref  /* This isn't included in expr1 */
+		{ 
+			if (!errcnt) {
+			    compile (PUSHPARAM, stkop($1)->o_val.v_s);
+			    compile (PUSHINDEX, 0);
+			}
+		}
+	|	'*' {
+			int  i1, i2, mode;
+
+			if (!errcnt) {
+			    if (index(curr_param, '.') != NULL) {
+				errmsg = exlimits;
+				EYYERROR;
+			    }
+			    if (getlimits (curr_param, index_cnt, &i1, &i2) 
+				== ERR) {
+				eprintf ("Implicit index error for %s.\n",
+					curr_param);
+				EYYERROR;
+			    }
+			    mode = make_imloop (i1, i2);
+			    if (mode)
+				compile (PUSHINDEX, mode);
+			    else
+				push (compile (PUSHINDEX, mode));
+			}
+		}
+	|	Y_CONSTANT {
+			/*  There is an ambiguity in the grammar between
+			 *  sexagesimal constants, and array range references.
+			 *  Since the sexagesimal constants are recognized
+			 *  in the lexical analyzer we can't just change the
+			 *  grammar.  The kludge around this is to have
+			 *  makeop set a flag telling us that the last
+			 *  constant it compiled COULD have been an index
+			 *  range.  We check the flag here and if it is
+			 *  set we convert back and compile an implicit loop
+			 *  otherwise we just push the constant.
+			 */
+			int  i1, i2, mode;
+
+			if (!errcnt) {
+			    if (maybeindex) {
+				sexa_to_index (stkop($1)->o_val.v_r, &i1, &i2);
+				mode = make_imloop (i1, i2);
+				if (mode)
+				    compile (PUSHINDEX, mode);
+				else
+				    push (compile (PUSHINDEX, mode));
+			    } else {
+				compile (PUSHCONST, stkop($1));
+				compile (PUSHINDEX, 0);
+			    }
+			}
+		}
+	;
+
+/* these are just to make the grammar a bit easier to read.
+ * can yank them out to shrink parser a bit...
+ */
+
+intrins	:	Y_IDENT {
+		    $$ = $1;
+		}
+	;
+
+param	:	Y_IDENT {
+		    $$ = $1;
+		}
+	;
+
+tasknam	:	Y_IDENT {
+		    $$ = $1;
+		}
+	;
+
+EOST	:	NL
+	|	';' {
+		    /* If statements are delimited by ';'s, do not execute
+		     * until next newline EOST is received.
+		     */
+		    sawnl = 0;
+		}
+	;
+	
+DELIM	:	','
+	;
+
+BARG	:	/* empty */
+	|	LP
+	;
+
+EARG	:	/* empty */
+	|	RP
+	;
+
+/* These eliminate several interior actions.
+ */
+
+LP	:	'('	{ parenlevel++; }
+	;
+
+RP	:	')'	{ --parenlevel; }
+	;
+
+NL	:	Y_NEWLINE  { sawnl = 1; }
+	;
+
+%%
+
+#include "lexyy.c"
+#include "lexicon.c"