1 /* Parser for GNU CHILL (CCITT High-Level Language) -*- C -*-
2 Copyright (C) 1992, 1993 Free Software Foundation, Inc.
4 This file is part of GNU CC.
6 GNU CC is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU CC is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU CC; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
21 * This is a two-pass parser. In pass 1, we collect declarations,
22 * ignoring actions and most expressions. We store only the
23 * declarations and close, open and re-lex the input file to save
24 * main memory. We anticipate that the compiler will be processing
25 * *very* large single programs which are mechanically generated,
26 * and so we want to store a minimum of information between passes.
28 * yylex detects the end of the main input file and returns the
29 * END_PASS_1 token. We then re-initialize each CHILL compiler
30 * module's global variables and re-process the input file. The
31 * grant file is output. If the user has requested it, GNU CHILL
32 * exits at this time - its only purpose was to generate the grant
33 * file. Optionally, the compiler may exit if errors were detected
36 * As each symbol scope is entered, we install its declarations into
37 * the symbol table. Undeclared types and variables are announced
40 * Then code is generated.
53 /* Since parsers are distinct for each language, put the
54 language string definition here. (fnf) */
55 char *language_string = "GNU CHILL";
57 /* Common code to be done before expanding any action. */
58 #define INIT_ACTION { \
59 if (! ignoring) emit_line_note (input_filename, lineno); }
61 /* Pop a scope for an ON handler. */
62 #define POP_USED_ON_CONTEXT pop_handler(1)
64 /* Pop a scope for an ON handler that wasn't there. */
65 #define POP_UNUSED_ON_CONTEXT pop_handler(0)
67 #define PUSH_ACTION push_action()
69 /* Cause the `yydebug' variable to be defined. */
72 extern struct rtx_def* gen_label_rtx PROTO((void));
73 extern void emit_jump PROTO((struct rtx_def *));
74 extern struct rtx_def* emit_label PROTO((struct rtx_def *));
76 static int parse_action PROTO((void));
79 extern char *input_filename;
80 extern tree generic_signal_type_node;
81 extern tree signal_code;
82 extern int all_static_flag;
83 extern int ignore_case;
86 static int quasi_signal = 0; /* 1 if processing a quasi signal decl */
89 int parsing_newmode; /* 0 while parsing SYNMODE;
90 1 while parsing NEWMODE. */
91 int expand_exit_needed = 0;
93 /* Gets incremented if we see errors such that we don't want to run pass 2. */
95 int serious_errors = 0;
97 static tree current_fieldlist;
99 /* We don't care about expressions during pass 1, except while we're
100 parsing the RHS of a SYN definition, or while parsing a mode that
101 we need. NOTE: This also causes mode expressions to be ignored. */
102 int ignoring = 1; /* 1 to ignore expressions */
104 /* True if we have seen an action not in a (user) function. */
106 int build_constructor = 0;
108 /* The action_nesting_level of the current procedure body. */
109 int proc_action_level = 0;
111 /* This is the identifier of the label that prefixes the current action,
112 or NULL if there was none. It is cleared at the end of an action,
113 or when starting a nested action list, so get it while you can! */
114 static tree label = NULL_TREE; /* for statement labels */
117 static tree current_block;
120 int in_pseudo_module = 0;
121 int pass = 0; /* 0 for init_decl_processing,
122 1 for pass 1, 2 for pass 2 */
124 /* re-initialize global variables for pass 2 */
128 expand_exit_needed = 0;
129 label = NULL_TREE; /* for statement labels */
130 current_module = NULL;
131 in_pseudo_module = 0;
135 check_end_label (start, end)
138 if (end != NULL_TREE)
140 if (start == NULL_TREE && pass == 1)
141 error ("there was no start label to match the end label '%s'",
142 IDENTIFIER_POINTER(end));
143 else if (start != end && pass == 1)
144 error ("start label '%s' does not match end label '%s'",
145 IDENTIFIER_POINTER(start),
146 IDENTIFIER_POINTER(end));
152 * given a tree which is an id, a type or a decl,
153 * return the associated type, or issue an error and
154 * return error_mark_node.
157 get_type_of (id_or_decl)
160 tree type = id_or_decl;
162 if (id_or_decl == NULL_TREE
163 || TREE_CODE (id_or_decl) == ERROR_MARK)
164 return error_mark_node;
166 if (pass == 1 || ignoring == 1)
169 if (TREE_CODE (type) == IDENTIFIER_NODE)
171 type = lookup_name (id_or_decl);
172 if (type == NULL_TREE)
174 error ("`%s' not declared", IDENTIFIER_POINTER (id_or_decl));
175 type = error_mark_node;
178 if (TREE_CODE (type) == TYPE_DECL)
179 type = TREE_TYPE (type);
180 return type; /* was a type all along */
187 if (CH_DECL_PROCESS (current_function_decl))
189 /* finishing a process */
193 build_chill_function_call
194 (lookup_name (get_identifier ("__stop_process")),
196 expand_expr_stmt (result);
197 emit_line_note (input_filename, lineno);
202 /* finishing a procedure.. */
206 && TREE_CODE (TREE_TYPE (TREE_TYPE (current_function_decl)))
208 warning ("No RETURN or RESULT in procedure");
209 chill_expand_return (NULL_TREE, 1);
212 finish_chill_function ();
213 pop_chill_function_context ();
217 build_prefix_clause (id)
222 if (current_module && current_module->name)
223 { char *module_name = IDENTIFIER_POINTER (current_module->name);
224 if (module_name[0] && module_name[0] != '_')
225 return current_module->name;
227 error ("PREFIXED clause with no prelix in unlabeled module");
233 possibly_define_exit_label (label)
237 define_label (input_filename, lineno, munge_exit_label (label));
240 #define MAX_LOOK_AHEAD 2
241 static enum terminal terminal_buffer[MAX_LOOK_AHEAD+1];
243 static YYSTYPE val_buffer[MAX_LOOK_AHEAD+1];
245 /*enum terminal current_token, lookahead_token;*/
247 #define TOKEN_NOT_READ dummy_last_terminal
255 if (terminal_buffer[0] == TOKEN_NOT_READ)
257 terminal_buffer[0] = yylex();
258 val_buffer[0] = yylval;
260 return terminal_buffer[0];
262 #define PEEK_TREE() val_buffer[0].ttype
263 #define PEEK_TOKEN1() peek_token_(1)
264 #define PEEK_TOKEN2() peek_token_(2)
269 if (i > MAX_LOOK_AHEAD)
270 fatal ("internal error - too much lookahead");
271 if (terminal_buffer[i] == TOKEN_NOT_READ)
273 terminal_buffer[i] = yylex();
274 val_buffer[i] = yylval;
276 return terminal_buffer[i];
280 pushback_token (code, node)
285 if (terminal_buffer[MAX_LOOK_AHEAD] != TOKEN_NOT_READ)
286 fatal ("internal error - cannot pushback token");
287 for (i = MAX_LOOK_AHEAD; i > 0; i--)
289 terminal_buffer[i] = terminal_buffer[i - 1];
290 val_buffer[i] = val_buffer[i - 1];
292 terminal_buffer[0] = code;
293 val_buffer[0].ttype = node;
300 for (i = 0; i < MAX_LOOK_AHEAD; i++)
302 terminal_buffer[i] = terminal_buffer[i+1];
303 val_buffer[i] = val_buffer[i+1];
305 terminal_buffer[MAX_LOOK_AHEAD] = TOKEN_NOT_READ;
307 #define FORWARD_TOKEN() forward_token_()
309 /* Skip the next token.
310 if it isn't TOKEN, the parser is broken. */
316 if (PEEK_TOKEN() != token)
319 sprintf (buf, "internal parser error - expected token %d", (int)token);
329 if (PEEK_TOKEN() != token)
335 /* return 0 if expected token was not found,
339 expect(token, message)
343 if (PEEK_TOKEN() != token)
346 error(message ? message : "syntax error");
354 /* define a SYNONYM __PROCNAME__ (__procname__) which holds
355 the name of the current procedure.
356 This should be quit the same as __FUNCTION__ in C */
358 define__PROCNAME__ ()
364 if (current_function_decl == NULL_TREE)
367 fname = IDENTIFIER_POINTER (DECL_NAME (current_function_decl));
369 string = build_chill_string (strlen (fname), fname);
370 procname = get_identifier (ignore_case ? "__procname__" : "__PROCNAME__");
371 push_syndecl (procname, NULL_TREE, string);
374 /* Forward declarations. */
375 static tree parse_expression ();
376 static tree parse_primval ();
377 static tree parse_mode PROTO((void));
378 static tree parse_opt_mode PROTO((void));
379 static tree parse_untyped_expr ();
380 static tree parse_opt_untyped_expr ();
381 static int parse_definition PROTO((int));
382 static void parse_opt_actions ();
383 static void parse_body PROTO((void));
384 static tree parse_if_expression_body PROTO((void));
385 static tree parse_opt_handler PROTO((void));
388 parse_opt_name_string (allow_all)
389 int allow_all; /* 1 if ALL is allowed as a postfix */
391 enum terminal token = PEEK_TOKEN();
395 if (token == ALL && allow_all)
406 token = PEEK_TOKEN();
410 token = PEEK_TOKEN();
411 if (token == ALL && allow_all)
412 return get_identifier3(IDENTIFIER_POINTER (name), "!", "*");
416 error ("'%s!' is not followed by an identifier",
417 IDENTIFIER_POINTER (name));
420 name = get_identifier3(IDENTIFIER_POINTER(name),
421 "!", IDENTIFIER_POINTER(PEEK_TREE()));
426 parse_simple_name_string ()
428 enum terminal token = PEEK_TOKEN();
432 error ("expected a name here");
433 return error_mark_node;
443 tree name = parse_opt_name_string (0);
447 error ("expected a name string here");
448 return error_mark_node;
452 parse_defining_occurrence ()
454 if (PEEK_TOKEN () == NAME)
456 tree id = PEEK_TREE();
463 /* Matches: <name_string>
464 Returns if pass 1: the identifier.
465 Returns if pass 2: a decl or value for identifier. */
470 tree name = parse_name_string ();
471 if (pass == 1 || ignoring)
475 tree decl = lookup_name (name);
476 if (decl == NULL_TREE)
478 error ("`%s' undeclared", IDENTIFIER_POINTER (name));
479 return error_mark_node;
481 else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK)
482 return error_mark_node;
483 else if (TREE_CODE (decl) == CONST_DECL)
484 return DECL_INITIAL (decl);
485 else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE)
486 return convert_from_reference (decl);
495 tree label = parse_defining_occurrence();
497 expect(COLON, "expected a ':' here");
504 enum terminal token = PEEK_TOKEN ();
508 (token == END ? pedwarn : error) ("expected ';' here");
513 parse_opt_end_label_semi_colon (start_label)
516 if (PEEK_TOKEN() == NAME)
518 tree end_label = parse_name_string ();
519 check_end_label (start_label, end_label);
525 parse_modulion (label)
530 label = set_module_name (label);
531 module_name = push_module (label, 0);
536 expect(END, "expected END here");
537 parse_opt_handler ();
538 parse_opt_end_label_semi_colon (label);
539 find_granted_decls ();
544 parse_spec_module (label)
547 tree module_name = push_module (set_module_name (label), 1);
548 int save_ignoring = ignoring;
549 ignoring = pass == 2;
550 FORWARD_TOKEN(); /* SKIP SPEC */
551 expect (MODULE, "expected 'MODULE' here");
553 while (parse_definition (1)) { }
555 error ("action not allowed in SPEC MODULE");
556 expect(END, "expected END here");
557 parse_opt_end_label_semi_colon (label);
558 find_granted_decls ();
560 ignoring = save_ignoring;
563 /* Matches: <name_string> ( "," <name_string> )*
564 Returns either a single IDENTIFIER_NODE,
565 or a chain (TREE_LIST) of IDENTIFIER_NODES.
566 (Since a single identifier is the common case, we avoid wasting space
567 (twice, once for each pass) with extra TREE_LIST nodes in that case.)
568 (Will not return NULL_TREE even if ignoring is true.) */
571 parse_defining_occurrence_list ()
573 tree chain = NULL_TREE;
574 tree name = parse_defining_occurrence ();
575 if (name == NULL_TREE)
577 error("missing defining occurrence");
580 if (! check_token (COMMA))
582 chain = build_tree_list (NULL_TREE, name);
585 name = parse_defining_occurrence ();
588 error ("bad defining occurrence following ','");
591 chain = tree_cons (NULL_TREE, name, chain);
592 if (! check_token (COMMA))
595 return nreverse (chain);
599 parse_mode_definition (is_newmode)
603 int save_ignoring = ignoring;
604 ignoring = pass == 2;
605 names = parse_defining_occurrence_list ();
606 expect (EQL, "missing '=' in mode definition");
607 mode = parse_mode ();
608 if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
610 for ( ; names != NULL_TREE; names = TREE_CHAIN (names))
611 push_modedef (names, mode, is_newmode);
614 push_modedef (names, mode, is_newmode);
615 ignoring = save_ignoring;
619 parse_mode_definition_statement (is_newmode)
622 FORWARD_TOKEN (); /* skip SYNMODE or NEWMODE */
623 parse_mode_definition (is_newmode);
624 while (PEEK_TOKEN () == COMMA)
627 parse_mode_definition (is_newmode);
633 parse_synonym_definition ()
634 { tree expr = NULL_TREE;
635 tree names = parse_defining_occurrence_list ();
636 tree mode = parse_opt_mode ();
637 if (! expect (EQL, "missing '=' in synonym definition"))
638 mode = error_mark_node;
642 expr = parse_untyped_expr ();
644 expr = parse_expression ();
646 if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
648 for ( ; names != NULL_TREE; names = TREE_CHAIN (names))
649 push_syndecl (names, mode, expr);
652 push_syndecl (names, mode, expr);
656 parse_synonym_definition_statement()
658 int save_ignoring= ignoring;
659 ignoring = pass == 2;
661 parse_synonym_definition ();
662 while (PEEK_TOKEN () == COMMA)
665 parse_synonym_definition ();
667 ignoring = save_ignoring;
671 /* Attempts to match: "(" <exception list> ")" ":".
672 Return NULL_TREE on failure, and non-NULL on success.
673 On success, if pass 1, return a TREE_LIST of IDENTIFIER_NODEs. */
676 parse_on_exception_list ()
679 tree list = NULL_TREE;
680 int tok1 = PEEK_TOKEN ();
681 int tok2 = PEEK_TOKEN1 ();
683 /* This requires a lot of look-ahead, because we cannot
684 easily a priori distinguish an exception-list from an expression. */
685 if (tok1 != LPRN || tok2 != NAME)
687 if (tok1 == NAME && tok2 == COLON && pass == 1)
688 error ("missing '(' in exception list");
692 name = parse_name_string ();
693 if (PEEK_TOKEN () == RPRN && PEEK_TOKEN1 () == COLON)
695 /* Matched: '(' <name_string> ')' ':' */
696 FORWARD_TOKEN (); FORWARD_TOKEN ();
697 return pass == 1 ? build_tree_list (NULL_TREE, name) : name;
699 if (PEEK_TOKEN() == COMMA)
702 list = build_tree_list (NULL_TREE, name);
703 while (check_token (COMMA))
705 tree old_names = list;
706 name = parse_name_string ();
709 for ( ; old_names != NULL_TREE; old_names = TREE_CHAIN (old_names))
711 if (TREE_VALUE (old_names) == name)
713 error ("ON exception names must be unique");
714 goto continue_parsing;
717 list = tree_cons (NULL_TREE, name, list);
722 if (! check_token (RPRN) || ! check_token(COLON))
723 error ("syntax error in exception list");
724 return pass == 1 ? nreverse (list) : name;
726 /* Matched: '(' name_string
727 but it doesn't match the syntax of an exception list.
728 It could be the beginning of an expression, so back up. */
729 pushback_token (NAME, name);
730 pushback_token (LPRN, 0);
735 parse_on_alternatives ()
739 tree except_list = parse_on_exception_list ();
740 if (except_list != NULL)
741 chill_handle_on_labels (except_list);
742 else if (parse_action ())
743 expand_exit_needed = 1;
752 if (! check_token (ON))
754 POP_UNUSED_ON_CONTEXT;
757 if (check_token (END))
759 pedwarn ("empty ON-condition");
760 POP_UNUSED_ON_CONTEXT;
766 expand_exit_needed = 0;
768 if (PEEK_TOKEN () != ELSE)
770 parse_on_alternatives ();
771 if (! ignoring && expand_exit_needed)
772 expand_exit_something ();
774 if (check_token (ELSE))
776 chill_start_default_handler ();
778 parse_opt_actions ();
781 emit_line_note (input_filename, lineno);
782 expand_exit_something ();
785 expect (END, "missing 'END' after");
789 return integer_zero_node;
793 parse_loc_declaration (in_spec_module)
796 tree names = parse_defining_occurrence_list ();
797 int save_ignoring = ignoring;
798 int is_static, lifetime_bound;
799 tree mode, init_value = NULL_TREE;
802 ignoring = pass == 2;
803 mode = parse_mode ();
804 ignoring = save_ignoring;
805 is_static = check_token (STATIC);
806 if (check_token (BASED))
808 expect(LPRN, "BASED must be followed by (NAME)");
809 do_based_decls (names, mode, parse_name_string ());
810 expect(RPRN, "BASED must be followed by (NAME)");
813 if (check_token (LOC))
815 /* loc-identity declaration */
817 mode = build_chill_reference_type (mode);
820 lifetime_bound = check_token (INIT);
821 if (lifetime_bound && loc_decl)
824 error ("INIT not allowed at loc-identity declaration");
827 if (PEEK_TOKEN () == ASGN || PEEK_TOKEN() == EQL)
829 save_ignoring = ignoring;
830 ignoring = pass == 1;
831 if (PEEK_TOKEN() == EQL)
834 error ("'=' used where ':=' is required");
837 if (! lifetime_bound)
839 init_value = parse_untyped_expr ();
842 error ("initialization is not allowed in spec module");
843 init_value = NULL_TREE;
845 if (! lifetime_bound)
846 parse_opt_handler ();
847 ignoring = save_ignoring;
849 if (init_value == NULL_TREE && loc_decl && pass == 1)
850 error ("loc-identity declaration without initialisation");
851 do_decls (names, mode,
852 is_static || global_bindings_p ()
853 /* the variable becomes STATIC if all_static_flag is set and
854 current functions doesn't have the RECURSIVE attribute */
855 || (all_static_flag && !CH_DECL_RECURSIVE (current_function_decl)),
856 lifetime_bound, init_value, in_spec_module);
858 /* Free any temporaries we made while initializing the decl. */
863 parse_declaration_statement (in_spec_module)
866 int save_ignoring = ignoring;
867 ignoring = pass == 2;
869 parse_loc_declaration (in_spec_module);
870 while (PEEK_TOKEN () == COMMA)
873 parse_loc_declaration (in_spec_module);
875 ignoring = save_ignoring;
882 if (check_token (FORBID) == 0)
884 if (check_token (ALL))
885 return ignoring ? NULL_TREE : build_int_2 (-1, -1);
887 if (check_token (LPRN))
889 tree list = parse_forbidlist ();
890 expect (RPRN, "missing ')' after FORBID list");
894 error ("bad syntax following FORBID");
898 /* Matches: <grant postfix> or <seize postfix>
899 Returns: A (singleton) TREE_LIST. */
902 parse_postfix (grant_or_seize)
903 enum terminal grant_or_seize;
905 tree name = parse_opt_name_string (1);
906 tree forbid = NULL_TREE;
907 if (name == NULL_TREE)
909 error ("expected a postfix name here");
910 name = error_mark_node;
912 if (grant_or_seize == GRANT)
913 forbid = parse_optforbid ();
914 return build_tree_list (forbid, name);
918 parse_postfix_list (grant_or_seize)
919 enum terminal grant_or_seize;
921 tree list = parse_postfix (grant_or_seize);
922 while (check_token (COMMA))
923 list = chainon (list, parse_postfix (grant_or_seize));
928 parse_rename_clauses (grant_or_seize)
929 enum terminal grant_or_seize;
933 tree rename_old_prefix, rename_new_prefix, postfix;
935 rename_old_prefix = parse_opt_name_string (0);
936 expect (ARROW, "missing '->' in rename clause");
937 rename_new_prefix = parse_opt_name_string (0);
938 expect (RPRN, "missing ')' in rename clause");
939 expect ('!', "missing '!' in rename clause");
940 postfix = parse_postfix (grant_or_seize);
942 if (grant_or_seize == GRANT)
943 chill_grant (rename_old_prefix, rename_new_prefix,
944 TREE_VALUE (postfix), TREE_PURPOSE (postfix));
946 chill_seize (rename_old_prefix, rename_new_prefix,
947 TREE_VALUE (postfix));
949 if (PEEK_TOKEN () != COMMA)
952 if (PEEK_TOKEN () != LPRN)
954 error ("expected another rename clause");
961 parse_opt_prefix_clause ()
963 if (check_token (PREFIXED) == 0)
965 return build_prefix_clause (parse_opt_name_string (0));
969 parse_grant_statement ()
972 if (PEEK_TOKEN () == LPRN)
973 parse_rename_clauses (GRANT);
976 tree window = parse_postfix_list (GRANT);
977 tree new_prefix = parse_opt_prefix_clause ();
979 for (t = window; t; t = TREE_CHAIN (t))
980 chill_grant (NULL_TREE, new_prefix, TREE_VALUE (t), TREE_PURPOSE (t));
985 parse_seize_statement ()
988 if (PEEK_TOKEN () == LPRN)
989 parse_rename_clauses (SEIZE);
992 tree seize_window = parse_postfix_list (SEIZE);
993 tree old_prefix = parse_opt_prefix_clause ();
995 for (t = seize_window; t; t = TREE_CHAIN (t))
996 chill_seize (old_prefix, NULL_TREE, TREE_VALUE (t));
1000 /* In pass 1, this returns a TREE_LIST, one node for each parameter.
1001 In pass 2, we get a list of PARM_DECLs chained together.
1002 In either case, the list is in reverse order. */
1005 parse_param_name_list ()
1007 tree list = NULL_TREE;
1011 tree name = parse_defining_occurrence ();
1012 if (name == NULL_TREE)
1014 error ("syntax error in parameter name list");
1018 new_link = build_tree_list (NULL_TREE, name);
1019 /* else if (current_module->is_spec_module) ; nothing */
1020 else /* pass == 2 */
1022 new_link = make_node (PARM_DECL);
1023 DECL_NAME (new_link) = name;
1024 DECL_ASSEMBLER_NAME (new_link) = name;
1027 TREE_CHAIN (new_link) = list;
1029 } while (check_token (COMMA));
1037 switch (PEEK_TOKEN ())
1039 case PARAMATTR: /* INOUT is returned here */
1040 attr = PEEK_TREE ();
1045 return ridpointers[(int) RID_IN];
1048 return ridpointers[(int) RID_LOC];
1052 return ridpointers[(int) RID_DYNAMIC];
1059 /* We wrap CHILL array parameters in a STRUCT. The original parameter
1060 name is unpacked from the struct at get_identifier time */
1062 /* In pass 1, returns list of types; in pass 2: chain of PARM_DECLs. */
1067 tree names = parse_param_name_list ();
1068 tree mode = parse_mode ();
1069 tree paramattr = parse_param_attr ();
1070 return chill_munge_params (nreverse (names), mode, paramattr);
1074 * Note: build_process_header depends upon the *exact*
1075 * representation of STRUCT fields and of formal parameter
1076 * lists. If either is changed, build_process_header will
1077 * also need change. Push_extern_process is affected as well.
1080 parse_formparlist ()
1082 tree list = NULL_TREE;
1083 if (PEEK_TOKEN() == RPRN)
1087 list = chainon (list, parse_formpar ());
1088 if (! check_token (COMMA))
1095 parse_opt_result_spec ()
1098 int is_nonref, is_loc, is_dynamic;
1099 if (!check_token (RETURNS))
1100 return void_type_node;
1101 expect (LPRN, "expected '(' after RETURNS");
1102 mode = parse_mode ();
1103 is_nonref = check_token (NONREF);
1104 is_loc = check_token (LOC);
1105 is_dynamic = check_token (DYNAMIC);
1106 if (is_nonref && !is_loc)
1107 error ("NONREF specific without LOC in result attribute");
1108 if (is_dynamic && !is_loc)
1109 error ("DYNAMIC specific without LOC in result attribute");
1110 mode = get_type_of (mode);
1111 if (is_loc && ! ignoring)
1112 mode = build_chill_reference_type (mode);
1113 expect (RPRN, "expected ')' after RETURNS");
1120 tree list = NULL_TREE;
1121 if (!check_token (EXCEPTIONS))
1123 expect (LPRN, "expected '(' after EXCEPTIONS");
1126 tree except_name = parse_name_string ();
1128 for (name = list; name != NULL_TREE; name = TREE_CHAIN (name))
1129 if (TREE_VALUE (name) == except_name && pass == 1)
1131 error ("exception names must be unique");
1134 if (name == NULL_TREE && !ignoring)
1135 list = tree_cons (NULL_TREE, except_name, list);
1136 } while (check_token (COMMA));
1137 expect (RPRN, "expected ')' after EXCEPTIONS");
1142 parse_opt_recursive ()
1144 if (check_token (RECURSIVE))
1145 return ridpointers[RID_RECURSIVE];
1151 parse_procedureattr ()
1155 switch (PEEK_TOKEN ())
1159 generality = ridpointers[RID_GENERAL];
1163 generality = ridpointers[RID_SIMPLE];
1167 generality = ridpointers[RID_INLINE];
1170 generality = NULL_TREE;
1172 optrecursive = parse_opt_recursive ();
1176 generality = build_tree_list (NULL_TREE, generality);
1178 generality = tree_cons (NULL_TREE, optrecursive, generality);
1182 /* Parse the body and last part of a procedure or process definition. */
1185 parse_proc_body (name, exceptions)
1189 int save_proc_action_level = proc_action_level;
1190 proc_action_level = action_nesting_level;
1191 if (exceptions != NULL_TREE)
1192 /* set up a handler for reraising exceptions */
1195 define__PROCNAME__ ();
1197 proc_action_level = save_proc_action_level;
1198 expect (END, "'END' was expected here");
1199 parse_opt_handler ();
1200 if (exceptions != NULL_TREE)
1201 chill_reraise_exceptions (exceptions);
1202 parse_opt_end_label_semi_colon (name);
1207 parse_procedure_definition (in_spec_module)
1210 int save_ignoring = ignoring;
1211 tree name = parse_defining_occurrence ();
1212 tree params, result, exceptlist, attributes;
1213 int save_chill_at_module_level = chill_at_module_level;
1214 chill_at_module_level = 0;
1215 if (!in_spec_module)
1216 ignoring = pass == 2;
1217 require (COLON); require (PROC);
1218 expect (LPRN, "missing '(' after PROC");
1219 params = parse_formparlist ();
1220 expect (RPRN, "missing ')' in PROC");
1221 result = parse_opt_result_spec ();
1222 exceptlist = parse_opt_except ();
1223 attributes = parse_procedureattr ();
1224 ignoring = save_ignoring;
1227 expect (END, "missing 'END'");
1228 parse_opt_end_label_semi_colon (name);
1229 push_extern_function (name, result, params, exceptlist, 0);
1232 push_chill_function_context ();
1233 start_chill_function (name, result, params, exceptlist, attributes);
1234 current_module->procedure_seen = 1;
1235 parse_proc_body (name, TYPE_RAISES_EXCEPTIONS (TREE_TYPE (current_function_decl)));
1236 chill_at_module_level = save_chill_at_module_level;
1242 tree names = parse_defining_occurrence_list ();
1243 tree mode = parse_mode ();
1244 tree paramattr = parse_param_attr ();
1246 if (names && TREE_CODE (names) == IDENTIFIER_NODE)
1247 names = build_tree_list (NULL_TREE, names);
1248 return tree_cons (tree_cons (paramattr, mode, NULL_TREE), names, NULL_TREE);
1252 parse_processparlist ()
1254 tree list = NULL_TREE;
1255 if (PEEK_TOKEN() == RPRN)
1259 list = chainon (list, parse_processpar ());
1260 if (! check_token (COMMA))
1267 parse_process_definition (in_spec_module)
1270 int save_ignoring = ignoring;
1271 tree name = parse_defining_occurrence ();
1274 if (!in_spec_module)
1276 require (COLON); require (PROCESS);
1277 expect (LPRN, "missing '(' after PROCESS");
1278 params = parse_processparlist (in_spec_module);
1279 expect (RPRN, "missing ')' in PROCESS");
1280 ignoring = save_ignoring;
1283 expect (END, "missing 'END'");
1284 parse_opt_end_label_semi_colon (name);
1285 push_extern_process (name, params, NULL_TREE, 0);
1288 tmp = build_process_header (name, params);
1289 parse_proc_body (name, NULL_TREE);
1290 build_process_wrapper (name, tmp);
1294 parse_signal_definition ()
1296 tree signame = parse_defining_occurrence ();
1297 tree modes = NULL_TREE;
1298 tree dest = NULL_TREE;
1300 if (check_token (EQL))
1302 expect (LPRN, "missing '(' after 'SIGNAL <name> ='");
1305 tree mode = parse_mode ();
1306 modes = tree_cons (NULL_TREE, mode, modes);
1307 if (! check_token (COMMA))
1310 expect (RPRN, "missing ')'");
1311 modes = nreverse (modes);
1314 if (check_token (TO))
1317 int save_ignoring = ignoring;
1319 decl = parse_name ();
1320 ignoring = save_ignoring;
1323 if (decl == NULL_TREE
1324 || TREE_CODE (decl) == ERROR_MARK
1325 || TREE_CODE (decl) != FUNCTION_DECL
1326 || !CH_DECL_PROCESS (decl))
1327 error ("must specify a PROCESS name");
1333 if (! global_bindings_p ())
1334 error ("SIGNAL must be in global reach");
1337 tree struc = build_signal_struct_type (signame, modes, dest);
1339 generate_tasking_code_variable (signame,
1341 current_module->is_spec_module);
1342 /* remember the code variable in the struct type */
1343 DECL_TASKING_CODE_DECL (struc) = (struct lang_decl *)decl;
1344 CH_DECL_SIGNAL (struc) = 1;
1345 add_taskstuff_to_list (decl, "_TT_Signal",
1346 current_module->is_spec_module ?
1347 NULL_TREE : signal_code, struc, NULL_TREE);
1353 parse_signal_definition_statement ()
1355 int save_ignoring = ignoring;
1356 ignoring = pass == 2;
1360 parse_signal_definition ();
1361 if (! check_token (COMMA))
1363 if (PEEK_TOKEN () == SC)
1365 error ("syntax error while parsing signal definition statement");
1369 parse_semi_colon ();
1370 ignoring = save_ignoring;
1374 parse_definition (in_spec_module)
1377 switch (PEEK_TOKEN ())
1380 if (PEEK_TOKEN1() == COLON)
1382 if (PEEK_TOKEN2() == PROC)
1384 parse_procedure_definition (in_spec_module);
1387 else if (PEEK_TOKEN2() == PROCESS)
1389 parse_process_definition (in_spec_module);
1395 parse_declaration_statement(in_spec_module);
1398 parse_grant_statement ();
1401 parse_mode_definition_statement(1);
1408 parse_seize_statement ();
1411 parse_signal_definition_statement ();
1414 parse_synonym_definition_statement();
1417 parse_mode_definition_statement(0);
1426 parse_then_clause ()
1428 expect (THEN, "expected 'THEN' after 'IF'");
1430 emit_line_note (input_filename, lineno);
1431 parse_opt_actions ();
1435 parse_opt_else_clause ()
1437 while (check_token (ELSIF))
1439 tree cond = parse_expression ();
1441 expand_start_elseif (truthvalue_conversion (cond));
1442 parse_then_clause ();
1444 if (check_token (ELSE))
1447 { emit_line_note (input_filename, lineno);
1448 expand_start_else ();
1450 parse_opt_actions ();
1454 static tree parse_expr_list ()
1456 tree expr = parse_expression ();
1457 tree list = ignoring ? NULL_TREE : build_tree_list (NULL_TREE, expr);
1458 while (check_token (COMMA))
1460 expr = parse_expression ();
1462 list = tree_cons (NULL_TREE, expr, list);
1468 parse_range_list_clause ()
1470 tree name = parse_opt_name_string (0);
1471 if (name == NULL_TREE)
1473 while (check_token (COMMA))
1475 name = parse_name_string (0);
1477 if (check_token (SC))
1479 sorry ("case range list");
1480 return error_mark_node;
1482 pushback_token (NAME, name);
1487 pushback_paren_expr (expr)
1490 if (pass == 1 && !ignoring)
1491 expr = build1 (PAREN_EXPR, NULL_TREE, expr);
1492 pushback_token (EXPR, expr);
1495 /* Matches: <case label> */
1501 if (check_token (ELSE))
1502 return case_else_node;
1503 /* Does this also handle the case of a mode name? FIXME */
1504 expr = parse_expression ();
1505 if (check_token (COLON))
1507 tree max_expr = parse_expression ();
1509 expr = build (RANGE_EXPR, NULL_TREE, expr, max_expr);
1514 /* Parses: <case_label_list>
1515 Fails if not followed by COMMA or COLON.
1516 If it fails, it backs up if needed, and returns NULL_TREE.
1517 IN_TUPLE is true if we are parsing a tuple element,
1518 and 0 if we are parsing a case label specification. */
1521 parse_case_label_list (selector, in_tuple)
1526 if (! check_token (LPRN))
1528 if (check_token (MUL))
1530 expect (RPRN, "missing ')' after '*' case label list");
1532 return integer_zero_node;
1533 expr = build (RANGE_EXPR, NULL_TREE, NULL_TREE, NULL_TREE);
1534 expr = build_tree_list (NULL_TREE, expr);
1537 expr = parse_case_label ();
1538 if (check_token (RPRN))
1540 if ((in_tuple || PEEK_TOKEN () != COMMA) && PEEK_TOKEN () != COLON)
1542 /* Ooops! It looks like it was the start of an action or
1543 unlabelled tuple element, and not a case label, so back up. */
1544 if (expr != NULL_TREE && TREE_CODE (expr) == RANGE_EXPR)
1546 error ("misplaced colon in case label");
1547 expr = error_mark_node;
1549 pushback_paren_expr (expr);
1552 list = build_tree_list (NULL_TREE, expr);
1553 if (expr == case_else_node && selector != NULL_TREE)
1554 ELSE_LABEL_SPECIFIED (selector) = 1;
1557 list = build_tree_list (NULL_TREE, expr);
1558 if (expr == case_else_node && selector != NULL_TREE)
1559 ELSE_LABEL_SPECIFIED (selector) = 1;
1561 while (check_token (COMMA))
1563 expr = parse_case_label ();
1564 list = tree_cons (NULL_TREE, expr, list);
1565 if (expr == case_else_node && selector != NULL_TREE)
1566 ELSE_LABEL_SPECIFIED (selector) = 1;
1568 expect (RPRN, "missing ')' at end of case label list");
1569 return nreverse (list);
1572 /* Parses: <case_label_specification>
1573 Must be followed by a COLON.
1574 If it fails, it backs up if needed, and returns NULL_TREE. */
1577 parse_case_label_specification (selectors)
1580 tree list_list = NULL_TREE;
1582 list = parse_case_label_list (selectors, 0);
1583 if (list == NULL_TREE)
1585 list_list = build_tree_list (NULL_TREE, list);
1586 while (check_token (COMMA))
1588 if (selectors != NULL_TREE)
1589 selectors = TREE_CHAIN (selectors);
1590 list = parse_case_label_list (selectors, 0);
1591 if (list == NULL_TREE)
1593 error ("unrecognized case label list after ','");
1596 list_list = tree_cons (NULL_TREE, list, list_list);
1598 return nreverse (list_list);
1602 parse_single_dimension_case_action (selector)
1605 int no_completeness_check = 0;
1607 /* The case label/action toggle. It is 0 initially, and when an action
1608 was last seen. It is 1 integer_zero_node when a label was last seen. */
1609 int caseaction_flag = 0;
1613 expand_exit_needed = 0;
1614 selector = check_case_selector (selector);
1615 expand_start_case (1, selector, TREE_TYPE (selector), "CASE statement");
1621 tree label_spec = parse_case_label_specification (selector);
1622 if (label_spec != NULL_TREE)
1624 expect (COLON, "missing ':' in case alternative");
1627 no_completeness_check |= chill_handle_single_dimension_case_label (
1628 selector, label_spec, &expand_exit_needed, &caseaction_flag);
1631 else if (parse_action ())
1633 expand_exit_needed = 1;
1634 caseaction_flag = 0;
1642 if (expand_exit_needed || caseaction_flag == 1)
1643 expand_exit_something ();
1645 if (check_token (ELSE))
1648 chill_handle_case_default ();
1649 parse_opt_actions ();
1652 emit_line_note (input_filename, lineno);
1653 expand_exit_something ();
1656 else if (! ignoring && TREE_CODE (selector) != ERROR_MARK &&
1657 ! no_completeness_check)
1658 check_missing_cases (TREE_TYPE (selector));
1660 expect (ESAC, "missing 'ESAC' after 'CASE'");
1663 expand_end_case (selector);
1669 parse_multi_dimension_case_action (selector)
1672 struct rtx_def *begin_test_label = 0, *end_case_label, *new_label;
1673 tree action_labels = NULL_TREE;
1674 tree tests = NULL_TREE;
1675 int save_lineno = lineno;
1676 char *save_filename = input_filename;
1678 /* We can't compute the range of an (ELSE) label until all of the CASE
1679 label specifications have been seen, however, the code for the actions
1680 between them is generated on the fly. We can still generate everything in
1681 one pass is we use the following form:
1683 Compile a CASE of the form
1686 (X11),...,(X1n): A1;
1688 (Xm1),...,(Xmn): Am;
1700 T1 := s1; ...; Tn := Sn;
1701 if (T1 = X11 and ... and Tn = X1n) GOTO L1;
1703 if (T1 = Xm1 and ... and Tn = Xmn) GOTO Lm;
1710 selector = check_case_selector_list (selector);
1711 begin_test_label = gen_label_rtx ();
1712 end_case_label = gen_label_rtx ();
1713 emit_jump (begin_test_label);
1718 tree label_spec = parse_case_label_specification (selector);
1719 if (label_spec != NULL_TREE)
1721 expect (COLON, "missing ':' in case alternative");
1724 tests = tree_cons (label_spec, NULL_TREE, tests);
1726 if (action_labels != NULL_TREE)
1727 emit_jump (end_case_label);
1729 new_label = gen_label_rtx ();
1730 emit_label (new_label);
1731 emit_line_note (input_filename, lineno);
1732 action_labels = tree_cons (NULL_TREE, NULL_TREE, action_labels);
1733 TREE_CST_RTL (action_labels) = new_label;
1736 else if (! parse_action ())
1738 if (action_labels != NULL_TREE)
1739 emit_jump (end_case_label);
1744 if (check_token (ELSE))
1748 new_label = gen_label_rtx ();
1749 emit_label (new_label);
1750 emit_line_note (input_filename, lineno);
1751 action_labels = tree_cons (NULL_TREE, NULL_TREE, action_labels);
1752 TREE_CST_RTL (action_labels) = new_label;
1754 parse_opt_actions ();
1756 emit_jump (end_case_label);
1759 expect (ESAC, "missing 'ESAC' after 'CASE'");
1763 emit_label (begin_test_label);
1764 emit_line_note (save_filename, save_lineno);
1765 if (tests != NULL_TREE)
1768 tests = nreverse (tests);
1769 action_labels = nreverse (action_labels);
1770 compute_else_ranges (selector, tests);
1772 cond = build_multi_case_selector_expression (selector, TREE_PURPOSE (tests));
1773 expand_start_cond (truthvalue_conversion (cond), label ? 1 : 0);
1774 emit_jump (TREE_CST_RTL (action_labels));
1776 for (tests = TREE_CHAIN (tests), action_labels = TREE_CHAIN (action_labels);
1777 tests != NULL_TREE && action_labels != NULL_TREE;
1778 tests = TREE_CHAIN (tests), action_labels = TREE_CHAIN (action_labels))
1781 build_multi_case_selector_expression (selector, TREE_PURPOSE (tests));
1782 expand_start_elseif (truthvalue_conversion (cond));
1783 emit_jump (TREE_CST_RTL (action_labels));
1785 if (action_labels != NULL_TREE)
1787 expand_start_else ();
1788 emit_jump (TREE_CST_RTL (action_labels));
1792 emit_label (end_case_label);
1797 parse_case_action (label)
1801 int multi_dimension_case = 0;
1804 selector = parse_expr_list ();
1805 selector = nreverse (selector);
1806 expect (OF, "missing 'OF' after 'CASE'");
1807 parse_range_list_clause ();
1815 expand_exit_needed = 0;
1816 if (TREE_CODE (selector) == TREE_LIST)
1818 if (TREE_CHAIN (selector) != NULL_TREE)
1819 multi_dimension_case = 1;
1821 selector = TREE_VALUE (selector);
1825 /* We want to use the regular CASE support for the single dimension case. The
1826 multi dimension case requires different handling. Note that when "ignoring"
1827 is true we parse using the single dimension code. This is OK since it will
1828 still parse correctly. */
1829 if (multi_dimension_case)
1830 parse_multi_dimension_case_action (selector);
1832 parse_single_dimension_case_action (selector);
1836 possibly_define_exit_label (label);
1841 /* Matches: [ <asm_operand> { "," <asm_operand> }* ],
1842 where <asm_operand> = STRING '(' <expression> ')'
1843 These are the operands other than the first string and colon
1844 in asm ("addextend %2,%1": "=dm" (x), "0" (y), "g" (*x)) */
1847 parse_asm_operands ()
1849 tree list = NULL_TREE;
1850 if (PEEK_TOKEN () != STRING)
1855 if (PEEK_TOKEN () != STRING)
1857 error ("bad ASM operand");
1860 string = PEEK_TREE();
1862 expect (LPRN, "missing '(' in ASM operand");
1863 expr = parse_expression ();
1864 expect (RPRN, "missing ')' in ASM operand");
1865 list = tree_cons (string, expr, list);
1866 if (! check_token (COMMA))
1869 return nreverse (list);
1872 /* Matches: STRING { ',' STRING }* */
1875 parse_asm_clobbers ()
1877 tree list = NULL_TREE;
1881 if (PEEK_TOKEN () != STRING)
1883 error ("bad ASM operand");
1886 string = PEEK_TREE();
1888 list = tree_cons (NULL_TREE, string, list);
1889 if (! check_token (COMMA))
1896 ch_expand_asm_operands (string, outputs, inputs, clobbers, vol, filename, line)
1897 tree string, outputs, inputs, clobbers;
1902 int noutputs = list_length (outputs);
1904 /* o[I] is the place that output number I should be written. */
1905 register tree *o = (tree *) alloca (noutputs * sizeof (tree));
1908 if (TREE_CODE (string) == ADDR_EXPR)
1909 string = TREE_OPERAND (string, 0);
1910 if (TREE_CODE (string) != STRING_CST)
1912 error ("asm template is not a string constant");
1916 /* Record the contents of OUTPUTS before it is modified. */
1917 for (i = 0, tail = outputs; tail; tail = TREE_CHAIN (tail), i++)
1918 o[i] = TREE_VALUE (tail);
1921 /* Perform default conversions on array and function inputs. */
1922 /* Don't do this for other types--
1923 it would screw up operands expected to be in memory. */
1924 for (i = 0, tail = inputs; tail; tail = TREE_CHAIN (tail), i++)
1925 if (TREE_CODE (TREE_TYPE (TREE_VALUE (tail))) == ARRAY_TYPE
1926 || TREE_CODE (TREE_TYPE (TREE_VALUE (tail))) == FUNCTION_TYPE)
1927 TREE_VALUE (tail) = default_conversion (TREE_VALUE (tail));
1930 /* Generate the ASM_OPERANDS insn;
1931 store into the TREE_VALUEs of OUTPUTS some trees for
1932 where the values were actually stored. */
1933 expand_asm_operands (string, outputs, inputs, clobbers, vol, filename, line);
1935 /* Copy all the intermediate outputs into the specified outputs. */
1936 for (i = 0, tail = outputs; tail; tail = TREE_CHAIN (tail), i++)
1938 if (o[i] != TREE_VALUE (tail))
1940 expand_expr (build_chill_modify_expr (o[i], TREE_VALUE (tail)),
1944 /* Detect modification of read-only values.
1945 (Otherwise done by build_modify_expr.) */
1948 tree type = TREE_TYPE (o[i]);
1949 if (TYPE_READONLY (type)
1950 || ((TREE_CODE (type) == RECORD_TYPE
1951 || TREE_CODE (type) == UNION_TYPE)
1952 && TYPE_FIELDS_READONLY (type)))
1953 warning ("readonly location modified by 'asm'");
1957 /* Those MODIFY_EXPRs could do autoincrements. */
1965 require (ASM_KEYWORD);
1966 expect (LPRN, "missing '('");
1969 emit_line_note (input_filename, lineno);
1970 insn = parse_expression ();
1971 if (check_token (COLON))
1973 tree output_operand, input_operand, clobbered_regs;
1974 output_operand = parse_asm_operands ();
1975 if (check_token (COLON))
1976 input_operand = parse_asm_operands ();
1978 input_operand = NULL_TREE;
1979 if (check_token (COLON))
1980 clobbered_regs = parse_asm_clobbers ();
1982 clobbered_regs = NULL_TREE;
1983 expect (RPRN, "missing ')'");
1985 ch_expand_asm_operands (insn, output_operand, input_operand,
1986 clobbered_regs, FALSE,
1987 input_filename, lineno);
1991 expect (RPRN, "missing ')'");
1994 else if ((TREE_CODE (insn) == ADDR_EXPR
1995 && TREE_CODE (TREE_OPERAND (insn, 0)) == STRING_CST)
1996 || TREE_CODE (insn) == STRING_CST)
1999 error ("argument of `asm' is not a constant string");
2004 parse_begin_end_block (label)
2007 require (BEGINTOKEN);
2009 /* don't make a linenote at BEGIN */
2017 expand_start_bindings (label ? 1 : 0);
2021 expect (END, "missing 'END'");
2022 /* Note that the opthandler comes before the poplevel
2023 - hence a handler is in the scope of the block. */
2024 parse_opt_handler ();
2025 possibly_define_exit_label (label);
2028 emit_line_note (input_filename, lineno);
2029 expand_end_bindings (getdecls (), kept_level_p (), 0);
2031 poplevel (kept_level_p (), 0, 0);
2034 parse_opt_end_label_semi_colon (label);
2038 parse_if_action (label)
2044 cond = parse_expression ();
2049 expand_start_cond (truthvalue_conversion (cond),
2052 parse_then_clause ();
2053 parse_opt_else_clause ();
2054 expect (FI, "expected 'FI' after 'IF'");
2057 emit_line_note (input_filename, lineno);
2062 possibly_define_exit_label (label);
2067 /* Matches: <iteration> (as in a <for control>). */
2072 tree loop_counter = parse_defining_occurrence ();
2073 if (check_token (ASGN))
2075 tree start_value = parse_expression ();
2077 = check_token (BY) ? parse_expression () : NULL_TREE;
2078 int going_down = check_token (DOWN);
2080 if (check_token (TO))
2081 end_value = parse_expression ();
2084 error ("expected 'TO' in step enumeration");
2085 end_value = error_mark_node;
2088 build_loop_iterator (loop_counter, start_value, step_value,
2089 end_value, going_down, 0, 0);
2093 int going_down = check_token (DOWN);
2095 if (check_token (IN))
2096 expr = parse_expression ();
2099 error ("expected 'IN' in FOR control here");
2100 expr = error_mark_node;
2104 tree low_bound, high_bound;
2105 if (expr && TREE_CODE (expr) == TYPE_DECL)
2107 expr = TREE_TYPE (expr);
2108 /* FIXME: expr must be an array or powerset */
2109 low_bound = convert (expr, TYPE_MIN_VALUE (expr));
2110 high_bound = convert (expr, TYPE_MAX_VALUE (expr));
2115 high_bound = NULL_TREE;
2117 build_loop_iterator (loop_counter, low_bound,
2118 NULL_TREE, high_bound,
2124 /* Matches: '(' <event list> ')' ':'.
2125 Or; returns NULL_EXPR. */
2128 parse_delay_case_event_list ()
2130 tree event_list = NULL_TREE;
2132 if (! check_token (LPRN))
2134 event = parse_expression ();
2135 if (PEEK_TOKEN () == ')' && PEEK_TOKEN1 () != ':')
2139 pushback_paren_expr (event);
2145 event_list = tree_cons (NULL_TREE, event, event_list);
2146 if (! check_token (COMMA))
2148 event = parse_expression ();
2150 expect (RPRN, "missing ')'");
2151 expect (COLON, "missing ':'");
2152 return ignoring ? error_mark_node : event_list;
2156 parse_delay_case_action (label)
2159 tree label_cnt = NULL_TREE, set_location, priority;
2160 tree combined_event_list = NULL_TREE;
2165 expand_exit_needed = 0;
2166 if (check_token (SET))
2168 set_location = parse_expression ();
2169 parse_semi_colon ();
2172 set_location = NULL_TREE;
2173 if (check_token (PRIORITY))
2175 priority = parse_expression ();
2176 parse_semi_colon ();
2179 priority = NULL_TREE;
2181 label_cnt = build_delay_case_start (set_location, priority);
2184 tree event_list = parse_delay_case_event_list ();
2189 int if_or_elseif = combined_event_list == NULL_TREE;
2190 build_delay_case_label (event_list, if_or_elseif);
2191 combined_event_list = chainon (combined_event_list, event_list);
2194 else if (parse_action ())
2198 expand_exit_needed = 1;
2199 if (combined_event_list == NULL_TREE)
2200 error ("missing DELAY CASE alternative");
2206 expect (ESAC, "missing 'ESAC' in DELAY CASE'");
2208 build_delay_case_end (label_cnt, combined_event_list);
2209 possibly_define_exit_label (label);
2214 parse_do_action (label)
2220 if (check_token (WITH))
2222 tree list = NULL_TREE;
2225 tree name = parse_primval ();
2226 if (! ignoring && TREE_CODE (name) != ERROR_MARK)
2228 if (TREE_CODE (TREE_TYPE (name)) == REFERENCE_TYPE)
2229 name = convert (TREE_TYPE (TREE_TYPE (name)), name);
2232 int is_loc = chill_location (name);
2233 if (is_loc == 1) /* This is probably not possible */
2234 warning ("non-referable location in DO WITH");
2237 name = build_chill_arrow_expr (name, 1);
2238 name = decl_temp1 (get_identifier ("__with_element"),
2242 name = build_chill_indirect_ref (name, NULL_TREE, 0);
2245 if (TREE_CODE (TREE_TYPE (name)) != RECORD_TYPE)
2246 error ("WITH element must be of STRUCT mode");
2248 list = tree_cons (NULL_TREE, name, list);
2250 if (! check_token (COMMA))
2255 for (list = nreverse (list); list != NULL_TREE; list = TREE_CHAIN (list))
2256 shadow_record_fields (TREE_VALUE (list));
2258 parse_semi_colon ();
2259 parse_opt_actions ();
2260 expect (OD, "missing 'OD' in 'DO WITH'");
2262 emit_line_note (input_filename, lineno);
2263 possibly_define_exit_label (label);
2264 parse_opt_handler ();
2265 parse_opt_end_label_semi_colon (label);
2269 token = PEEK_TOKEN();
2270 if (token != FOR && token != WHILE)
2273 parse_opt_actions ();
2274 expect (OD, "Missing 'OD' after 'DO'");
2275 parse_opt_handler ();
2276 parse_opt_end_label_semi_colon (label);
2280 emit_line_note (input_filename, lineno);
2282 if (check_token (FOR))
2284 if (check_token (EVER))
2287 build_loop_iterator (NULL_TREE, NULL_TREE,
2288 NULL_TREE, NULL_TREE,
2294 while (check_token (COMMA))
2299 build_loop_iterator (NULL_TREE, NULL_TREE,
2300 NULL_TREE, NULL_TREE,
2303 begin_loop_scope ();
2305 build_loop_start (label);
2306 condition = check_token (WHILE) ? parse_expression () : NULL_TREE;
2308 top_loop_end_check (condition);
2309 parse_semi_colon ();
2310 parse_opt_actions ();
2313 expect (OD, "Missing 'OD' after 'DO'");
2314 /* Note that the handler is inside the reach of the DO. */
2315 parse_opt_handler ();
2316 end_loop_scope (label);
2318 parse_opt_end_label_semi_colon (label);
2321 /* Matches: '(' <signal name> [ 'IN' <defining occurrence list> ']' ')' ':'
2322 or: '(' <buffer location> IN (defining occurrence> ')' ':'
2323 or: returns NULL_TREE. */
2326 parse_receive_spec ()
2329 tree name_list = NULL_TREE;
2330 if (!check_token (LPRN))
2332 val = parse_primval ();
2333 if (check_token (IN))
2336 if (flag_local_loop_counter)
2337 name_list = parse_defining_occurrence_list ();
2343 tree loc = parse_primval ();
2345 name_list = tree_cons (NULL_TREE, loc, name_list);
2346 if (! check_token (COMMA))
2351 if (! check_token (RPRN))
2353 error ("missing ')' in signal/buffer receive alternative");
2356 if (check_token (COLON))
2358 if (ignoring || val == NULL_TREE || TREE_CODE (val) == ERROR_MARK)
2359 return error_mark_node;
2361 return build_receive_case_label (val, name_list);
2364 /* We saw: '(' <primitive value> ')' not followed by ':'.
2365 Presumably the start of an action. Backup and fail. */
2366 if (name_list != NULL_TREE)
2367 error ("misplaced 'IN' in signal/buffer receive alternative");
2368 pushback_paren_expr (val);
2372 /* To understand the code generation for this, see ch-tasking.c,
2373 and the 2-page comments preceding the
2374 build_chill_receive_case_start () definition. */
2377 parse_receive_case_action (label)
2380 tree instance_location;
2381 tree have_else_actions;
2383 tree alt_list = NULL_TREE;
2390 expand_exit_needed = 0;
2393 if (check_token (SET))
2395 instance_location = parse_expression ();
2396 parse_semi_colon ();
2399 instance_location = NULL_TREE;
2401 instance_location = build_receive_case_start (instance_location);
2405 tree receive_spec = parse_receive_spec ();
2409 alt_list = tree_cons (NULL_TREE, receive_spec, alt_list);
2412 else if (parse_action ())
2414 if (! spec_seen && pass == 1)
2415 error ("missing RECEIVE alternative");
2417 expand_exit_needed = 1;
2423 if (check_token (ELSE))
2427 emit_line_note (input_filename, lineno);
2428 if (build_receive_case_if_generated ())
2429 expand_start_else ();
2431 parse_opt_actions ();
2432 have_else_actions = integer_one_node;
2435 have_else_actions = integer_zero_node;
2436 expect (ESAC, "missing 'ESAC' matching 'RECEIVE CASE'");
2439 build_receive_case_end (instance_location, nreverse (alt_list),
2442 possibly_define_exit_label (label);
2447 parse_send_action ()
2449 tree signal = NULL_TREE;
2450 tree buffer = NULL_TREE;
2452 tree with_expr, to_expr, priority;
2454 /* The tricky part is distinguishing between a SEND buffer action,
2455 and a SEND signal action. */
2456 if (pass != 2 || PEEK_TOKEN () != NAME)
2458 /* If this is pass 2, it's a SEND buffer action.
2459 If it's pass 1, we don't care. */
2460 buffer = parse_primval ();
2464 /* We have to specifically check for signalname followed by
2465 a '(', since we allow a signalname to be used (syntactically)
2467 tree name = parse_name ();
2468 if (TREE_CODE (name) == TYPE_DECL && CH_DECL_SIGNAL (name))
2469 signal = name; /* It's a SEND signal action! */
2472 /* It's not a legal SEND signal action.
2473 Back up and try as a SEND buffer action. */
2474 pushback_token (EXPR, name);
2475 buffer = parse_primval ();
2478 if (check_token (LPRN))
2480 value_list = NULL_TREE;
2483 tree expr = parse_untyped_expr ();
2485 value_list = tree_cons (NULL_TREE, expr, value_list);
2486 if (! check_token (COMMA))
2489 value_list = nreverse (value_list);
2490 expect (RPRN, "missing ')'");
2493 value_list = NULL_TREE;
2494 if (check_token (WITH))
2495 with_expr = parse_expression ();
2497 with_expr = NULL_TREE;
2498 if (check_token (TO))
2499 to_expr = parse_expression ();
2501 to_expr = NULL_TREE;
2502 if (check_token (PRIORITY))
2503 priority = parse_expression ();
2505 priority = NULL_TREE;
2511 { /* It's a <send signal action>! */
2512 tree sigdesc = build_signal_descriptor (signal, value_list);
2513 if (sigdesc != NULL_TREE && TREE_CODE (sigdesc) != ERROR_MARK)
2515 tree sendto = to_expr ? to_expr : IDENTIFIER_SIGNAL_DEST (signal);
2516 expand_send_signal (sigdesc, with_expr,
2517 sendto, priority, DECL_NAME (signal));
2522 /* all checks are done in expand_send_buffer */
2523 expand_send_buffer (buffer, value_list, priority, with_expr, to_expr);
2528 parse_start_action ()
2530 tree name, copy_number, param_list, startset;
2532 name = parse_name_string ();
2533 expect (LPRN, "missing '(' in START action");
2535 /* copy number is a required parameter */
2536 copy_number = parse_expression ();
2538 && (copy_number == NULL_TREE
2539 || TREE_CODE (copy_number) == ERROR_MARK
2540 || TREE_CODE (TREE_TYPE (copy_number)) != INTEGER_TYPE))
2542 error ("PROCESS copy number must be integer");
2543 copy_number = integer_zero_node;
2545 if (check_token (COMMA))
2546 param_list = parse_expr_list (); /* user parameters */
2548 param_list = NULL_TREE;
2549 expect (RPRN, "missing ')'");
2550 startset = check_token (SET) ? parse_primval () : NULL;
2551 build_start_process (name, copy_number, param_list, startset);
2555 parse_opt_actions ()
2557 while (parse_action ()) ;
2563 tree label = NULL_TREE;
2564 tree expr, rhs, loclist;
2567 if (current_function_decl == global_function_decl
2568 && PEEK_TOKEN () != SC
2569 && PEEK_TOKEN () != END)
2570 seen_action = 1, build_constructor = 1;
2572 if (PEEK_TOKEN () == NAME && PEEK_TOKEN1 () == COLON)
2574 label = parse_defining_occurrence ();
2577 define_label (input_filename, lineno, label);
2580 switch (PEEK_TOKEN ())
2586 expr = parse_primval ();
2587 delay = check_token (DELAY);
2588 expect (IN, "missing 'IN'");
2591 build_after_start (expr, delay);
2592 parse_opt_actions ();
2593 expect (TIMEOUT, "missing 'TIMEOUT'");
2594 build_after_timeout_start ();
2595 parse_opt_actions ();
2596 expect (END, "missing 'END'");
2598 possibly_define_exit_label (label);
2601 goto bracketed_action;
2603 parse_asm_action ();
2604 goto no_handler_action;
2608 expr = parse_expression ();
2610 { tree assertfail = ridpointers[(int) RID_ASSERTFAIL];
2611 expr = build (TRUTH_ORIF_EXPR, void_type_node, expr,
2612 build_cause_exception (assertfail, 0));
2613 expand_expr_stmt (fold (expr));
2615 goto handler_action;
2619 expr = parse_primval ();
2620 expect (IN, "missing 'IN'");
2623 build_at_action (expr);
2624 parse_opt_actions ();
2625 expect (TIMEOUT, "missing 'TIMEOUT'");
2627 expand_start_else ();
2628 parse_opt_actions ();
2629 expect (END, "missing 'END'");
2632 possibly_define_exit_label (label);
2634 goto bracketed_action;
2636 parse_begin_end_block (label);
2639 parse_case_action (label);
2640 goto bracketed_action;
2643 expr = parse_name_string ();
2645 if (! ignoring && TREE_CODE (expr) != ERROR_MARK)
2646 expand_cause_exception (expr);
2647 goto no_handler_action;
2650 expr = parse_expression ();
2653 expand_continue_event (expr);
2654 goto handler_action;
2658 expr = parse_primval ();
2659 expect (IN, "missing 'IN' after 'CYCLE'");
2661 /* We a tree list where TREE_VALUE is the label
2662 and TREE_PURPOSE is the variable denotes the timeout id. */
2663 expr = build_cycle_start (expr);
2664 parse_opt_actions ();
2665 expect (END, "missing 'END'");
2667 build_cycle_end (expr);
2668 possibly_define_exit_label (label);
2670 goto bracketed_action;
2672 if (PEEK_TOKEN1 () == CASE)
2674 parse_delay_case_action (label);
2675 goto bracketed_action;
2679 expr = parse_primval ();
2680 rhs = check_token (PRIORITY) ? parse_expression () : NULL_TREE;
2682 build_delay_action (expr, rhs);
2683 goto handler_action;
2685 parse_do_action (label);
2689 expr = parse_name_string ();
2691 lookup_and_handle_exit (expr);
2692 goto no_handler_action;
2695 expr = parse_name_string ();
2697 lookup_and_expand_goto (expr);
2698 goto no_handler_action;
2700 parse_if_action (label);
2701 goto bracketed_action;
2703 if (PEEK_TOKEN1 () != CASE)
2705 parse_receive_case_action (label);
2706 goto bracketed_action;
2710 expr = parse_untyped_expr ();
2712 chill_expand_result (expr, 1);
2713 goto handler_action;
2717 expr = parse_opt_untyped_expr ();
2720 /* Do this as RESULT expr and RETURN to get exceptions */
2721 chill_expand_result (expr, 0);
2722 expand_goto_except_cleanup (proc_action_level);
2723 chill_expand_return (NULL_TREE, 0);
2726 goto handler_action;
2728 goto no_handler_action;
2733 parse_send_action ();
2734 goto handler_action;
2736 parse_start_action ();
2737 goto handler_action;
2742 { tree func = lookup_name (get_identifier ("__stop_process"));
2743 tree result = build_chill_function_call (func, NULL_TREE);
2744 expand_expr_stmt (result);
2746 goto no_handler_action;
2749 /* Fall through to here ... */
2753 /* This handles calls and assignments. */
2755 expr = parse_primval ();
2756 switch (PEEK_TOKEN ())
2759 parse_semi_colon (); /* Emits error message. */
2762 if (!ignoring && TREE_CODE (expr) != ERROR_MARK)
2764 if (TREE_CODE (expr) != CALL_EXPR
2765 && TREE_TYPE (expr) != void_type_node
2766 && ! TREE_SIDE_EFFECTS (expr))
2768 if (TREE_CODE (expr) == FUNCTION_DECL)
2769 error ("missing parenthesis for procedure call");
2771 error ("expression is not an action");
2772 expr = error_mark_node;
2775 expand_expr_stmt (expr);
2777 goto handler_action;
2780 = ignoring ? NULL_TREE : build_tree_list (NULL_TREE, expr);
2781 while (PEEK_TOKEN () == COMMA)
2784 expr = parse_primval ();
2785 if (!ignoring && TREE_CODE (expr) != ERROR_MARK)
2786 loclist = tree_cons (NULL_TREE, expr, loclist);
2789 switch (PEEK_TOKEN ())
2791 case OR: op = BIT_IOR_EXPR; break;
2792 case XOR: op = BIT_XOR_EXPR; break;
2793 case ORIF: op = TRUTH_ORIF_EXPR; break;
2794 case AND: op = BIT_AND_EXPR; break;
2795 case ANDIF: op = TRUTH_ANDIF_EXPR; break;
2796 case PLUS: op = PLUS_EXPR; break;
2797 case SUB: op = MINUS_EXPR; break;
2798 case CONCAT: op = CONCAT_EXPR; break;
2799 case MUL: op = MULT_EXPR; break;
2800 case DIV: op = TRUNC_DIV_EXPR; break;
2801 case MOD: op = FLOOR_MOD_EXPR; break;
2802 case REM: op = TRUNC_MOD_EXPR; break;
2805 error ("syntax error in action");
2807 case ASGN: op = NOP_EXPR; break;
2811 /* Looks like it was an assignment action. */
2814 expect (ASGN, "expected ':=' here");
2815 rhs = parse_untyped_expr ();
2817 expand_assignment_action (loclist, op, rhs);
2818 goto handler_action;
2825 /* We've parsed a bracketed action. */
2826 parse_opt_handler ();
2827 parse_opt_end_label_semi_colon (label);
2831 if (parse_opt_handler () != NULL_TREE && pass == 1)
2832 error ("no handler is permitted on this action.");
2833 parse_semi_colon ();
2837 parse_opt_handler ();
2838 parse_semi_colon ();
2846 while (parse_definition (0)) ;
2848 while (parse_action ()) ;
2850 if (parse_definition (0))
2853 pedwarn ("definition follows action");
2859 parse_opt_untyped_expr ()
2861 switch (PEEK_TOKEN ())
2871 return parse_untyped_expr ();
2876 parse_call (function)
2879 tree arg1, arg2, arg_list = NULL_TREE;
2882 arg1 = parse_opt_untyped_expr ();
2883 if (arg1 != NULL_TREE)
2885 tok = PEEK_TOKEN ();
2886 if (tok == UP || tok == COLON)
2890 /* check that arg1 isn't untyped (or mode);*/
2892 arg2 = parse_expression ();
2893 expect (RPRN, "expected ')' to terminate slice");
2895 return integer_zero_node;
2897 return build_chill_slice_with_length (function, arg1, arg2);
2899 return build_chill_slice_with_range (function, arg1, arg2);
2902 arg_list = build_tree_list (NULL_TREE, arg1);
2903 while (check_token (COMMA))
2905 arg2 = parse_untyped_expr ();
2907 arg_list = tree_cons (NULL_TREE, arg2, arg_list);
2911 expect (RPRN, "expected ')' here");
2912 return ignoring ? function
2913 : build_generalized_call (function, nreverse (arg_list));
2916 /* Matches: <field name list>
2917 Returns: A list of IDENTIFIER_NODEs (or NULL_TREE if ignoring),
2918 in reverse order. */
2921 parse_tuple_fieldname_list ()
2923 tree list = NULL_TREE;
2927 if (!check_token (DOT))
2929 error ("bad tuple field name list");
2932 name = parse_simple_name_string ();
2933 list = ignoring ? NULL_TREE : tree_cons (NULL_TREE, name, list);
2934 } while (check_token (COMMA));
2938 /* Returns one or nore TREE_LIST nodes, in reverse order. */
2941 parse_tuple_element ()
2943 /* The tupleelement chain is built in reverse order,
2944 and put in forward order when the list is used. */
2946 if (PEEK_TOKEN () == DOT)
2948 /* Parse a labelled structure tuple. */
2949 tree list = parse_tuple_fieldname_list (), field;
2950 expect (COLON, "missing ':' in tuple");
2951 value = parse_untyped_expr ();
2954 /* FIXME: Should use save_expr(value), but that
2955 confuses nested calls to digest_init! */
2956 /* Re-use the list of field names as a list of name-value pairs. */
2957 for (field = list; field != NULL_TREE; field = TREE_CHAIN (field))
2958 { tree field_name = TREE_VALUE (field);
2959 TREE_PURPOSE (field) = field_name;
2960 TREE_VALUE (field) = value;
2961 TUPLE_NAMED_FIELD (field) = 1;
2966 label = parse_case_label_list (NULL_TREE, 1);
2969 expect (COLON, "missing ':' in tuple");
2970 value = parse_untyped_expr ();
2971 if (ignoring || label == NULL_TREE)
2973 if (TREE_CODE (label) != TREE_LIST)
2975 error ("invalid syntax for label in tuple");
2980 /* FIXME: Should use save_expr(value), but that
2981 confuses nested calls to digest_init! */
2983 for (; link != NULL_TREE; link = TREE_CHAIN (link))
2984 { tree index = TREE_VALUE (link);
2985 if (pass == 1 && TREE_CODE (index) != TREE_LIST)
2986 index = build1 (PAREN_EXPR, NULL_TREE, index);
2987 TREE_VALUE (link) = value;
2988 TREE_PURPOSE (link) = index;
2990 return nreverse (label);
2994 value = parse_untyped_expr ();
2995 if (check_token (COLON))
2997 /* A powerset range [or possibly a labeled Array?] */
2998 tree value2 = parse_untyped_expr ();
2999 return ignoring ? NULL_TREE : build_tree_list (value, value2);
3001 return ignoring ? NULL_TREE : build_tree_list (NULL_TREE, value);
3004 /* Matches: a COMMA-separated list of tuple elements.
3005 Returns a list (of TREE_LIST nodes). */
3007 parse_opt_element_list ()
3009 tree list = NULL_TREE;
3010 if (PEEK_TOKEN () == RPC)
3014 tree element = parse_tuple_element ();
3015 list = chainon (element, list); /* Built in reverse order */
3016 if (PEEK_TOKEN () == RPC)
3018 if (!check_token (COMMA))
3020 error ("bad syntax in tuple");
3024 return nreverse (list);
3027 /* Parses: '[' elements ']'
3028 If modename is non-NULL it prefixed the tuple. */
3031 parse_tuple (modename)
3036 list = parse_opt_element_list ();
3037 expect (RPC, "missing ']' after tuple");
3039 return integer_zero_node;
3040 list = build_nt (CONSTRUCTOR, NULL_TREE, list);
3041 if (modename == NULL_TREE)
3044 TREE_TYPE (list) = modename;
3045 else if (TREE_CODE (modename) != TYPE_DECL)
3047 error ("non-mode name before tuple");
3048 return error_mark_node;
3051 list = chill_expand_tuple (TREE_TYPE (modename), list);
3059 switch (PEEK_TOKEN ())
3072 val = build_chill_function_call (PEEK_TREE (), NULL_TREE);
3077 val = parse_expression ();
3078 expect (RPRN, "missing right parenthesis");
3079 if (pass == 1 && ! ignoring)
3080 val = build1 (PAREN_EXPR, NULL_TREE, val);
3083 val = parse_tuple (NULL_TREE);
3086 val = parse_name ();
3087 if (PEEK_TOKEN() == LPC)
3088 val = parse_tuple (val); /* Matched: <mode_name> <tuple> */
3092 error ("invalid expression/location syntax");
3093 val = error_mark_node;
3098 switch (PEEK_TOKEN ())
3102 name = parse_simple_name_string ();
3103 val = ignoring ? val : build_chill_component_ref (val, name);
3107 name = parse_opt_name_string (0);
3108 val = ignoring ? val : build_chill_indirect_ref (val, name, 1);
3111 /* The SEND buffer action syntax is ambiguous, at least when
3112 parsed left-to-right. In the example 'SEND foo(v) ...' the
3113 phrase 'foo(v)' could be a buffer location procedure call
3114 (which then must be followed by the value to send).
3115 On the other hand, if 'foo' is a buffer, stop parsing
3116 after 'foo', and let parse_send_action pick up '(v) as
3119 We handle the ambiguity for SEND signal action differently,
3120 since we allow (as an extension) a signal to be used as
3121 a "function" (see build_generalized_call). */
3122 if (TREE_TYPE (val) != NULL_TREE
3123 && CH_IS_BUFFER_MODE (TREE_TYPE (val)))
3125 val = parse_call (val);
3131 /* Handle string repetition. (See comment in parse_operand5.) */
3132 args = parse_primval ();
3133 val = ignoring ? val : build_generalized_call (val, args);
3146 if (check_token (RECEIVE))
3148 tree location = parse_primval ();
3149 sorry ("RECEIVE expression");
3150 return integer_one_node;
3152 else if (check_token (ARROW))
3154 tree location = parse_primval ();
3155 return ignoring ? location : build_chill_arrow_expr (location, 0);
3158 return parse_primval();
3165 /* We are supposed to be looking for a <string repetition operator>,
3166 but in general we can't distinguish that from a parenthesized
3167 expression. This is especially difficult if we allow the
3168 string operand to be a constant expression (as requested by
3169 some users), and not just a string literal.
3170 Consider: LPRN expr RPRN LPRN expr RPRN
3171 Is that a function call or string repetition?
3172 Instead, we handle string repetition in parse_primval,
3173 and build_generalized_call. */
3175 switch (PEEK_TOKEN())
3177 case NOT: op = BIT_NOT_EXPR; break;
3178 case SUB: op = NEGATE_EXPR; break;
3184 rarg = parse_operand6();
3185 return (op == NOP_EXPR || ignoring) ? rarg
3186 : build_chill_unary_op (op, rarg);
3192 tree larg = parse_operand5(), rarg;
3196 switch (PEEK_TOKEN())
3198 case MUL: op = MULT_EXPR; break;
3199 case DIV: op = TRUNC_DIV_EXPR; break;
3200 case MOD: op = FLOOR_MOD_EXPR; break;
3201 case REM: op = TRUNC_MOD_EXPR; break;
3206 rarg = parse_operand5();
3208 larg = build_chill_binary_op (op, larg, rarg);
3215 tree larg = parse_operand4 (), rarg;
3219 switch (PEEK_TOKEN())
3221 case PLUS: op = PLUS_EXPR; break;
3222 case SUB: op = MINUS_EXPR; break;
3223 case CONCAT: op = CONCAT_EXPR; break;
3228 rarg = parse_operand4();
3230 larg = build_chill_binary_op (op, larg, rarg);
3237 tree larg = parse_operand3 (), rarg;
3241 if (check_token (IN))
3243 rarg = parse_operand3();
3245 larg = build_chill_binary_op (SET_IN_EXPR, larg, rarg);
3249 switch (PEEK_TOKEN())
3251 case GT: op = GT_EXPR; break;
3252 case GTE: op = GE_EXPR; break;
3253 case LT: op = LT_EXPR; break;
3254 case LTE: op = LE_EXPR; break;
3255 case EQL: op = EQ_EXPR; break;
3256 case NE: op = NE_EXPR; break;
3261 rarg = parse_operand3();
3263 larg = build_compare_expr (op, larg, rarg);
3271 tree larg = parse_operand2 (), rarg;
3275 switch (PEEK_TOKEN())
3277 case AND: op = BIT_AND_EXPR; break;
3278 case ANDIF: op = TRUTH_ANDIF_EXPR; break;
3283 rarg = parse_operand2();
3285 larg = build_chill_binary_op (op, larg, rarg);
3292 tree larg = parse_operand1(), rarg;
3296 switch (PEEK_TOKEN())
3298 case OR: op = BIT_IOR_EXPR; break;
3299 case XOR: op = BIT_XOR_EXPR; break;
3300 case ORIF: op = TRUTH_ORIF_EXPR; break;
3305 rarg = parse_operand1();
3307 larg = build_chill_binary_op (op, larg, rarg);
3314 return parse_operand0 ();
3318 parse_case_expression ()
3323 tree case_alt_list = NULL_TREE;
3326 selector_list = parse_expr_list ();
3327 selector_list = nreverse (selector_list);
3329 expect (OF, "missing 'OF'");
3330 while (PEEK_TOKEN () == LPRN)
3332 tree label_spec = parse_case_label_specification (selector_list);
3334 expect (COLON, "missing ':' in value case alternative");
3335 sub_expr = parse_expression ();
3336 expect (SC, "missing ';'");
3338 case_alt_list = tree_cons (label_spec, sub_expr, case_alt_list);
3340 if (check_token (ELSE))
3342 else_expr = parse_expression ();
3343 if (check_token (SC) && pass == 1)
3344 warning("there should not be a ';' here");
3347 else_expr = NULL_TREE;
3348 expect (ESAC, "missing 'ESAC' in 'CASE' expression");
3351 return integer_zero_node;
3353 /* If this is a multi dimension case, then transform it into an COND_EXPR
3354 here. This must be done before store_expr is called since it has some
3355 special handling for COND_EXPR expressions. */
3356 if (TREE_CHAIN (selector_list) != NULL_TREE)
3358 case_alt_list = nreverse (case_alt_list);
3359 compute_else_ranges (selector_list, case_alt_list);
3361 build_chill_multi_dimension_case_expr (selector_list, case_alt_list, else_expr);
3364 case_expr = build_chill_case_expr (selector_list, case_alt_list, else_expr);
3370 parse_then_alternative ()
3372 expect (THEN, "missing 'THEN' in 'IF' expression");
3373 return parse_expression ();
3377 parse_else_alternative ()
3379 if (check_token (ELSIF))
3380 return parse_if_expression_body ();
3381 else if (check_token (ELSE))
3382 return parse_expression ();
3383 error ("missing ELSE/ELSIF in IF expression");
3384 return error_mark_node;
3387 /* Matches: <boolean expression> <then alternative> <else alternative> */
3390 parse_if_expression_body ()
3392 tree bool_expr, then_expr, else_expr;
3393 bool_expr = parse_expression ();
3394 then_expr = parse_then_alternative ();
3395 else_expr = parse_else_alternative ();
3397 return integer_zero_node;
3399 return build_nt (COND_EXPR, bool_expr, then_expr, else_expr);
3403 parse_if_expression ()
3407 expr = parse_if_expression_body ();
3408 expect (FI, "missing 'FI' at end of conditional expression");
3412 /* An <untyped_expr> is a superset of <expr>. It also includes
3413 <conditional expressions> and untyped <tuples>, whose types
3414 are not given by their constituents. Hence, these are only
3415 allowed in certain contexts that expect a certain type.
3416 You should call convert() to fix up the <untyped_expr>. */
3419 parse_untyped_expr ()
3422 switch (PEEK_TOKEN())
3425 return parse_if_expression ();
3427 return parse_case_expression ();
3429 switch (PEEK_TOKEN1())
3434 pedwarn ("conditional expression not allowed inside parentheses");
3438 pedwarn ("mode-less tuple not allowed inside parentheses");
3441 val = parse_untyped_expr ();
3442 expect (RPRN, "missing ')'");
3448 return parse_operand0 ();
3452 /* Matches: <index mode> */
3457 /* This is another one that is nasty to parse!
3458 Let's feel our way ahead ... */
3460 if (PEEK_TOKEN () == NAME)
3462 tree name = parse_name ();
3463 switch (PEEK_TOKEN ())
3467 case SC: /* An error */
3468 /* This can only (legally) be a discrete mode name. */
3471 /* This could be named discrete range,
3472 a cast, or some other expression (maybe). */
3474 lower = parse_expression ();
3475 if (check_token (COLON))
3477 upper = parse_expression ();
3478 expect (RPRN, "missing ')'");
3479 /* Matched: <mode_name> '(' <expr> ':' <expr> ')' */
3483 return build_chill_range_type (name, lower, upper);
3485 /* Looks like a cast or procedure call or something.
3486 Backup, and try again. */
3487 pushback_token (EXPR, lower);
3488 pushback_token (LPRN, NULL_TREE);
3489 lower = parse_call (name);
3490 goto parse_literal_range_colon;
3492 /* This has to be the start of an expression. */
3493 pushback_token (EXPR, name);
3494 goto parse_literal_range;
3497 /* It's not a name. But it could still be a discrete mode. */
3498 lower = parse_opt_mode ();
3501 parse_literal_range:
3502 /* Nope, it's a discrete literal range. */
3503 lower = parse_expression ();
3504 parse_literal_range_colon:
3505 expect (COLON, "expected ':' here");
3507 upper = parse_expression ();
3508 return ignoring ? NULL_TREE
3509 : build_chill_range_type (NULL_TREE, lower, upper);
3515 int set_name_cnt = 0; /* count of named set elements */
3516 int set_is_numbered = 0; /* TRUE if set elements have explicit values */
3517 int set_is_not_numbered = 0;
3518 tree list = NULL_TREE;
3519 tree mode = ignoring ? void_type_node : start_enum (NULL_TREE);
3521 expect (LPRN, "missing left parenthesis after SET");
3524 tree name, value = NULL_TREE;
3525 if (check_token (MUL))
3529 name = parse_defining_occurrence ();
3530 if (check_token (EQL))
3532 value = parse_expression ();
3533 set_is_numbered = 1;
3536 set_is_not_numbered = 1;
3539 name = build_enumerator (name, value);
3541 list = chainon (name, list);
3542 if (! check_token (COMMA))
3545 expect (RPRN, "missing right parenthesis after SET");
3548 if (set_is_numbered && set_is_not_numbered)
3549 /* Z.200 doesn't allow mixed numbered and unnumbered set elements,
3550 but we can do it. Print a warning */
3551 pedwarn ("mixed numbered and unnumbered set elements is not standard");
3552 mode = finish_enum (mode, list);
3553 if (set_name_cnt == 0)
3554 error ("SET mode must define at least one named value");
3555 CH_ENUM_IS_NUMBERED(mode) = set_is_numbered ? 1 : 0;
3560 /* parse layout POS:
3561 returns a tree with following layout
3564 pupose=treelist value=NULL_TREE (to indicate POS)
3565 pupose=word value=treelist | NULL_TREE
3566 pupose=startbit value=treelist | NULL_TREE
3568 integer_zero | integer_one length | endbit
3574 tree startbit = NULL_TREE, endbit = NULL_TREE;
3575 tree what = NULL_TREE;
3578 word = parse_untyped_expr ();
3579 if (check_token (COMMA))
3581 startbit = parse_untyped_expr ();
3582 if (check_token (COMMA))
3584 what = integer_zero_node;
3585 endbit = parse_untyped_expr ();
3587 else if (check_token (COLON))
3589 what = integer_one_node;
3590 endbit = parse_untyped_expr ();
3595 /* build the tree as described above */
3596 if (what != NULL_TREE)
3597 what = tree_cons (what, endbit, NULL_TREE);
3598 if (startbit != NULL_TREE)
3599 startbit = tree_cons (startbit, what, NULL_TREE);
3600 endbit = tree_cons (word, startbit, NULL_TREE);
3601 return tree_cons (endbit, NULL_TREE, NULL_TREE);
3604 /* parse layout STEP
3605 returns a tree with the following layout
3608 pupose=NULL_TREE value=treelist (to indicate STEP)
3609 pupose=POS(see baove) value=stepsize | NULL_TREE
3615 tree stepsize = NULL_TREE;
3620 if (check_token (COMMA))
3621 stepsize = parse_untyped_expr ();
3623 TREE_VALUE (pos) = stepsize;
3624 return tree_cons (NULL_TREE, pos, NULL_TREE);
3627 /* returns layout for fields or array elements.
3628 NULL_TREE no layout specified
3629 integer_one_node PACK specified
3630 integer_zero_node NOPACK specified
3631 tree_list PURPOSE POS
3632 tree_list VALUE STEP
3635 parse_opt_layout (in)
3636 int in; /* 0 ... parse structure, 1 ... parse array */
3638 tree val = NULL_TREE;
3640 if (check_token (PACK))
3642 return integer_one_node;
3644 else if (check_token (NOPACK))
3646 return integer_zero_node;
3648 else if (check_token (POS))
3651 if (in == 1 && pass == 1)
3653 error ("POS not allowed for ARRAY");
3658 else if (check_token (STEP))
3660 val = parse_step ();
3661 if (in == 0 && pass == 1)
3663 error ("STEP not allowed in field definition");
3673 parse_field_name_list ()
3675 tree chain = NULL_TREE;
3676 tree name = parse_defining_occurrence ();
3677 if (name == NULL_TREE)
3679 error("missing field name");
3682 chain = build_tree_list (NULL_TREE, name);
3683 while (check_token (COMMA))
3685 name = parse_defining_occurrence ();
3688 error ("bad field name following ','");
3692 chain = tree_cons (NULL_TREE, name, chain);
3697 /* Matches: <fixed field> or <variant field>, i.e.:
3698 <field name defining occurrence list> <mode> [ <field layout> ].
3699 Returns: A chain of FIELD_DECLs.
3700 NULL_TREE is returned if ignoring is true or an error is seen. */
3703 parse_fixed_field ()
3705 tree field_names = parse_field_name_list ();
3706 tree mode = parse_mode ();
3707 tree layout = parse_opt_layout (0);
3708 return ignoring ? NULL_TREE
3709 : grok_chill_fixedfields (field_names, mode, layout);
3713 /* Matches: [ <variant field> { "," <variant field> }* ]
3714 Returns: A chain of FIELD_DECLs.
3715 NULL_TREE is returned if ignoring is true or an error is seen. */
3718 parse_variant_field_list ()
3720 tree fields = NULL_TREE;
3721 if (PEEK_TOKEN () != NAME)
3725 fields = chainon (fields, parse_fixed_field ());
3726 if (PEEK_TOKEN () != COMMA || PEEK_TOKEN1 () != NAME)
3733 /* Matches: <variant alternative>
3734 Returns a TREE_LIST node, whose TREE_PURPOSE (if non-NULL) is the label,
3735 and whose TREE_VALUE is the list of FIELD_DECLs. */
3738 parse_variant_alternative ()
3742 if (PEEK_TOKEN () == LPRN)
3743 labels = parse_case_label_specification (NULL_TREE);
3746 if (! check_token (COLON))
3748 error ("expected ':' in structure variant alternative");
3752 /* We now read a list a variant fields, until we come to the end
3753 of the variant alternative. But since both variant fields
3754 *and* variant alternatives are separated by COMMAs,
3755 we will have to look ahead to distinguish the start of a variant
3756 field from the start of a new variant alternative.
3757 We use the fact that a variant alternative must start with
3758 either a LPRN or a COLON, while a variant field must start with a NAME.
3759 This look-ahead is handled by parse_simple_fields. */
3760 return build_tree_list (labels, parse_variant_field_list ());
3763 /* Parse <field> (which is <fixed field> or <alternative field>).
3764 Returns: A chain of FIELD_DECLs (or NULL_TREE on error or if ignoring). */
3769 if (check_token (CASE))
3771 tree tag_list = NULL_TREE, variants, opt_variant_else;
3772 if (PEEK_TOKEN () == NAME)
3774 tag_list = nreverse (parse_field_name_list ());
3776 tag_list = lookup_tag_fields (tag_list, current_fieldlist);
3778 expect (OF, "missing 'OF' in alternative structure field");
3780 variants = parse_variant_alternative ();
3781 while (check_token (COMMA))
3782 variants = chainon (parse_variant_alternative (), variants);
3783 variants = nreverse (variants);
3785 if (check_token (ELSE))
3786 opt_variant_else = parse_variant_field_list ();
3788 opt_variant_else = NULL_TREE;
3789 expect (ESAC, "missing 'ESAC' following alternative structure field");
3792 return grok_chill_variantdefs (tag_list, variants, opt_variant_else);
3794 else if (PEEK_TOKEN () == NAME)
3795 return parse_fixed_field ();
3799 error ("missing field");
3805 parse_structure_mode ()
3807 tree save_fieldlist = current_fieldlist;
3810 expect (LPRN, "expected '(' after STRUCT");
3811 current_fieldlist = fields = parse_field ();
3812 while (check_token (COMMA))
3813 fields = chainon (fields, parse_field ());
3814 expect (RPRN, "expected ')' after STRUCT");
3815 current_fieldlist = save_fieldlist;
3816 return ignoring ? void_type_node : build_chill_struct_type (fields);
3820 parse_opt_queue_size ()
3822 if (check_token (LPRN))
3824 tree size = parse_expression ();
3825 expect (RPRN, "missing ')'");
3833 parse_procedure_mode ()
3835 tree param_types = NULL_TREE, result_spec, except_list, recursive;
3837 expect (LPRN, "missing '(' after PROC");
3838 if (! check_token (RPRN))
3842 tree pmode = parse_mode ();
3843 tree paramattr = parse_param_attr ();
3846 pmode = get_type_of (pmode);
3847 param_types = tree_cons (paramattr, pmode, param_types);
3849 if (! check_token (COMMA))
3852 expect (RPRN, "missing ')' after PROC");
3854 result_spec = parse_opt_result_spec ();
3855 except_list = parse_opt_except ();
3856 recursive = parse_opt_recursive ();
3858 return void_type_node;
3859 return build_chill_pointer_type (build_chill_function_type
3860 (result_spec, nreverse (param_types),
3861 except_list, recursive));
3865 A NAME will be assumed to be a <mode name>, and thus a <mode>.
3866 Returns NULL_TREE if no mode is seen.
3867 (If ignoring is true, the return value may be an arbitrary tree node,
3868 but will be non-NULL if something that could be a mode is seen.) */
3873 switch (PEEK_TOKEN ())
3877 tree index_mode, record_mode;
3880 if (check_token (LPRN))
3882 index_mode = parse_index_mode ();
3883 expect (RPRN, "mssing ')'");
3886 index_mode = NULL_TREE;
3887 record_mode = parse_opt_mode ();
3889 dynamic = check_token (DYNAMIC);
3890 return ignoring ? void_type_node
3891 : build_access_mode (index_mode, record_mode, dynamic);
3895 tree index_list = NULL_TREE, base_mode;
3897 int num_index_modes = 0;
3899 tree layouts = NULL_TREE;
3901 expect (LPRN, "missing '(' after ARRAY");
3904 tree index = parse_index_mode ();
3907 index_list = tree_cons (NULL_TREE, index, index_list);
3908 if (! check_token (COMMA))
3911 expect (RPRN, "missing ')' after ARRAY");
3912 varying = check_token (VARYING);
3913 base_mode = parse_mode ();
3914 /* Allow a layout specification for each index mode */
3915 for (i = 0; i < num_index_modes; ++i)
3917 tree new_layout = parse_opt_layout (1);
3918 if (new_layout == NULL_TREE)
3921 layouts = tree_cons (NULL_TREE, new_layout, layouts);
3925 return build_chill_array_type (get_type_of (base_mode),
3926 index_list, varying, layouts);
3929 require (ASSOCIATION);
3930 return association_type_node;
3934 expect (LPRN, "missing left parenthesis after BIN");
3935 length = parse_expression ();
3936 expect (RPRN, "missing right parenthesis after BIN");
3937 return ignoring ? void_type_node : build_chill_bin_type (length);
3943 expect (LPRN, "missing '(' after BOOLS");
3944 length = parse_expression ();
3945 expect (RPRN, "missing ')' after BOOLS");
3946 if (check_token (VARYING))
3947 error ("VARYING bit-strings not implemented");
3948 return ignoring ? void_type_node : build_bitstring_type (length);
3952 tree qsize, element_mode;
3954 qsize = parse_opt_queue_size ();
3955 element_mode = parse_mode ();
3956 return ignoring ? element_mode
3957 : build_buffer_type (element_mode, qsize);
3965 expect (LPRN, "missing '(' after CHARS");
3966 length = parse_expression ();
3967 expect (RPRN, "missing ')' after CHARS");
3968 varying = check_token (VARYING);
3970 return void_type_node;
3971 type = build_string_type (char_type_node, length);
3973 type = build_varying_struct (type);
3980 qsize = parse_opt_queue_size ();
3981 return ignoring ? void_type_node : build_event_type (qsize);
3985 tree mode = get_type_of (parse_name ());
3986 if (check_token (LPRN))
3988 tree min_value = parse_expression ();
3989 if (check_token (COLON))
3991 tree max_value = parse_expression ();
3992 expect (RPRN, "syntax error - expected ')'");
3993 /* Matched: <mode_name> '(' <expr> ':' <expr> ')' */
3997 return build_chill_range_type (mode, min_value, max_value);
3999 if (check_token (RPRN))
4001 int varying = check_token (VARYING);
4004 if (mode == char_type_node || varying)
4006 if (mode != char_type_node
4007 && mode != ridpointers[(int) RID_CHAR])
4008 error ("strings must be composed of chars");
4009 mode = build_string_type (char_type_node, min_value);
4011 mode = build_varying_struct (mode);
4015 /* Parameterized mode,
4016 or old-fashioned CHAR(N) string declaration.. */
4017 tree pmode = make_node (LANG_TYPE);
4018 TREE_TYPE (pmode) = mode;
4019 TYPE_DOMAIN (pmode) = min_value;
4030 mode = parse_mode ();
4031 if (ignoring || TREE_CODE (mode) == ERROR_MARK)
4033 return build_powerset_type (get_type_of (mode));
4036 return parse_procedure_mode ();
4040 expect (LPRN, "missing left parenthesis after RANGE");
4041 low = parse_expression ();
4042 expect (COLON, "missing colon");
4043 high = parse_expression ();
4044 expect (RPRN, "missing right parenthesis after RANGE");
4045 return ignoring ? void_type_node
4046 : build_chill_range_type (NULL_TREE, low, high);
4051 tree mode2 = get_type_of (parse_mode ());
4052 if (ignoring || TREE_CODE (mode2) == ERROR_MARK)
4055 && TREE_CODE_CLASS (TREE_CODE (mode2)) == 'd'
4056 && CH_IS_BUFFER_MODE (mode2))
4058 error ("BUFFER modes may not be readonly");
4062 && TREE_CODE_CLASS (TREE_CODE (mode2)) == 'd'
4063 && CH_IS_EVENT_MODE (mode2))
4065 error ("EVENT modes may not be readonly");
4068 return build_readonly_type (mode2);
4074 mode = parse_mode ();
4077 mode = get_type_of (mode);
4078 return (TREE_CODE (mode) == ERROR_MARK) ? mode
4079 : build_chill_pointer_type (mode);
4082 return parse_set_mode ();
4085 error ("SIGNAL is not a valid mode");
4086 return generic_signal_type_node;
4088 return parse_structure_mode ();
4091 tree length, index_mode;
4094 expect (LPRN, "missing '('");
4095 length = parse_expression ();
4096 expect (RPRN, "missing ')'");
4097 /* FIXME: This should actually look for an optional index_mode,
4098 but that is tricky to do. */
4099 index_mode = parse_opt_mode ();
4100 dynamic = check_token (DYNAMIC);
4101 return ignoring ? void_type_node
4102 : build_text_mode (length, index_mode, dynamic);
4106 return usage_type_node;
4109 return where_type_node;
4118 tree mode = parse_opt_mode ();
4119 if (mode == NULL_TREE)
4122 error ("syntax error - missing mode");
4123 mode = error_mark_node;
4131 /* Initialize global variables for current pass. */
4133 expand_exit_needed = 0;
4134 label = NULL_TREE; /* for statement labels */
4135 current_module = NULL;
4136 current_function_decl = NULL_TREE;
4137 in_pseudo_module = 0;
4139 for (i = 0; i <= MAX_LOOK_AHEAD; i++)
4140 terminal_buffer[i] = TOKEN_NOT_READ;
4143 /* skip some junk */
4144 while (PEEK_TOKEN() == HEADEREL)
4148 start_outer_function ();
4152 tree label = parse_optlabel ();
4153 if (PEEK_TOKEN() == MODULE || PEEK_TOKEN() == REGION)
4154 parse_modulion (label);
4155 else if (PEEK_TOKEN() == SPEC)
4156 parse_spec_module (label);
4160 finish_outer_function ();
4167 if (PEEK_TOKEN() != END_PASS_1)
4169 error ("syntax error - expected a module or end of file");
4172 chill_finish_compile ();
4174 exit (FATAL_EXIT_CODE);
4175 switch_to_pass_2 ();
4177 except_init_pass_2 ();
4180 chill_finish_compile ();
4190 * We've had an error. Move the compiler's state back to
4191 * the global binding level. This prevents the loop in
4192 * compile_file in toplev.c from looping forever, since the
4193 * CHILL poplevel() has *no* effect on the value returned by
4194 * global_bindings_p().
4197 to_global_binding_level ()
4199 while (! global_bindings_p ())
4200 current_function_decl = DECL_CONTEXT (current_function_decl);
4206 /* Sets the value of the 'yydebug' variable to VALUE.
4207 This is a function so we don't have to have YYDEBUG defined
4208 in order to build the compiler. */
4216 warning ("YYDEBUG not defined.");