1 /* $Id$ $Revision$ */
2 /* vim:set shiftwidth=4 ts=4: */
3 
4 /*************************************************************************
5  * Copyright (c) 2011 AT&T Intellectual Property
6  * All rights reserved. This program and the accompanying materials
7  * are made available under the terms of the Eclipse Public License v1.0
8  * which accompanies this distribution, and is available at
9  * http://www.eclipse.org/legal/epl-v10.html
10  *
11  * Contributors: See CVS logs. Details at http://www.graphviz.org/
12  *************************************************************************/
13 
14 %{
15 
16 /*
17  * Glenn Fowler
18  * AT&T Research
19  *
20  * expression library grammar and compiler
21  */
22 
23 #ifdef _WIN32
24 #include <config.h>
25 
26 #ifdef GVDLL
27 #define _BLD_sfio 1
28 #endif
29 #endif
30 
31 #include <stdio.h>
32 #include <ast.h>
33 
34 #undef	RS	/* hp.pa <signal.h> grabs this!! */
35 
36 %}
37 
38 %union
39 {
40 	struct Exnode_s*expr;
41 	double		floating;
42 	struct Exref_s*	reference;
43 	struct Exid_s*	id;
44 	Sflong_t	integer;
45 	int		op;
46 	char*		string;
47 	void*		user;
48 	struct Exbuf_s*	buffer;
49 }
50 
51 %start	program
52 
53 %token	MINTOKEN
54 
55 %token	INTEGER
56 %token	UNSIGNED
57 %token	CHARACTER
58 %token	FLOATING
59 %token	STRING
60 %token	VOIDTYPE
61 %token	STATIC
62 
63 %token	ADDRESS
64 %token	ARRAY
65 %token	BREAK
66 %token	CALL
67 %token	CASE
68 %token	CONSTANT
69 %token	CONTINUE
70 %token	DECLARE
71 %token	DEFAULT
72 %token	DYNAMIC
73 %token	ELSE
74 %token	EXIT
75 %token	FOR
76 %token	FUNCTION
77 %token	GSUB
78 %token	ITERATE
79 %token	ITERATER
80 %token	ID
81 %token	IF
82 %token	LABEL
83 %token	MEMBER
84 %token	NAME
85 %token	POS
86 %token	PRAGMA
87 %token	PRE
88 %token	PRINT
89 %token	PRINTF
90 %token	PROCEDURE
91 %token	QUERY
92 %token	RAND
93 %token	RETURN
94 %token	SCANF
95 %token	SPLIT
96 %token	SPRINTF
97 %token	SRAND
98 %token	SSCANF
99 %token	SUB
100 %token	SUBSTR
101 %token	SWITCH
102 %token	TOKENS
103 %token	UNSET
104 %token	WHILE
105 
106 %token	F2I
107 %token	F2S
108 %token	I2F
109 %token	I2S
110 %token	S2B
111 %token	S2F
112 %token	S2I
113 
114 %token	F2X
115 %token	I2X
116 %token	S2X
117 %token	X2F
118 %token	X2I
119 %token	X2S
120 %token	X2X
121 %token	XPRINT
122 
123 %left	<op>	','
124 %right	<op>	'='
125 %right	<op>	'?'	':'
126 %left	<op>	OR
127 %left	<op>	AND
128 %left	<op>	'|'
129 %left	<op>	'^'
130 %left	<op>	'&'
131 %binary	<op>	EQ	NE
132 %binary	<op>	'<'	'>'	LE	GE
133 %left	<op>	LS	RS
134 %left	<op>	'+'	'-'	IN_OP
135 %left	<op>	'*'	'/'	'%'
136 %right	<op>	'!'	'~'	'#'	UNARY
137 %right	<op>	INC	DEC
138 %right	<op>	CAST
139 %left	<op>	'('
140 
141 %type <expr>		statement	statement_list	arg_list
142 %type <expr>		else_opt	expr_opt	expr
143 %type <expr>		args		variable	assign
144 %type <expr>		dcl_list	dcl_item	index
145 %type <expr>		initialize	switch_item	constant
146 %type <expr>		formals		formal_list	formal_item
147 %type <reference>	members
148 %type <id>		ID		LABEL		NAME
149 %type <id>		CONSTANT	ARRAY		FUNCTION	DECLARE
150 %type <id>		EXIT		PRINT		PRINTF		QUERY
151 %type <id>		RAND		SRAND
152 %type <id>		SPRINTF		PROCEDURE	name		dcl_name
153 %type <id>		GSUB		SUB		SUBSTR
154 %type <id>		SPLIT		TOKENS          splitop
155 %type <id>		IF		WHILE		FOR		ITERATER
156 %type <id>		BREAK		CONTINUE	print		member
157 %type <id>		RETURN		DYNAMIC		SWITCH		UNSET
158 %type <id>		SCANF		SSCANF		scan
159 %type <floating>	FLOATING
160 %type <integer>		INTEGER		UNSIGNED	array
161 %type <integer>		static
162 %type <string>		STRING
163 
164 %token	MAXTOKEN
165 
166 %{
167 
168 #include "exgram.h"
169 
170 %}
171 
172 %%
173 
174 program		:	statement_list action_list
175 		{
176 			if ($1 && !(expr.program->disc->flags & EX_STRICT))
177 			{
178 				if (expr.program->main.value && !(expr.program->disc->flags & EX_RETAIN))
179 					exfreenode(expr.program, expr.program->main.value);
180 				if ($1->op == S2B)
181 				{
182 					Exnode_t*	x;
183 
184 					x = $1;
185 					$1 = x->data.operand.left;
186 					x->data.operand.left = 0;
187 					exfreenode(expr.program, x);
188 				}
189 				expr.program->main.lex = PROCEDURE;
190 				expr.program->main.value = exnewnode(expr.program, PROCEDURE, 1, $1->type, NiL, $1);
191 			}
192 		}
193 		;
194 
195 action_list	:	/* empty */
196 		|	action_list action
197 		;
198 
199 action		:	LABEL ':' {
200 				register Dtdisc_t*	disc;
201 
202 				if (expr.procedure)
203 					exerror("no nested function definitions");
204 				$1->lex = PROCEDURE;
205 				expr.procedure = $1->value = exnewnode(expr.program, PROCEDURE, 1, $1->type, NiL, NiL);
206 				expr.procedure->type = INTEGER;
207 				if (!(disc = newof(0, Dtdisc_t, 1, 0)))
208 					exnospace();
209 				disc->key = offsetof(Exid_t, name);
210 				if (expr.assigned && !streq($1->name, "begin"))
211 				{
212 					if (!(expr.procedure->data.procedure.frame = dtopen(disc, Dtset)) || !dtview(expr.procedure->data.procedure.frame, expr.program->symbols))
213 						exnospace();
214 					expr.program->symbols = expr.program->frame = expr.procedure->data.procedure.frame;
215 				}
216 			} statement_list
217 		{
218 			expr.procedure = 0;
219 			if (expr.program->frame)
220 			{
221 				expr.program->symbols = expr.program->frame->view;
222 				dtview(expr.program->frame, NiL);
223 				expr.program->frame = 0;
224 			}
225 			if ($4 && $4->op == S2B)
226 			{
227 				Exnode_t*	x;
228 
229 				x = $4;
230 				$4 = x->data.operand.left;
231 				x->data.operand.left = 0;
232 				exfreenode(expr.program, x);
233 			}
234 			$1->value->data.operand.right = excast(expr.program, $4, $1->type, NiL, 0);
235 		}
236 		;
237 
238 statement_list	:	/* empty */
239 		{
240 			$$ = 0;
241 		}
242 		|	statement_list statement
243 		{
244 			if (!$1)
245 				$$ = $2;
246 			else if (!$2)
247 				$$ = $1;
248 			else if ($1->op == CONSTANT)
249 			{
250 				exfreenode(expr.program, $1);
251 				$$ = $2;
252 			}
253 #ifdef UNUSED
254 			else if ($1->op == ';')
255 			{
256 				$$ = $1;
257 				$1->data.operand.last = $1->data.operand.last->data.operand.right = exnewnode(expr.program, ';', 1, $2->type, $2, NiL);
258 			}
259 			else
260 			{
261 				$$ = exnewnode(expr.program, ';', 1, $1->type, $1, NiL);
262 				$$->data.operand.last = $$->data.operand.right = exnewnode(expr.program, ';', 1, $2->type, $2, NiL);
263 			}
264 #endif
265 			else $$ = exnewnode(expr.program, ';', 1, $2->type, $1, $2);
266 		}
267 		;
268 
269 statement	:	'{' statement_list '}'
270 		{
271 			$$ = $2;
272 		}
273 		|	expr_opt ';'
274 		{
275 			$$ = ($1 && $1->type == STRING) ? exnewnode(expr.program, S2B, 1, INTEGER, $1, NiL) : $1;
276 		}
277 		|	static {expr.instatic=$1;} DECLARE {expr.declare=$3->type;} dcl_list ';'
278 		{
279 			$$ = $5;
280 			expr.declare = 0;
281 		}
282 		|	IF '(' expr ')' statement else_opt
283 		{
284 			if (exisAssign ($3))
285 				exwarn ("assignment used as boolean in if statement");
286 			if ($3->type == STRING)
287 				$3 = exnewnode(expr.program, S2B, 1, INTEGER, $3, NiL);
288 			else if (!INTEGRAL($3->type))
289 				$3 = excast(expr.program, $3, INTEGER, NiL, 0);
290 			$$ = exnewnode(expr.program, $1->index, 1, INTEGER, $3, exnewnode(expr.program, ':', 1, $5 ? $5->type : 0, $5, $6));
291 		}
292 		|	FOR '(' variable ')' statement
293 		{
294 			$$ = exnewnode(expr.program, ITERATE, 0, INTEGER, NiL, NiL);
295 			$$->data.generate.array = $3;
296 			if (!$3->data.variable.index || $3->data.variable.index->op != DYNAMIC)
297 				exerror("simple index variable expected");
298 			$$->data.generate.index = $3->data.variable.index->data.variable.symbol;
299 			if ($3->op == ID && $$->data.generate.index->type != INTEGER)
300 				exerror("integer index variable expected");
301 			exfreenode(expr.program, $3->data.variable.index);
302 			$3->data.variable.index = 0;
303 			$$->data.generate.statement = $5;
304 		}
305 		|	FOR '(' expr_opt ';' expr_opt ';' expr_opt ')' statement
306 		{
307 			if (!$5)
308 			{
309 				$5 = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
310 				$5->data.constant.value.integer = 1;
311 			}
312 			else if ($5->type == STRING)
313 				$5 = exnewnode(expr.program, S2B, 1, INTEGER, $5, NiL);
314 			else if (!INTEGRAL($5->type))
315 				$5 = excast(expr.program, $5, INTEGER, NiL, 0);
316 			$$ = exnewnode(expr.program, $1->index, 1, INTEGER, $5, exnewnode(expr.program, ';', 1, 0, $7, $9));
317 			if ($3)
318 				$$ = exnewnode(expr.program, ';', 1, INTEGER, $3, $$);
319 		}
320 		|	ITERATER '(' variable ')' statement
321 		{
322 			$$ = exnewnode(expr.program, ITERATER, 0, INTEGER, NiL, NiL);
323 			$$->data.generate.array = $3;
324 			if (!$3->data.variable.index || $3->data.variable.index->op != DYNAMIC)
325 				exerror("simple index variable expected");
326 			$$->data.generate.index = $3->data.variable.index->data.variable.symbol;
327 			if ($3->op == ID && $$->data.generate.index->type != INTEGER)
328 				exerror("integer index variable expected");
329 			exfreenode(expr.program, $3->data.variable.index);
330 			$3->data.variable.index = 0;
331 			$$->data.generate.statement = $5;
332 		}
333 		|	UNSET '(' DYNAMIC ')'
334 		{
335 			if ($3->local.pointer == 0)
336               			exerror("cannot apply unset to non-array %s", $3->name);
337 			$$ = exnewnode(expr.program, UNSET, 0, INTEGER, NiL, NiL);
338 			$$->data.variable.symbol = $3;
339 			$$->data.variable.index = NiL;
340 		}
341 		|	UNSET '(' DYNAMIC ',' expr  ')'
342 		{
343 			if ($3->local.pointer == 0)
344               			exerror("cannot apply unset to non-array %s", $3->name);
345 			if (($3->index_type > 0) && ($5->type != $3->index_type))
346             		    exerror("%s indices must have type %s, not %s",
347 				$3->name, extypename(expr.program, $3->index_type),extypename(expr.program, $5->type));
348 			$$ = exnewnode(expr.program, UNSET, 0, INTEGER, NiL, NiL);
349 			$$->data.variable.symbol = $3;
350 			$$->data.variable.index = $5;
351 		}
352 		|	WHILE '(' expr ')' statement
353 		{
354 			if (exisAssign ($3))
355 				exwarn ("assignment used as boolean in while statement");
356 			if ($3->type == STRING)
357 				$3 = exnewnode(expr.program, S2B, 1, INTEGER, $3, NiL);
358 			else if (!INTEGRAL($3->type))
359 				$3 = excast(expr.program, $3, INTEGER, NiL, 0);
360 			$$ = exnewnode(expr.program, $1->index, 1, INTEGER, $3, exnewnode(expr.program, ';', 1, 0, NiL, $5));
361 		}
362 		|	SWITCH '(' expr {expr.declare=$3->type;} ')' '{' switch_list '}'
363 		{
364 			register Switch_t*	sw = expr.swstate;
365 
366 			$$ = exnewnode(expr.program, $1->index, 1, INTEGER, $3, exnewnode(expr.program, DEFAULT, 1, 0, sw->defcase, sw->firstcase));
367 			expr.swstate = expr.swstate->prev;
368 			if (sw->base)
369 				free(sw->base);
370 			if (sw != &swstate)
371 				free(sw);
372 			expr.declare = 0;
373 		}
374 		|	BREAK expr_opt ';'
375 		{
376 		loopop:
377 			if (!$2)
378 			{
379 				$2 = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
380 				$2->data.constant.value.integer = 1;
381 			}
382 			else if (!INTEGRAL($2->type))
383 				$2 = excast(expr.program, $2, INTEGER, NiL, 0);
384 			$$ = exnewnode(expr.program, $1->index, 1, INTEGER, $2, NiL);
385 		}
386 		|	CONTINUE expr_opt ';'
387 		{
388 			goto loopop;
389 		}
390 		|	RETURN expr_opt ';'
391 		{
392 			if ($2)
393 			{
394 				if (expr.procedure && !expr.procedure->type)
395 					exerror("return in void function");
396 				$2 = excast(expr.program, $2, expr.procedure ? expr.procedure->type : INTEGER, NiL, 0);
397 			}
398 			$$ = exnewnode(expr.program, RETURN, 1, $2 ? $2->type : 0, $2, NiL);
399 		}
400 		;
401 
402 switch_list	:	/* empty */
403 		{
404 			register Switch_t*		sw;
405 			int				n;
406 
407 			if (expr.swstate)
408 			{
409 				if (!(sw = newof(0, Switch_t, 1, 0)))
410 				{
411 					exnospace();
412 					sw = &swstate;
413 				}
414 				sw->prev = expr.swstate;
415 			}
416 			else
417 				sw = &swstate;
418 			expr.swstate = sw;
419 			sw->type = expr.declare;
420 			sw->firstcase = 0;
421 			sw->lastcase = 0;
422 			sw->defcase = 0;
423 			sw->def = 0;
424 			n = 8;
425 			if (!(sw->base = newof(0, Extype_t*, n, 0)))
426 			{
427 				exnospace();
428 				n = 0;
429 			}
430 			sw->cur = sw->base;
431 			sw->last = sw->base + n;
432 		}
433 		|	switch_list switch_item
434 		;
435 
436 switch_item	:	case_list statement_list
437 		{
438 			register Switch_t*	sw = expr.swstate;
439 			int			n;
440 
441 			$$ = exnewnode(expr.program, CASE, 1, 0, $2, NiL);
442 			if (sw->cur > sw->base)
443 			{
444 				if (sw->lastcase)
445 					sw->lastcase->data.select.next = $$;
446 				else
447 					sw->firstcase = $$;
448 				sw->lastcase = $$;
449 				n = sw->cur - sw->base;
450 				sw->cur = sw->base;
451 				$$->data.select.constant = (Extype_t**)exalloc(expr.program, (n + 1) * sizeof(Extype_t*));
452 				memcpy($$->data.select.constant, sw->base, n * sizeof(Extype_t*));
453 				$$->data.select.constant[n] = 0;
454 			}
455 			else
456 				$$->data.select.constant = 0;
457 			if (sw->def)
458 			{
459 				sw->def = 0;
460 				if (sw->defcase)
461 					exerror("duplicate default in switch");
462 				else
463 					sw->defcase = $2;
464 			}
465 		}
466 		;
467 
468 case_list	:	case_item
469 		|	case_list case_item
470 		;
471 
472 case_item	:	CASE constant ':'
473 		{
474 			int	n;
475 
476 			if (expr.swstate->cur >= expr.swstate->last)
477 			{
478 				n = expr.swstate->cur - expr.swstate->base;
479 				if (!(expr.swstate->base = newof(expr.swstate->base, Extype_t*, 2 * n, 0)))
480 				{
481 					exerror("too many case labels for switch");
482 					n = 0;
483 				}
484 				expr.swstate->cur = expr.swstate->base + n;
485 				expr.swstate->last = expr.swstate->base + 2 * n;
486 			}
487 			if (expr.swstate->cur)
488 			{
489 				$2 = excast(expr.program, $2, expr.swstate->type, NiL, 0);
490 				*expr.swstate->cur++ = &($2->data.constant.value);
491 			}
492 		}
493 		|	DEFAULT ':'
494 		{
495 			expr.swstate->def = 1;
496 		}
497 		;
498 
499 static	:	/* empty */
500 		{
501 			$$ = 0;
502 		}
503 		|	STATIC
504 		{
505 			$$ = 1;
506 		}
507 		;
508 
509 dcl_list	:	dcl_item
510 		|	dcl_list ',' dcl_item
511 		{
512 			if ($3)
513 				$$ = $1 ? exnewnode(expr.program, ',', 1, $3->type, $1, $3) : $3;
514 		}
515 		;
516 
517 dcl_item	:	dcl_name {checkName ($1); expr.id=$1;} array initialize
518 		{
519 			$$ = 0;
520 			if (!$1->type || expr.declare)
521 				$1->type = expr.declare;
522 			if ($4 && $4->op == PROCEDURE)
523 			{
524 				$1->lex = PROCEDURE;
525 				$1->type = $4->type;
526 				$1->value = $4;
527 			}
528 			else
529 			{
530 				$1->lex = DYNAMIC;
531 				$1->value = exnewnode(expr.program, 0, 0, 0, NiL, NiL);
532 				if ($3 && !$1->local.pointer)
533 				{
534 					Dtdisc_t*	disc;
535 
536 					if (!(disc = newof(0, Dtdisc_t, 1, 0)))
537 						exnospace();
538 					if ($3 == INTEGER) {
539 						disc->key = offsetof(Exassoc_t, key);
540 						disc->size = sizeof(Extype_t);
541 						disc->comparf = (Dtcompar_f)cmpKey;
542 					}
543 					else
544 						disc->key = offsetof(Exassoc_t, name);
545 					if (!($1->local.pointer = (char*)dtopen(disc, Dtoset)))
546 						exerror("%s: cannot initialize associative array", $1->name);
547 					$1->index_type = $3; /* -1 indicates no typechecking */
548 				}
549 				if ($4)
550 				{
551 					if ($4->type != $1->type)
552 					{
553 						$4->type = $1->type;
554 						$4->data.operand.right = excast(expr.program, $4->data.operand.right, $1->type, NiL, 0);
555 					}
556 					$4->data.operand.left = exnewnode(expr.program, DYNAMIC, 0, $1->type, NiL, NiL);
557 					$4->data.operand.left->data.variable.symbol = $1;
558 					$$ = $4;
559 #if UNUSED
560 					if (!expr.program->frame && !expr.program->errors)
561 					{
562 						expr.assigned++;
563 						exeval(expr.program, $$, NiL);
564 					}
565 #endif
566 				}
567 				else if (!$3)
568 					$1->value->data.value = exzero($1->type);
569 			}
570 		}
571 		;
572 
573 dcl_name	:	NAME
574 		|	DYNAMIC
575 		|	ID
576 		|	FUNCTION
577 		;
578 
579 name		:	NAME
580 		|	DYNAMIC
581 		;
582 
583 else_opt	:	/* empty */
584 		{
585 			$$ = 0;
586 		}
587 		|	ELSE statement
588 		{
589 			$$ = $2;
590 		}
591 		;
592 
593 expr_opt	:	/* empty */
594 		{
595 			$$ = 0;
596 		}
597 		|	expr
598 		;
599 
600 expr		:	'(' expr ')'
601 		{
602 			$$ = $2;
603 		}
604 		|	'(' DECLARE ')' expr	%prec CAST
605 		{
606 			$$ = ($4->type == $2->type) ? $4 : excast(expr.program, $4, $2->type, NiL, 0);
607 		}
608 		|	expr '<' expr
609 		{
610 			int	rel;
611 
612 		relational:
613 			rel = INTEGER;
614 			goto coerce;
615 		binary:
616 			rel = 0;
617 		coerce:
618 			if (!$1->type)
619 			{
620 				if (!$3->type)
621 					$1->type = $3->type = rel ? STRING : INTEGER;
622 				else
623 					$1->type = $3->type;
624 			}
625 			else if (!$3->type)
626 				$3->type = $1->type;
627 			if ($1->type != $3->type)
628 			{
629 				if ($1->type == STRING)
630 					$1 = excast(expr.program, $1, $3->type, $3, 0);
631 				else if ($3->type == STRING)
632 					$3 = excast(expr.program, $3, $1->type, $1, 0);
633 				else if ($1->type == FLOATING)
634 					$3 = excast(expr.program, $3, FLOATING, $1, 0);
635 				else if ($3->type == FLOATING)
636 					$1 = excast(expr.program, $1, FLOATING, $3, 0);
637 			}
638 			if (!rel)
639 				rel = ($1->type == STRING) ? STRING : (($1->type == UNSIGNED) ? UNSIGNED : $3->type);
640 			$$ = exnewnode(expr.program, $2, 1, rel, $1, $3);
641 			if (!expr.program->errors && $1->op == CONSTANT && $3->op == CONSTANT)
642 			{
643 				$$->data.constant.value = exeval(expr.program, $$, NiL);
644 				/* If a constant string, re-allocate from program heap. This is because the
645 				 * value was constructed from string operators, which create a value in the
646 				 * temporary heap, which is cleared when exeval is called again.
647 				 */
648 				if ($$->type == STRING) {
649 					$$->data.constant.value.string =
650 						vmstrdup(expr.program->vm, $$->data.constant.value.string);
651 				}
652 				$$->binary = 0;
653 				$$->op = CONSTANT;
654 				exfreenode(expr.program, $1);
655 				exfreenode(expr.program, $3);
656 			}
657 			else if (!BUILTIN($1->type) || !BUILTIN($3->type)) {
658 				checkBinary(expr.program, $1, $$, $3);
659 			}
660 		}
661 		|	expr '-' expr
662 		{
663 			goto binary;
664 		}
665 		|	expr '*' expr
666 		{
667 			goto binary;
668 		}
669 		|	expr '/' expr
670 		{
671 			goto binary;
672 		}
673 		|	expr '%' expr
674 		{
675 			goto binary;
676 		}
677 		|	expr LS expr
678 		{
679 			goto binary;
680 		}
681 		|	expr RS expr
682 		{
683 			goto binary;
684 		}
685 		|	expr '>' expr
686 		{
687 			goto relational;
688 		}
689 		|	expr LE expr
690 		{
691 			goto relational;
692 		}
693 		|	expr GE expr
694 		{
695 			goto relational;
696 		}
697 		|	expr EQ expr
698 		{
699 			goto relational;
700 		}
701 		|	expr NE expr
702 		{
703 			goto relational;
704 		}
705 		|	expr '&' expr
706 		{
707 			goto binary;
708 		}
709 		|	expr '|' expr
710 		{
711 			goto binary;
712 		}
713 		|	expr '^' expr
714 		{
715 			goto binary;
716 		}
717 		|	expr '+' expr
718 		{
719 			goto binary;
720 		}
721 		|	expr AND expr
722 		{
723 		logical:
724 			if ($1->type == STRING)
725 				$1 = exnewnode(expr.program, S2B, 1, INTEGER, $1, NiL);
726 			else if (!BUILTIN($1->type))
727 				$1 = excast(expr.program, $1, INTEGER, NiL, 0);
728 			if ($3->type == STRING)
729 				$3 = exnewnode(expr.program, S2B, 1, INTEGER, $3, NiL);
730 			else if (!BUILTIN($3->type))
731 				$3 = excast(expr.program, $3, INTEGER, NiL, 0);
732 			goto binary;
733 		}
734 		|	expr OR expr
735 		{
736 			goto logical;
737 		}
738 		|	expr ',' expr
739 		{
740 			if ($1->op == CONSTANT)
741 			{
742 				exfreenode(expr.program, $1);
743 				$$ = $3;
744 			}
745 			else
746 				$$ = exnewnode(expr.program, ',', 1, $3->type, $1, $3);
747 		}
748 		|	expr '?' {expr.nolabel=1;} expr ':' {expr.nolabel=0;} expr
749 		{
750 			if (!$4->type)
751 			{
752 				if (!$7->type)
753 					$4->type = $7->type = INTEGER;
754 				else
755 					$4->type = $7->type;
756 			}
757 			else if (!$7->type)
758 				$7->type = $4->type;
759 			if ($1->type == STRING)
760 				$1 = exnewnode(expr.program, S2B, 1, INTEGER, $1, NiL);
761 			else if (!INTEGRAL($1->type))
762 				$1 = excast(expr.program, $1, INTEGER, NiL, 0);
763 			if ($4->type != $7->type)
764 			{
765 				if ($4->type == STRING || $7->type == STRING)
766 					exerror("if statement string type mismatch");
767 				else if ($4->type == FLOATING)
768 					$7 = excast(expr.program, $7, FLOATING, NiL, 0);
769 				else if ($7->type == FLOATING)
770 					$4 = excast(expr.program, $4, FLOATING, NiL, 0);
771 			}
772 			if ($1->op == CONSTANT)
773 			{
774 				if ($1->data.constant.value.integer)
775 				{
776 					$$ = $4;
777 					exfreenode(expr.program, $7);
778 				}
779 				else
780 				{
781 					$$ = $7;
782 					exfreenode(expr.program, $4);
783 				}
784 				exfreenode(expr.program, $1);
785 			}
786 			else
787 				$$ = exnewnode(expr.program, '?', 1, $4->type, $1, exnewnode(expr.program, ':', 1, $4->type, $4, $7));
788 		}
789 		|	'!' expr
790 		{
791 		iunary:
792 			if ($2->type == STRING)
793 				$2 = exnewnode(expr.program, S2B, 1, INTEGER, $2, NiL);
794 			else if (!INTEGRAL($2->type))
795 				$2 = excast(expr.program, $2, INTEGER, NiL, 0);
796 		unary:
797 			$$ = exnewnode(expr.program, $1, 1, $2->type == UNSIGNED ? INTEGER : $2->type, $2, NiL);
798 			if ($2->op == CONSTANT)
799 			{
800 				$$->data.constant.value = exeval(expr.program, $$, NiL);
801 				$$->binary = 0;
802 				$$->op = CONSTANT;
803 				exfreenode(expr.program, $2);
804 			}
805 			else if (!BUILTIN($2->type)) {
806 				checkBinary(expr.program, $2, $$, 0);
807 			}
808 		}
809 		|	'#' DYNAMIC
810 		{
811 			if ($2->local.pointer == 0)
812               			exerror("cannot apply '#' operator to non-array %s", $2->name);
813 			$$ = exnewnode(expr.program, '#', 0, INTEGER, NiL, NiL);
814 			$$->data.variable.symbol = $2;
815 		}
816 		|	'~' expr
817 		{
818 			goto iunary;
819 		}
820 		|	'-' expr	%prec UNARY
821 		{
822 			goto unary;
823 		}
824 		|	'+' expr	%prec UNARY
825 		{
826 			$$ = $2;
827 		}
828 		|	'&' variable	%prec UNARY
829 		{
830 			$$ = exnewnode(expr.program, ADDRESS, 0, T($2->type), $2, NiL);
831 		}
832 		|	ARRAY '[' args ']'
833 		{
834 			$$ = exnewnode(expr.program, ARRAY, 1, T($1->type), call(0, $1, $3), $3);
835 		}
836 		|	FUNCTION '(' args ')'
837 		{
838 			$$ = exnewnode(expr.program, FUNCTION, 1, T($1->type), call(0, $1, $3), $3);
839 #ifdef UNUSED
840 			if (!expr.program->disc->getf)
841 				exerror("%s: function references not supported", $$->data.operand.left->data.variable.symbol->name);
842 			else if (expr.program->disc->reff)
843 				(*expr.program->disc->reff)(expr.program, $$->data.operand.left, $$->data.operand.left->data.variable.symbol, 0, NiL, EX_CALL, expr.program->disc);
844 #endif
845 		}
846 		|	GSUB '(' args ')'
847 		{
848 			$$ = exnewsub (expr.program, $3, GSUB);
849 		}
850 		|	SUB '(' args ')'
851 		{
852 			$$ = exnewsub (expr.program, $3, SUB);
853 		}
854 		|	SUBSTR '(' args ')'
855 		{
856 			$$ = exnewsubstr (expr.program, $3);
857 		}
858 		|	splitop '(' expr ',' DYNAMIC ')'
859 		{
860 			$$ = exnewsplit (expr.program, $1->index, $5, $3, NiL);
861 		}
862 		|	splitop '(' expr ',' DYNAMIC ',' expr ')'
863 		{
864 			$$ = exnewsplit (expr.program, $1->index, $5, $3, $7);
865 		}
866 		|	EXIT '(' expr ')'
867 		{
868 			if (!INTEGRAL($3->type))
869 				$3 = excast(expr.program, $3, INTEGER, NiL, 0);
870 			$$ = exnewnode(expr.program, EXIT, 1, INTEGER, $3, NiL);
871 		}
872 		|	RAND '(' ')'
873 		{
874 			$$ = exnewnode(expr.program, RAND, 0, FLOATING, NiL, NiL);
875 		}
876 		|	SRAND '(' ')'
877 		{
878 			$$ = exnewnode(expr.program, SRAND, 0, INTEGER, NiL, NiL);
879 		}
880 		|	SRAND '(' expr ')'
881 		{
882 			if (!INTEGRAL($3->type))
883 				$3 = excast(expr.program, $3, INTEGER, NiL, 0);
884 			$$ = exnewnode(expr.program, SRAND, 1, INTEGER, $3, NiL);
885 		}
886 		|	PROCEDURE '(' args ')'
887 		{
888 			$$ = exnewnode(expr.program, CALL, 1, $1->type, NiL, $3);
889 			$$->data.call.procedure = $1;
890 		}
891 		|	PRINT '(' args ')'
892 		{
893 			$$ = exprint(expr.program, $1, $3);
894 		}
895 		|	print '(' args ')'
896 		{
897 			$$ = exnewnode(expr.program, $1->index, 0, $1->type, NiL, NiL);
898 			if ($3 && $3->data.operand.left->type == INTEGER)
899 			{
900 				$$->data.print.descriptor = $3->data.operand.left;
901 				$3 = $3->data.operand.right;
902 			}
903 			else
904 				switch ($1->index)
905 				{
906 				case QUERY:
907 					$$->data.print.descriptor = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
908 					$$->data.print.descriptor->data.constant.value.integer = 2;
909 					break;
910 				case PRINTF:
911 					$$->data.print.descriptor = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
912 					$$->data.print.descriptor->data.constant.value.integer = 1;
913 					break;
914 				case SPRINTF:
915 					$$->data.print.descriptor = 0;
916 					break;
917 				}
918 			$$->data.print.args = preprint($3);
919 		}
920 		|	scan '(' args ')'
921 		{
922 			register Exnode_t*	x;
923 
924 			$$ = exnewnode(expr.program, $1->index, 0, $1->type, NiL, NiL);
925 			if ($3 && $3->data.operand.left->type == INTEGER)
926 			{
927 				$$->data.scan.descriptor = $3->data.operand.left;
928 				$3 = $3->data.operand.right;
929 			}
930 			else
931 				switch ($1->index)
932 				{
933 				case SCANF:
934 					$$->data.scan.descriptor = 0;
935 					break;
936 				case SSCANF:
937 					if ($3 && $3->data.operand.left->type == STRING)
938 					{
939 						$$->data.scan.descriptor = $3->data.operand.left;
940 						$3 = $3->data.operand.right;
941 					}
942 					else
943 						exerror("%s: string argument expected", $1->name);
944 					break;
945 				}
946 			if (!$3 || !$3->data.operand.left || $3->data.operand.left->type != STRING)
947 				exerror("%s: format argument expected", $1->name);
948 			$$->data.scan.format = $3->data.operand.left;
949 			for (x = $$->data.scan.args = $3->data.operand.right; x; x = x->data.operand.right)
950 			{
951 				if (x->data.operand.left->op != ADDRESS)
952 					exerror("%s: address argument expected", $1->name);
953 				x->data.operand.left = x->data.operand.left->data.operand.left;
954 			}
955 		}
956 		|	variable assign
957 		{
958 			if ($2)
959 			{
960 				if ($1->op == ID && !expr.program->disc->setf)
961 					exerror("%s: variable assignment not supported", $1->data.variable.symbol->name);
962 				else
963 				{
964 					if (!$1->type)
965 						$1->type = $2->type;
966 #if 0
967 					else if ($2->type != $1->type && $1->type >= 0200)
968 #else
969 					else if ($2->type != $1->type)
970 #endif
971 					{
972 						$2->type = $1->type;
973 						$2->data.operand.right = excast(expr.program, $2->data.operand.right, $1->type, NiL, 0);
974 					}
975 					$2->data.operand.left = $1;
976 					$$ = $2;
977 				}
978 			}
979 		}
980 		|	INC variable
981 		{
982 		pre:
983 			if ($2->type == STRING)
984 				exerror("++ and -- invalid for string variables");
985 			$$ = exnewnode(expr.program, $1, 0, $2->type, $2, NiL);
986 			$$->subop = PRE;
987 		}
988 		|	variable INC
989 		{
990 		pos:
991 			if ($1->type == STRING)
992 				exerror("++ and -- invalid for string variables");
993 			$$ = exnewnode(expr.program, $2, 0, $1->type, $1, NiL);
994 			$$->subop = POS;
995 		}
996 		|	expr IN_OP DYNAMIC
997 		{
998 			if ($3->local.pointer == 0)
999               			exerror("cannot apply IN to non-array %s", $3->name);
1000 			if (($3->index_type > 0) && ($1->type != $3->index_type))
1001             		    exerror("%s indices must have type %s, not %s",
1002 				$3->name, extypename(expr.program, $3->index_type),extypename(expr.program, $1->type));
1003 			$$ = exnewnode(expr.program, IN_OP, 0, INTEGER, NiL, NiL);
1004 			$$->data.variable.symbol = $3;
1005 			$$->data.variable.index = $1;
1006 		}
1007 		|	DEC variable
1008 		{
1009 			goto pre;
1010 		}
1011 		|	variable DEC
1012 		{
1013 			goto pos;
1014 		}
1015 		|	constant
1016 		;
1017 
1018 splitop		:	SPLIT
1019 		|	TOKENS
1020 		;
1021 constant	:	CONSTANT
1022 		{
1023 			$$ = exnewnode(expr.program, CONSTANT, 0, $1->type, NiL, NiL);
1024 			if (!expr.program->disc->reff)
1025 				exerror("%s: identifier references not supported", $1->name);
1026 			else
1027 				$$->data.constant.value = (*expr.program->disc->reff)(expr.program, $$, $1, NiL, NiL, EX_SCALAR, expr.program->disc);
1028 		}
1029 		|	FLOATING
1030 		{
1031 			$$ = exnewnode(expr.program, CONSTANT, 0, FLOATING, NiL, NiL);
1032 			$$->data.constant.value.floating = $1;
1033 		}
1034 		|	INTEGER
1035 		{
1036 			$$ = exnewnode(expr.program, CONSTANT, 0, INTEGER, NiL, NiL);
1037 			$$->data.constant.value.integer = $1;
1038 		}
1039 		|	STRING
1040 		{
1041 			$$ = exnewnode(expr.program, CONSTANT, 0, STRING, NiL, NiL);
1042 			$$->data.constant.value.string = $1;
1043 		}
1044 		|	UNSIGNED
1045 		{
1046 			$$ = exnewnode(expr.program, CONSTANT, 0, UNSIGNED, NiL, NiL);
1047 			$$->data.constant.value.integer = $1;
1048 		}
1049 		;
1050 
1051 print		:	PRINTF
1052 		|	QUERY
1053 		|	SPRINTF
1054 		;
1055 
1056 scan		:	SCANF
1057 		|	SSCANF
1058 		;
1059 
1060 variable	:	ID members
1061 		{
1062 			$$ = makeVar(expr.program, $1, 0, 0, $2);
1063 		}
1064 		|	DYNAMIC index members
1065 		{
1066 			Exnode_t*   n;
1067 
1068 			n = exnewnode(expr.program, DYNAMIC, 0, $1->type, NiL, NiL);
1069 			n->data.variable.symbol = $1;
1070 			n->data.variable.reference = 0;
1071 			if (((n->data.variable.index = $2) == 0) != ($1->local.pointer == 0))
1072 				exerror("%s: is%s an array", $1->name, $1->local.pointer ? "" : " not");
1073 			if ($1->local.pointer && ($1->index_type > 0)) {
1074 				if ($2->type != $1->index_type)
1075 					exerror("%s: indices must have type %s, not %s",
1076 						$1->name, extypename(expr.program, $1->index_type),extypename(expr.program, $2->type));
1077 			}
1078 			if ($3) {
1079 				n->data.variable.dyna =exnewnode(expr.program, 0, 0, 0, NiL, NiL);
1080 				$$ = makeVar(expr.program, $1, $2, n, $3);
1081 			}
1082 			else $$ = n;
1083 		}
1084 		|	NAME
1085 		{
1086 			$$ = exnewnode(expr.program, ID, 0, STRING, NiL, NiL);
1087 			$$->data.variable.symbol = $1;
1088 			$$->data.variable.reference = 0;
1089 			$$->data.variable.index = 0;
1090 			$$->data.variable.dyna = 0;
1091 			if (!(expr.program->disc->flags & EX_UNDECLARED))
1092 				exerror("unknown identifier");
1093 		}
1094 		;
1095 
1096 array		:	/* empty */
1097 		{
1098 			$$ = 0;
1099 		}
1100 		|	'[' ']'
1101 		{
1102 			$$ = -1;
1103 		}
1104 		|	'[' DECLARE ']'
1105 		{
1106 			/* If DECLARE is VOID, its type is 0, so this acts like
1107 			 * the empty case.
1108 			 */
1109 			if (INTEGRAL($2->type))
1110 				$$ = INTEGER;
1111 			else
1112 				$$ = $2->type;
1113 
1114 		}
1115 		;
1116 
1117 index		:	/* empty */
1118 		{
1119 			$$ = 0;
1120 		}
1121 		|	'[' expr ']'
1122 		{
1123 			$$ = $2;
1124 		}
1125 		;
1126 
1127 args		:	/* empty */
1128 		{
1129 			$$ = 0;
1130 		}
1131 		|	arg_list
1132 		{
1133 			$$ = $1->data.operand.left;
1134 			$1->data.operand.left = $1->data.operand.right = 0;
1135 			exfreenode(expr.program, $1);
1136 		}
1137 		;
1138 
1139 arg_list	:	expr		%prec ','
1140 		{
1141 			$$ = exnewnode(expr.program, ',', 1, 0, exnewnode(expr.program, ',', 1, $1->type, $1, NiL), NiL);
1142 			$$->data.operand.right = $$->data.operand.left;
1143 		}
1144 		|	arg_list ',' expr
1145 		{
1146 			$1->data.operand.right = $1->data.operand.right->data.operand.right = exnewnode(expr.program, ',', 1, $1->type, $3, NiL);
1147 		}
1148 		;
1149 
1150 formals		:	/* empty */
1151 		{
1152 			$$ = 0;
1153 		}
1154 		|	DECLARE
1155 		{
1156 			$$ = 0;
1157 			if ($1->type)
1158 				exerror("(void) expected");
1159 		}
1160 		|	formal_list
1161 		;
1162 
1163 formal_list	:	formal_item
1164 		{
1165 			$$ = exnewnode(expr.program, ',', 1, $1->type, $1, NiL);
1166 		}
1167 		|	formal_list ',' formal_item
1168 		{
1169 			register Exnode_t*	x;
1170 			register Exnode_t*	y;
1171 
1172 			$$ = $1;
1173 			for (x = $1; (y = x->data.operand.right); x = y);
1174 			x->data.operand.right = exnewnode(expr.program, ',', 1, $3->type, $3, NiL);
1175 		}
1176 		;
1177 
1178 formal_item	:	DECLARE {expr.declare=$1->type;} name
1179 		{
1180 			$$ = exnewnode(expr.program, ID, 0, $1->type, NiL, NiL);
1181 			$$->data.variable.symbol = $3;
1182 			$3->lex = DYNAMIC;
1183 			$3->type = $1->type;
1184 			$3->value = exnewnode(expr.program, 0, 0, 0, NiL, NiL);
1185 			expr.procedure->data.procedure.arity++;
1186 			expr.declare = 0;
1187 		}
1188 		;
1189 
1190 members	:	/* empty */
1191 		{
1192 			$$ = expr.refs = expr.lastref = 0;
1193 		}
1194 		|	member
1195 		{
1196 			Exref_t*	r;
1197 
1198 			r = ALLOCATE(expr.program, Exref_t);
1199 			r->symbol = $1;
1200 			expr.refs = r;
1201 			expr.lastref = r;
1202 			r->next = 0;
1203 			r->index = 0;
1204 			$$ = expr.refs;
1205 		}
1206 		|	'.' ID member
1207 		{
1208 			Exref_t*	r;
1209 			Exref_t*	l;
1210 
1211 			r = ALLOCATE(expr.program, Exref_t);
1212 			r->symbol = $3;
1213 			r->index = 0;
1214 			r->next = 0;
1215 			l = ALLOCATE(expr.program, Exref_t);
1216 			l->symbol = $2;
1217 			l->index = 0;
1218 			l->next = r;
1219 			expr.refs = l;
1220 			expr.lastref = r;
1221 			$$ = expr.refs;
1222 		}
1223 		;
1224 
1225 member	:	'.' ID
1226 		{
1227 			$$ = $2;
1228 		}
1229 		|	'.' NAME
1230 		{
1231 			$$ = $2;
1232 		}
1233 		;
1234 assign		:	/* empty */
1235 		{
1236 			$$ = 0;
1237 		}
1238 		|	'=' expr
1239 		{
1240 			$$ = exnewnode(expr.program, '=', 1, $2->type, NiL, $2);
1241 			$$->subop = $1;
1242 		}
1243 		;
1244 
1245 initialize	:	assign
1246 		|	'(' {
1247 				register Dtdisc_t*	disc;
1248 
1249 				if (expr.procedure)
1250 					exerror("%s: nested function definitions not supported", expr.id->name);
1251 				expr.procedure = exnewnode(expr.program, PROCEDURE, 1, expr.declare, NiL, NiL);
1252 				if (!(disc = newof(0, Dtdisc_t, 1, 0)))
1253 					exnospace();
1254 				disc->key = offsetof(Exid_t, name);
1255 				if (!streq(expr.id->name, "begin"))
1256 				{
1257 					if (!(expr.procedure->data.procedure.frame = dtopen(disc, Dtset)) || !dtview(expr.procedure->data.procedure.frame, expr.program->symbols))
1258 						exnospace();
1259 					expr.program->symbols = expr.program->frame = expr.procedure->data.procedure.frame;
1260 					expr.program->formals = 1;
1261 				}
1262 				expr.declare = 0;
1263 			} formals {
1264 				expr.id->lex = PROCEDURE;
1265 				expr.id->type = expr.procedure->type;
1266 				expr.program->formals = 0;
1267 				expr.declare = 0;
1268 			} ')' '{' statement_list '}'
1269 		{
1270 			$$ = expr.procedure;
1271 			expr.procedure = 0;
1272 			if (expr.program->frame)
1273 			{
1274 				expr.program->symbols = expr.program->frame->view;
1275 				dtview(expr.program->frame, NiL);
1276 				expr.program->frame = 0;
1277 			}
1278 			$$->data.operand.left = $3;
1279 			$$->data.operand.right = excast(expr.program, $7, $$->type, NiL, 0);
1280 
1281 			/*
1282 			 * NOTE: procedure definition was slipped into the
1283 			 *	 declaration initializer statement production,
1284 			 *	 therefore requiring the statement terminator
1285 			 */
1286 
1287 			exunlex(expr.program, ';');
1288 		}
1289 		;
1290 
1291 %%
1292 
1293 #include "exgram.h"
1294