]> gcc.gnu.org Git - gcc.git/blame - gcc/ch/parse.c
git://gcc.gnu.org / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Makefile.in (OBJS, PROTO_OBJS): Remove getpwd.o.
[gcc.git] / gcc / ch / parse.c
CommitLineData
3c79b2da 1/* Parser for GNU CHILL (CCITT High-Level Language) -*- C -*-
ed730bcf 2 Copyright (C) 1992, 1993, 1998, 1999 Free Software Foundation, Inc.
3c79b2da
PB		 3
4This file is part of GNU CC.
5
6GNU CC is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option)
9any later version.
10
11GNU CC is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU CC; see the file COPYING. If not, write to
6f48294d
JL		 18the Free Software Foundation, 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */
3c79b2da
PB		 20
21/*
22 * This is a two-pass parser. In pass 1, we collect declarations,
23 * ignoring actions and most expressions. We store only the
24 * declarations and close, open and re-lex the input file to save
25 * main memory. We anticipate that the compiler will be processing
26 * *very* large single programs which are mechanically generated,
27 * and so we want to store a minimum of information between passes.
28 *
29 * yylex detects the end of the main input file and returns the
30 * END_PASS_1 token. We then re-initialize each CHILL compiler
31 * module's global variables and re-process the input file. The
32 * grant file is output. If the user has requested it, GNU CHILL
33 * exits at this time - its only purpose was to generate the grant
34 * file. Optionally, the compiler may exit if errors were detected
35 * in pass 1.
36 *
37 * As each symbol scope is entered, we install its declarations into
38 * the symbol table. Undeclared types and variables are announced
39 * now.
40 *
41 * Then code is generated.
42 */
43
3c79b2da 44#include "config.h"
75111422 45#include "system.h"
3c79b2da
PB		 46#include "tree.h"
47#include "ch-tree.h"
48#include "lex.h"
49#include "actions.h"
50#include "tasking.h"
51#include "parse.h"
75111422 52#include "toplev.h"
3c79b2da
PB		 53
54/* Since parsers are distinct for each language, put the
55 language string definition here. (fnf) */
56char *language_string = "GNU CHILL";
57
58/* Common code to be done before expanding any action. */
59#define INIT_ACTION { \
60 if (! ignoring) emit_line_note (input_filename, lineno); }
61
62/* Pop a scope for an ON handler. */
63#define POP_USED_ON_CONTEXT pop_handler(1)
64
65/* Pop a scope for an ON handler that wasn't there. */
66#define POP_UNUSED_ON_CONTEXT pop_handler(0)
67
68#define PUSH_ACTION push_action()
69
70/* Cause the `yydebug' variable to be defined. */
71#define YYDEBUG 1
72
3c79b2da
PB		 73extern struct rtx_def* gen_label_rtx PROTO((void));
74extern void emit_jump PROTO((struct rtx_def *));
c1daea12 75extern struct rtx_def* emit_label PROTO((struct rtx_def *));
3c79b2da 76
ed730bcf
JL		 77/* This is a hell of a lot easier than getting expr.h included in
78 by parse.c. */
79extern struct rtx_def *expand_expr PROTO((tree, struct rtx_def *,
80 enum machine_mode, int));
81
75111422 82static int parse_action PROTO((void));
31029ad7
KG		 83static void ch_parse_init PROTO((void));
84static void check_end_label PROTO((tree, tree));
85static void end_function PROTO((void));
86static tree build_prefix_clause PROTO((tree));
87static enum terminal PEEK_TOKEN PROTO((void));
88static int peek_token_ PROTO((int));
89static void pushback_token PROTO((int, tree));
90static void forward_token_ PROTO((void));
91static void require PROTO((enum terminal));
92static int check_token PROTO((enum terminal));
93static int expect PROTO((enum terminal, const char *));
94static void define__PROCNAME__ PROTO((void));
3c79b2da
PB		 95
96extern int lineno;
97extern char *input_filename;
98extern tree generic_signal_type_node;
99extern tree signal_code;
100extern int all_static_flag;
101extern int ignore_case;
102
75111422 103#if 0
3c79b2da 104static int quasi_signal = 0; /* 1 if processing a quasi signal decl */
75111422 105#endif
3c79b2da
PB		 106
107int parsing_newmode; /* 0 while parsing SYNMODE;
108 1 while parsing NEWMODE. */
109int expand_exit_needed = 0;
110
111/* Gets incremented if we see errors such that we don't want to run pass 2. */
112
113int serious_errors = 0;
114
115static tree current_fieldlist;
116
117/* We don't care about expressions during pass 1, except while we're
118 parsing the RHS of a SYN definition, or while parsing a mode that
119 we need. NOTE: This also causes mode expressions to be ignored. */
120int ignoring = 1; /* 1 to ignore expressions */
121
122/* True if we have seen an action not in a (user) function. */
123int seen_action = 0;
124int build_constructor = 0;
125
126/* The action_nesting_level of the current procedure body. */
127int proc_action_level = 0;
128
129/* This is the identifier of the label that prefixes the current action,
130 or NULL if there was none. It is cleared at the end of an action,
131 or when starting a nested action list, so get it while you can! */
132static tree label = NULL_TREE; /* for statement labels */
133
134#if 0
135static tree current_block;
136#endif
137
138int in_pseudo_module = 0;
139int pass = 0; /* 0 for init_decl_processing,
140 1 for pass 1, 2 for pass 2 */
141\f
142/* re-initialize global variables for pass 2 */
143static void
144ch_parse_init ()
145{
146 expand_exit_needed = 0;
147 label = NULL_TREE; /* for statement labels */
148 current_module = NULL;
149 in_pseudo_module = 0;
150}
151
152static void
153check_end_label (start, end)
154 tree start, end;
155{
156 if (end != NULL_TREE)
157 {
158 if (start == NULL_TREE && pass == 1)
159 error ("there was no start label to match the end label '%s'",
160 IDENTIFIER_POINTER(end));
161 else if (start != end && pass == 1)
162 error ("start label '%s' does not match end label '%s'",
163 IDENTIFIER_POINTER(start),
164 IDENTIFIER_POINTER(end));
165 }
166}
167
168
169/*
170 * given a tree which is an id, a type or a decl,
171 * return the associated type, or issue an error and
172 * return error_mark_node.
173 */
174tree
175get_type_of (id_or_decl)
176 tree id_or_decl;
177{
178 tree type = id_or_decl;
179
180 if (id_or_decl == NULL_TREE
181 || TREE_CODE (id_or_decl) == ERROR_MARK)
182 return error_mark_node;
183
184 if (pass == 1 || ignoring == 1)
185 return id_or_decl;
186
187 if (TREE_CODE (type) == IDENTIFIER_NODE)
188 {
189 type = lookup_name (id_or_decl);
190 if (type == NULL_TREE)
191 {
192 error ("`%s' not declared", IDENTIFIER_POINTER (id_or_decl));
193 type = error_mark_node;
194 }
195 }
196 if (TREE_CODE (type) == TYPE_DECL)
197 type = TREE_TYPE (type);
198 return type; /* was a type all along */
199}
200
201
202static void
203end_function ()
204{
205 if (CH_DECL_PROCESS (current_function_decl))
206 {
207 /* finishing a process */
208 if (! ignoring)
209 {
210 tree result =
211 build_chill_function_call
212 (lookup_name (get_identifier ("__stop_process")),
213 NULL_TREE);
214 expand_expr_stmt (result);
215 emit_line_note (input_filename, lineno);
216 }
217 }
218 else
219 {
220 /* finishing a procedure.. */
221 if (! ignoring)
222 {
223 if (result_never_set
224 && TREE_CODE (TREE_TYPE (TREE_TYPE (current_function_decl)))
225 != VOID_TYPE)
226 warning ("No RETURN or RESULT in procedure");
227 chill_expand_return (NULL_TREE, 1);
228 }
229 }
230 finish_chill_function ();
231 pop_chill_function_context ();
232}
233
234static tree
235build_prefix_clause (id)
236 tree id;
237{
238 if (!id)
239 {
240 if (current_module && current_module->name)
31029ad7 241 { const char *module_name = IDENTIFIER_POINTER (current_module->name);
3c79b2da
PB		 242 if (module_name[0] && module_name[0] != '_')
243 return current_module->name;
244 }
245 error ("PREFIXED clause with no prelix in unlabeled module");
246 }
247 return id;
248}
249
250void
251possibly_define_exit_label (label)
252 tree label;
253{
254 if (label)
255 define_label (input_filename, lineno, munge_exit_label (label));
256}
257
258#define MAX_LOOK_AHEAD 2
259static enum terminal terminal_buffer[MAX_LOOK_AHEAD+1];
260YYSTYPE yylval;
261static YYSTYPE val_buffer[MAX_LOOK_AHEAD+1];
262
263/*enum terminal current_token, lookahead_token;*/
264
265#define TOKEN_NOT_READ dummy_last_terminal
266
267#ifdef __GNUC__
268__inline__
269#endif
75111422 270static enum terminal
3c79b2da
PB		 271PEEK_TOKEN()
272{
273 if (terminal_buffer[0] == TOKEN_NOT_READ)
274 {
275 terminal_buffer[0] = yylex();
276 val_buffer[0] = yylval;
277 }
278 return terminal_buffer[0];
279}
280#define PEEK_TREE() val_buffer[0].ttype
281#define PEEK_TOKEN1() peek_token_(1)
282#define PEEK_TOKEN2() peek_token_(2)
283static int
284peek_token_ (i)
285 int i;
286{
287 if (i > MAX_LOOK_AHEAD)
288 fatal ("internal error - too much lookahead");
289 if (terminal_buffer[i] == TOKEN_NOT_READ)
290 {
291 terminal_buffer[i] = yylex();
292 val_buffer[i] = yylval;
293 }
294 return terminal_buffer[i];
295}
296
297static void
298pushback_token (code, node)
299 int code;
300 tree node;
301{
302 int i;
303 if (terminal_buffer[MAX_LOOK_AHEAD] != TOKEN_NOT_READ)
304 fatal ("internal error - cannot pushback token");
305 for (i = MAX_LOOK_AHEAD; i > 0; i--)
306 {
307 terminal_buffer[i] = terminal_buffer[i - 1];
308 val_buffer[i] = val_buffer[i - 1];
309 }
310 terminal_buffer[0] = code;
311 val_buffer[0].ttype = node;
312}
313
314static void
315forward_token_()
316{
317 int i;
318 for (i = 0; i < MAX_LOOK_AHEAD; i++)
319 {
320 terminal_buffer[i] = terminal_buffer[i+1];
321 val_buffer[i] = val_buffer[i+1];
322 }
323 terminal_buffer[MAX_LOOK_AHEAD] = TOKEN_NOT_READ;
324}
325#define FORWARD_TOKEN() forward_token_()
326
327/* Skip the next token.
328 if it isn't TOKEN, the parser is broken. */
329
31029ad7 330static void
3c79b2da
PB		 331require(token)
332 enum terminal token;
333{
334 if (PEEK_TOKEN() != token)
335 {
336 char buf[80];
337 sprintf (buf, "internal parser error - expected token %d", (int)token);
338 fatal(buf);
339 }
340 FORWARD_TOKEN();
341}
342
31029ad7 343static int
3c79b2da
PB		 344check_token (token)
345 enum terminal token;
346{
347 if (PEEK_TOKEN() != token)
348 return 0;
349 FORWARD_TOKEN ();
350 return 1;
351}
352
353/* return 0 if expected token was not found,
354 else return 1.
355*/
31029ad7 356static int
3c79b2da
PB		 357expect(token, message)
358 enum terminal token;
31029ad7 359 const char *message;
3c79b2da
PB		 360{
361 if (PEEK_TOKEN() != token)
362 {
363 if (pass == 1)
364 error(message ? message : "syntax error");
365 return 0;
366 }
367 else
368 FORWARD_TOKEN();
369 return 1;
370}
371
372/* define a SYNONYM __PROCNAME__ (__procname__) which holds
373 the name of the current procedure.
374 This should be quit the same as __FUNCTION__ in C */
375static void
376define__PROCNAME__ ()
377{
31029ad7 378 const char *fname;
3c79b2da
PB		 379 tree string;
380 tree procname;
381
382 if (current_function_decl == NULL_TREE)
383 fname = "toplevel";
384 else
385 fname = IDENTIFIER_POINTER (DECL_NAME (current_function_decl));
386
387 string = build_chill_string (strlen (fname), fname);
388 procname = get_identifier (ignore_case ? "__procname__" : "__PROCNAME__");
389 push_syndecl (procname, NULL_TREE, string);
390}
391
392/* Forward declarations. */
31029ad7
KG		 393static tree parse_expression PROTO((void));
394static tree parse_primval PROTO((void));
3c79b2da
PB		 395static tree parse_mode PROTO((void));
396static tree parse_opt_mode PROTO((void));
31029ad7
KG		 397static tree parse_untyped_expr PROTO((void));
398static tree parse_opt_untyped_expr PROTO((void));
3c79b2da 399static int parse_definition PROTO((int));
31029ad7 400static void parse_opt_actions PROTO((void));
3c79b2da
PB		 401static void parse_body PROTO((void));
402static tree parse_if_expression_body PROTO((void));
403static tree parse_opt_handler PROTO((void));
31029ad7
KG		 404static tree parse_opt_name_string PROTO((int));
405static tree parse_simple_name_string PROTO((void));
406static tree parse_name_string PROTO((void));
407static tree parse_defining_occurrence PROTO((void));
408static tree parse_name PROTO((void));
409static tree parse_optlabel PROTO((void));
410static void parse_opt_end_label_semi_colon PROTO((tree));
411static void parse_modulion PROTO((tree));
412static void parse_spec_module PROTO((tree));
413static void parse_semi_colon PROTO((void));
414static tree parse_defining_occurrence_list PROTO((void));
415static void parse_mode_definition PROTO((int));
416static void parse_mode_definition_statement PROTO((int));
417static void parse_synonym_definition PROTO((void));
418static void parse_synonym_definition_statement PROTO((void));
419static tree parse_on_exception_list PROTO((void));
420static void parse_on_alternatives PROTO((void));
421static void parse_loc_declaration PROTO((int));
422static void parse_declaration_statement PROTO((int));
423static tree parse_optforbid PROTO((void));
424static tree parse_postfix PROTO((enum terminal));
425static tree parse_postfix_list PROTO((enum terminal));
426static void parse_rename_clauses PROTO((enum terminal));
427static tree parse_opt_prefix_clause PROTO((void));
428static void parse_grant_statement PROTO((void));
429static void parse_seize_statement PROTO((void));
430static tree parse_param_name_list PROTO((void));
431static tree parse_param_attr PROTO((void));
432static tree parse_formpar PROTO((void));
433static tree parse_formparlist PROTO((void));
434static tree parse_opt_result_spec PROTO((void));
435static tree parse_opt_except PROTO((void));
436static tree parse_opt_recursive PROTO((void));
437static tree parse_procedureattr PROTO((void));
438static void parse_proc_body PROTO((tree, tree));
439static void parse_procedure_definition PROTO((int));
440static tree parse_processpar PROTO((void));
441static tree parse_processparlist PROTO((void));
442static void parse_process_definition PROTO((int));
443static void parse_signal_definition PROTO((void));
444static void parse_signal_definition_statement PROTO((void));
445static void parse_then_clause PROTO((void));
446static void parse_opt_else_clause PROTO((void));
447static tree parse_expr_list PROTO((void));
448static tree parse_range_list_clause PROTO((void));
449static void pushback_paren_expr PROTO((tree));
450static tree parse_case_label PROTO((void));
451static tree parse_case_label_list PROTO((tree, int));
452static tree parse_case_label_specification PROTO((tree));
453static void parse_single_dimension_case_action PROTO((tree));
454static void parse_multi_dimension_case_action PROTO((tree));
455static void parse_case_action PROTO((tree));
456static tree parse_asm_operands PROTO((void));
457static tree parse_asm_clobbers PROTO((void));
458static void ch_expand_asm_operands PROTO((tree, tree, tree, tree, int, char *, int));
459static void parse_asm_action PROTO((void));
460static void parse_begin_end_block PROTO((tree));
461static void parse_if_action PROTO((tree));
462static void parse_iteration PROTO((void));
463static tree parse_delay_case_event_list PROTO((void));
464static void parse_delay_case_action PROTO((tree));
465static void parse_do_action PROTO((tree));
466static tree parse_receive_spec PROTO((void));
467static void parse_receive_case_action PROTO((tree));
468static void parse_send_action PROTO((void));
469static void parse_start_action PROTO((void));
470static tree parse_call PROTO((tree));
471static tree parse_tuple_fieldname_list PROTO((void));
472static tree parse_tuple_element PROTO((void));
473static tree parse_opt_element_list PROTO((void));
474static tree parse_tuple PROTO((tree));
475static tree parse_operand6 PROTO((void));
476static tree parse_operand5 PROTO((void));
477static tree parse_operand4 PROTO((void));
478static tree parse_operand3 PROTO((void));
479static tree parse_operand2 PROTO((void));
480static tree parse_operand1 PROTO((void));
481static tree parse_operand0 PROTO((void));
482static tree parse_case_expression PROTO((void));
483static tree parse_then_alternative PROTO((void));
484static tree parse_else_alternative PROTO((void));
485static tree parse_if_expression PROTO((void));
486static tree parse_index_mode PROTO((void));
487static tree parse_set_mode PROTO((void));
488static tree parse_pos PROTO((void));
489static tree parse_step PROTO((void));
490static tree parse_opt_layout PROTO((int));
491static tree parse_field_name_list PROTO((void));
492static tree parse_fixed_field PROTO((void));
493static tree parse_variant_field_list PROTO((void));
494static tree parse_variant_alternative PROTO((void));
495static tree parse_field PROTO((void));
496static tree parse_structure_mode PROTO((void));
497static tree parse_opt_queue_size PROTO((void));
498static tree parse_procedure_mode PROTO((void));
499static void parse_program PROTO((void));
500static void parse_pass_1_2 PROTO((void));
3c79b2da
PB		 501
502static tree
503parse_opt_name_string (allow_all)
504 int allow_all; /* 1 if ALL is allowed as a postfix */
505{
506 enum terminal token = PEEK_TOKEN();
507 tree name;
508 if (token != NAME)
509 {
510 if (token == ALL && allow_all)
511 {
512 FORWARD_TOKEN ();
513 return ALL_POSTFIX;
514 }
515 return NULL_TREE;
516 }
517 name = PEEK_TREE();
518 for (;;)
519 {
520 FORWARD_TOKEN ();
521 token = PEEK_TOKEN();
522 if (token != '!')
523 return name;
524 FORWARD_TOKEN();
525 token = PEEK_TOKEN();
526 if (token == ALL && allow_all)
527 return get_identifier3(IDENTIFIER_POINTER (name), "!", "*");
528 if (token != NAME)
529 {
530 if (pass == 1)
531 error ("'%s!' is not followed by an identifier",
532 IDENTIFIER_POINTER (name));
533 return name;
534 }
535 name = get_identifier3(IDENTIFIER_POINTER(name),
536 "!", IDENTIFIER_POINTER(PEEK_TREE()));
537 }
538}
539
540static tree
541parse_simple_name_string ()
542{
543 enum terminal token = PEEK_TOKEN();
544 tree name;
545 if (token != NAME)
546 {
547 error ("expected a name here");
548 return error_mark_node;
549 }
550 name = PEEK_TREE ();
551 FORWARD_TOKEN ();
552 return name;
553}
554
555static tree
556parse_name_string ()
557{
558 tree name = parse_opt_name_string (0);
559 if (name)
560 return name;
561 if (pass == 1)
562 error ("expected a name string here");
563 return error_mark_node;
564}
565
566static tree
567parse_defining_occurrence ()
568{
569 if (PEEK_TOKEN () == NAME)
570 {
571 tree id = PEEK_TREE();
572 FORWARD_TOKEN ();
573 return id;
574 }
575 return NULL;
576}
577
578/* Matches: <name_string>
579 Returns if pass 1: the identifier.
580 Returns if pass 2: a decl or value for identifier. */
581
582static tree
583parse_name ()
584{
585 tree name = parse_name_string ();
586 if (pass == 1 || ignoring)
587 return name;
588 else
589 {
590 tree decl = lookup_name (name);
591 if (decl == NULL_TREE)
592 {
593 error ("`%s' undeclared", IDENTIFIER_POINTER (name));
594 return error_mark_node;
595 }
596 else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK)
597 return error_mark_node;
598 else if (TREE_CODE (decl) == CONST_DECL)
599 return DECL_INITIAL (decl);
600 else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE)
601 return convert_from_reference (decl);
602 else
603 return decl;
604 }
605}
606
607static tree
608parse_optlabel()
609{
610 tree label = parse_defining_occurrence();
611 if (label != NULL)
612 expect(COLON, "expected a ':' here");
613 return label;
614}
615
616static void
617parse_semi_colon ()
618{
619 enum terminal token = PEEK_TOKEN ();
620 if (token == SC)
621 FORWARD_TOKEN ();
622 else if (pass == 1)
623 (token == END ? pedwarn : error) ("expected ';' here");
624 label = NULL_TREE;
625}
626
627static void
628parse_opt_end_label_semi_colon (start_label)
629 tree start_label;
630{
631 if (PEEK_TOKEN() == NAME)
632 {
633 tree end_label = parse_name_string ();
634 check_end_label (start_label, end_label);
635 }
636 parse_semi_colon ();
637}
638
3c79b2da
PB		 639static void
640parse_modulion (label)
641 tree label;
642{
643 tree module_name;
644
645 label = set_module_name (label);
646 module_name = push_module (label, 0);
647 FORWARD_TOKEN();
648
649 push_action ();
650 parse_body();
651 expect(END, "expected END here");
652 parse_opt_handler ();
653 parse_opt_end_label_semi_colon (label);
654 find_granted_decls ();
655 pop_module ();
656}
657
658static void
659parse_spec_module (label)
660 tree label;
661{
3c79b2da 662 int save_ignoring = ignoring;
12fe4621
KG		 663
664 push_module (set_module_name (label), 1);
3c79b2da
PB		 665 ignoring = pass == 2;
666 FORWARD_TOKEN(); /* SKIP SPEC */
667 expect (MODULE, "expected 'MODULE' here");
668
669 while (parse_definition (1)) { }
670 if (parse_action ())
671 error ("action not allowed in SPEC MODULE");
672 expect(END, "expected END here");
673 parse_opt_end_label_semi_colon (label);
674 find_granted_decls ();
675 pop_module ();
676 ignoring = save_ignoring;
677}
678
679/* Matches: <name_string> ( "," <name_string> )*
680 Returns either a single IDENTIFIER_NODE,
681 or a chain (TREE_LIST) of IDENTIFIER_NODES.
682 (Since a single identifier is the common case, we avoid wasting space
683 (twice, once for each pass) with extra TREE_LIST nodes in that case.)
684 (Will not return NULL_TREE even if ignoring is true.) */
685
686static tree
687parse_defining_occurrence_list ()
688{
689 tree chain = NULL_TREE;
690 tree name = parse_defining_occurrence ();
691 if (name == NULL_TREE)
692 {
693 error("missing defining occurrence");
694 return NULL_TREE;
695 }
696 if (! check_token (COMMA))
697 return name;
698 chain = build_tree_list (NULL_TREE, name);
699 for (;;)
700 {
701 name = parse_defining_occurrence ();
702 if (name == NULL)
703 {
704 error ("bad defining occurrence following ','");
705 break;
706 }
707 chain = tree_cons (NULL_TREE, name, chain);
708 if (! check_token (COMMA))
709 break;
710 }
711 return nreverse (chain);
712}
713
714static void
715parse_mode_definition (is_newmode)
716 int is_newmode;
717{
718 tree mode, names;
719 int save_ignoring = ignoring;
720 ignoring = pass == 2;
721 names = parse_defining_occurrence_list ();
722 expect (EQL, "missing '=' in mode definition");
723 mode = parse_mode ();
724 if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
725 {
726 for ( ; names != NULL_TREE; names = TREE_CHAIN (names))
727 push_modedef (names, mode, is_newmode);
728 }
729 else
730 push_modedef (names, mode, is_newmode);
731 ignoring = save_ignoring;
732}
733
31029ad7 734static void
3c79b2da
PB		 735parse_mode_definition_statement (is_newmode)
736 int is_newmode;
737{
3c79b2da
PB		 738 FORWARD_TOKEN (); /* skip SYNMODE or NEWMODE */
739 parse_mode_definition (is_newmode);
740 while (PEEK_TOKEN () == COMMA)
741 {
742 FORWARD_TOKEN ();
743 parse_mode_definition (is_newmode);
744 }
745 parse_semi_colon ();
746}
747
748static void
749parse_synonym_definition ()
750{ tree expr = NULL_TREE;
751 tree names = parse_defining_occurrence_list ();
752 tree mode = parse_opt_mode ();
753 if (! expect (EQL, "missing '=' in synonym definition"))
754 mode = error_mark_node;
755 else
756 {
757 if (mode)
758 expr = parse_untyped_expr ();
759 else
760 expr = parse_expression ();
761 }
762 if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
763 {
764 for ( ; names != NULL_TREE; names = TREE_CHAIN (names))
765 push_syndecl (names, mode, expr);
766 }
767 else
768 push_syndecl (names, mode, expr);
769}
770
771static void
772parse_synonym_definition_statement()
773{
774 int save_ignoring= ignoring;
775 ignoring = pass == 2;
776 require (SYN);
777 parse_synonym_definition ();
778 while (PEEK_TOKEN () == COMMA)
779 {
780 FORWARD_TOKEN ();
781 parse_synonym_definition ();
782 }
783 ignoring = save_ignoring;
784 parse_semi_colon ();
785}
786
787/* Attempts to match: "(" <exception list> ")" ":".
788 Return NULL_TREE on failure, and non-NULL on success.
789 On success, if pass 1, return a TREE_LIST of IDENTIFIER_NODEs. */
790
791static tree
792parse_on_exception_list ()
793{
794 tree name;
795 tree list = NULL_TREE;
796 int tok1 = PEEK_TOKEN ();
797 int tok2 = PEEK_TOKEN1 ();
798
799 /* This requires a lot of look-ahead, because we cannot
800 easily a priori distinguish an exception-list from an expression. */
801 if (tok1 != LPRN || tok2 != NAME)
802 {
803 if (tok1 == NAME && tok2 == COLON && pass == 1)
804 error ("missing '(' in exception list");
805 return 0;
806 }
807 require (LPRN);
808 name = parse_name_string ();
809 if (PEEK_TOKEN () == RPRN && PEEK_TOKEN1 () == COLON)
810 {
811 /* Matched: '(' <name_string> ')' ':' */
812 FORWARD_TOKEN (); FORWARD_TOKEN ();
813 return pass == 1 ? build_tree_list (NULL_TREE, name) : name;
814 }
815 if (PEEK_TOKEN() == COMMA)
816 {
817 if (pass == 1)
818 list = build_tree_list (NULL_TREE, name);
819 while (check_token (COMMA))
820 {
821 tree old_names = list;
822 name = parse_name_string ();
823 if (pass == 1)
824 {
825 for ( ; old_names != NULL_TREE; old_names = TREE_CHAIN (old_names))
826 {
827 if (TREE_VALUE (old_names) == name)
828 {
829 error ("ON exception names must be unique");
830 goto continue_parsing;
831 }
832 }
833 list = tree_cons (NULL_TREE, name, list);
834 continue_parsing:
835 ;
836 }
837 }
838 if (! check_token (RPRN) || ! check_token(COLON))
839 error ("syntax error in exception list");
840 return pass == 1 ? nreverse (list) : name;
841 }
842 /* Matched: '(' name_string
843 but it doesn't match the syntax of an exception list.
844 It could be the beginning of an expression, so back up. */
845 pushback_token (NAME, name);
846 pushback_token (LPRN, 0);
847 return NULL_TREE;
848}
849
850static void
851parse_on_alternatives ()
852{
853 for (;;)
854 {
855 tree except_list = parse_on_exception_list ();
856 if (except_list != NULL)
857 chill_handle_on_labels (except_list);
858 else if (parse_action ())
859 expand_exit_needed = 1;
860 else
861 break;
862 }
863}
864
865static tree
866parse_opt_handler ()
867{
868 if (! check_token (ON))
869 {
870 POP_UNUSED_ON_CONTEXT;
871 return NULL_TREE;
872 }
873 if (check_token (END))
874 {
875 pedwarn ("empty ON-condition");
876 POP_UNUSED_ON_CONTEXT;
877 return NULL_TREE;
878 }
879 if (! ignoring)
880 {
881 chill_start_on ();
882 expand_exit_needed = 0;
883 }
884 if (PEEK_TOKEN () != ELSE)
885 {
886 parse_on_alternatives ();
887 if (! ignoring && expand_exit_needed)
888 expand_exit_something ();
889 }
890 if (check_token (ELSE))
891 {
892 chill_start_default_handler ();
893 label = NULL_TREE;
894 parse_opt_actions ();
895 if (! ignoring)
896 {
897 emit_line_note (input_filename, lineno);
898 expand_exit_something ();
899 }
900 }
901 expect (END, "missing 'END' after");
902 if (! ignoring)
903 chill_finish_on ();
904 POP_USED_ON_CONTEXT;
905 return integer_zero_node;
906}
907
908static void
909parse_loc_declaration (in_spec_module)
910 int in_spec_module;
911{
912 tree names = parse_defining_occurrence_list ();
913 int save_ignoring = ignoring;
914 int is_static, lifetime_bound;
915 tree mode, init_value = NULL_TREE;
916 int loc_decl = 0;
917
918 ignoring = pass == 2;
919 mode = parse_mode ();
920 ignoring = save_ignoring;
921 is_static = check_token (STATIC);
922 if (check_token (BASED))
923 {
924 expect(LPRN, "BASED must be followed by (NAME)");
925 do_based_decls (names, mode, parse_name_string ());
926 expect(RPRN, "BASED must be followed by (NAME)");
927 return;
928 }
929 if (check_token (LOC))
930 {
931 /* loc-identity declaration */
932 if (pass == 1)
933 mode = build_chill_reference_type (mode);
934 loc_decl = 1;
935 }
936 lifetime_bound = check_token (INIT);
937 if (lifetime_bound && loc_decl)
938 {
939 if (pass == 1)
940 error ("INIT not allowed at loc-identity declaration");
941 lifetime_bound = 0;
942 }
943 if (PEEK_TOKEN () == ASGN || PEEK_TOKEN() == EQL)
944 {
945 save_ignoring = ignoring;
946 ignoring = pass == 1;
947 if (PEEK_TOKEN() == EQL)
948 {
949 if (pass == 1)
950 error ("'=' used where ':=' is required");
951 }
952 FORWARD_TOKEN();
953 if (! lifetime_bound)
954 push_handler ();
955 init_value = parse_untyped_expr ();
956 if (in_spec_module)
957 {
958 error ("initialization is not allowed in spec module");
959 init_value = NULL_TREE;
960 }
961 if (! lifetime_bound)
962 parse_opt_handler ();
963 ignoring = save_ignoring;
964 }
965 if (init_value == NULL_TREE && loc_decl && pass == 1)
966 error ("loc-identity declaration without initialisation");
967 do_decls (names, mode,
968 is_static || global_bindings_p ()
969 /* the variable becomes STATIC if all_static_flag is set and
970 current functions doesn't have the RECURSIVE attribute */
971 || (all_static_flag && !CH_DECL_RECURSIVE (current_function_decl)),
972 lifetime_bound, init_value, in_spec_module);
973
974 /* Free any temporaries we made while initializing the decl. */
975 free_temp_slots ();
976}
977
978static void
979parse_declaration_statement (in_spec_module)
980 int in_spec_module;
981{
982 int save_ignoring = ignoring;
983 ignoring = pass == 2;
984 require (DCL);
985 parse_loc_declaration (in_spec_module);
986 while (PEEK_TOKEN () == COMMA)
987 {
988 FORWARD_TOKEN ();
989 parse_loc_declaration (in_spec_module);
990 }
991 ignoring = save_ignoring;
992 parse_semi_colon ();
993}
994
31029ad7 995static tree
3c79b2da
PB		 996parse_optforbid ()
997{
998 if (check_token (FORBID) == 0)
999 return NULL_TREE;
1000 if (check_token (ALL))
1001 return ignoring ? NULL_TREE : build_int_2 (-1, -1);
1002#if 0
1003 if (check_token (LPRN))
1004 {
1005 tree list = parse_forbidlist ();
1006 expect (RPRN, "missing ')' after FORBID list");
1007 return list;
1008 }
1009#endif
1010 error ("bad syntax following FORBID");
1011 return NULL_TREE;
1012}
1013
1014/* Matches: <grant postfix> or <seize postfix>
1015 Returns: A (singleton) TREE_LIST. */
1016
31029ad7 1017static tree
3c79b2da
PB		 1018parse_postfix (grant_or_seize)
1019 enum terminal grant_or_seize;
1020{
1021 tree name = parse_opt_name_string (1);
1022 tree forbid = NULL_TREE;
1023 if (name == NULL_TREE)
1024 {
1025 error ("expected a postfix name here");
1026 name = error_mark_node;
1027 }
1028 if (grant_or_seize == GRANT)
1029 forbid = parse_optforbid ();
1030 return build_tree_list (forbid, name);
1031}
1032
31029ad7 1033static tree
3c79b2da
PB		 1034parse_postfix_list (grant_or_seize)
1035 enum terminal grant_or_seize;
1036{
1037 tree list = parse_postfix (grant_or_seize);
1038 while (check_token (COMMA))
1039 list = chainon (list, parse_postfix (grant_or_seize));
1040 return list;
1041}
1042
31029ad7 1043static void
3c79b2da
PB		 1044parse_rename_clauses (grant_or_seize)
1045 enum terminal grant_or_seize;
1046{
1047 for (;;)
1048 {
1049 tree rename_old_prefix, rename_new_prefix, postfix;
1050 require (LPRN);
1051 rename_old_prefix = parse_opt_name_string (0);
1052 expect (ARROW, "missing '->' in rename clause");
1053 rename_new_prefix = parse_opt_name_string (0);
1054 expect (RPRN, "missing ')' in rename clause");
1055 expect ('!', "missing '!' in rename clause");
1056 postfix = parse_postfix (grant_or_seize);
1057
1058 if (grant_or_seize == GRANT)
1059 chill_grant (rename_old_prefix, rename_new_prefix,
1060 TREE_VALUE (postfix), TREE_PURPOSE (postfix));
1061 else
1062 chill_seize (rename_old_prefix, rename_new_prefix,
1063 TREE_VALUE (postfix));
1064
1065 if (PEEK_TOKEN () != COMMA)
1066 break;
1067 FORWARD_TOKEN ();
1068 if (PEEK_TOKEN () != LPRN)
1069 {
1070 error ("expected another rename clause");
1071 break;
1072 }
1073 }
1074}
1075
1076static tree
1077parse_opt_prefix_clause ()
1078{
1079 if (check_token (PREFIXED) == 0)
1080 return NULL_TREE;
1081 return build_prefix_clause (parse_opt_name_string (0));
1082}
1083
31029ad7 1084static void
3c79b2da
PB		 1085parse_grant_statement ()
1086{
1087 require (GRANT);
1088 if (PEEK_TOKEN () == LPRN)
1089 parse_rename_clauses (GRANT);
1090 else
1091 {
1092 tree window = parse_postfix_list (GRANT);
1093 tree new_prefix = parse_opt_prefix_clause ();
1094 tree t;
1095 for (t = window; t; t = TREE_CHAIN (t))
1096 chill_grant (NULL_TREE, new_prefix, TREE_VALUE (t), TREE_PURPOSE (t));
1097 }
1098}
1099
31029ad7 1100static void
3c79b2da
PB		 1101parse_seize_statement ()
1102{
1103 require (SEIZE);
1104 if (PEEK_TOKEN () == LPRN)
1105 parse_rename_clauses (SEIZE);
1106 else
1107 {
1108 tree seize_window = parse_postfix_list (SEIZE);
1109 tree old_prefix = parse_opt_prefix_clause ();
1110 tree t;
1111 for (t = seize_window; t; t = TREE_CHAIN (t))
1112 chill_seize (old_prefix, NULL_TREE, TREE_VALUE (t));
1113 }
1114}
1115
1116/* In pass 1, this returns a TREE_LIST, one node for each parameter.
1117 In pass 2, we get a list of PARM_DECLs chained together.
1118 In either case, the list is in reverse order. */
1119
1120static tree
1121parse_param_name_list ()
1122{
1123 tree list = NULL_TREE;
1124 do
1125 {
1126 tree new_link;
1127 tree name = parse_defining_occurrence ();
1128 if (name == NULL_TREE)
1129 {
1130 error ("syntax error in parameter name list");
1131 return list;
1132 }
1133 if (pass == 1)
1134 new_link = build_tree_list (NULL_TREE, name);
1135 /* else if (current_module->is_spec_module) ; nothing */
1136 else /* pass == 2 */
1137 {
1138 new_link = make_node (PARM_DECL);
1139 DECL_NAME (new_link) = name;
1140 DECL_ASSEMBLER_NAME (new_link) = name;
1141 }
1142
1143 TREE_CHAIN (new_link) = list;
1144 list = new_link;
1145 } while (check_token (COMMA));
1146 return list;
1147}
1148
1149static tree
1150parse_param_attr ()
1151{
1152 tree attr;
1153 switch (PEEK_TOKEN ())
1154 {
1155 case PARAMATTR: /* INOUT is returned here */
1156 attr = PEEK_TREE ();
1157 FORWARD_TOKEN ();
1158 return attr;
1159 case IN:
1160 FORWARD_TOKEN ();
1161 return ridpointers[(int) RID_IN];
1162 case LOC:
1163 FORWARD_TOKEN ();
1164 return ridpointers[(int) RID_LOC];
1165#if 0
1166 case DYNAMIC:
1167 FORWARD_TOKEN ();
1168 return ridpointers[(int) RID_DYNAMIC];
1169#endif
1170 default:
1171 return NULL_TREE;
1172 }
1173}
1174
1175/* We wrap CHILL array parameters in a STRUCT. The original parameter
1176 name is unpacked from the struct at get_identifier time */
1177
1178/* In pass 1, returns list of types; in pass 2: chain of PARM_DECLs. */
1179
1180static tree
75111422 1181parse_formpar ()
3c79b2da
PB		 1182{
1183 tree names = parse_param_name_list ();
1184 tree mode = parse_mode ();
1185 tree paramattr = parse_param_attr ();
1186 return chill_munge_params (nreverse (names), mode, paramattr);
1187}
1188
1189/*
1190 * Note: build_process_header depends upon the *exact*
1191 * representation of STRUCT fields and of formal parameter
1192 * lists. If either is changed, build_process_header will
1193 * also need change. Push_extern_process is affected as well.
1194 */
1195static tree
75111422 1196parse_formparlist ()
3c79b2da
PB		 1197{
1198 tree list = NULL_TREE;
1199 if (PEEK_TOKEN() == RPRN)
1200 return NULL_TREE;
1201 for (;;)
1202 {
75111422 1203 list = chainon (list, parse_formpar ());
3c79b2da
PB		 1204 if (! check_token (COMMA))
1205 break;
1206 }
1207 return list;
1208}
1209
1210static tree
1211parse_opt_result_spec ()
1212{
1213 tree mode;
1214 int is_nonref, is_loc, is_dynamic;
1215 if (!check_token (RETURNS))
1216 return void_type_node;
1217 expect (LPRN, "expected '(' after RETURNS");
1218 mode = parse_mode ();
1219 is_nonref = check_token (NONREF);
1220 is_loc = check_token (LOC);
1221 is_dynamic = check_token (DYNAMIC);
1222 if (is_nonref && !is_loc)
1223 error ("NONREF specific without LOC in result attribute");
1224 if (is_dynamic && !is_loc)
1225 error ("DYNAMIC specific without LOC in result attribute");
1226 mode = get_type_of (mode);
1227 if (is_loc && ! ignoring)
1228 mode = build_chill_reference_type (mode);
1229 expect (RPRN, "expected ')' after RETURNS");
1230 return mode;
1231}
1232
1233static tree
1234parse_opt_except ()
1235{
1236 tree list = NULL_TREE;
1237 if (!check_token (EXCEPTIONS))
1238 return NULL_TREE;
1239 expect (LPRN, "expected '(' after EXCEPTIONS");
1240 do
1241 {
1242 tree except_name = parse_name_string ();
1243 tree name;
1244 for (name = list; name != NULL_TREE; name = TREE_CHAIN (name))
1245 if (TREE_VALUE (name) == except_name && pass == 1)
1246 {
1247 error ("exception names must be unique");
1248 break;
1249 }
1250 if (name == NULL_TREE && !ignoring)
1251 list = tree_cons (NULL_TREE, except_name, list);
1252 } while (check_token (COMMA));
1253 expect (RPRN, "expected ')' after EXCEPTIONS");
1254 return list;
1255}
1256
1257static tree
1258parse_opt_recursive ()
1259{
1260 if (check_token (RECURSIVE))
1261 return ridpointers[RID_RECURSIVE];
1262 else
1263 return NULL_TREE;
1264}
1265
1266static tree
1267parse_procedureattr ()
1268{
1269 tree generality;
1270 tree optrecursive;
1271 switch (PEEK_TOKEN ())
1272 {
1273 case GENERAL:
1274 FORWARD_TOKEN ();
1275 generality = ridpointers[RID_GENERAL];
1276 break;
1277 case SIMPLE:
1278 FORWARD_TOKEN ();
1279 generality = ridpointers[RID_SIMPLE];
1280 break;
1281 case INLINE:
1282 FORWARD_TOKEN ();
1283 generality = ridpointers[RID_INLINE];
1284 break;
1285 default:
1286 generality = NULL_TREE;
1287 }
1288 optrecursive = parse_opt_recursive ();
1289 if (pass != 1)
1290 return NULL_TREE;
1291 if (generality)
1292 generality = build_tree_list (NULL_TREE, generality);
1293 if (optrecursive)
1294 generality = tree_cons (NULL_TREE, optrecursive, generality);
1295 return generality;
1296}
1297
1298/* Parse the body and last part of a procedure or process definition. */
1299
1300static void
1301parse_proc_body (name, exceptions)
1302 tree name;
1303 tree exceptions;
1304{
1305 int save_proc_action_level = proc_action_level;
1306 proc_action_level = action_nesting_level;
1307 if (exceptions != NULL_TREE)
1308 /* set up a handler for reraising exceptions */
1309 push_handler ();
1310 push_action ();
1311 define__PROCNAME__ ();
1312 parse_body ();
1313 proc_action_level = save_proc_action_level;
1314 expect (END, "'END' was expected here");
1315 parse_opt_handler ();
1316 if (exceptions != NULL_TREE)
1317 chill_reraise_exceptions (exceptions);
1318 parse_opt_end_label_semi_colon (name);
1319 end_function ();
1320}
1321
1322static void
1323parse_procedure_definition (in_spec_module)
1324 int in_spec_module;
1325{
1326 int save_ignoring = ignoring;
1327 tree name = parse_defining_occurrence ();
1328 tree params, result, exceptlist, attributes;
1329 int save_chill_at_module_level = chill_at_module_level;
1330 chill_at_module_level = 0;
1331 if (!in_spec_module)
1332 ignoring = pass == 2;
1333 require (COLON); require (PROC);
1334 expect (LPRN, "missing '(' after PROC");
75111422 1335 params = parse_formparlist ();
3c79b2da
PB		 1336 expect (RPRN, "missing ')' in PROC");
1337 result = parse_opt_result_spec ();
1338 exceptlist = parse_opt_except ();
1339 attributes = parse_procedureattr ();
1340 ignoring = save_ignoring;
1341 if (in_spec_module)
1342 {
1343 expect (END, "missing 'END'");
1344 parse_opt_end_label_semi_colon (name);
1345 push_extern_function (name, result, params, exceptlist, 0);
1346 return;
1347 }
1348 push_chill_function_context ();
1349 start_chill_function (name, result, params, exceptlist, attributes);
1350 current_module->procedure_seen = 1;
1351 parse_proc_body (name, TYPE_RAISES_EXCEPTIONS (TREE_TYPE (current_function_decl)));
1352 chill_at_module_level = save_chill_at_module_level;
1353}
1354
1355static tree
1356parse_processpar ()
1357{
1358 tree names = parse_defining_occurrence_list ();
1359 tree mode = parse_mode ();
1360 tree paramattr = parse_param_attr ();
75111422 1361
3c79b2da
PB		 1362 if (names && TREE_CODE (names) == IDENTIFIER_NODE)
1363 names = build_tree_list (NULL_TREE, names);
1364 return tree_cons (tree_cons (paramattr, mode, NULL_TREE), names, NULL_TREE);
1365}
1366
1367static tree
1368parse_processparlist ()
1369{
1370 tree list = NULL_TREE;
1371 if (PEEK_TOKEN() == RPRN)
1372 return NULL_TREE;
1373 for (;;)
1374 {
1375 list = chainon (list, parse_processpar ());
1376 if (! check_token (COMMA))
1377 break;
1378 }
1379 return list;
1380}
1381
1382static void
1383parse_process_definition (in_spec_module)
1384 int in_spec_module;
1385{
1386 int save_ignoring = ignoring;
1387 tree name = parse_defining_occurrence ();
1388 tree params;
1389 tree tmp;
1390 if (!in_spec_module)
1391 ignoring = 0;
1392 require (COLON); require (PROCESS);
1393 expect (LPRN, "missing '(' after PROCESS");
31029ad7 1394 params = parse_processparlist ();
3c79b2da
PB		 1395 expect (RPRN, "missing ')' in PROCESS");
1396 ignoring = save_ignoring;
1397 if (in_spec_module)
1398 {
1399 expect (END, "missing 'END'");
1400 parse_opt_end_label_semi_colon (name);
1401 push_extern_process (name, params, NULL_TREE, 0);
1402 return;
1403 }
1404 tmp = build_process_header (name, params);
1405 parse_proc_body (name, NULL_TREE);
1406 build_process_wrapper (name, tmp);
1407}
1408
1409static void
1410parse_signal_definition ()
1411{
1412 tree signame = parse_defining_occurrence ();
1413 tree modes = NULL_TREE;
1414 tree dest = NULL_TREE;
1415
1416 if (check_token (EQL))
1417 {
1418 expect (LPRN, "missing '(' after 'SIGNAL <name> ='");
1419 for (;;)
1420 {
1421 tree mode = parse_mode ();
1422 modes = tree_cons (NULL_TREE, mode, modes);
1423 if (! check_token (COMMA))
1424 break;
1425 }
1426 expect (RPRN, "missing ')'");
1427 modes = nreverse (modes);
1428 }
1429
1430 if (check_token (TO))
1431 {
1432 tree decl;
1433 int save_ignoring = ignoring;
1434 ignoring = 0;
1435 decl = parse_name ();
1436 ignoring = save_ignoring;
1437 if (pass > 1)
1438 {
1439 if (decl == NULL_TREE
1440 || TREE_CODE (decl) == ERROR_MARK
1441 || TREE_CODE (decl) != FUNCTION_DECL
1442 || !CH_DECL_PROCESS (decl))
1443 error ("must specify a PROCESS name");
1444 else
1445 dest = decl;
1446 }
1447 }
1448
1449 if (! global_bindings_p ())
1450 error ("SIGNAL must be in global reach");
1451 else
1452 {
1453 tree struc = build_signal_struct_type (signame, modes, dest);
1454 tree decl =
1455 generate_tasking_code_variable (signame,
1456 &signal_code,
1457 current_module->is_spec_module);
1458 /* remember the code variable in the struct type */
1459 DECL_TASKING_CODE_DECL (struc) = (struct lang_decl *)decl;
1460 CH_DECL_SIGNAL (struc) = 1;
1461 add_taskstuff_to_list (decl, "_TT_Signal",
1462 current_module->is_spec_module ?
1463 NULL_TREE : signal_code, struc, NULL_TREE);
1464 }
1465
1466}
1467
1468static void
1469parse_signal_definition_statement ()
1470{
1471 int save_ignoring = ignoring;
1472 ignoring = pass == 2;
1473 require (SIGNAL);
1474 for (;;)
1475 {
1476 parse_signal_definition ();
1477 if (! check_token (COMMA))
1478 break;
1479 if (PEEK_TOKEN () == SC)
1480 {
1481 error ("syntax error while parsing signal definition statement");
1482 break;
1483 }
1484 }
1485 parse_semi_colon ();
1486 ignoring = save_ignoring;
1487}
1488
1489static int
1490parse_definition (in_spec_module)
1491 int in_spec_module;
1492{
1493 switch (PEEK_TOKEN ())
1494 {
1495 case NAME:
1496 if (PEEK_TOKEN1() == COLON)
75111422
KG		 1497 {
1498 if (PEEK_TOKEN2() == PROC)
1499 {
1500 parse_procedure_definition (in_spec_module);
1501 return 1;
1502 }
1503 else if (PEEK_TOKEN2() == PROCESS)
1504 {
1505 parse_process_definition (in_spec_module);
1506 return 1;
1507 }
1508 }
3c79b2da
PB		 1509 return 0;
1510 case DCL:
1511 parse_declaration_statement(in_spec_module);
1512 break;
1513 case GRANT:
1514 parse_grant_statement ();
1515 break;
1516 case NEWMODE:
1517 parse_mode_definition_statement(1);
1518 break;
1519 case SC:
1520 label = NULL_TREE;
1521 FORWARD_TOKEN();
1522 return 1;
1523 case SEIZE:
1524 parse_seize_statement ();
1525 break;
1526 case SIGNAL:
1527 parse_signal_definition_statement ();
1528 break;
1529 case SYN:
1530 parse_synonym_definition_statement();
1531 break;
1532 case SYNMODE:
1533 parse_mode_definition_statement(0);
1534 break;
1535 default:
1536 return 0;
1537 }
1538 return 1;
1539}
1540
1541static void
1542parse_then_clause ()
1543{
1544 expect (THEN, "expected 'THEN' after 'IF'");
1545 if (! ignoring)
1546 emit_line_note (input_filename, lineno);
1547 parse_opt_actions ();
1548}
1549
1550static void
1551parse_opt_else_clause ()
1552{
1553 while (check_token (ELSIF))
1554 {
1555 tree cond = parse_expression ();
1556 if (! ignoring)
1557 expand_start_elseif (truthvalue_conversion (cond));
1558 parse_then_clause ();
1559 }
1560 if (check_token (ELSE))
1561 {
1562 if (! ignoring)
1563 { emit_line_note (input_filename, lineno);
1564 expand_start_else ();
1565 }
1566 parse_opt_actions ();
1567 }
1568}
1569
1570static tree parse_expr_list ()
1571{
1572 tree expr = parse_expression ();
1573 tree list = ignoring ? NULL_TREE : build_tree_list (NULL_TREE, expr);
1574 while (check_token (COMMA))
1575 {
1576 expr = parse_expression ();
1577 if (! ignoring)
1578 list = tree_cons (NULL_TREE, expr, list);
1579 }
1580 return list;
1581}
1582
1583static tree
1584parse_range_list_clause ()
1585{
1586 tree name = parse_opt_name_string (0);
1587 if (name == NULL_TREE)
1588 return NULL_TREE;
1589 while (check_token (COMMA))
1590 {
31029ad7 1591 name = parse_name_string ();
3c79b2da
PB		 1592 }
1593 if (check_token (SC))
1594 {
1595 sorry ("case range list");
1596 return error_mark_node;
1597 }
1598 pushback_token (NAME, name);
1599 return NULL_TREE;
1600}
1601
1602static void
1603pushback_paren_expr (expr)
1604 tree expr;
1605{
1606 if (pass == 1 && !ignoring)
1607 expr = build1 (PAREN_EXPR, NULL_TREE, expr);
1608 pushback_token (EXPR, expr);
1609}
1610
1611/* Matches: <case label> */
1612
1613static tree
1614parse_case_label ()
1615{
1616 tree expr;
1617 if (check_token (ELSE))
1618 return case_else_node;
1619 /* Does this also handle the case of a mode name? FIXME */
1620 expr = parse_expression ();
1621 if (check_token (COLON))
1622 {
1623 tree max_expr = parse_expression ();
1624 if (! ignoring)
1625 expr = build (RANGE_EXPR, NULL_TREE, expr, max_expr);
1626 }
1627 return expr;
1628}
1629
1630/* Parses: <case_label_list>
1631 Fails if not followed by COMMA or COLON.
1632 If it fails, it backs up if needed, and returns NULL_TREE.
1633 IN_TUPLE is true if we are parsing a tuple element,
1634 and 0 if we are parsing a case label specification. */
1635
1636static tree
1637parse_case_label_list (selector, in_tuple)
1638 tree selector;
1639 int in_tuple;
1640{
1641 tree expr, list;
1642 if (! check_token (LPRN))
1643 return NULL_TREE;
1644 if (check_token (MUL))
1645 {
1646 expect (RPRN, "missing ')' after '*' case label list");
1647 if (ignoring)
1648 return integer_zero_node;
1649 expr = build (RANGE_EXPR, NULL_TREE, NULL_TREE, NULL_TREE);
1650 expr = build_tree_list (NULL_TREE, expr);
1651 return expr;
1652 }
1653 expr = parse_case_label ();
1654 if (check_token (RPRN))
1655 {
1656 if ((in_tuple || PEEK_TOKEN () != COMMA) && PEEK_TOKEN () != COLON)
1657 {
1658 /* Ooops! It looks like it was the start of an action or
1659 unlabelled tuple element, and not a case label, so back up. */
1660 if (expr != NULL_TREE && TREE_CODE (expr) == RANGE_EXPR)
1661 {
1662 error ("misplaced colon in case label");
1663 expr = error_mark_node;
1664 }
1665 pushback_paren_expr (expr);
1666 return NULL_TREE;
1667 }
1668 list = build_tree_list (NULL_TREE, expr);
1669 if (expr == case_else_node && selector != NULL_TREE)
1670 ELSE_LABEL_SPECIFIED (selector) = 1;
1671 return list;
1672 }
1673 list = build_tree_list (NULL_TREE, expr);
1674 if (expr == case_else_node && selector != NULL_TREE)
1675 ELSE_LABEL_SPECIFIED (selector) = 1;
1676
1677 while (check_token (COMMA))
1678 {
1679 expr = parse_case_label ();
1680 list = tree_cons (NULL_TREE, expr, list);
1681 if (expr == case_else_node && selector != NULL_TREE)
1682 ELSE_LABEL_SPECIFIED (selector) = 1;
1683 }
1684 expect (RPRN, "missing ')' at end of case label list");
1685 return nreverse (list);
1686}
1687
1688/* Parses: <case_label_specification>
1689 Must be followed by a COLON.
1690 If it fails, it backs up if needed, and returns NULL_TREE. */
1691
1692static tree
1693parse_case_label_specification (selectors)
1694 tree selectors;
1695{
1696 tree list_list = NULL_TREE;
1697 tree list;
1698 list = parse_case_label_list (selectors, 0);
1699 if (list == NULL_TREE)
1700 return NULL_TREE;
1701 list_list = build_tree_list (NULL_TREE, list);
1702 while (check_token (COMMA))
1703 {
1704 if (selectors != NULL_TREE)
1705 selectors = TREE_CHAIN (selectors);
1706 list = parse_case_label_list (selectors, 0);
1707 if (list == NULL_TREE)
1708 {
1709 error ("unrecognized case label list after ','");
1710 return list_list;
1711 }
1712 list_list = tree_cons (NULL_TREE, list, list_list);
1713 }
1714 return nreverse (list_list);
1715}
1716
1717static void
1718parse_single_dimension_case_action (selector)
1719 tree selector;
1720{
1721 int no_completeness_check = 0;
1722
1723/* The case label/action toggle. It is 0 initially, and when an action
1724 was last seen. It is 1 integer_zero_node when a label was last seen. */
1725 int caseaction_flag = 0;
1726
1727 if (! ignoring)
1728 {
1729 expand_exit_needed = 0;
1730 selector = check_case_selector (selector);
1731 expand_start_case (1, selector, TREE_TYPE (selector), "CASE statement");
1732 push_momentary ();
1733 }
1734
1735 for (;;)
1736 {
1737 tree label_spec = parse_case_label_specification (selector);
1738 if (label_spec != NULL_TREE)
1739 {
1740 expect (COLON, "missing ':' in case alternative");
1741 if (! ignoring)
1742 {
1743 no_completeness_check |= chill_handle_single_dimension_case_label (
1744 selector, label_spec, &expand_exit_needed, &caseaction_flag);
1745 }
1746 }
1747 else if (parse_action ())
1748 {
1749 expand_exit_needed = 1;
1750 caseaction_flag = 0;
1751 }
1752 else
1753 break;
1754 }
1755
1756 if (! ignoring)
1757 {
1758 if (expand_exit_needed || caseaction_flag == 1)
1759 expand_exit_something ();
1760 }
1761 if (check_token (ELSE))
1762 {
1763 if (! ignoring)
1764 chill_handle_case_default ();
1765 parse_opt_actions ();
1766 if (! ignoring)
1767 {
1768 emit_line_note (input_filename, lineno);
1769 expand_exit_something ();
1770 }
1771 }
1772 else if (! ignoring && TREE_CODE (selector) != ERROR_MARK &&
1773 ! no_completeness_check)
1774 check_missing_cases (TREE_TYPE (selector));
1775
1776 expect (ESAC, "missing 'ESAC' after 'CASE'");
1777 if (! ignoring)
1778 {
1779 expand_end_case (selector);
1780 pop_momentary ();
1781 }
1782}
1783
1784static void
1785parse_multi_dimension_case_action (selector)
1786 tree selector;
1787{
ed730bcf 1788 struct rtx_def *begin_test_label = 0, *end_case_label = 0, *new_label;
3c79b2da
PB		 1789 tree action_labels = NULL_TREE;
1790 tree tests = NULL_TREE;
3c79b2da
PB		 1791 int save_lineno = lineno;
1792 char *save_filename = input_filename;
1793
1794 /* We can't compute the range of an (ELSE) label until all of the CASE
1795 label specifications have been seen, however, the code for the actions
1796 between them is generated on the fly. We can still generate everything in
1797 one pass is we use the following form:
1798
1799 Compile a CASE of the form
1800
1801 case S1,...,Sn of
1802 (X11),...,(X1n): A1;
1803 ...
1804 (Xm1),...,(Xmn): Am;
1805 else Ae;
1806 esac;
1807
1808 into:
1809
1810 goto L0;
1811 L1: A1; goto L99;
1812 ...
1813 Lm: Am; goto L99;
1814 Le: Ae; goto L99;
1815 L0:
1816 T1 := s1; ...; Tn := Sn;
1817 if (T1 = X11 and ... and Tn = X1n) GOTO L1;
1818 ...
1819 if (T1 = Xm1 and ... and Tn = Xmn) GOTO Lm;
1820 GOTO Le;
1821 L99;
1822 */
1823
1824 if (! ignoring)
1825 {
1826 selector = check_case_selector_list (selector);
1827 begin_test_label = gen_label_rtx ();
1828 end_case_label = gen_label_rtx ();
1829 emit_jump (begin_test_label);
1830 }
1831
1832 for (;;)
1833 {
1834 tree label_spec = parse_case_label_specification (selector);
1835 if (label_spec != NULL_TREE)
1836 {
1837 expect (COLON, "missing ':' in case alternative");
1838 if (! ignoring)
1839 {
1840 tests = tree_cons (label_spec, NULL_TREE, tests);
1841
1842 if (action_labels != NULL_TREE)
1843 emit_jump (end_case_label);
1844
1845 new_label = gen_label_rtx ();
1846 emit_label (new_label);
1847 emit_line_note (input_filename, lineno);
1848 action_labels = tree_cons (NULL_TREE, NULL_TREE, action_labels);
1849 TREE_CST_RTL (action_labels) = new_label;
1850 }
1851 }
1852 else if (! parse_action ())
1853 {
1854 if (action_labels != NULL_TREE)
1855 emit_jump (end_case_label);
1856 break;
1857 }
1858 }
1859
1860 if (check_token (ELSE))
1861 {
1862 if (! ignoring)
1863 {
1864 new_label = gen_label_rtx ();
1865 emit_label (new_label);
1866 emit_line_note (input_filename, lineno);
1867 action_labels = tree_cons (NULL_TREE, NULL_TREE, action_labels);
1868 TREE_CST_RTL (action_labels) = new_label;
1869 }
1870 parse_opt_actions ();
1871 if (! ignoring)
1872 emit_jump (end_case_label);
1873 }
1874
1875 expect (ESAC, "missing 'ESAC' after 'CASE'");
1876
1877 if (! ignoring)
1878 {
1879 emit_label (begin_test_label);
1880 emit_line_note (save_filename, save_lineno);
1881 if (tests != NULL_TREE)
1882 {
1883 tree cond;
1884 tests = nreverse (tests);
1885 action_labels = nreverse (action_labels);
1886 compute_else_ranges (selector, tests);
1887
1888 cond = build_multi_case_selector_expression (selector, TREE_PURPOSE (tests));
1889 expand_start_cond (truthvalue_conversion (cond), label ? 1 : 0);
1890 emit_jump (TREE_CST_RTL (action_labels));
1891
1892 for (tests = TREE_CHAIN (tests), action_labels = TREE_CHAIN (action_labels);
1893 tests != NULL_TREE && action_labels != NULL_TREE;
1894 tests = TREE_CHAIN (tests), action_labels = TREE_CHAIN (action_labels))
1895 {
1896 cond =
1897 build_multi_case_selector_expression (selector, TREE_PURPOSE (tests));
1898 expand_start_elseif (truthvalue_conversion (cond));
1899 emit_jump (TREE_CST_RTL (action_labels));
1900 }
1901 if (action_labels != NULL_TREE)
1902 {
1903 expand_start_else ();
1904 emit_jump (TREE_CST_RTL (action_labels));
1905 }
1906 expand_end_cond ();
1907 }
1908 emit_label (end_case_label);
1909 }
1910}
1911
1912static void
1913parse_case_action (label)
1914 tree label;
1915{
1916 tree selector;
1917 int multi_dimension_case = 0;
1918
3c79b2da
PB		 1919 require (CASE);
1920 selector = parse_expr_list ();
1921 selector = nreverse (selector);
1922 expect (OF, "missing 'OF' after 'CASE'");
1923 parse_range_list_clause ();
1924
1925 PUSH_ACTION;
1926 if (label)
1927 pushlevel (1);
1928
1929 if (! ignoring)
1930 {
1931 expand_exit_needed = 0;
1932 if (TREE_CODE (selector) == TREE_LIST)
1933 {
1934 if (TREE_CHAIN (selector) != NULL_TREE)
1935 multi_dimension_case = 1;
1936 else
1937 selector = TREE_VALUE (selector);
1938 }
1939 }
1940
1941 /* We want to use the regular CASE support for the single dimension case. The
1942 multi dimension case requires different handling. Note that when "ignoring"
1943 is true we parse using the single dimension code. This is OK since it will
1944 still parse correctly. */
1945 if (multi_dimension_case)
1946 parse_multi_dimension_case_action (selector);
1947 else
1948 parse_single_dimension_case_action (selector);
1949
1950 if (label)
1951 {
1952 possibly_define_exit_label (label);
1953 poplevel (0, 0, 0);
1954 }
1955}
1956
1957/* Matches: [ <asm_operand> { "," <asm_operand> }* ],
1958 where <asm_operand> = STRING '(' <expression> ')'
1959 These are the operands other than the first string and colon
1960 in asm ("addextend %2,%1": "=dm" (x), "0" (y), "g" (*x)) */
1961
1962static tree
1963parse_asm_operands ()
1964{
1965 tree list = NULL_TREE;
1966 if (PEEK_TOKEN () != STRING)
1967 return NULL_TREE;
1968 for (;;)
1969 {
1970 tree string, expr;
1971 if (PEEK_TOKEN () != STRING)
1972 {
1973 error ("bad ASM operand");
1974 return list;
1975 }
1976 string = PEEK_TREE();
1977 FORWARD_TOKEN ();
1978 expect (LPRN, "missing '(' in ASM operand");
1979 expr = parse_expression ();
1980 expect (RPRN, "missing ')' in ASM operand");
1981 list = tree_cons (string, expr, list);
1982 if (! check_token (COMMA))
1983 break;
1984 }
1985 return nreverse (list);
1986}
1987
1988/* Matches: STRING { ',' STRING }* */
1989
1990static tree
1991parse_asm_clobbers ()
1992{
1993 tree list = NULL_TREE;
1994 for (;;)
1995 {
75111422 1996 tree string;
3c79b2da
PB		 1997 if (PEEK_TOKEN () != STRING)
1998 {
1999 error ("bad ASM operand");
2000 return list;
2001 }
2002 string = PEEK_TREE();
2003 FORWARD_TOKEN ();
2004 list = tree_cons (NULL_TREE, string, list);
2005 if (! check_token (COMMA))
2006 break;
2007 }
2008 return list;
2009}
2010
31029ad7 2011static void
3c79b2da
PB		 2012ch_expand_asm_operands (string, outputs, inputs, clobbers, vol, filename, line)
2013 tree string, outputs, inputs, clobbers;
2014 int vol;
2015 char *filename;
2016 int line;
2017{
2018 int noutputs = list_length (outputs);
2019 register int i;
2020 /* o[I] is the place that output number I should be written. */
2021 register tree *o = (tree *) alloca (noutputs * sizeof (tree));
2022 register tree tail;
2023
2024 if (TREE_CODE (string) == ADDR_EXPR)
2025 string = TREE_OPERAND (string, 0);
2026 if (TREE_CODE (string) != STRING_CST)
2027 {
2028 error ("asm template is not a string constant");
2029 return;
2030 }
2031
2032 /* Record the contents of OUTPUTS before it is modified. */
2033 for (i = 0, tail = outputs; tail; tail = TREE_CHAIN (tail), i++)
2034 o[i] = TREE_VALUE (tail);
2035
2036#if 0
2037 /* Perform default conversions on array and function inputs. */
2038 /* Don't do this for other types--
2039 it would screw up operands expected to be in memory. */
2040 for (i = 0, tail = inputs; tail; tail = TREE_CHAIN (tail), i++)
2041 if (TREE_CODE (TREE_TYPE (TREE_VALUE (tail))) == ARRAY_TYPE
2042 || TREE_CODE (TREE_TYPE (TREE_VALUE (tail))) == FUNCTION_TYPE)
2043 TREE_VALUE (tail) = default_conversion (TREE_VALUE (tail));
2044#endif
2045
2046 /* Generate the ASM_OPERANDS insn;
2047 store into the TREE_VALUEs of OUTPUTS some trees for
2048 where the values were actually stored. */
2049 expand_asm_operands (string, outputs, inputs, clobbers, vol, filename, line);
2050
2051 /* Copy all the intermediate outputs into the specified outputs. */
2052 for (i = 0, tail = outputs; tail; tail = TREE_CHAIN (tail), i++)
2053 {
2054 if (o[i] != TREE_VALUE (tail))
2055 {
2056 expand_expr (build_chill_modify_expr (o[i], TREE_VALUE (tail)),
2057 0, VOIDmode, 0);
2058 free_temp_slots ();
2059 }
2060 /* Detect modification of read-only values.
2061 (Otherwise done by build_modify_expr.) */
2062 else
2063 {
2064 tree type = TREE_TYPE (o[i]);
2065 if (TYPE_READONLY (type)
2066 || ((TREE_CODE (type) == RECORD_TYPE
2067 || TREE_CODE (type) == UNION_TYPE)
2068 && TYPE_FIELDS_READONLY (type)))
2069 warning ("readonly location modified by 'asm'");
2070 }
2071 }
2072
2073 /* Those MODIFY_EXPRs could do autoincrements. */
2074 emit_queue ();
2075}
2076
2077static void
2078parse_asm_action ()
2079{
2080 tree insn;
2081 require (ASM_KEYWORD);
2082 expect (LPRN, "missing '('");
2083 PUSH_ACTION;
2084 if (!ignoring)
2085 emit_line_note (input_filename, lineno);
2086 insn = parse_expression ();
2087 if (check_token (COLON))
2088 {
2089 tree output_operand, input_operand, clobbered_regs;
2090 output_operand = parse_asm_operands ();
2091 if (check_token (COLON))
2092 input_operand = parse_asm_operands ();
2093 else
2094 input_operand = NULL_TREE;
2095 if (check_token (COLON))
2096 clobbered_regs = parse_asm_clobbers ();
2097 else
2098 clobbered_regs = NULL_TREE;
2099 expect (RPRN, "missing ')'");
2100 if (!ignoring)
2101 ch_expand_asm_operands (insn, output_operand, input_operand,
2102 clobbered_regs, FALSE,
2103 input_filename, lineno);
2104 }
2105 else
2106 {
2107 expect (RPRN, "missing ')'");
2108 STRIP_NOPS (insn);
2109 if (ignoring) { }
2110 else if ((TREE_CODE (insn) == ADDR_EXPR
2111 && TREE_CODE (TREE_OPERAND (insn, 0)) == STRING_CST)
2112 || TREE_CODE (insn) == STRING_CST)
2113 expand_asm (insn);
2114 else
2115 error ("argument of `asm' is not a constant string");
2116 }
2117}
2118
2119static void
2120parse_begin_end_block (label)
2121 tree label;
2122{
2123 require (BEGINTOKEN);
2124#if 0
2125 /* don't make a linenote at BEGIN */
2126 INIT_ACTION;
2127#endif
2128 pushlevel (1);
2129 if (! ignoring)
2130 {
2131 clear_last_expr ();
2132 push_momentary ();
2133 expand_start_bindings (label ? 1 : 0);
2134 }
2135 push_handler ();
2136 parse_body ();
2137 expect (END, "missing 'END'");
2138 /* Note that the opthandler comes before the poplevel
2139 - hence a handler is in the scope of the block. */
2140 parse_opt_handler ();
2141 possibly_define_exit_label (label);
2142 if (! ignoring)
2143 {
2144 emit_line_note (input_filename, lineno);
2145 expand_end_bindings (getdecls (), kept_level_p (), 0);
2146 }
2147 poplevel (kept_level_p (), 0, 0);
2148 if (! ignoring)
2149 pop_momentary ();
2150 parse_opt_end_label_semi_colon (label);
2151}
2152
2153static void
2154parse_if_action (label)
2155 tree label;
2156{
2157 tree cond;
2158 require (IF);
2159 PUSH_ACTION;
2160 cond = parse_expression ();
2161 if (label)
2162 pushlevel (1);
2163 if (! ignoring)
2164 {
2165 expand_start_cond (truthvalue_conversion (cond),
2166 label ? 1 : 0);
2167 }
2168 parse_then_clause ();
2169 parse_opt_else_clause ();
2170 expect (FI, "expected 'FI' after 'IF'");
2171 if (! ignoring)
2172 {
2173 emit_line_note (input_filename, lineno);
2174 expand_end_cond ();
2175 }
2176 if (label)
2177 {
2178 possibly_define_exit_label (label);
2179 poplevel (0, 0, 0);
2180 }
2181}
2182
2183/* Matches: <iteration> (as in a <for control>). */
2184
2185static void
2186parse_iteration ()
2187{
2188 tree loop_counter = parse_defining_occurrence ();
2189 if (check_token (ASGN))
2190 {
2191 tree start_value = parse_expression ();
2192 tree step_value
2193 = check_token (BY) ? parse_expression () : NULL_TREE;
2194 int going_down = check_token (DOWN);
2195 tree end_value;
2196 if (check_token (TO))
2197 end_value = parse_expression ();
2198 else
2199 {
2200 error ("expected 'TO' in step enumeration");
2201 end_value = error_mark_node;
2202 }
2203 if (!ignoring)
2204 build_loop_iterator (loop_counter, start_value, step_value,
2205 end_value, going_down, 0, 0);
2206 }
2207 else
2208 {
2209 int going_down = check_token (DOWN);
2210 tree expr;
2211 if (check_token (IN))
2212 expr = parse_expression ();
2213 else
2214 {
2215 error ("expected 'IN' in FOR control here");
2216 expr = error_mark_node;
2217 }
2218 if (!ignoring)
2219 {
2220 tree low_bound, high_bound;
2221 if (expr && TREE_CODE (expr) == TYPE_DECL)
2222 {
2223 expr = TREE_TYPE (expr);
2224 /* FIXME: expr must be an array or powerset */
2225 low_bound = convert (expr, TYPE_MIN_VALUE (expr));
2226 high_bound = convert (expr, TYPE_MAX_VALUE (expr));
2227 }
2228 else
2229 {
2230 low_bound = expr;
2231 high_bound = NULL_TREE;
2232 }
2233 build_loop_iterator (loop_counter, low_bound,
2234 NULL_TREE, high_bound,
2235 going_down, 1, 0);
2236 }
2237 }
2238}
2239
2240/* Matches: '(' <event list> ')' ':'.
2241 Or; returns NULL_EXPR. */
2242
2243static tree
2244parse_delay_case_event_list ()
2245{
2246 tree event_list = NULL_TREE;
2247 tree event;
2248 if (! check_token (LPRN))
2249 return NULL_TREE;
2250 event = parse_expression ();
2251 if (PEEK_TOKEN () == ')' && PEEK_TOKEN1 () != ':')
2252 {
2253 /* Oops. */
2254 require (RPRN);
2255 pushback_paren_expr (event);
2256 return NULL_TREE;
2257 }
2258 for (;;)
2259 {
2260 if (! ignoring)
2261 event_list = tree_cons (NULL_TREE, event, event_list);
2262 if (! check_token (COMMA))
2263 break;
2264 event = parse_expression ();
2265 }
2266 expect (RPRN, "missing ')'");
2267 expect (COLON, "missing ':'");
2268 return ignoring ? error_mark_node : event_list;
2269}
2270
2271static void
2272parse_delay_case_action (label)
2273 tree label;
2274{
75111422 2275 tree label_cnt = NULL_TREE, set_location, priority;
3c79b2da
PB		 2276 tree combined_event_list = NULL_TREE;
2277 require (DELAY);
2278 require (CASE);
2279 PUSH_ACTION;
2280 pushlevel (1);
2281 expand_exit_needed = 0;
2282 if (check_token (SET))
2283 {
2284 set_location = parse_expression ();
2285 parse_semi_colon ();
2286 }
2287 else
2288 set_location = NULL_TREE;
2289 if (check_token (PRIORITY))
2290 {
2291 priority = parse_expression ();
2292 parse_semi_colon ();
2293 }
2294 else
2295 priority = NULL_TREE;
2296 if (! ignoring)
2297 label_cnt = build_delay_case_start (set_location, priority);
2298 for (;;)
2299 {
2300 tree event_list = parse_delay_case_event_list ();
2301 if (event_list)
2302 {
2303 if (! ignoring )
2304 {
2305 int if_or_elseif = combined_event_list == NULL_TREE;
2306 build_delay_case_label (event_list, if_or_elseif);
2307 combined_event_list = chainon (combined_event_list, event_list);
2308 }
2309 }
2310 else if (parse_action ())
2311 {
2312 if (! ignoring)
2313 {
2314 expand_exit_needed = 1;
2315 if (combined_event_list == NULL_TREE)
2316 error ("missing DELAY CASE alternative");
2317 }
2318 }
2319 else
2320 break;
2321 }
2322 expect (ESAC, "missing 'ESAC' in DELAY CASE'");
2323 if (! ignoring)
297a6bfc 2324 build_delay_case_end (combined_event_list);
3c79b2da
PB		 2325 possibly_define_exit_label (label);
2326 poplevel (0, 0, 0);
2327}
2328
2329static void
2330parse_do_action (label)
2331 tree label;
2332{
2333 tree condition;
2334 int token;
2335 require (DO);
2336 if (check_token (WITH))
2337 {
2338 tree list = NULL_TREE;
2339 for (;;)
2340 {
2341 tree name = parse_primval ();
2342 if (! ignoring && TREE_CODE (name) != ERROR_MARK)
2343 {
2344 if (TREE_CODE (TREE_TYPE (name)) == REFERENCE_TYPE)
2345 name = convert (TREE_TYPE (TREE_TYPE (name)), name);
2346 else
2347 {
2348 int is_loc = chill_location (name);
2349 if (is_loc == 1) /* This is probably not possible */
2350 warning ("non-referable location in DO WITH");
2351
2352 if (is_loc > 1)
2353 name = build_chill_arrow_expr (name, 1);
2354 name = decl_temp1 (get_identifier ("__with_element"),
2355 TREE_TYPE (name),
2356 0, name, 0, 0);
2357 if (is_loc > 1)
2358 name = build_chill_indirect_ref (name, NULL_TREE, 0);
2359
2360 }
2361 if (TREE_CODE (TREE_TYPE (name)) != RECORD_TYPE)
2362 error ("WITH element must be of STRUCT mode");
2363 else
2364 list = tree_cons (NULL_TREE, name, list);
2365 }
2366 if (! check_token (COMMA))
2367 break;
2368 }
2369 pushlevel (1);
2370 push_action ();
2371 for (list = nreverse (list); list != NULL_TREE; list = TREE_CHAIN (list))
2372 shadow_record_fields (TREE_VALUE (list));
2373
2374 parse_semi_colon ();
2375 parse_opt_actions ();
2376 expect (OD, "missing 'OD' in 'DO WITH'");
2377 if (! ignoring)
2378 emit_line_note (input_filename, lineno);
2379 possibly_define_exit_label (label);
2380 parse_opt_handler ();
2381 parse_opt_end_label_semi_colon (label);
2382 poplevel (0, 0, 0);
2383 return;
2384 }
2385 token = PEEK_TOKEN();
2386 if (token != FOR && token != WHILE)
2387 {
2388 push_handler ();
2389 parse_opt_actions ();
2390 expect (OD, "Missing 'OD' after 'DO'");
2391 parse_opt_handler ();
2392 parse_opt_end_label_semi_colon (label);
2393 return;
2394 }
2395 if (! ignoring)
2396 emit_line_note (input_filename, lineno);
2397 push_loop_block ();
2398 if (check_token (FOR))
2399 {
2400 if (check_token (EVER))
2401 {
2402 if (!ignoring)
2403 build_loop_iterator (NULL_TREE, NULL_TREE,
2404 NULL_TREE, NULL_TREE,
2405 0, 0, 1);
2406 }
2407 else
2408 {
2409 parse_iteration ();
2410 while (check_token (COMMA))
2411 parse_iteration ();
2412 }
2413 }
2414 else if (!ignoring)
2415 build_loop_iterator (NULL_TREE, NULL_TREE,
2416 NULL_TREE, NULL_TREE,
2417 0, 0, 1);
2418
2419 begin_loop_scope ();
2420 if (! ignoring)
2421 build_loop_start (label);
2422 condition = check_token (WHILE) ? parse_expression () : NULL_TREE;
2423 if (! ignoring)
2424 top_loop_end_check (condition);
2425 parse_semi_colon ();
2426 parse_opt_actions ();
2427 if (! ignoring)
2428 build_loop_end ();
2429 expect (OD, "Missing 'OD' after 'DO'");
2430 /* Note that the handler is inside the reach of the DO. */
2431 parse_opt_handler ();
2432 end_loop_scope (label);
2433 pop_loop_block ();
2434 parse_opt_end_label_semi_colon (label);
2435}
2436
2437/* Matches: '(' <signal name> [ 'IN' <defining occurrence list> ']' ')' ':'
2438 or: '(' <buffer location> IN (defining occurrence> ')' ':'
2439 or: returns NULL_TREE. */
2440
2441static tree
2442parse_receive_spec ()
2443{
2444 tree val;
2445 tree name_list = NULL_TREE;
2446 if (!check_token (LPRN))
2447 return NULL_TREE;
2448 val = parse_primval ();
2449 if (check_token (IN))
2450 {
2451#if 0
2452 if (flag_local_loop_counter)
2453 name_list = parse_defining_occurrence_list ();
2454 else
2455#endif
2456 {
2457 for (;;)
2458 {
2459 tree loc = parse_primval ();
2460 if (! ignoring)
2461 name_list = tree_cons (NULL_TREE, loc, name_list);
2462 if (! check_token (COMMA))
2463 break;
2464 }
2465 }
2466 }
2467 if (! check_token (RPRN))
2468 {
2469 error ("missing ')' in signal/buffer receive alternative");
2470 return NULL_TREE;
2471 }
2472 if (check_token (COLON))
2473 {
2474 if (ignoring || val == NULL_TREE || TREE_CODE (val) == ERROR_MARK)
2475 return error_mark_node;
2476 else
2477 return build_receive_case_label (val, name_list);
2478 }
2479
2480 /* We saw: '(' <primitive value> ')' not followed by ':'.
2481 Presumably the start of an action. Backup and fail. */
2482 if (name_list != NULL_TREE)
2483 error ("misplaced 'IN' in signal/buffer receive alternative");
2484 pushback_paren_expr (val);
2485 return NULL_TREE;
2486}
2487
2488/* To understand the code generation for this, see ch-tasking.c,
2489 and the 2-page comments preceding the
2490 build_chill_receive_case_start () definition. */
2491
2492static void
2493parse_receive_case_action (label)
2494 tree label;
2495{
2496 tree instance_location;
2497 tree have_else_actions;
2498 int spec_seen = 0;
2499 tree alt_list = NULL_TREE;
2500 require (RECEIVE);
2501 require (CASE);
2502 push_action ();
2503 pushlevel (1);
2504 if (! ignoring)
2505 {
2506 expand_exit_needed = 0;
2507 }
2508
2509 if (check_token (SET))
2510 {
2511 instance_location = parse_expression ();
2512 parse_semi_colon ();
2513 }
2514 else
2515 instance_location = NULL_TREE;
2516 if (! ignoring)
2517 instance_location = build_receive_case_start (instance_location);
2518
2519 for (;;)
2520 {
2521 tree receive_spec = parse_receive_spec ();
2522 if (receive_spec)
2523 {
2524 if (! ignoring)
2525 alt_list = tree_cons (NULL_TREE, receive_spec, alt_list);
2526 spec_seen++;
2527 }
2528 else if (parse_action ())
2529 {
2530 if (! spec_seen && pass == 1)
2531 error ("missing RECEIVE alternative");
2532 if (! ignoring)
2533 expand_exit_needed = 1;
2534 spec_seen = 1;
2535 }
2536 else
2537 break;
2538 }
2539 if (check_token (ELSE))
2540 {
2541 if (! ignoring)
2542 {
2543 emit_line_note (input_filename, lineno);
2544 if (build_receive_case_if_generated ())
2545 expand_start_else ();
2546 }
2547 parse_opt_actions ();
2548 have_else_actions = integer_one_node;
2549 }
2550 else
2551 have_else_actions = integer_zero_node;
2552 expect (ESAC, "missing 'ESAC' matching 'RECEIVE CASE'");
2553 if (! ignoring)
2554 {
297a6bfc 2555 build_receive_case_end (nreverse (alt_list), have_else_actions);
3c79b2da
PB		 2556 }
2557 possibly_define_exit_label (label);
2558 poplevel (0, 0, 0);
2559}
2560
2561static void
2562parse_send_action ()
2563{
2564 tree signal = NULL_TREE;
2565 tree buffer = NULL_TREE;
2566 tree value_list;
2567 tree with_expr, to_expr, priority;
2568 require (SEND);
2569 /* The tricky part is distinguishing between a SEND buffer action,
2570 and a SEND signal action. */
2571 if (pass != 2 || PEEK_TOKEN () != NAME)
2572 {
2573 /* If this is pass 2, it's a SEND buffer action.
2574 If it's pass 1, we don't care. */
2575 buffer = parse_primval ();
2576 }
2577 else
2578 {
2579 /* We have to specifically check for signalname followed by
2580 a '(', since we allow a signalname to be used (syntactically)
2581 as a "function". */
2582 tree name = parse_name ();
2583 if (TREE_CODE (name) == TYPE_DECL && CH_DECL_SIGNAL (name))
2584 signal = name; /* It's a SEND signal action! */
2585 else
2586 {
2587 /* It's not a legal SEND signal action.
2588 Back up and try as a SEND buffer action. */
2589 pushback_token (EXPR, name);
2590 buffer = parse_primval ();
2591 }
2592 }
2593 if (check_token (LPRN))
2594 {
2595 value_list = NULL_TREE;
2596 for (;;)
2597 {
2598 tree expr = parse_untyped_expr ();
2599 if (! ignoring)
2600 value_list = tree_cons (NULL_TREE, expr, value_list);
2601 if (! check_token (COMMA))
2602 break;
2603 }
2604 value_list = nreverse (value_list);
2605 expect (RPRN, "missing ')'");
2606 }
2607 else
2608 value_list = NULL_TREE;
2609 if (check_token (WITH))
2610 with_expr = parse_expression ();
2611 else
2612 with_expr = NULL_TREE;
2613 if (check_token (TO))
2614 to_expr = parse_expression ();
2615 else
2616 to_expr = NULL_TREE;
2617 if (check_token (PRIORITY))
2618 priority = parse_expression ();
2619 else
2620 priority = NULL_TREE;
2621 PUSH_ACTION;
2622 if (ignoring)
2623 return;
2624
2625 if (signal)
2626 { /* It's a <send signal action>! */
2627 tree sigdesc = build_signal_descriptor (signal, value_list);
2628 if (sigdesc != NULL_TREE && TREE_CODE (sigdesc) != ERROR_MARK)
2629 {
2630 tree sendto = to_expr ? to_expr : IDENTIFIER_SIGNAL_DEST (signal);
2631 expand_send_signal (sigdesc, with_expr,
2632 sendto, priority, DECL_NAME (signal));
2633 }
2634 }
2635 else
2636 {
2637 /* all checks are done in expand_send_buffer */
2638 expand_send_buffer (buffer, value_list, priority, with_expr, to_expr);
2639 }
2640}
2641
2642static void
2643parse_start_action ()
2644{
2645 tree name, copy_number, param_list, startset;
2646 require (START);
2647 name = parse_name_string ();
2648 expect (LPRN, "missing '(' in START action");
2649 PUSH_ACTION;
2650 /* copy number is a required parameter */
2651 copy_number = parse_expression ();
2652 if (!ignoring
2653 && (copy_number == NULL_TREE
2654 || TREE_CODE (copy_number) == ERROR_MARK
2655 || TREE_CODE (TREE_TYPE (copy_number)) != INTEGER_TYPE))
2656 {
2657 error ("PROCESS copy number must be integer");
2658 copy_number = integer_zero_node;
2659 }
2660 if (check_token (COMMA))
2661 param_list = parse_expr_list (); /* user parameters */
2662 else
2663 param_list = NULL_TREE;
2664 expect (RPRN, "missing ')'");
2665 startset = check_token (SET) ? parse_primval () : NULL;
2666 build_start_process (name, copy_number, param_list, startset);
2667}
2668
2669static void
2670parse_opt_actions ()
2671{
2672 while (parse_action ()) ;
2673}
2674
75111422 2675static int
3c79b2da
PB		 2676parse_action ()
2677{
2678 tree label = NULL_TREE;
2679 tree expr, rhs, loclist;
2680 enum tree_code op;
2681
2682 if (current_function_decl == global_function_decl
2683 && PEEK_TOKEN () != SC
2684 && PEEK_TOKEN () != END)
2685 seen_action = 1, build_constructor = 1;
2686
2687 if (PEEK_TOKEN () == NAME && PEEK_TOKEN1 () == COLON)
2688 {
2689 label = parse_defining_occurrence ();
2690 require (COLON);
2691 INIT_ACTION;
2692 define_label (input_filename, lineno, label);
2693 }
2694
2695 switch (PEEK_TOKEN ())
2696 {
2697 case AFTER:
2698 {
2699 int delay;
2700 require (AFTER);
2701 expr = parse_primval ();
2702 delay = check_token (DELAY);
2703 expect (IN, "missing 'IN'");
2704 push_action ();
2705 pushlevel (1);
2706 build_after_start (expr, delay);
2707 parse_opt_actions ();
2708 expect (TIMEOUT, "missing 'TIMEOUT'");
2709 build_after_timeout_start ();
2710 parse_opt_actions ();
2711 expect (END, "missing 'END'");
2712 build_after_end ();
2713 possibly_define_exit_label (label);
2714 poplevel (0, 0, 0);
2715 }
2716 goto bracketed_action;
2717 case ASM_KEYWORD:
2718 parse_asm_action ();
2719 goto no_handler_action;
2720 case ASSERT:
2721 require (ASSERT);
2722 PUSH_ACTION;
2723 expr = parse_expression ();
2724 if (! ignoring)
2725 { tree assertfail = ridpointers[(int) RID_ASSERTFAIL];
2726 expr = build (TRUTH_ORIF_EXPR, void_type_node, expr,
2727 build_cause_exception (assertfail, 0));
2728 expand_expr_stmt (fold (expr));
2729 }
2730 goto handler_action;
2731 case AT:
2732 require (AT);
2733 PUSH_ACTION;
2734 expr = parse_primval ();
2735 expect (IN, "missing 'IN'");
2736 pushlevel (1);
2737 if (! ignoring)
2738 build_at_action (expr);
2739 parse_opt_actions ();
2740 expect (TIMEOUT, "missing 'TIMEOUT'");
2741 if (! ignoring)
2742 expand_start_else ();
2743 parse_opt_actions ();
2744 expect (END, "missing 'END'");
2745 if (! ignoring)
2746 expand_end_cond ();
2747 possibly_define_exit_label (label);
2748 poplevel (0, 0, 0);
2749 goto bracketed_action;
2750 case BEGINTOKEN:
2751 parse_begin_end_block (label);
2752 return 1;
2753 case CASE:
2754 parse_case_action (label);
2755 goto bracketed_action;
2756 case CAUSE:
2757 require (CAUSE);
2758 expr = parse_name_string ();
2759 PUSH_ACTION;
2760 if (! ignoring && TREE_CODE (expr) != ERROR_MARK)
2761 expand_cause_exception (expr);
2762 goto no_handler_action;
2763 case CONTINUE:
2764 require (CONTINUE);
2765 expr = parse_expression ();
2766 PUSH_ACTION;
2767 if (! ignoring)
2768 expand_continue_event (expr);
2769 goto handler_action;
2770 case CYCLE:
2771 require (CYCLE);
2772 PUSH_ACTION;
2773 expr = parse_primval ();
2774 expect (IN, "missing 'IN' after 'CYCLE'");
2775 pushlevel (1);
2776 /* We a tree list where TREE_VALUE is the label
2777 and TREE_PURPOSE is the variable denotes the timeout id. */
2778 expr = build_cycle_start (expr);
2779 parse_opt_actions ();
2780 expect (END, "missing 'END'");
2781 if (! ignoring)
2782 build_cycle_end (expr);
2783 possibly_define_exit_label (label);
2784 poplevel (0, 0, 0);
2785 goto bracketed_action;
2786 case DELAY:
2787 if (PEEK_TOKEN1 () == CASE)
2788 {
2789 parse_delay_case_action (label);
2790 goto bracketed_action;
2791 }
2792 require (DELAY);
2793 PUSH_ACTION;
2794 expr = parse_primval ();
2795 rhs = check_token (PRIORITY) ? parse_expression () : NULL_TREE;
2796 if (! ignoring)
2797 build_delay_action (expr, rhs);
2798 goto handler_action;
2799 case DO:
2800 parse_do_action (label);
2801 return 1;
2802 case EXIT:
2803 require (EXIT);
2804 expr = parse_name_string ();
2805 PUSH_ACTION;
2806 lookup_and_handle_exit (expr);
2807 goto no_handler_action;
2808 case GOTO:
2809 require (GOTO);
2810 expr = parse_name_string ();
2811 PUSH_ACTION;
2812 lookup_and_expand_goto (expr);
2813 goto no_handler_action;
2814 case IF:
2815 parse_if_action (label);
2816 goto bracketed_action;
2817 case RECEIVE:
2818 if (PEEK_TOKEN1 () != CASE)
2819 return 0;
2820 parse_receive_case_action (label);
2821 goto bracketed_action;
2822 case RESULT:
2823 require (RESULT);
2824 PUSH_ACTION;
2825 expr = parse_untyped_expr ();
2826 if (! ignoring)
2827 chill_expand_result (expr, 1);
2828 goto handler_action;
2829 case RETURN:
2830 require (RETURN);
2831 PUSH_ACTION;
2832 expr = parse_opt_untyped_expr ();
2833 if (! ignoring)
2834 {
2835 /* Do this as RESULT expr and RETURN to get exceptions */
2836 chill_expand_result (expr, 0);
2837 expand_goto_except_cleanup (proc_action_level);
2838 chill_expand_return (NULL_TREE, 0);
2839 }
2840 if (expr)
2841 goto handler_action;
2842 else
2843 goto no_handler_action;
2844 case SC:
2845 require (SC);
2846 return 1;
2847 case SEND:
2848 parse_send_action ();
2849 goto handler_action;
2850 case START:
2851 parse_start_action ();
2852 goto handler_action;
2853 case STOP:
2854 require (STOP);
2855 PUSH_ACTION;
2856 if (! ignoring)
2857 { tree func = lookup_name (get_identifier ("__stop_process"));
2858 tree result = build_chill_function_call (func, NULL_TREE);
2859 expand_expr_stmt (result);
2860 }
2861 goto no_handler_action;
2862 case CALL:
2863 require (CALL);
2864 /* Fall through to here ... */
2865 case EXPR:
2866 case LPRN:
2867 case NAME:
2868 /* This handles calls and assignments. */
2869 PUSH_ACTION;
2870 expr = parse_primval ();
2871 switch (PEEK_TOKEN ())
2872 {
2873 case END:
2874 parse_semi_colon (); /* Emits error message. */
2875 case ON:
2876 case SC:
2877 if (!ignoring && TREE_CODE (expr) != ERROR_MARK)
2878 {
2879 if (TREE_CODE (expr) != CALL_EXPR
2880 && TREE_TYPE (expr) != void_type_node
2881 && ! TREE_SIDE_EFFECTS (expr))
2882 {
2883 if (TREE_CODE (expr) == FUNCTION_DECL)
2884 error ("missing parenthesis for procedure call");
2885 else
2886 error ("expression is not an action");
2887 expr = error_mark_node;
2888 }
2889 else
2890 expand_expr_stmt (expr);
2891 }
2892 goto handler_action;
2893 default:
2894 loclist
2895 = ignoring ? NULL_TREE : build_tree_list (NULL_TREE, expr);
2896 while (PEEK_TOKEN () == COMMA)
2897 {
2898 FORWARD_TOKEN ();
2899 expr = parse_primval ();
2900 if (!ignoring && TREE_CODE (expr) != ERROR_MARK)
2901 loclist = tree_cons (NULL_TREE, expr, loclist);
2902 }
2903 }
2904 switch (PEEK_TOKEN ())
2905 {
2906 case OR: op = BIT_IOR_EXPR; break;
2907 case XOR: op = BIT_XOR_EXPR; break;
2908 case ORIF: op = TRUTH_ORIF_EXPR; break;
2909 case AND: op = BIT_AND_EXPR; break;
2910 case ANDIF: op = TRUTH_ANDIF_EXPR; break;
2911 case PLUS: op = PLUS_EXPR; break;
2912 case SUB: op = MINUS_EXPR; break;
2913 case CONCAT: op = CONCAT_EXPR; break;
2914 case MUL: op = MULT_EXPR; break;
2915 case DIV: op = TRUNC_DIV_EXPR; break;
2916 case MOD: op = FLOOR_MOD_EXPR; break;
2917 case REM: op = TRUNC_MOD_EXPR; break;
2918
2919 default:
2920 error ("syntax error in action");
2921 case SC: case ON:
2922 case ASGN: op = NOP_EXPR; break;
2923 ;
2924 }
2925
2926 /* Looks like it was an assignment action. */
2927 FORWARD_TOKEN ();
2928 if (op != NOP_EXPR)
2929 expect (ASGN, "expected ':=' here");
2930 rhs = parse_untyped_expr ();
2931 if (!ignoring)
2932 expand_assignment_action (loclist, op, rhs);
2933 goto handler_action;
2934
2935 default:
2936 return 0;
2937 }
2938
2939 bracketed_action:
2940 /* We've parsed a bracketed action. */
2941 parse_opt_handler ();
2942 parse_opt_end_label_semi_colon (label);
2943 return 1;
2944
2945 no_handler_action:
2946 if (parse_opt_handler () != NULL_TREE && pass == 1)
2947 error ("no handler is permitted on this action.");
2948 parse_semi_colon ();
2949 return 1;
2950
2951 handler_action:
2952 parse_opt_handler ();
2953 parse_semi_colon ();
2954 return 1;
2955}
2956
2957static void
2958parse_body ()
2959{
2960 again:
2961 while (parse_definition (0)) ;
2962
2963 while (parse_action ()) ;
2964
2965 if (parse_definition (0))
2966 {
2967 if (pass == 1)
2968 pedwarn ("definition follows action");
2969 goto again;
2970 }
2971}
2972
2973static tree
2974parse_opt_untyped_expr ()
2975{
2976 switch (PEEK_TOKEN ())
2977 {
2978 case ON:
2979 case END:
2980 case SC:
2981 case COMMA:
2982 case COLON:
2983 case RPRN:
2984 return NULL_TREE;
2985 default:
2986 return parse_untyped_expr ();
2987 }
2988}
2989
2990static tree
2991parse_call (function)
2992 tree function;
2993{
2994 tree arg1, arg2, arg_list = NULL_TREE;
2995 enum terminal tok;
2996 require (LPRN);
2997 arg1 = parse_opt_untyped_expr ();
2998 if (arg1 != NULL_TREE)
2999 {
3000 tok = PEEK_TOKEN ();
3001 if (tok == UP || tok == COLON)
3002 {
3003 FORWARD_TOKEN ();
3004#if 0
3005 /* check that arg1 isn't untyped (or mode);*/
3006#endif
3007 arg2 = parse_expression ();
3008 expect (RPRN, "expected ')' to terminate slice");
3009 if (ignoring)
3010 return integer_zero_node;
3011 else if (tok == UP)
3012 return build_chill_slice_with_length (function, arg1, arg2);
3013 else
3014 return build_chill_slice_with_range (function, arg1, arg2);
3015 }
3016 if (!ignoring)
3017 arg_list = build_tree_list (NULL_TREE, arg1);
3018 while (check_token (COMMA))
3019 {
3020 arg2 = parse_untyped_expr ();
3021 if (!ignoring)
3022 arg_list = tree_cons (NULL_TREE, arg2, arg_list);
3023 }
3024 }
3025
3026 expect (RPRN, "expected ')' here");
3027 return ignoring ? function
3028 : build_generalized_call (function, nreverse (arg_list));
3029}
3030
3031/* Matches: <field name list>
3032 Returns: A list of IDENTIFIER_NODEs (or NULL_TREE if ignoring),
3033 in reverse order. */
3034
3035static tree
3036parse_tuple_fieldname_list ()
3037{
3038 tree list = NULL_TREE;
3039 do
3040 {
3041 tree name;
3042 if (!check_token (DOT))
3043 {
3044 error ("bad tuple field name list");
3045 return NULL_TREE;
3046 }
3047 name = parse_simple_name_string ();
3048 list = ignoring ? NULL_TREE : tree_cons (NULL_TREE, name, list);
3049 } while (check_token (COMMA));
3050 return list;
3051}
3052
3053/* Returns one or nore TREE_LIST nodes, in reverse order. */
3054
3055static tree
3056parse_tuple_element ()
3057{
3058 /* The tupleelement chain is built in reverse order,
3059 and put in forward order when the list is used. */
75111422 3060 tree value, label;
3c79b2da
PB		 3061 if (PEEK_TOKEN () == DOT)
3062 {
3063 /* Parse a labelled structure tuple. */
3064 tree list = parse_tuple_fieldname_list (), field;
3065 expect (COLON, "missing ':' in tuple");
3066 value = parse_untyped_expr ();
3067 if (ignoring)
3068 return NULL_TREE;
3069 /* FIXME: Should use save_expr(value), but that
3070 confuses nested calls to digest_init! */
3071 /* Re-use the list of field names as a list of name-value pairs. */
3072 for (field = list; field != NULL_TREE; field = TREE_CHAIN (field))
3073 { tree field_name = TREE_VALUE (field);
3074 TREE_PURPOSE (field) = field_name;
3075 TREE_VALUE (field) = value;
3076 TUPLE_NAMED_FIELD (field) = 1;
3077 }
3078 return list;
3079 }
3080
3081 label = parse_case_label_list (NULL_TREE, 1);
3082 if (label)
3083 {
3084 expect (COLON, "missing ':' in tuple");
3085 value = parse_untyped_expr ();
3086 if (ignoring || label == NULL_TREE)
3087 return NULL_TREE;
3088 if (TREE_CODE (label) != TREE_LIST)
3089 {
3090 error ("invalid syntax for label in tuple");
3091 return NULL_TREE;
3092 }
3093 else
3094 {
3095 /* FIXME: Should use save_expr(value), but that
3096 confuses nested calls to digest_init! */
3097 tree link = label;
3098 for (; link != NULL_TREE; link = TREE_CHAIN (link))
3099 { tree index = TREE_VALUE (link);
3100 if (pass == 1 && TREE_CODE (index) != TREE_LIST)
3101 index = build1 (PAREN_EXPR, NULL_TREE, index);
3102 TREE_VALUE (link) = value;
3103 TREE_PURPOSE (link) = index;
3104 }
3105 return nreverse (label);
3106 }
3107 }
3108
3109 value = parse_untyped_expr ();
3110 if (check_token (COLON))
3111 {
3112 /* A powerset range [or possibly a labeled Array?] */
3113 tree value2 = parse_untyped_expr ();
3114 return ignoring ? NULL_TREE : build_tree_list (value, value2);
3115 }
3116 return ignoring ? NULL_TREE : build_tree_list (NULL_TREE, value);
3117}
3118
3119/* Matches: a COMMA-separated list of tuple elements.
3120 Returns a list (of TREE_LIST nodes). */
3121static tree
3122parse_opt_element_list ()
3123{
3124 tree list = NULL_TREE;
3125 if (PEEK_TOKEN () == RPC)
3126 return NULL_TREE;
3127 for (;;)
3128 {
3129 tree element = parse_tuple_element ();
3130 list = chainon (element, list); /* Built in reverse order */
3131 if (PEEK_TOKEN () == RPC)
3132 break;
3133 if (!check_token (COMMA))
3134 {
3135 error ("bad syntax in tuple");
3136 return NULL_TREE;
3137 }
3138 }
3139 return nreverse (list);
3140}
3141
3142/* Parses: '[' elements ']'
3143 If modename is non-NULL it prefixed the tuple. */
3144
3145static tree
3146parse_tuple (modename)
3147 tree modename;
3148{
3149 tree list;
3150 require (LPC);
3151 list = parse_opt_element_list ();
3152 expect (RPC, "missing ']' after tuple");
3153 if (ignoring)
3154 return integer_zero_node;
3155 list = build_nt (CONSTRUCTOR, NULL_TREE, list);
3156 if (modename == NULL_TREE)
3157 return list;
3158 else if (pass == 1)
3159 TREE_TYPE (list) = modename;
3160 else if (TREE_CODE (modename) != TYPE_DECL)
3161 {
3162 error ("non-mode name before tuple");
3163 return error_mark_node;
3164 }
3165 else
3166 list = chill_expand_tuple (TREE_TYPE (modename), list);
3167 return list;
3168}
3169
3170static tree
3171parse_primval ()
3172{
3173 tree val;
3174 switch (PEEK_TOKEN ())
3175 {
3176 case NUMBER:
3177 case FLOATING:
3178 case STRING:
3179 case SINGLECHAR:
3180 case BITSTRING:
3181 case CONST:
3182 case EXPR:
3183 val = PEEK_TREE();
3184 FORWARD_TOKEN ();
3185 break;
3186 case THIS:
3187 val = build_chill_function_call (PEEK_TREE (), NULL_TREE);
3188 FORWARD_TOKEN ();
3189 break;
3190 case LPRN:
3191 FORWARD_TOKEN ();
3192 val = parse_expression ();
3193 expect (RPRN, "missing right parenthesis");
3194 if (pass == 1 && ! ignoring)
3195 val = build1 (PAREN_EXPR, NULL_TREE, val);
3196 break;
3197 case LPC:
3198 val = parse_tuple (NULL_TREE);
3199 break;
3200 case NAME:
3201 val = parse_name ();
3202 if (PEEK_TOKEN() == LPC)
3203 val = parse_tuple (val); /* Matched: <mode_name> <tuple> */
3204 break;
3205 default:
3206 if (!ignoring)
3207 error ("invalid expression/location syntax");
3208 val = error_mark_node;
3209 }
3210 for (;;)
3211 {
3212 tree name, args;
3213 switch (PEEK_TOKEN ())
3214 {
3215 case DOT:
3216 FORWARD_TOKEN ();
3217 name = parse_simple_name_string ();
3218 val = ignoring ? val : build_chill_component_ref (val, name);
3219 continue;
3220 case ARROW:
3221 FORWARD_TOKEN ();
3222 name = parse_opt_name_string (0);
3223 val = ignoring ? val : build_chill_indirect_ref (val, name, 1);
3224 continue;
3225 case LPRN:
3226 /* The SEND buffer action syntax is ambiguous, at least when
3227 parsed left-to-right. In the example 'SEND foo(v) ...' the
3228 phrase 'foo(v)' could be a buffer location procedure call
3229 (which then must be followed by the value to send).
3230 On the other hand, if 'foo' is a buffer, stop parsing
3231 after 'foo', and let parse_send_action pick up '(v) as
3232 the value ot send.
3233
3234 We handle the ambiguity for SEND signal action differently,
3235 since we allow (as an extension) a signal to be used as
3236 a "function" (see build_generalized_call). */
3237 if (TREE_TYPE (val) != NULL_TREE
3238 && CH_IS_BUFFER_MODE (TREE_TYPE (val)))
3239 return val;
3240 val = parse_call (val);
3241 continue;
3242 case STRING:
3243 case BITSTRING:
3244 case SINGLECHAR:
3245 case NAME:
3246 /* Handle string repetition. (See comment in parse_operand5.) */
3247 args = parse_primval ();
3248 val = ignoring ? val : build_generalized_call (val, args);
3249 continue;
75111422
KG		 3250 default:
3251 break;
3c79b2da
PB		 3252 }
3253 break;
3254 }
3255 return val;
3256}
3257
3258static tree
3259parse_operand6 ()
3260{
3261 if (check_token (RECEIVE))
3262 {
12fe4621 3263 tree location ATTRIBUTE_UNUSED = parse_primval ();
3c79b2da
PB		 3264 sorry ("RECEIVE expression");
3265 return integer_one_node;
3266 }
3267 else if (check_token (ARROW))
3268 {
3269 tree location = parse_primval ();
3270 return ignoring ? location : build_chill_arrow_expr (location, 0);
3271 }
3272 else
3273 return parse_primval();
3274}
3275
3276static tree
3277parse_operand5()
3278{
3279 enum tree_code op;
3280 /* We are supposed to be looking for a <string repetition operator>,
3281 but in general we can't distinguish that from a parenthesized
3282 expression. This is especially difficult if we allow the
3283 string operand to be a constant expression (as requested by
3284 some users), and not just a string literal.
3285 Consider: LPRN expr RPRN LPRN expr RPRN
3286 Is that a function call or string repetition?
3287 Instead, we handle string repetition in parse_primval,
3288 and build_generalized_call. */
3289 tree rarg;
3290 switch (PEEK_TOKEN())
3291 {
3292 case NOT: op = BIT_NOT_EXPR; break;
3293 case SUB: op = NEGATE_EXPR; break;
3294 default:
3295 op = NOP_EXPR;
3296 }
3297 if (op != NOP_EXPR)
3298 FORWARD_TOKEN();
3299 rarg = parse_operand6();
3300 return (op == NOP_EXPR || ignoring) ? rarg
3301 : build_chill_unary_op (op, rarg);
3302}
3303
3304static tree
3305parse_operand4 ()
3306{
3307 tree larg = parse_operand5(), rarg;
3308 enum tree_code op;
3309 for (;;)
3310 {
3311 switch (PEEK_TOKEN())
3312 {
3313 case MUL: op = MULT_EXPR; break;
3314 case DIV: op = TRUNC_DIV_EXPR; break;
3315 case MOD: op = FLOOR_MOD_EXPR; break;
3316 case REM: op = TRUNC_MOD_EXPR; break;
3317 default:
3318 return larg;
3319 }
3320 FORWARD_TOKEN();
3321 rarg = parse_operand5();
3322 if (!ignoring)
3323 larg = build_chill_binary_op (op, larg, rarg);
3324 }
3325}
3326
3327static tree
3328parse_operand3 ()
3329{
3330 tree larg = parse_operand4 (), rarg;
3331 enum tree_code op;
3332 for (;;)
3333 {
3334 switch (PEEK_TOKEN())
3335 {
3336 case PLUS: op = PLUS_EXPR; break;
3337 case SUB: op = MINUS_EXPR; break;
3338 case CONCAT: op = CONCAT_EXPR; break;
3339 default:
3340 return larg;
3341 }
3342 FORWARD_TOKEN();
3343 rarg = parse_operand4();
3344 if (!ignoring)
3345 larg = build_chill_binary_op (op, larg, rarg);
3346 }
3347}
3348
3349static tree
3350parse_operand2 ()
3351{
3352 tree larg = parse_operand3 (), rarg;
3353 enum tree_code op;
3354 for (;;)
3355 {
3356 if (check_token (IN))
3357 {
3358 rarg = parse_operand3();
3359 if (! ignoring)
3360 larg = build_chill_binary_op (SET_IN_EXPR, larg, rarg);
3361 }
3362 else
3363 {
3364 switch (PEEK_TOKEN())
3365 {
3366 case GT: op = GT_EXPR; break;
3367 case GTE: op = GE_EXPR; break;
3368 case LT: op = LT_EXPR; break;
3369 case LTE: op = LE_EXPR; break;
3370 case EQL: op = EQ_EXPR; break;
3371 case NE: op = NE_EXPR; break;
3372 default:
3373 return larg;
3374 }
3375 FORWARD_TOKEN();
3376 rarg = parse_operand3();
3377 if (!ignoring)
3378 larg = build_compare_expr (op, larg, rarg);
3379 }
3380 }
3381}
3382
3383static tree
3384parse_operand1 ()
3385{
3386 tree larg = parse_operand2 (), rarg;
3387 enum tree_code op;
3388 for (;;)
3389 {
3390 switch (PEEK_TOKEN())
3391 {
3392 case AND: op = BIT_AND_EXPR; break;
3393 case ANDIF: op = TRUTH_ANDIF_EXPR; break;
3394 default:
3395 return larg;
3396 }
3397 FORWARD_TOKEN();
3398 rarg = parse_operand2();
3399 if (!ignoring)
3400 larg = build_chill_binary_op (op, larg, rarg);
3401 }
3402}
3403
3404static tree
3405parse_operand0 ()
3406{
3407 tree larg = parse_operand1(), rarg;
3408 enum tree_code op;
3409 for (;;)
3410 {
3411 switch (PEEK_TOKEN())
3412 {
3413 case OR: op = BIT_IOR_EXPR; break;
3414 case XOR: op = BIT_XOR_EXPR; break;
3415 case ORIF: op = TRUTH_ORIF_EXPR; break;
3416 default:
3417 return larg;
3418 }
3419 FORWARD_TOKEN();
3420 rarg = parse_operand1();
3421 if (!ignoring)
3422 larg = build_chill_binary_op (op, larg, rarg);
3423 }
3424}
3425
3426static tree
3427parse_expression ()
3428{
3429 return parse_operand0 ();
3430}
3431
3432static tree
3433parse_case_expression ()
3434{
3435 tree selector_list;
3436 tree else_expr;
3437 tree case_expr;
3438 tree case_alt_list = NULL_TREE;
3439
3440 require (CASE);
3441 selector_list = parse_expr_list ();
3442 selector_list = nreverse (selector_list);
3443
3444 expect (OF, "missing 'OF'");
3445 while (PEEK_TOKEN () == LPRN)
3446 {
3447 tree label_spec = parse_case_label_specification (selector_list);
3448 tree sub_expr;
3449 expect (COLON, "missing ':' in value case alternative");
3450 sub_expr = parse_expression ();
3451 expect (SC, "missing ';'");
3452 if (! ignoring)
3453 case_alt_list = tree_cons (label_spec, sub_expr, case_alt_list);
3454 }
3455 if (check_token (ELSE))
3456 {
3457 else_expr = parse_expression ();
3458 if (check_token (SC) && pass == 1)
3459 warning("there should not be a ';' here");
3460 }
3461 else
3462 else_expr = NULL_TREE;
3463 expect (ESAC, "missing 'ESAC' in 'CASE' expression");
3464
3465 if (ignoring)
3466 return integer_zero_node;
3467
3468 /* If this is a multi dimension case, then transform it into an COND_EXPR
3469 here. This must be done before store_expr is called since it has some
3470 special handling for COND_EXPR expressions. */
3471 if (TREE_CHAIN (selector_list) != NULL_TREE)
3472 {
3473 case_alt_list = nreverse (case_alt_list);
3474 compute_else_ranges (selector_list, case_alt_list);
3475 case_expr =
3476 build_chill_multi_dimension_case_expr (selector_list, case_alt_list, else_expr);
3477 }
3478 else
3479 case_expr = build_chill_case_expr (selector_list, case_alt_list, else_expr);
3480
3481 return case_expr;
3482}
3483
3484static tree
3485parse_then_alternative ()
3486{
3487 expect (THEN, "missing 'THEN' in 'IF' expression");
3488 return parse_expression ();
3489}
3490
3491static tree
3492parse_else_alternative ()
3493{
3494 if (check_token (ELSIF))
3495 return parse_if_expression_body ();
3496 else if (check_token (ELSE))
3497 return parse_expression ();
3498 error ("missing ELSE/ELSIF in IF expression");
3499 return error_mark_node;
3500}
3501
3502/* Matches: <boolean expression> <then alternative> <else alternative> */
3503
3504static tree
3505parse_if_expression_body ()
3506{
3507 tree bool_expr, then_expr, else_expr;
3508 bool_expr = parse_expression ();
3509 then_expr = parse_then_alternative ();
3510 else_expr = parse_else_alternative ();
3511 if (ignoring)
3512 return integer_zero_node;
3513 else
3514 return build_nt (COND_EXPR, bool_expr, then_expr, else_expr);
3515}
3516
3517static tree
3518parse_if_expression ()
3519{
3520 tree expr;
3521 require (IF);
3522 expr = parse_if_expression_body ();
3523 expect (FI, "missing 'FI' at end of conditional expression");
3524 return expr;
3525}
3526
3527/* An <untyped_expr> is a superset of <expr>. It also includes
3528 <conditional expressions> and untyped <tuples>, whose types
3529 are not given by their constituents. Hence, these are only
3530 allowed in certain contexts that expect a certain type.
3531 You should call convert() to fix up the <untyped_expr>. */
3532
3533static tree
3534parse_untyped_expr ()
3535{
3536 tree val;
3537 switch (PEEK_TOKEN())
3538 {
3539 case IF:
3540 return parse_if_expression ();
3541 case CASE:
3542 return parse_case_expression ();
3543 case LPRN:
3544 switch (PEEK_TOKEN1())
3545 {
3546 case IF:
3547 case CASE:
3548 if (pass == 1)
3549 pedwarn ("conditional expression not allowed inside parentheses");
3550 goto skip_lprn;
3551 case LPC:
3552 if (pass == 1)
3553 pedwarn ("mode-less tuple not allowed inside parentheses");
3554 skip_lprn:
3555 FORWARD_TOKEN ();
3556 val = parse_untyped_expr ();
3557 expect (RPRN, "missing ')'");
3558 return val;
3559 default: ;
3560 /* fall through */
3561 }
3562 default:
3563 return parse_operand0 ();
3564 }
3565}
3566
3567/* Matches: <index mode> */
3568
3569static tree
3570parse_index_mode ()
3571{
3572 /* This is another one that is nasty to parse!
3573 Let's feel our way ahead ... */
3574 tree lower, upper;
3575 if (PEEK_TOKEN () == NAME)
3576 {
3577 tree name = parse_name ();
3578 switch (PEEK_TOKEN ())
3579 {
3580 case COMMA:
3581 case RPRN:
3582 case SC: /* An error */
3583 /* This can only (legally) be a discrete mode name. */
3584 return name;
3585 case LPRN:
3586 /* This could be named discrete range,
3587 a cast, or some other expression (maybe). */
3588 require (LPRN);
3589 lower = parse_expression ();
3590 if (check_token (COLON))
3591 {
3592 upper = parse_expression ();
3593 expect (RPRN, "missing ')'");
3594 /* Matched: <mode_name> '(' <expr> ':' <expr> ')' */
3595 if (ignoring)
3596 return NULL_TREE;
3597 else
3598 return build_chill_range_type (name, lower, upper);
3599 }
3600 /* Looks like a cast or procedure call or something.
3601 Backup, and try again. */
3602 pushback_token (EXPR, lower);
3603 pushback_token (LPRN, NULL_TREE);
3604 lower = parse_call (name);
3605 goto parse_literal_range_colon;
3606 default:
3607 /* This has to be the start of an expression. */
3608 pushback_token (EXPR, name);
3609 goto parse_literal_range;
3610 }
3611 }
3612 /* It's not a name. But it could still be a discrete mode. */
3613 lower = parse_opt_mode ();
3614 if (lower)
3615 return lower;
3616 parse_literal_range:
3617 /* Nope, it's a discrete literal range. */
3618 lower = parse_expression ();
3619 parse_literal_range_colon:
3620 expect (COLON, "expected ':' here");
3621
3622 upper = parse_expression ();
3623 return ignoring ? NULL_TREE
3624 : build_chill_range_type (NULL_TREE, lower, upper);
3625}
3626
3627static tree
3628parse_set_mode ()
3629{
3630 int set_name_cnt = 0; /* count of named set elements */
3631 int set_is_numbered = 0; /* TRUE if set elements have explicit values */
3632 int set_is_not_numbered = 0;
3633 tree list = NULL_TREE;
3634 tree mode = ignoring ? void_type_node : start_enum (NULL_TREE);
3635 require (SET);
3636 expect (LPRN, "missing left parenthesis after SET");
3637 for (;;)
3638 {
3639 tree name, value = NULL_TREE;
3640 if (check_token (MUL))
3641 name = NULL_TREE;
3642 else
3643 {
3644 name = parse_defining_occurrence ();
3645 if (check_token (EQL))
3646 {
3647 value = parse_expression ();
3648 set_is_numbered = 1;
3649 }
3650 else
3651 set_is_not_numbered = 1;
3652 set_name_cnt++;
3653 }
3654 name = build_enumerator (name, value);
3655 if (pass == 1)
3656 list = chainon (name, list);
3657 if (! check_token (COMMA))
3658 break;
3659 }
3660 expect (RPRN, "missing right parenthesis after SET");
3661 if (!ignoring)
3662 {
3663 if (set_is_numbered && set_is_not_numbered)
3664 /* Z.200 doesn't allow mixed numbered and unnumbered set elements,
3665 but we can do it. Print a warning */
3666 pedwarn ("mixed numbered and unnumbered set elements is not standard");
3667 mode = finish_enum (mode, list);
3668 if (set_name_cnt == 0)
3669 error ("SET mode must define at least one named value");
3670 CH_ENUM_IS_NUMBERED(mode) = set_is_numbered ? 1 : 0;
3671 }
3672 return mode;
3673}
3674
3675/* parse layout POS:
3676 returns a tree with following layout
3677
3678 treelist
3679 pupose=treelist value=NULL_TREE (to indicate POS)
3680 pupose=word value=treelist | NULL_TREE
3681 pupose=startbit value=treelist | NULL_TREE
3682 purpose= value=
3683 integer_zero | integer_one length | endbit
3684*/
3685static tree
3686parse_pos ()
3687{
3688 tree word;
3689 tree startbit = NULL_TREE, endbit = NULL_TREE;
3690 tree what = NULL_TREE;
3691
3692 require (LPRN);
3693 word = parse_untyped_expr ();
3694 if (check_token (COMMA))
3695 {
3696 startbit = parse_untyped_expr ();
3697 if (check_token (COMMA))
3698 {
3699 what = integer_zero_node;
3700 endbit = parse_untyped_expr ();
3701 }
3702 else if (check_token (COLON))
3703 {
3704 what = integer_one_node;
3705 endbit = parse_untyped_expr ();
3706 }
3707 }
3708 require (RPRN);
3709
3710 /* build the tree as described above */
3711 if (what != NULL_TREE)
3712 what = tree_cons (what, endbit, NULL_TREE);
3713 if (startbit != NULL_TREE)
3714 startbit = tree_cons (startbit, what, NULL_TREE);
3715 endbit = tree_cons (word, startbit, NULL_TREE);
3716 return tree_cons (endbit, NULL_TREE, NULL_TREE);
3717}
3718
3719/* parse layout STEP
3720 returns a tree with the following layout
3721
3722 treelist
3723 pupose=NULL_TREE value=treelist (to indicate STEP)
3724 pupose=POS(see baove) value=stepsize | NULL_TREE
3725*/
3726static tree
3727parse_step ()
3728{
3729 tree pos;
3730 tree stepsize = NULL_TREE;
3731
3732 require (LPRN);
3733 require (POS);
3734 pos = parse_pos ();
3735 if (check_token (COMMA))
3736 stepsize = parse_untyped_expr ();
3737 require (RPRN);
3738 TREE_VALUE (pos) = stepsize;
3739 return tree_cons (NULL_TREE, pos, NULL_TREE);
3740}
3741
3742/* returns layout for fields or array elements.
3743 NULL_TREE no layout specified
3744 integer_one_node PACK specified
3745 integer_zero_node NOPACK specified
3746 tree_list PURPOSE POS
3747 tree_list VALUE STEP
3748*/
3749static tree
3750parse_opt_layout (in)
3751 int in; /* 0 ... parse structure, 1 ... parse array */
3752{
3753 tree val = NULL_TREE;
3754
3755 if (check_token (PACK))
3756 {
3757 return integer_one_node;
3758 }
3759 else if (check_token (NOPACK))
3760 {
3761 return integer_zero_node;
3762 }
3763 else if (check_token (POS))
3764 {
3765 val = parse_pos ();
3766 if (in == 1 && pass == 1)
3767 {
3768 error ("POS not allowed for ARRAY");
3769 val = NULL_TREE;
3770 }
3771 return val;
3772 }
3773 else if (check_token (STEP))
3774 {
3775 val = parse_step ();
3776 if (in == 0 && pass == 1)
3777 {
3778 error ("STEP not allowed in field definition");
3779 val = NULL_TREE;
3780 }
3781 return val;
3782 }
3783 else
3784 return NULL_TREE;
3785}
3786
3787static tree
3788parse_field_name_list ()
3789{
3790 tree chain = NULL_TREE;
3791 tree name = parse_defining_occurrence ();
3792 if (name == NULL_TREE)
3793 {
3794 error("missing field name");
3795 return NULL_TREE;
3796 }
3797 chain = build_tree_list (NULL_TREE, name);
3798 while (check_token (COMMA))
3799 {
3800 name = parse_defining_occurrence ();
3801 if (name == NULL)
3802 {
3803 error ("bad field name following ','");
3804 break;
3805 }
3806 if (! ignoring)
3807 chain = tree_cons (NULL_TREE, name, chain);
3808 }
3809 return chain;
3810}
3811
3812/* Matches: <fixed field> or <variant field>, i.e.:
3813 <field name defining occurrence list> <mode> [ <field layout> ].
3814 Returns: A chain of FIELD_DECLs.
3815 NULL_TREE is returned if ignoring is true or an error is seen. */
3816
3817static tree
3818parse_fixed_field ()
3819{
3820 tree field_names = parse_field_name_list ();
3821 tree mode = parse_mode ();
3822 tree layout = parse_opt_layout (0);
3823 return ignoring ? NULL_TREE
3824 : grok_chill_fixedfields (field_names, mode, layout);
3825}
3826
3827
3828/* Matches: [ <variant field> { "," <variant field> }* ]
3829 Returns: A chain of FIELD_DECLs.
3830 NULL_TREE is returned if ignoring is true or an error is seen. */
3831
3832static tree
3833parse_variant_field_list ()
3834{
3835 tree fields = NULL_TREE;
3836 if (PEEK_TOKEN () != NAME)
3837 return NULL_TREE;
3838 for (;;)
3839 {
3840 fields = chainon (fields, parse_fixed_field ());
3841 if (PEEK_TOKEN () != COMMA || PEEK_TOKEN1 () != NAME)
3842 break;
3843 require (COMMA);
3844 }
3845 return fields;
3846}
3847
3848/* Matches: <variant alternative>
3849 Returns a TREE_LIST node, whose TREE_PURPOSE (if non-NULL) is the label,
3850 and whose TREE_VALUE is the list of FIELD_DECLs. */
3851
3852static tree
3853parse_variant_alternative ()
3854{
75111422
KG		 3855 tree labels;
3856
3c79b2da
PB		 3857 if (PEEK_TOKEN () == LPRN)
3858 labels = parse_case_label_specification (NULL_TREE);
3859 else
3860 labels = NULL_TREE;
3861 if (! check_token (COLON))
3862 {
3863 error ("expected ':' in structure variant alternative");
3864 return NULL_TREE;
3865 }
3866
3867 /* We now read a list a variant fields, until we come to the end
3868 of the variant alternative. But since both variant fields
3869 *and* variant alternatives are separated by COMMAs,
3870 we will have to look ahead to distinguish the start of a variant
3871 field from the start of a new variant alternative.
3872 We use the fact that a variant alternative must start with
3873 either a LPRN or a COLON, while a variant field must start with a NAME.
3874 This look-ahead is handled by parse_simple_fields. */
3875 return build_tree_list (labels, parse_variant_field_list ());
3876}
3877
3878/* Parse <field> (which is <fixed field> or <alternative field>).
3879 Returns: A chain of FIELD_DECLs (or NULL_TREE on error or if ignoring). */
3880
3881static tree
3882parse_field ()
3883{
3884 if (check_token (CASE))
3885 {
3886 tree tag_list = NULL_TREE, variants, opt_variant_else;
3887 if (PEEK_TOKEN () == NAME)
3888 {
3889 tag_list = nreverse (parse_field_name_list ());
3890 if (pass == 1)
3891 tag_list = lookup_tag_fields (tag_list, current_fieldlist);
3892 }
3893 expect (OF, "missing 'OF' in alternative structure field");
3894
3895 variants = parse_variant_alternative ();
3896 while (check_token (COMMA))
3897 variants = chainon (parse_variant_alternative (), variants);
3898 variants = nreverse (variants);
3899
3900 if (check_token (ELSE))
3901 opt_variant_else = parse_variant_field_list ();
3902 else
3903 opt_variant_else = NULL_TREE;
3904 expect (ESAC, "missing 'ESAC' following alternative structure field");
3905 if (ignoring)
3906 return NULL_TREE;
3907 return grok_chill_variantdefs (tag_list, variants, opt_variant_else);
3908 }
3909 else if (PEEK_TOKEN () == NAME)
3910 return parse_fixed_field ();
3911 else
3912 {
3913 if (pass == 1)
3914 error ("missing field");
3915 return NULL_TREE;
3916 }
3917}
3918
3919static tree
3920parse_structure_mode ()
3921{
3922 tree save_fieldlist = current_fieldlist;
3923 tree fields;
3924 require (STRUCT);
3925 expect (LPRN, "expected '(' after STRUCT");
3926 current_fieldlist = fields = parse_field ();
3927 while (check_token (COMMA))
3928 fields = chainon (fields, parse_field ());
3929 expect (RPRN, "expected ')' after STRUCT");
3930 current_fieldlist = save_fieldlist;
3931 return ignoring ? void_type_node : build_chill_struct_type (fields);
3932}
3933
3934static tree
3935parse_opt_queue_size ()
3936{
3937 if (check_token (LPRN))
3938 {
3939 tree size = parse_expression ();
3940 expect (RPRN, "missing ')'");
3941 return size;
3942 }
3943 else
3944 return NULL_TREE;
3945}
3946
3947static tree
3948parse_procedure_mode ()
3949{
3950 tree param_types = NULL_TREE, result_spec, except_list, recursive;
3951 require (PROC);
3952 expect (LPRN, "missing '(' after PROC");
3953 if (! check_token (RPRN))
3954 {
3955 for (;;)
3956 {
3957 tree pmode = parse_mode ();
3958 tree paramattr = parse_param_attr ();
3959 if (! ignoring)
3960 {
3961 pmode = get_type_of (pmode);
3962 param_types = tree_cons (paramattr, pmode, param_types);
3963 }
3964 if (! check_token (COMMA))
3965 break;
3966 }
3967 expect (RPRN, "missing ')' after PROC");
3968 }
3969 result_spec = parse_opt_result_spec ();
3970 except_list = parse_opt_except ();
3971 recursive = parse_opt_recursive ();
3972 if (ignoring)
3973 return void_type_node;
3974 return build_chill_pointer_type (build_chill_function_type
3975 (result_spec, nreverse (param_types),
3976 except_list, recursive));
3977}
3978
3979/* Matches: <mode>
3980 A NAME will be assumed to be a <mode name>, and thus a <mode>.
3981 Returns NULL_TREE if no mode is seen.
3982 (If ignoring is true, the return value may be an arbitrary tree node,
3983 but will be non-NULL if something that could be a mode is seen.) */
3984
3985static tree
3986parse_opt_mode ()
3987{
3988 switch (PEEK_TOKEN ())
3989 {
3990 case ACCESS:
3991 {
3992 tree index_mode, record_mode;
3993 int dynamic = 0;
3994 require (ACCESS);
3995 if (check_token (LPRN))
3996 {
3997 index_mode = parse_index_mode ();
3998 expect (RPRN, "mssing ')'");
3999 }
4000 else
4001 index_mode = NULL_TREE;
4002 record_mode = parse_opt_mode ();
4003 if (record_mode)
4004 dynamic = check_token (DYNAMIC);
4005 return ignoring ? void_type_node
4006 : build_access_mode (index_mode, record_mode, dynamic);
4007 }
4008 case ARRAY:
4009 {
4010 tree index_list = NULL_TREE, base_mode;
4011 int varying;
4012 int num_index_modes = 0;
4013 int i;
4014 tree layouts = NULL_TREE;
4015 FORWARD_TOKEN ();
4016 expect (LPRN, "missing '(' after ARRAY");
4017 for (;;)
4018 {
4019 tree index = parse_index_mode ();
4020 num_index_modes++;
4021 if (!ignoring)
4022 index_list = tree_cons (NULL_TREE, index, index_list);
4023 if (! check_token (COMMA))
4024 break;
4025 }
4026 expect (RPRN, "missing ')' after ARRAY");
4027 varying = check_token (VARYING);
4028 base_mode = parse_mode ();
4029 /* Allow a layout specification for each index mode */
4030 for (i = 0; i < num_index_modes; ++i)
4031 {
4032 tree new_layout = parse_opt_layout (1);
4033 if (new_layout == NULL_TREE)
4034 break;
4035 if (!ignoring)
4036 layouts = tree_cons (NULL_TREE, new_layout, layouts);
4037 }
4038 if (ignoring)
4039 return base_mode;
4040 return build_chill_array_type (get_type_of (base_mode),
4041 index_list, varying, layouts);
4042 }
4043 case ASSOCIATION:
4044 require (ASSOCIATION);
4045 return association_type_node;
4046 case BIN:
4047 { tree length;
4048 FORWARD_TOKEN();
4049 expect (LPRN, "missing left parenthesis after BIN");
4050 length = parse_expression ();
4051 expect (RPRN, "missing right parenthesis after BIN");
4052 return ignoring ? void_type_node : build_chill_bin_type (length);
4053 }
4054 case BOOLS:
4055 {
4056 tree length;
4057 FORWARD_TOKEN ();
4058 expect (LPRN, "missing '(' after BOOLS");
4059 length = parse_expression ();
4060 expect (RPRN, "missing ')' after BOOLS");
4061 if (check_token (VARYING))
4062 error ("VARYING bit-strings not implemented");
4063 return ignoring ? void_type_node : build_bitstring_type (length);
4064 }
4065 case BUFFER:
4066 {
4067 tree qsize, element_mode;
4068 require (BUFFER);
4069 qsize = parse_opt_queue_size ();
4070 element_mode = parse_mode ();
4071 return ignoring ? element_mode
4072 : build_buffer_type (element_mode, qsize);
4073 }
4074 case CHARS:
4075 {
4076 tree length;
4077 int varying;
4078 tree type;
4079 FORWARD_TOKEN ();
4080 expect (LPRN, "missing '(' after CHARS");
4081 length = parse_expression ();
4082 expect (RPRN, "missing ')' after CHARS");
4083 varying = check_token (VARYING);
4084 if (ignoring)
4085 return void_type_node;
4086 type = build_string_type (char_type_node, length);
4087 if (varying)
4088 type = build_varying_struct (type);
4089 return type;
4090 }
4091 case EVENT:
4092 {
4093 tree qsize;
4094 require (EVENT);
4095 qsize = parse_opt_queue_size ();
4096 return ignoring ? void_type_node : build_event_type (qsize);
4097 }
4098 case NAME:
4099 {
4100 tree mode = get_type_of (parse_name ());
4101 if (check_token (LPRN))
4102 {
4103 tree min_value = parse_expression ();
4104 if (check_token (COLON))
4105 {
4106 tree max_value = parse_expression ();
4107 expect (RPRN, "syntax error - expected ')'");
4108 /* Matched: <mode_name> '(' <expr> ':' <expr> ')' */
4109 if (ignoring)
4110 return mode;
4111 else
4112 return build_chill_range_type (mode, min_value, max_value);
4113 }
4114 if (check_token (RPRN))
4115 {
4116 int varying = check_token (VARYING);
4117 if (! ignoring)
4118 {
4119 if (mode == char_type_node || varying)
4120 {
4121 if (mode != char_type_node
4122 && mode != ridpointers[(int) RID_CHAR])
4123 error ("strings must be composed of chars");
4124 mode = build_string_type (char_type_node, min_value);
4125 if (varying)
4126 mode = build_varying_struct (mode);
4127 }
4128 else
4129 {
4130 /* Parameterized mode,
4131 or old-fashioned CHAR(N) string declaration.. */
4132 tree pmode = make_node (LANG_TYPE);
4133 TREE_TYPE (pmode) = mode;
4134 TYPE_DOMAIN (pmode) = min_value;
4135 mode = pmode;
4136 }
4137 }
4138 }
4139 }
4140 return mode;
4141 }
4142 case POWERSET:
4143 { tree mode;
4144 FORWARD_TOKEN ();
4145 mode = parse_mode ();
4146 if (ignoring || TREE_CODE (mode) == ERROR_MARK)
4147 return mode;
4148 return build_powerset_type (get_type_of (mode));
4149 }
4150 case PROC:
4151 return parse_procedure_mode ();
4152 case RANGE:
4153 { tree low, high;
4154 FORWARD_TOKEN();
4155 expect (LPRN, "missing left parenthesis after RANGE");
4156 low = parse_expression ();
4157 expect (COLON, "missing colon");
4158 high = parse_expression ();
4159 expect (RPRN, "missing right parenthesis after RANGE");
4160 return ignoring ? void_type_node
4161 : build_chill_range_type (NULL_TREE, low, high);
4162 }
4163 case READ:
4164 FORWARD_TOKEN ();
4165 {
4166 tree mode2 = get_type_of (parse_mode ());
4167 if (ignoring || TREE_CODE (mode2) == ERROR_MARK)
4168 return mode2;
4169 if (mode2
4170 && TREE_CODE_CLASS (TREE_CODE (mode2)) == 'd'
4171 && CH_IS_BUFFER_MODE (mode2))
4172 {
4173 error ("BUFFER modes may not be readonly");
4174 return mode2;
4175 }
4176 if (mode2
4177 && TREE_CODE_CLASS (TREE_CODE (mode2)) == 'd'
4178 && CH_IS_EVENT_MODE (mode2))
4179 {
4180 error ("EVENT modes may not be readonly");
4181 return mode2;
4182 }
4183 return build_readonly_type (mode2);
4184
4185 }
4186 case REF:
4187 { tree mode;
4188 FORWARD_TOKEN ();
4189 mode = parse_mode ();
4190 if (ignoring)
4191 return mode;
4192 mode = get_type_of (mode);
4193 return (TREE_CODE (mode) == ERROR_MARK) ? mode
4194 : build_chill_pointer_type (mode);
4195 }
4196 case SET:
4197 return parse_set_mode ();
4198 case SIGNAL:
4199 if (pedantic)
4200 error ("SIGNAL is not a valid mode");
4201 return generic_signal_type_node;
4202 case STRUCT:
4203 return parse_structure_mode ();
4204 case TEXT:
4205 {
4206 tree length, index_mode;
4207 int dynamic;
4208 require (TEXT);
4209 expect (LPRN, "missing '('");
4210 length = parse_expression ();
4211 expect (RPRN, "missing ')'");
4212 /* FIXME: This should actually look for an optional index_mode,
4213 but that is tricky to do. */
4214 index_mode = parse_opt_mode ();
4215 dynamic = check_token (DYNAMIC);
4216 return ignoring ? void_type_node
4217 : build_text_mode (length, index_mode, dynamic);
4218 }
4219 case USAGE:
4220 require (USAGE);
4221 return usage_type_node;
4222 case WHERE:
4223 require (WHERE);
4224 return where_type_node;
4225 default:
4226 return NULL_TREE;
4227 }
4228}
4229
4230static tree
4231parse_mode ()
4232{
4233 tree mode = parse_opt_mode ();
4234 if (mode == NULL_TREE)
4235 {
4236 if (pass == 1)
4237 error ("syntax error - missing mode");
4238 mode = error_mark_node;
4239 }
4240 return mode;
4241}
4242
4243static void
4244parse_program()
4245{
4246 /* Initialize global variables for current pass. */
4247 int i;
4248 expand_exit_needed = 0;
4249 label = NULL_TREE; /* for statement labels */
4250 current_module = NULL;
4251 current_function_decl = NULL_TREE;
4252 in_pseudo_module = 0;
4253
4254 for (i = 0; i <= MAX_LOOK_AHEAD; i++)
4255 terminal_buffer[i] = TOKEN_NOT_READ;
4256
4257#if 0
4258 /* skip some junk */
4259 while (PEEK_TOKEN() == HEADEREL)
4260 FORWARD_TOKEN();
4261#endif
4262
4263 start_outer_function ();
4264
4265 for (;;)
4266 {
4267 tree label = parse_optlabel ();
4268 if (PEEK_TOKEN() == MODULE || PEEK_TOKEN() == REGION)
4269 parse_modulion (label);
4270 else if (PEEK_TOKEN() == SPEC)
4271 parse_spec_module (label);
4272 else break;
4273 }
4274
4275 finish_outer_function ();
4276}
4277
31029ad7 4278static void
3c79b2da
PB		 4279parse_pass_1_2()
4280{
4281 parse_program();
4282 if (PEEK_TOKEN() != END_PASS_1)
4283 {
4284 error ("syntax error - expected a module or end of file");
4285 serious_errors++;
4286 }
4287 chill_finish_compile ();
4288 if (serious_errors)
4289 exit (FATAL_EXIT_CODE);
4290 switch_to_pass_2 ();
4291 ch_parse_init ();
4292 except_init_pass_2 ();
4293 ignoring = 0;
4294 parse_program();
4295 chill_finish_compile ();
4296}
4297
4298int yyparse ()
4299{
4300 parse_pass_1_2 ();
4301 return 0;
4302}
4303
4304/*
4305 * We've had an error. Move the compiler's state back to
4306 * the global binding level. This prevents the loop in
4307 * compile_file in toplev.c from looping forever, since the
4308 * CHILL poplevel() has *no* effect on the value returned by
4309 * global_bindings_p().
4310 */
4311void
4312to_global_binding_level ()
4313{
4314 while (! global_bindings_p ())
4315 current_function_decl = DECL_CONTEXT (current_function_decl);
4316 serious_errors++;
4317}
4318
4319#if 1
4320int yydebug;
4321/* Sets the value of the 'yydebug' variable to VALUE.
4322 This is a function so we don't have to have YYDEBUG defined
4323 in order to build the compiler. */
4324void
4325set_yydebug (value)
4326 int value;
4327{
4328#if YYDEBUG != 0
4329 yydebug = value;
4330#else
4331 warning ("YYDEBUG not defined.");
4332#endif
4333}
4334#endif
GNU Compiler Collection
This page took 0.565847 seconds and 5 git commands to generate.