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