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