1 /* Parser for GNU CHILL (CCITT High-Level Language) -*- C -*-
2 Copyright (C) 1992, 1993, 1998, 1999 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, 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 * This is a two-pass parser. In pass 1, we collect declarations,
23 * ignoring actions and most expressions. We store only the
24 * declarations and close, open and re-lex the input file to save
25 * main memory. We anticipate that the compiler will be processing
26 * *very* large single programs which are mechanically generated,
27 * and so we want to store a minimum of information between passes.
29 * yylex detects the end of the main input file and returns the
30 * END_PASS_1 token. We then re-initialize each CHILL compiler
31 * module's global variables and re-process the input file. The
32 * grant file is output. If the user has requested it, GNU CHILL
33 * exits at this time - its only purpose was to generate the grant
34 * file. Optionally, the compiler may exit if errors were detected
37 * As each symbol scope is entered, we install its declarations into
38 * the symbol table. Undeclared types and variables are announced
41 * Then code is generated.
54 /* Since parsers are distinct for each language, put the
55 language string definition here. (fnf) */
56 const char * const language_string
= "GNU CHILL";
58 /* Common code to be done before expanding any action. */
59 #define INIT_ACTION { \
60 if (! ignoring) emit_line_note (input_filename, lineno); }
62 /* Pop a scope for an ON handler. */
63 #define POP_USED_ON_CONTEXT pop_handler(1)
65 /* Pop a scope for an ON handler that wasn't there. */
66 #define POP_UNUSED_ON_CONTEXT pop_handler(0)
68 #define PUSH_ACTION push_action()
70 /* Cause the `yydebug' variable to be defined. */
73 extern struct rtx_def
* gen_label_rtx
PROTO((void));
74 extern void emit_jump
PROTO((struct rtx_def
*));
75 extern struct rtx_def
* emit_label
PROTO((struct rtx_def
*));
77 /* This is a hell of a lot easier than getting expr.h included in
79 extern struct rtx_def
*expand_expr
PROTO((tree
, struct rtx_def
*,
80 enum machine_mode
, int));
82 static int parse_action
PROTO((void));
83 static void ch_parse_init
PROTO((void));
84 static void check_end_label
PROTO((tree
, tree
));
85 static void end_function
PROTO((void));
86 static tree build_prefix_clause
PROTO((tree
));
87 static enum terminal PEEK_TOKEN
PROTO((void));
88 static int peek_token_
PROTO((int));
89 static void pushback_token
PROTO((int, tree
));
90 static void forward_token_
PROTO((void));
91 static void require
PROTO((enum terminal
));
92 static int check_token
PROTO((enum terminal
));
93 static int expect
PROTO((enum terminal
, const char *));
94 static void define__PROCNAME__
PROTO((void));
97 extern char *input_filename
;
98 extern tree generic_signal_type_node
;
99 extern tree signal_code
;
100 extern int all_static_flag
;
101 extern int ignore_case
;
104 static int quasi_signal
= 0; /* 1 if processing a quasi signal decl */
107 int parsing_newmode
; /* 0 while parsing SYNMODE;
108 1 while parsing NEWMODE. */
109 int expand_exit_needed
= 0;
111 /* Gets incremented if we see errors such that we don't want to run pass 2. */
113 int serious_errors
= 0;
115 static tree current_fieldlist
;
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. */
120 int ignoring
= 1; /* 1 to ignore expressions */
122 /* True if we have seen an action not in a (user) function. */
124 int build_constructor
= 0;
126 /* The action_nesting_level of the current procedure body. */
127 int proc_action_level
= 0;
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! */
132 static tree label
= NULL_TREE
; /* for statement labels */
135 static tree current_block
;
138 int in_pseudo_module
= 0;
139 int pass
= 0; /* 0 for init_decl_processing,
140 1 for pass 1, 2 for pass 2 */
142 /* re-initialize global variables for pass 2 */
146 expand_exit_needed
= 0;
147 label
= NULL_TREE
; /* for statement labels */
148 current_module
= NULL
;
149 in_pseudo_module
= 0;
153 check_end_label (start
, end
)
156 if (end
!= NULL_TREE
)
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
));
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.
175 get_type_of (id_or_decl
)
178 tree type
= id_or_decl
;
180 if (id_or_decl
== NULL_TREE
181 || TREE_CODE (id_or_decl
) == ERROR_MARK
)
182 return error_mark_node
;
184 if (pass
== 1 || ignoring
== 1)
187 if (TREE_CODE (type
) == IDENTIFIER_NODE
)
189 type
= lookup_name (id_or_decl
);
190 if (type
== NULL_TREE
)
192 error ("`%s' not declared", IDENTIFIER_POINTER (id_or_decl
));
193 type
= error_mark_node
;
196 if (TREE_CODE (type
) == TYPE_DECL
)
197 type
= TREE_TYPE (type
);
198 return type
; /* was a type all along */
205 if (CH_DECL_PROCESS (current_function_decl
))
207 /* finishing a process */
211 build_chill_function_call
212 (lookup_name (get_identifier ("__stop_process")),
214 expand_expr_stmt (result
);
215 emit_line_note (input_filename
, lineno
);
220 /* finishing a procedure.. */
224 && TREE_CODE (TREE_TYPE (TREE_TYPE (current_function_decl
)))
226 warning ("No RETURN or RESULT in procedure");
227 chill_expand_return (NULL_TREE
, 1);
230 finish_chill_function ();
231 pop_chill_function_context ();
235 build_prefix_clause (id
)
240 if (current_module
&& current_module
->name
)
241 { const char *module_name
= IDENTIFIER_POINTER (current_module
->name
);
242 if (module_name
[0] && module_name
[0] != '_')
243 return current_module
->name
;
245 error ("PREFIXED clause with no prelix in unlabeled module");
251 possibly_define_exit_label (label
)
255 define_label (input_filename
, lineno
, munge_exit_label (label
));
258 #define MAX_LOOK_AHEAD 2
259 static enum terminal terminal_buffer
[MAX_LOOK_AHEAD
+1];
261 static YYSTYPE val_buffer
[MAX_LOOK_AHEAD
+1];
263 /*enum terminal current_token, lookahead_token;*/
265 #define TOKEN_NOT_READ dummy_last_terminal
273 if (terminal_buffer
[0] == TOKEN_NOT_READ
)
275 terminal_buffer
[0] = yylex();
276 val_buffer
[0] = yylval
;
278 return terminal_buffer
[0];
280 #define PEEK_TREE() val_buffer[0].ttype
281 #define PEEK_TOKEN1() peek_token_(1)
282 #define PEEK_TOKEN2() peek_token_(2)
287 if (i
> MAX_LOOK_AHEAD
)
288 fatal ("internal error - too much lookahead");
289 if (terminal_buffer
[i
] == TOKEN_NOT_READ
)
291 terminal_buffer
[i
] = yylex();
292 val_buffer
[i
] = yylval
;
294 return terminal_buffer
[i
];
298 pushback_token (code
, node
)
303 if (terminal_buffer
[MAX_LOOK_AHEAD
] != TOKEN_NOT_READ
)
304 fatal ("internal error - cannot pushback token");
305 for (i
= MAX_LOOK_AHEAD
; i
> 0; i
--)
307 terminal_buffer
[i
] = terminal_buffer
[i
- 1];
308 val_buffer
[i
] = val_buffer
[i
- 1];
310 terminal_buffer
[0] = code
;
311 val_buffer
[0].ttype
= node
;
318 for (i
= 0; i
< MAX_LOOK_AHEAD
; i
++)
320 terminal_buffer
[i
] = terminal_buffer
[i
+1];
321 val_buffer
[i
] = val_buffer
[i
+1];
323 terminal_buffer
[MAX_LOOK_AHEAD
] = TOKEN_NOT_READ
;
325 #define FORWARD_TOKEN() forward_token_()
327 /* Skip the next token.
328 if it isn't TOKEN, the parser is broken. */
334 if (PEEK_TOKEN() != token
)
337 sprintf (buf
, "internal parser error - expected token %d", (int)token
);
347 if (PEEK_TOKEN() != token
)
353 /* return 0 if expected token was not found,
357 expect(token
, message
)
361 if (PEEK_TOKEN() != token
)
364 error(message
? message
: "syntax error");
372 /* define a SYNONYM __PROCNAME__ (__procname__) which holds
373 the name of the current procedure.
374 This should be quit the same as __FUNCTION__ in C */
376 define__PROCNAME__ ()
382 if (current_function_decl
== NULL_TREE
)
385 fname
= IDENTIFIER_POINTER (DECL_NAME (current_function_decl
));
387 string
= build_chill_string (strlen (fname
), fname
);
388 procname
= get_identifier (ignore_case
? "__procname__" : "__PROCNAME__");
389 push_syndecl (procname
, NULL_TREE
, string
);
392 /* Forward declarations. */
393 static tree parse_expression
PROTO((void));
394 static tree parse_primval
PROTO((void));
395 static tree parse_mode
PROTO((void));
396 static tree parse_opt_mode
PROTO((void));
397 static tree parse_untyped_expr
PROTO((void));
398 static tree parse_opt_untyped_expr
PROTO((void));
399 static int parse_definition
PROTO((int));
400 static void parse_opt_actions
PROTO((void));
401 static void parse_body
PROTO((void));
402 static tree parse_if_expression_body
PROTO((void));
403 static tree parse_opt_handler
PROTO((void));
404 static tree parse_opt_name_string
PROTO((int));
405 static tree parse_simple_name_string
PROTO((void));
406 static tree parse_name_string
PROTO((void));
407 static tree parse_defining_occurrence
PROTO((void));
408 static tree parse_name
PROTO((void));
409 static tree parse_optlabel
PROTO((void));
410 static void parse_opt_end_label_semi_colon
PROTO((tree
));
411 static void parse_modulion
PROTO((tree
));
412 static void parse_spec_module
PROTO((tree
));
413 static void parse_semi_colon
PROTO((void));
414 static tree parse_defining_occurrence_list
PROTO((void));
415 static void parse_mode_definition
PROTO((int));
416 static void parse_mode_definition_statement
PROTO((int));
417 static void parse_synonym_definition
PROTO((void));
418 static void parse_synonym_definition_statement
PROTO((void));
419 static tree parse_on_exception_list
PROTO((void));
420 static void parse_on_alternatives
PROTO((void));
421 static void parse_loc_declaration
PROTO((int));
422 static void parse_declaration_statement
PROTO((int));
423 static tree parse_optforbid
PROTO((void));
424 static tree parse_postfix
PROTO((enum terminal
));
425 static tree parse_postfix_list
PROTO((enum terminal
));
426 static void parse_rename_clauses
PROTO((enum terminal
));
427 static tree parse_opt_prefix_clause
PROTO((void));
428 static void parse_grant_statement
PROTO((void));
429 static void parse_seize_statement
PROTO((void));
430 static tree parse_param_name_list
PROTO((void));
431 static tree parse_param_attr
PROTO((void));
432 static tree parse_formpar
PROTO((void));
433 static tree parse_formparlist
PROTO((void));
434 static tree parse_opt_result_spec
PROTO((void));
435 static tree parse_opt_except
PROTO((void));
436 static tree parse_opt_recursive
PROTO((void));
437 static tree parse_procedureattr
PROTO((void));
438 static void parse_proc_body
PROTO((tree
, tree
));
439 static void parse_procedure_definition
PROTO((int));
440 static tree parse_processpar
PROTO((void));
441 static tree parse_processparlist
PROTO((void));
442 static void parse_process_definition
PROTO((int));
443 static void parse_signal_definition
PROTO((void));
444 static void parse_signal_definition_statement
PROTO((void));
445 static void parse_then_clause
PROTO((void));
446 static void parse_opt_else_clause
PROTO((void));
447 static tree parse_expr_list
PROTO((void));
448 static tree parse_range_list_clause
PROTO((void));
449 static void pushback_paren_expr
PROTO((tree
));
450 static tree parse_case_label
PROTO((void));
451 static tree parse_case_label_list
PROTO((tree
, int));
452 static tree parse_case_label_specification
PROTO((tree
));
453 static void parse_single_dimension_case_action
PROTO((tree
));
454 static void parse_multi_dimension_case_action
PROTO((tree
));
455 static void parse_case_action
PROTO((tree
));
456 static tree parse_asm_operands
PROTO((void));
457 static tree parse_asm_clobbers
PROTO((void));
458 static void ch_expand_asm_operands
PROTO((tree
, tree
, tree
, tree
, int, char *, int));
459 static void parse_asm_action
PROTO((void));
460 static void parse_begin_end_block
PROTO((tree
));
461 static void parse_if_action
PROTO((tree
));
462 static void parse_iteration
PROTO((void));
463 static tree parse_delay_case_event_list
PROTO((void));
464 static void parse_delay_case_action
PROTO((tree
));
465 static void parse_do_action
PROTO((tree
));
466 static tree parse_receive_spec
PROTO((void));
467 static void parse_receive_case_action
PROTO((tree
));
468 static void parse_send_action
PROTO((void));
469 static void parse_start_action
PROTO((void));
470 static tree parse_call
PROTO((tree
));
471 static tree parse_tuple_fieldname_list
PROTO((void));
472 static tree parse_tuple_element
PROTO((void));
473 static tree parse_opt_element_list
PROTO((void));
474 static tree parse_tuple
PROTO((tree
));
475 static tree parse_operand6
PROTO((void));
476 static tree parse_operand5
PROTO((void));
477 static tree parse_operand4
PROTO((void));
478 static tree parse_operand3
PROTO((void));
479 static tree parse_operand2
PROTO((void));
480 static tree parse_operand1
PROTO((void));
481 static tree parse_operand0
PROTO((void));
482 static tree parse_case_expression
PROTO((void));
483 static tree parse_then_alternative
PROTO((void));
484 static tree parse_else_alternative
PROTO((void));
485 static tree parse_if_expression
PROTO((void));
486 static tree parse_index_mode
PROTO((void));
487 static tree parse_set_mode
PROTO((void));
488 static tree parse_pos
PROTO((void));
489 static tree parse_step
PROTO((void));
490 static tree parse_opt_layout
PROTO((int));
491 static tree parse_field_name_list
PROTO((void));
492 static tree parse_fixed_field
PROTO((void));
493 static tree parse_variant_field_list
PROTO((void));
494 static tree parse_variant_alternative
PROTO((void));
495 static tree parse_field
PROTO((void));
496 static tree parse_structure_mode
PROTO((void));
497 static tree parse_opt_queue_size
PROTO((void));
498 static tree parse_procedure_mode
PROTO((void));
499 static void parse_program
PROTO((void));
500 static void parse_pass_1_2
PROTO((void));
503 parse_opt_name_string (allow_all
)
504 int allow_all
; /* 1 if ALL is allowed as a postfix */
506 enum terminal token
= PEEK_TOKEN();
510 if (token
== ALL
&& allow_all
)
521 token
= PEEK_TOKEN();
525 token
= PEEK_TOKEN();
526 if (token
== ALL
&& allow_all
)
527 return get_identifier3(IDENTIFIER_POINTER (name
), "!", "*");
531 error ("'%s!' is not followed by an identifier",
532 IDENTIFIER_POINTER (name
));
535 name
= get_identifier3(IDENTIFIER_POINTER(name
),
536 "!", IDENTIFIER_POINTER(PEEK_TREE()));
541 parse_simple_name_string ()
543 enum terminal token
= PEEK_TOKEN();
547 error ("expected a name here");
548 return error_mark_node
;
558 tree name
= parse_opt_name_string (0);
562 error ("expected a name string here");
563 return error_mark_node
;
567 parse_defining_occurrence ()
569 if (PEEK_TOKEN () == NAME
)
571 tree id
= PEEK_TREE();
578 /* Matches: <name_string>
579 Returns if pass 1: the identifier.
580 Returns if pass 2: a decl or value for identifier. */
585 tree name
= parse_name_string ();
586 if (pass
== 1 || ignoring
)
590 tree decl
= lookup_name (name
);
591 if (decl
== NULL_TREE
)
593 error ("`%s' undeclared", IDENTIFIER_POINTER (name
));
594 return error_mark_node
;
596 else if (TREE_CODE (TREE_TYPE (decl
)) == ERROR_MARK
)
597 return error_mark_node
;
598 else if (TREE_CODE (decl
) == CONST_DECL
)
599 return DECL_INITIAL (decl
);
600 else if (TREE_CODE (TREE_TYPE (decl
)) == REFERENCE_TYPE
)
601 return convert_from_reference (decl
);
610 tree label
= parse_defining_occurrence();
612 expect(COLON
, "expected a ':' here");
619 enum terminal token
= PEEK_TOKEN ();
623 (token
== END
? pedwarn
: error
) ("expected ';' here");
628 parse_opt_end_label_semi_colon (start_label
)
631 if (PEEK_TOKEN() == NAME
)
633 tree end_label
= parse_name_string ();
634 check_end_label (start_label
, end_label
);
640 parse_modulion (label
)
645 label
= set_module_name (label
);
646 module_name
= push_module (label
, 0);
651 expect(END
, "expected END here");
652 parse_opt_handler ();
653 parse_opt_end_label_semi_colon (label
);
654 find_granted_decls ();
659 parse_spec_module (label
)
662 int save_ignoring
= ignoring
;
664 push_module (set_module_name (label
), 1);
665 ignoring
= pass
== 2;
666 FORWARD_TOKEN(); /* SKIP SPEC */
667 expect (MODULE
, "expected 'MODULE' here");
669 while (parse_definition (1)) { }
671 error ("action not allowed in SPEC MODULE");
672 expect(END
, "expected END here");
673 parse_opt_end_label_semi_colon (label
);
674 find_granted_decls ();
676 ignoring
= save_ignoring
;
679 /* Matches: <name_string> ( "," <name_string> )*
680 Returns either a single IDENTIFIER_NODE,
681 or a chain (TREE_LIST) of IDENTIFIER_NODES.
682 (Since a single identifier is the common case, we avoid wasting space
683 (twice, once for each pass) with extra TREE_LIST nodes in that case.)
684 (Will not return NULL_TREE even if ignoring is true.) */
687 parse_defining_occurrence_list ()
689 tree chain
= NULL_TREE
;
690 tree name
= parse_defining_occurrence ();
691 if (name
== NULL_TREE
)
693 error("missing defining occurrence");
696 if (! check_token (COMMA
))
698 chain
= build_tree_list (NULL_TREE
, name
);
701 name
= parse_defining_occurrence ();
704 error ("bad defining occurrence following ','");
707 chain
= tree_cons (NULL_TREE
, name
, chain
);
708 if (! check_token (COMMA
))
711 return nreverse (chain
);
715 parse_mode_definition (is_newmode
)
719 int save_ignoring
= ignoring
;
720 ignoring
= pass
== 2;
721 names
= parse_defining_occurrence_list ();
722 expect (EQL
, "missing '=' in mode definition");
723 mode
= parse_mode ();
724 if (names
== NULL_TREE
|| TREE_CODE (names
) == TREE_LIST
)
726 for ( ; names
!= NULL_TREE
; names
= TREE_CHAIN (names
))
727 push_modedef (names
, mode
, is_newmode
);
730 push_modedef (names
, mode
, is_newmode
);
731 ignoring
= save_ignoring
;
735 parse_mode_definition_statement (is_newmode
)
738 FORWARD_TOKEN (); /* skip SYNMODE or NEWMODE */
739 parse_mode_definition (is_newmode
);
740 while (PEEK_TOKEN () == COMMA
)
743 parse_mode_definition (is_newmode
);
749 parse_synonym_definition ()
750 { tree expr
= NULL_TREE
;
751 tree names
= parse_defining_occurrence_list ();
752 tree mode
= parse_opt_mode ();
753 if (! expect (EQL
, "missing '=' in synonym definition"))
754 mode
= error_mark_node
;
758 expr
= parse_untyped_expr ();
760 expr
= parse_expression ();
762 if (names
== NULL_TREE
|| TREE_CODE (names
) == TREE_LIST
)
764 for ( ; names
!= NULL_TREE
; names
= TREE_CHAIN (names
))
765 push_syndecl (names
, mode
, expr
);
768 push_syndecl (names
, mode
, expr
);
772 parse_synonym_definition_statement()
774 int save_ignoring
= ignoring
;
775 ignoring
= pass
== 2;
777 parse_synonym_definition ();
778 while (PEEK_TOKEN () == COMMA
)
781 parse_synonym_definition ();
783 ignoring
= save_ignoring
;
787 /* Attempts to match: "(" <exception list> ")" ":".
788 Return NULL_TREE on failure, and non-NULL on success.
789 On success, if pass 1, return a TREE_LIST of IDENTIFIER_NODEs. */
792 parse_on_exception_list ()
795 tree list
= NULL_TREE
;
796 int tok1
= PEEK_TOKEN ();
797 int tok2
= PEEK_TOKEN1 ();
799 /* This requires a lot of look-ahead, because we cannot
800 easily a priori distinguish an exception-list from an expression. */
801 if (tok1
!= LPRN
|| tok2
!= NAME
)
803 if (tok1
== NAME
&& tok2
== COLON
&& pass
== 1)
804 error ("missing '(' in exception list");
808 name
= parse_name_string ();
809 if (PEEK_TOKEN () == RPRN
&& PEEK_TOKEN1 () == COLON
)
811 /* Matched: '(' <name_string> ')' ':' */
812 FORWARD_TOKEN (); FORWARD_TOKEN ();
813 return pass
== 1 ? build_tree_list (NULL_TREE
, name
) : name
;
815 if (PEEK_TOKEN() == COMMA
)
818 list
= build_tree_list (NULL_TREE
, name
);
819 while (check_token (COMMA
))
821 tree old_names
= list
;
822 name
= parse_name_string ();
825 for ( ; old_names
!= NULL_TREE
; old_names
= TREE_CHAIN (old_names
))
827 if (TREE_VALUE (old_names
) == name
)
829 error ("ON exception names must be unique");
830 goto continue_parsing
;
833 list
= tree_cons (NULL_TREE
, name
, list
);
838 if (! check_token (RPRN
) || ! check_token(COLON
))
839 error ("syntax error in exception list");
840 return pass
== 1 ? nreverse (list
) : name
;
842 /* Matched: '(' name_string
843 but it doesn't match the syntax of an exception list.
844 It could be the beginning of an expression, so back up. */
845 pushback_token (NAME
, name
);
846 pushback_token (LPRN
, 0);
851 parse_on_alternatives ()
855 tree except_list
= parse_on_exception_list ();
856 if (except_list
!= NULL
)
857 chill_handle_on_labels (except_list
);
858 else if (parse_action ())
859 expand_exit_needed
= 1;
868 if (! check_token (ON
))
870 POP_UNUSED_ON_CONTEXT
;
873 if (check_token (END
))
875 pedwarn ("empty ON-condition");
876 POP_UNUSED_ON_CONTEXT
;
882 expand_exit_needed
= 0;
884 if (PEEK_TOKEN () != ELSE
)
886 parse_on_alternatives ();
887 if (! ignoring
&& expand_exit_needed
)
888 expand_exit_something ();
890 if (check_token (ELSE
))
892 chill_start_default_handler ();
894 parse_opt_actions ();
897 emit_line_note (input_filename
, lineno
);
898 expand_exit_something ();
901 expect (END
, "missing 'END' after");
905 return integer_zero_node
;
909 parse_loc_declaration (in_spec_module
)
912 tree names
= parse_defining_occurrence_list ();
913 int save_ignoring
= ignoring
;
914 int is_static
, lifetime_bound
;
915 tree mode
, init_value
= NULL_TREE
;
918 ignoring
= pass
== 2;
919 mode
= parse_mode ();
920 ignoring
= save_ignoring
;
921 is_static
= check_token (STATIC
);
922 if (check_token (BASED
))
924 expect(LPRN
, "BASED must be followed by (NAME)");
925 do_based_decls (names
, mode
, parse_name_string ());
926 expect(RPRN
, "BASED must be followed by (NAME)");
929 if (check_token (LOC
))
931 /* loc-identity declaration */
933 mode
= build_chill_reference_type (mode
);
936 lifetime_bound
= check_token (INIT
);
937 if (lifetime_bound
&& loc_decl
)
940 error ("INIT not allowed at loc-identity declaration");
943 if (PEEK_TOKEN () == ASGN
|| PEEK_TOKEN() == EQL
)
945 save_ignoring
= ignoring
;
946 ignoring
= pass
== 1;
947 if (PEEK_TOKEN() == EQL
)
950 error ("'=' used where ':=' is required");
953 if (! lifetime_bound
)
955 init_value
= parse_untyped_expr ();
958 error ("initialization is not allowed in spec module");
959 init_value
= NULL_TREE
;
961 if (! lifetime_bound
)
962 parse_opt_handler ();
963 ignoring
= save_ignoring
;
965 if (init_value
== NULL_TREE
&& loc_decl
&& pass
== 1)
966 error ("loc-identity declaration without initialisation");
967 do_decls (names
, mode
,
968 is_static
|| global_bindings_p ()
969 /* the variable becomes STATIC if all_static_flag is set and
970 current functions doesn't have the RECURSIVE attribute */
971 || (all_static_flag
&& !CH_DECL_RECURSIVE (current_function_decl
)),
972 lifetime_bound
, init_value
, in_spec_module
);
974 /* Free any temporaries we made while initializing the decl. */
979 parse_declaration_statement (in_spec_module
)
982 int save_ignoring
= ignoring
;
983 ignoring
= pass
== 2;
985 parse_loc_declaration (in_spec_module
);
986 while (PEEK_TOKEN () == COMMA
)
989 parse_loc_declaration (in_spec_module
);
991 ignoring
= save_ignoring
;
998 if (check_token (FORBID
) == 0)
1000 if (check_token (ALL
))
1001 return ignoring
? NULL_TREE
: build_int_2 (-1, -1);
1003 if (check_token (LPRN
))
1005 tree list
= parse_forbidlist ();
1006 expect (RPRN
, "missing ')' after FORBID list");
1010 error ("bad syntax following FORBID");
1014 /* Matches: <grant postfix> or <seize postfix>
1015 Returns: A (singleton) TREE_LIST. */
1018 parse_postfix (grant_or_seize
)
1019 enum terminal grant_or_seize
;
1021 tree name
= parse_opt_name_string (1);
1022 tree forbid
= NULL_TREE
;
1023 if (name
== NULL_TREE
)
1025 error ("expected a postfix name here");
1026 name
= error_mark_node
;
1028 if (grant_or_seize
== GRANT
)
1029 forbid
= parse_optforbid ();
1030 return build_tree_list (forbid
, name
);
1034 parse_postfix_list (grant_or_seize
)
1035 enum terminal grant_or_seize
;
1037 tree list
= parse_postfix (grant_or_seize
);
1038 while (check_token (COMMA
))
1039 list
= chainon (list
, parse_postfix (grant_or_seize
));
1044 parse_rename_clauses (grant_or_seize
)
1045 enum terminal grant_or_seize
;
1049 tree rename_old_prefix
, rename_new_prefix
, postfix
;
1051 rename_old_prefix
= parse_opt_name_string (0);
1052 expect (ARROW
, "missing '->' in rename clause");
1053 rename_new_prefix
= parse_opt_name_string (0);
1054 expect (RPRN
, "missing ')' in rename clause");
1055 expect ('!', "missing '!' in rename clause");
1056 postfix
= parse_postfix (grant_or_seize
);
1058 if (grant_or_seize
== GRANT
)
1059 chill_grant (rename_old_prefix
, rename_new_prefix
,
1060 TREE_VALUE (postfix
), TREE_PURPOSE (postfix
));
1062 chill_seize (rename_old_prefix
, rename_new_prefix
,
1063 TREE_VALUE (postfix
));
1065 if (PEEK_TOKEN () != COMMA
)
1068 if (PEEK_TOKEN () != LPRN
)
1070 error ("expected another rename clause");
1077 parse_opt_prefix_clause ()
1079 if (check_token (PREFIXED
) == 0)
1081 return build_prefix_clause (parse_opt_name_string (0));
1085 parse_grant_statement ()
1088 if (PEEK_TOKEN () == LPRN
)
1089 parse_rename_clauses (GRANT
);
1092 tree window
= parse_postfix_list (GRANT
);
1093 tree new_prefix
= parse_opt_prefix_clause ();
1095 for (t
= window
; t
; t
= TREE_CHAIN (t
))
1096 chill_grant (NULL_TREE
, new_prefix
, TREE_VALUE (t
), TREE_PURPOSE (t
));
1101 parse_seize_statement ()
1104 if (PEEK_TOKEN () == LPRN
)
1105 parse_rename_clauses (SEIZE
);
1108 tree seize_window
= parse_postfix_list (SEIZE
);
1109 tree old_prefix
= parse_opt_prefix_clause ();
1111 for (t
= seize_window
; t
; t
= TREE_CHAIN (t
))
1112 chill_seize (old_prefix
, NULL_TREE
, TREE_VALUE (t
));
1116 /* In pass 1, this returns a TREE_LIST, one node for each parameter.
1117 In pass 2, we get a list of PARM_DECLs chained together.
1118 In either case, the list is in reverse order. */
1121 parse_param_name_list ()
1123 tree list
= NULL_TREE
;
1127 tree name
= parse_defining_occurrence ();
1128 if (name
== NULL_TREE
)
1130 error ("syntax error in parameter name list");
1134 new_link
= build_tree_list (NULL_TREE
, name
);
1135 /* else if (current_module->is_spec_module) ; nothing */
1136 else /* pass == 2 */
1138 new_link
= make_node (PARM_DECL
);
1139 DECL_NAME (new_link
) = name
;
1140 DECL_ASSEMBLER_NAME (new_link
) = name
;
1143 TREE_CHAIN (new_link
) = list
;
1145 } while (check_token (COMMA
));
1153 switch (PEEK_TOKEN ())
1155 case PARAMATTR
: /* INOUT is returned here */
1156 attr
= PEEK_TREE ();
1161 return ridpointers
[(int) RID_IN
];
1164 return ridpointers
[(int) RID_LOC
];
1168 return ridpointers
[(int) RID_DYNAMIC
];
1175 /* We wrap CHILL array parameters in a STRUCT. The original parameter
1176 name is unpacked from the struct at get_identifier time */
1178 /* In pass 1, returns list of types; in pass 2: chain of PARM_DECLs. */
1183 tree names
= parse_param_name_list ();
1184 tree mode
= parse_mode ();
1185 tree paramattr
= parse_param_attr ();
1186 return chill_munge_params (nreverse (names
), mode
, paramattr
);
1190 * Note: build_process_header depends upon the *exact*
1191 * representation of STRUCT fields and of formal parameter
1192 * lists. If either is changed, build_process_header will
1193 * also need change. Push_extern_process is affected as well.
1196 parse_formparlist ()
1198 tree list
= NULL_TREE
;
1199 if (PEEK_TOKEN() == RPRN
)
1203 list
= chainon (list
, parse_formpar ());
1204 if (! check_token (COMMA
))
1211 parse_opt_result_spec ()
1214 int is_nonref
, is_loc
, is_dynamic
;
1215 if (!check_token (RETURNS
))
1216 return void_type_node
;
1217 expect (LPRN
, "expected '(' after RETURNS");
1218 mode
= parse_mode ();
1219 is_nonref
= check_token (NONREF
);
1220 is_loc
= check_token (LOC
);
1221 is_dynamic
= check_token (DYNAMIC
);
1222 if (is_nonref
&& !is_loc
)
1223 error ("NONREF specific without LOC in result attribute");
1224 if (is_dynamic
&& !is_loc
)
1225 error ("DYNAMIC specific without LOC in result attribute");
1226 mode
= get_type_of (mode
);
1227 if (is_loc
&& ! ignoring
)
1228 mode
= build_chill_reference_type (mode
);
1229 expect (RPRN
, "expected ')' after RETURNS");
1236 tree list
= NULL_TREE
;
1237 if (!check_token (EXCEPTIONS
))
1239 expect (LPRN
, "expected '(' after EXCEPTIONS");
1242 tree except_name
= parse_name_string ();
1244 for (name
= list
; name
!= NULL_TREE
; name
= TREE_CHAIN (name
))
1245 if (TREE_VALUE (name
) == except_name
&& pass
== 1)
1247 error ("exception names must be unique");
1250 if (name
== NULL_TREE
&& !ignoring
)
1251 list
= tree_cons (NULL_TREE
, except_name
, list
);
1252 } while (check_token (COMMA
));
1253 expect (RPRN
, "expected ')' after EXCEPTIONS");
1258 parse_opt_recursive ()
1260 if (check_token (RECURSIVE
))
1261 return ridpointers
[RID_RECURSIVE
];
1267 parse_procedureattr ()
1271 switch (PEEK_TOKEN ())
1275 generality
= ridpointers
[RID_GENERAL
];
1279 generality
= ridpointers
[RID_SIMPLE
];
1283 generality
= ridpointers
[RID_INLINE
];
1286 generality
= NULL_TREE
;
1288 optrecursive
= parse_opt_recursive ();
1292 generality
= build_tree_list (NULL_TREE
, generality
);
1294 generality
= tree_cons (NULL_TREE
, optrecursive
, generality
);
1298 /* Parse the body and last part of a procedure or process definition. */
1301 parse_proc_body (name
, exceptions
)
1305 int save_proc_action_level
= proc_action_level
;
1306 proc_action_level
= action_nesting_level
;
1307 if (exceptions
!= NULL_TREE
)
1308 /* set up a handler for reraising exceptions */
1311 define__PROCNAME__ ();
1313 proc_action_level
= save_proc_action_level
;
1314 expect (END
, "'END' was expected here");
1315 parse_opt_handler ();
1316 if (exceptions
!= NULL_TREE
)
1317 chill_reraise_exceptions (exceptions
);
1318 parse_opt_end_label_semi_colon (name
);
1323 parse_procedure_definition (in_spec_module
)
1326 int save_ignoring
= ignoring
;
1327 tree name
= parse_defining_occurrence ();
1328 tree params
, result
, exceptlist
, attributes
;
1329 int save_chill_at_module_level
= chill_at_module_level
;
1330 chill_at_module_level
= 0;
1331 if (!in_spec_module
)
1332 ignoring
= pass
== 2;
1333 require (COLON
); require (PROC
);
1334 expect (LPRN
, "missing '(' after PROC");
1335 params
= parse_formparlist ();
1336 expect (RPRN
, "missing ')' in PROC");
1337 result
= parse_opt_result_spec ();
1338 exceptlist
= parse_opt_except ();
1339 attributes
= parse_procedureattr ();
1340 ignoring
= save_ignoring
;
1343 expect (END
, "missing 'END'");
1344 parse_opt_end_label_semi_colon (name
);
1345 push_extern_function (name
, result
, params
, exceptlist
, 0);
1348 push_chill_function_context ();
1349 start_chill_function (name
, result
, params
, exceptlist
, attributes
);
1350 current_module
->procedure_seen
= 1;
1351 parse_proc_body (name
, TYPE_RAISES_EXCEPTIONS (TREE_TYPE (current_function_decl
)));
1352 chill_at_module_level
= save_chill_at_module_level
;
1358 tree names
= parse_defining_occurrence_list ();
1359 tree mode
= parse_mode ();
1360 tree paramattr
= parse_param_attr ();
1362 if (names
&& TREE_CODE (names
) == IDENTIFIER_NODE
)
1363 names
= build_tree_list (NULL_TREE
, names
);
1364 return tree_cons (tree_cons (paramattr
, mode
, NULL_TREE
), names
, NULL_TREE
);
1368 parse_processparlist ()
1370 tree list
= NULL_TREE
;
1371 if (PEEK_TOKEN() == RPRN
)
1375 list
= chainon (list
, parse_processpar ());
1376 if (! check_token (COMMA
))
1383 parse_process_definition (in_spec_module
)
1386 int save_ignoring
= ignoring
;
1387 tree name
= parse_defining_occurrence ();
1390 if (!in_spec_module
)
1392 require (COLON
); require (PROCESS
);
1393 expect (LPRN
, "missing '(' after PROCESS");
1394 params
= parse_processparlist ();
1395 expect (RPRN
, "missing ')' in PROCESS");
1396 ignoring
= save_ignoring
;
1399 expect (END
, "missing 'END'");
1400 parse_opt_end_label_semi_colon (name
);
1401 push_extern_process (name
, params
, NULL_TREE
, 0);
1404 tmp
= build_process_header (name
, params
);
1405 parse_proc_body (name
, NULL_TREE
);
1406 build_process_wrapper (name
, tmp
);
1410 parse_signal_definition ()
1412 tree signame
= parse_defining_occurrence ();
1413 tree modes
= NULL_TREE
;
1414 tree dest
= NULL_TREE
;
1416 if (check_token (EQL
))
1418 expect (LPRN
, "missing '(' after 'SIGNAL <name> ='");
1421 tree mode
= parse_mode ();
1422 modes
= tree_cons (NULL_TREE
, mode
, modes
);
1423 if (! check_token (COMMA
))
1426 expect (RPRN
, "missing ')'");
1427 modes
= nreverse (modes
);
1430 if (check_token (TO
))
1433 int save_ignoring
= ignoring
;
1435 decl
= parse_name ();
1436 ignoring
= save_ignoring
;
1439 if (decl
== NULL_TREE
1440 || TREE_CODE (decl
) == ERROR_MARK
1441 || TREE_CODE (decl
) != FUNCTION_DECL
1442 || !CH_DECL_PROCESS (decl
))
1443 error ("must specify a PROCESS name");
1449 if (! global_bindings_p ())
1450 error ("SIGNAL must be in global reach");
1453 tree struc
= build_signal_struct_type (signame
, modes
, dest
);
1455 generate_tasking_code_variable (signame
,
1457 current_module
->is_spec_module
);
1458 /* remember the code variable in the struct type */
1459 DECL_TASKING_CODE_DECL (struc
) = (struct lang_decl
*)decl
;
1460 CH_DECL_SIGNAL (struc
) = 1;
1461 add_taskstuff_to_list (decl
, "_TT_Signal",
1462 current_module
->is_spec_module
?
1463 NULL_TREE
: signal_code
, struc
, NULL_TREE
);
1469 parse_signal_definition_statement ()
1471 int save_ignoring
= ignoring
;
1472 ignoring
= pass
== 2;
1476 parse_signal_definition ();
1477 if (! check_token (COMMA
))
1479 if (PEEK_TOKEN () == SC
)
1481 error ("syntax error while parsing signal definition statement");
1485 parse_semi_colon ();
1486 ignoring
= save_ignoring
;
1490 parse_definition (in_spec_module
)
1493 switch (PEEK_TOKEN ())
1496 if (PEEK_TOKEN1() == COLON
)
1498 if (PEEK_TOKEN2() == PROC
)
1500 parse_procedure_definition (in_spec_module
);
1503 else if (PEEK_TOKEN2() == PROCESS
)
1505 parse_process_definition (in_spec_module
);
1511 parse_declaration_statement(in_spec_module
);
1514 parse_grant_statement ();
1517 parse_mode_definition_statement(1);
1524 parse_seize_statement ();
1527 parse_signal_definition_statement ();
1530 parse_synonym_definition_statement();
1533 parse_mode_definition_statement(0);
1542 parse_then_clause ()
1544 expect (THEN
, "expected 'THEN' after 'IF'");
1546 emit_line_note (input_filename
, lineno
);
1547 parse_opt_actions ();
1551 parse_opt_else_clause ()
1553 while (check_token (ELSIF
))
1555 tree cond
= parse_expression ();
1557 expand_start_elseif (truthvalue_conversion (cond
));
1558 parse_then_clause ();
1560 if (check_token (ELSE
))
1563 { emit_line_note (input_filename
, lineno
);
1564 expand_start_else ();
1566 parse_opt_actions ();
1570 static tree
parse_expr_list ()
1572 tree expr
= parse_expression ();
1573 tree list
= ignoring
? NULL_TREE
: build_tree_list (NULL_TREE
, expr
);
1574 while (check_token (COMMA
))
1576 expr
= parse_expression ();
1578 list
= tree_cons (NULL_TREE
, expr
, list
);
1584 parse_range_list_clause ()
1586 tree name
= parse_opt_name_string (0);
1587 if (name
== NULL_TREE
)
1589 while (check_token (COMMA
))
1591 name
= parse_name_string ();
1593 if (check_token (SC
))
1595 sorry ("case range list");
1596 return error_mark_node
;
1598 pushback_token (NAME
, name
);
1603 pushback_paren_expr (expr
)
1606 if (pass
== 1 && !ignoring
)
1607 expr
= build1 (PAREN_EXPR
, NULL_TREE
, expr
);
1608 pushback_token (EXPR
, expr
);
1611 /* Matches: <case label> */
1617 if (check_token (ELSE
))
1618 return case_else_node
;
1619 /* Does this also handle the case of a mode name? FIXME */
1620 expr
= parse_expression ();
1621 if (check_token (COLON
))
1623 tree max_expr
= parse_expression ();
1625 expr
= build (RANGE_EXPR
, NULL_TREE
, expr
, max_expr
);
1630 /* Parses: <case_label_list>
1631 Fails if not followed by COMMA or COLON.
1632 If it fails, it backs up if needed, and returns NULL_TREE.
1633 IN_TUPLE is true if we are parsing a tuple element,
1634 and 0 if we are parsing a case label specification. */
1637 parse_case_label_list (selector
, in_tuple
)
1642 if (! check_token (LPRN
))
1644 if (check_token (MUL
))
1646 expect (RPRN
, "missing ')' after '*' case label list");
1648 return integer_zero_node
;
1649 expr
= build (RANGE_EXPR
, NULL_TREE
, NULL_TREE
, NULL_TREE
);
1650 expr
= build_tree_list (NULL_TREE
, expr
);
1653 expr
= parse_case_label ();
1654 if (check_token (RPRN
))
1656 if ((in_tuple
|| PEEK_TOKEN () != COMMA
) && PEEK_TOKEN () != COLON
)
1658 /* Ooops! It looks like it was the start of an action or
1659 unlabelled tuple element, and not a case label, so back up. */
1660 if (expr
!= NULL_TREE
&& TREE_CODE (expr
) == RANGE_EXPR
)
1662 error ("misplaced colon in case label");
1663 expr
= error_mark_node
;
1665 pushback_paren_expr (expr
);
1668 list
= build_tree_list (NULL_TREE
, expr
);
1669 if (expr
== case_else_node
&& selector
!= NULL_TREE
)
1670 ELSE_LABEL_SPECIFIED (selector
) = 1;
1673 list
= build_tree_list (NULL_TREE
, expr
);
1674 if (expr
== case_else_node
&& selector
!= NULL_TREE
)
1675 ELSE_LABEL_SPECIFIED (selector
) = 1;
1677 while (check_token (COMMA
))
1679 expr
= parse_case_label ();
1680 list
= tree_cons (NULL_TREE
, expr
, list
);
1681 if (expr
== case_else_node
&& selector
!= NULL_TREE
)
1682 ELSE_LABEL_SPECIFIED (selector
) = 1;
1684 expect (RPRN
, "missing ')' at end of case label list");
1685 return nreverse (list
);
1688 /* Parses: <case_label_specification>
1689 Must be followed by a COLON.
1690 If it fails, it backs up if needed, and returns NULL_TREE. */
1693 parse_case_label_specification (selectors
)
1696 tree list_list
= NULL_TREE
;
1698 list
= parse_case_label_list (selectors
, 0);
1699 if (list
== NULL_TREE
)
1701 list_list
= build_tree_list (NULL_TREE
, list
);
1702 while (check_token (COMMA
))
1704 if (selectors
!= NULL_TREE
)
1705 selectors
= TREE_CHAIN (selectors
);
1706 list
= parse_case_label_list (selectors
, 0);
1707 if (list
== NULL_TREE
)
1709 error ("unrecognized case label list after ','");
1712 list_list
= tree_cons (NULL_TREE
, list
, list_list
);
1714 return nreverse (list_list
);
1718 parse_single_dimension_case_action (selector
)
1721 int no_completeness_check
= 0;
1723 /* The case label/action toggle. It is 0 initially, and when an action
1724 was last seen. It is 1 integer_zero_node when a label was last seen. */
1725 int caseaction_flag
= 0;
1729 expand_exit_needed
= 0;
1730 selector
= check_case_selector (selector
);
1731 expand_start_case (1, selector
, TREE_TYPE (selector
), "CASE statement");
1737 tree label_spec
= parse_case_label_specification (selector
);
1738 if (label_spec
!= NULL_TREE
)
1740 expect (COLON
, "missing ':' in case alternative");
1743 no_completeness_check
|= chill_handle_single_dimension_case_label (
1744 selector
, label_spec
, &expand_exit_needed
, &caseaction_flag
);
1747 else if (parse_action ())
1749 expand_exit_needed
= 1;
1750 caseaction_flag
= 0;
1758 if (expand_exit_needed
|| caseaction_flag
== 1)
1759 expand_exit_something ();
1761 if (check_token (ELSE
))
1764 chill_handle_case_default ();
1765 parse_opt_actions ();
1768 emit_line_note (input_filename
, lineno
);
1769 expand_exit_something ();
1772 else if (! ignoring
&& TREE_CODE (selector
) != ERROR_MARK
&&
1773 ! no_completeness_check
)
1774 check_missing_cases (TREE_TYPE (selector
));
1776 expect (ESAC
, "missing 'ESAC' after 'CASE'");
1779 expand_end_case (selector
);
1785 parse_multi_dimension_case_action (selector
)
1788 struct rtx_def
*begin_test_label
= 0, *end_case_label
= 0, *new_label
;
1789 tree action_labels
= NULL_TREE
;
1790 tree tests
= NULL_TREE
;
1791 int save_lineno
= lineno
;
1792 char *save_filename
= input_filename
;
1794 /* We can't compute the range of an (ELSE) label until all of the CASE
1795 label specifications have been seen, however, the code for the actions
1796 between them is generated on the fly. We can still generate everything in
1797 one pass is we use the following form:
1799 Compile a CASE of the form
1802 (X11),...,(X1n): A1;
1804 (Xm1),...,(Xmn): Am;
1816 T1 := s1; ...; Tn := Sn;
1817 if (T1 = X11 and ... and Tn = X1n) GOTO L1;
1819 if (T1 = Xm1 and ... and Tn = Xmn) GOTO Lm;
1826 selector
= check_case_selector_list (selector
);
1827 begin_test_label
= gen_label_rtx ();
1828 end_case_label
= gen_label_rtx ();
1829 emit_jump (begin_test_label
);
1834 tree label_spec
= parse_case_label_specification (selector
);
1835 if (label_spec
!= NULL_TREE
)
1837 expect (COLON
, "missing ':' in case alternative");
1840 tests
= tree_cons (label_spec
, NULL_TREE
, tests
);
1842 if (action_labels
!= NULL_TREE
)
1843 emit_jump (end_case_label
);
1845 new_label
= gen_label_rtx ();
1846 emit_label (new_label
);
1847 emit_line_note (input_filename
, lineno
);
1848 action_labels
= tree_cons (NULL_TREE
, NULL_TREE
, action_labels
);
1849 TREE_CST_RTL (action_labels
) = new_label
;
1852 else if (! parse_action ())
1854 if (action_labels
!= NULL_TREE
)
1855 emit_jump (end_case_label
);
1860 if (check_token (ELSE
))
1864 new_label
= gen_label_rtx ();
1865 emit_label (new_label
);
1866 emit_line_note (input_filename
, lineno
);
1867 action_labels
= tree_cons (NULL_TREE
, NULL_TREE
, action_labels
);
1868 TREE_CST_RTL (action_labels
) = new_label
;
1870 parse_opt_actions ();
1872 emit_jump (end_case_label
);
1875 expect (ESAC
, "missing 'ESAC' after 'CASE'");
1879 emit_label (begin_test_label
);
1880 emit_line_note (save_filename
, save_lineno
);
1881 if (tests
!= NULL_TREE
)
1884 tests
= nreverse (tests
);
1885 action_labels
= nreverse (action_labels
);
1886 compute_else_ranges (selector
, tests
);
1888 cond
= build_multi_case_selector_expression (selector
, TREE_PURPOSE (tests
));
1889 expand_start_cond (truthvalue_conversion (cond
), label
? 1 : 0);
1890 emit_jump (TREE_CST_RTL (action_labels
));
1892 for (tests
= TREE_CHAIN (tests
), action_labels
= TREE_CHAIN (action_labels
);
1893 tests
!= NULL_TREE
&& action_labels
!= NULL_TREE
;
1894 tests
= TREE_CHAIN (tests
), action_labels
= TREE_CHAIN (action_labels
))
1897 build_multi_case_selector_expression (selector
, TREE_PURPOSE (tests
));
1898 expand_start_elseif (truthvalue_conversion (cond
));
1899 emit_jump (TREE_CST_RTL (action_labels
));
1901 if (action_labels
!= NULL_TREE
)
1903 expand_start_else ();
1904 emit_jump (TREE_CST_RTL (action_labels
));
1908 emit_label (end_case_label
);
1913 parse_case_action (label
)
1917 int multi_dimension_case
= 0;
1920 selector
= parse_expr_list ();
1921 selector
= nreverse (selector
);
1922 expect (OF
, "missing 'OF' after 'CASE'");
1923 parse_range_list_clause ();
1931 expand_exit_needed
= 0;
1932 if (TREE_CODE (selector
) == TREE_LIST
)
1934 if (TREE_CHAIN (selector
) != NULL_TREE
)
1935 multi_dimension_case
= 1;
1937 selector
= TREE_VALUE (selector
);
1941 /* We want to use the regular CASE support for the single dimension case. The
1942 multi dimension case requires different handling. Note that when "ignoring"
1943 is true we parse using the single dimension code. This is OK since it will
1944 still parse correctly. */
1945 if (multi_dimension_case
)
1946 parse_multi_dimension_case_action (selector
);
1948 parse_single_dimension_case_action (selector
);
1952 possibly_define_exit_label (label
);
1957 /* Matches: [ <asm_operand> { "," <asm_operand> }* ],
1958 where <asm_operand> = STRING '(' <expression> ')'
1959 These are the operands other than the first string and colon
1960 in asm ("addextend %2,%1": "=dm" (x), "0" (y), "g" (*x)) */
1963 parse_asm_operands ()
1965 tree list
= NULL_TREE
;
1966 if (PEEK_TOKEN () != STRING
)
1971 if (PEEK_TOKEN () != STRING
)
1973 error ("bad ASM operand");
1976 string
= PEEK_TREE();
1978 expect (LPRN
, "missing '(' in ASM operand");
1979 expr
= parse_expression ();
1980 expect (RPRN
, "missing ')' in ASM operand");
1981 list
= tree_cons (string
, expr
, list
);
1982 if (! check_token (COMMA
))
1985 return nreverse (list
);
1988 /* Matches: STRING { ',' STRING }* */
1991 parse_asm_clobbers ()
1993 tree list
= NULL_TREE
;
1997 if (PEEK_TOKEN () != STRING
)
1999 error ("bad ASM operand");
2002 string
= PEEK_TREE();
2004 list
= tree_cons (NULL_TREE
, string
, list
);
2005 if (! check_token (COMMA
))
2012 ch_expand_asm_operands (string
, outputs
, inputs
, clobbers
, vol
, filename
, line
)
2013 tree string
, outputs
, inputs
, clobbers
;
2018 int noutputs
= list_length (outputs
);
2020 /* o[I] is the place that output number I should be written. */
2021 register tree
*o
= (tree
*) alloca (noutputs
* sizeof (tree
));
2024 if (TREE_CODE (string
) == ADDR_EXPR
)
2025 string
= TREE_OPERAND (string
, 0);
2026 if (TREE_CODE (string
) != STRING_CST
)
2028 error ("asm template is not a string constant");
2032 /* Record the contents of OUTPUTS before it is modified. */
2033 for (i
= 0, tail
= outputs
; tail
; tail
= TREE_CHAIN (tail
), i
++)
2034 o
[i
] = TREE_VALUE (tail
);
2037 /* Perform default conversions on array and function inputs. */
2038 /* Don't do this for other types--
2039 it would screw up operands expected to be in memory. */
2040 for (i
= 0, tail
= inputs
; tail
; tail
= TREE_CHAIN (tail
), i
++)
2041 if (TREE_CODE (TREE_TYPE (TREE_VALUE (tail
))) == ARRAY_TYPE
2042 || TREE_CODE (TREE_TYPE (TREE_VALUE (tail
))) == FUNCTION_TYPE
)
2043 TREE_VALUE (tail
) = default_conversion (TREE_VALUE (tail
));
2046 /* Generate the ASM_OPERANDS insn;
2047 store into the TREE_VALUEs of OUTPUTS some trees for
2048 where the values were actually stored. */
2049 expand_asm_operands (string
, outputs
, inputs
, clobbers
, vol
, filename
, line
);
2051 /* Copy all the intermediate outputs into the specified outputs. */
2052 for (i
= 0, tail
= outputs
; tail
; tail
= TREE_CHAIN (tail
), i
++)
2054 if (o
[i
] != TREE_VALUE (tail
))
2056 expand_expr (build_chill_modify_expr (o
[i
], TREE_VALUE (tail
)),
2060 /* Detect modification of read-only values.
2061 (Otherwise done by build_modify_expr.) */
2064 tree type
= TREE_TYPE (o
[i
]);
2065 if (TYPE_READONLY (type
)
2066 || ((TREE_CODE (type
) == RECORD_TYPE
2067 || TREE_CODE (type
) == UNION_TYPE
)
2068 && TYPE_FIELDS_READONLY (type
)))
2069 warning ("readonly location modified by 'asm'");
2073 /* Those MODIFY_EXPRs could do autoincrements. */
2081 require (ASM_KEYWORD
);
2082 expect (LPRN
, "missing '('");
2085 emit_line_note (input_filename
, lineno
);
2086 insn
= parse_expression ();
2087 if (check_token (COLON
))
2089 tree output_operand
, input_operand
, clobbered_regs
;
2090 output_operand
= parse_asm_operands ();
2091 if (check_token (COLON
))
2092 input_operand
= parse_asm_operands ();
2094 input_operand
= NULL_TREE
;
2095 if (check_token (COLON
))
2096 clobbered_regs
= parse_asm_clobbers ();
2098 clobbered_regs
= NULL_TREE
;
2099 expect (RPRN
, "missing ')'");
2101 ch_expand_asm_operands (insn
, output_operand
, input_operand
,
2102 clobbered_regs
, FALSE
,
2103 input_filename
, lineno
);
2107 expect (RPRN
, "missing ')'");
2110 else if ((TREE_CODE (insn
) == ADDR_EXPR
2111 && TREE_CODE (TREE_OPERAND (insn
, 0)) == STRING_CST
)
2112 || TREE_CODE (insn
) == STRING_CST
)
2115 error ("argument of `asm' is not a constant string");
2120 parse_begin_end_block (label
)
2123 require (BEGINTOKEN
);
2125 /* don't make a linenote at BEGIN */
2133 expand_start_bindings (label
? 1 : 0);
2137 expect (END
, "missing 'END'");
2138 /* Note that the opthandler comes before the poplevel
2139 - hence a handler is in the scope of the block. */
2140 parse_opt_handler ();
2141 possibly_define_exit_label (label
);
2144 emit_line_note (input_filename
, lineno
);
2145 expand_end_bindings (getdecls (), kept_level_p (), 0);
2147 poplevel (kept_level_p (), 0, 0);
2150 parse_opt_end_label_semi_colon (label
);
2154 parse_if_action (label
)
2160 cond
= parse_expression ();
2165 expand_start_cond (truthvalue_conversion (cond
),
2168 parse_then_clause ();
2169 parse_opt_else_clause ();
2170 expect (FI
, "expected 'FI' after 'IF'");
2173 emit_line_note (input_filename
, lineno
);
2178 possibly_define_exit_label (label
);
2183 /* Matches: <iteration> (as in a <for control>). */
2188 tree loop_counter
= parse_defining_occurrence ();
2189 if (check_token (ASGN
))
2191 tree start_value
= parse_expression ();
2193 = check_token (BY
) ? parse_expression () : NULL_TREE
;
2194 int going_down
= check_token (DOWN
);
2196 if (check_token (TO
))
2197 end_value
= parse_expression ();
2200 error ("expected 'TO' in step enumeration");
2201 end_value
= error_mark_node
;
2204 build_loop_iterator (loop_counter
, start_value
, step_value
,
2205 end_value
, going_down
, 0, 0);
2209 int going_down
= check_token (DOWN
);
2211 if (check_token (IN
))
2212 expr
= parse_expression ();
2215 error ("expected 'IN' in FOR control here");
2216 expr
= error_mark_node
;
2220 tree low_bound
, high_bound
;
2221 if (expr
&& TREE_CODE (expr
) == TYPE_DECL
)
2223 expr
= TREE_TYPE (expr
);
2224 /* FIXME: expr must be an array or powerset */
2225 low_bound
= convert (expr
, TYPE_MIN_VALUE (expr
));
2226 high_bound
= convert (expr
, TYPE_MAX_VALUE (expr
));
2231 high_bound
= NULL_TREE
;
2233 build_loop_iterator (loop_counter
, low_bound
,
2234 NULL_TREE
, high_bound
,
2240 /* Matches: '(' <event list> ')' ':'.
2241 Or; returns NULL_EXPR. */
2244 parse_delay_case_event_list ()
2246 tree event_list
= NULL_TREE
;
2248 if (! check_token (LPRN
))
2250 event
= parse_expression ();
2251 if (PEEK_TOKEN () == ')' && PEEK_TOKEN1 () != ':')
2255 pushback_paren_expr (event
);
2261 event_list
= tree_cons (NULL_TREE
, event
, event_list
);
2262 if (! check_token (COMMA
))
2264 event
= parse_expression ();
2266 expect (RPRN
, "missing ')'");
2267 expect (COLON
, "missing ':'");
2268 return ignoring
? error_mark_node
: event_list
;
2272 parse_delay_case_action (label
)
2275 tree label_cnt
= NULL_TREE
, set_location
, priority
;
2276 tree combined_event_list
= NULL_TREE
;
2281 expand_exit_needed
= 0;
2282 if (check_token (SET
))
2284 set_location
= parse_expression ();
2285 parse_semi_colon ();
2288 set_location
= NULL_TREE
;
2289 if (check_token (PRIORITY
))
2291 priority
= parse_expression ();
2292 parse_semi_colon ();
2295 priority
= NULL_TREE
;
2297 label_cnt
= build_delay_case_start (set_location
, priority
);
2300 tree event_list
= parse_delay_case_event_list ();
2305 int if_or_elseif
= combined_event_list
== NULL_TREE
;
2306 build_delay_case_label (event_list
, if_or_elseif
);
2307 combined_event_list
= chainon (combined_event_list
, event_list
);
2310 else if (parse_action ())
2314 expand_exit_needed
= 1;
2315 if (combined_event_list
== NULL_TREE
)
2316 error ("missing DELAY CASE alternative");
2322 expect (ESAC
, "missing 'ESAC' in DELAY CASE'");
2324 build_delay_case_end (combined_event_list
);
2325 possibly_define_exit_label (label
);
2330 parse_do_action (label
)
2336 if (check_token (WITH
))
2338 tree list
= NULL_TREE
;
2341 tree name
= parse_primval ();
2342 if (! ignoring
&& TREE_CODE (name
) != ERROR_MARK
)
2344 if (TREE_CODE (TREE_TYPE (name
)) == REFERENCE_TYPE
)
2345 name
= convert (TREE_TYPE (TREE_TYPE (name
)), name
);
2348 int is_loc
= chill_location (name
);
2349 if (is_loc
== 1) /* This is probably not possible */
2350 warning ("non-referable location in DO WITH");
2353 name
= build_chill_arrow_expr (name
, 1);
2354 name
= decl_temp1 (get_identifier ("__with_element"),
2358 name
= build_chill_indirect_ref (name
, NULL_TREE
, 0);
2361 if (TREE_CODE (TREE_TYPE (name
)) != RECORD_TYPE
)
2362 error ("WITH element must be of STRUCT mode");
2364 list
= tree_cons (NULL_TREE
, name
, list
);
2366 if (! check_token (COMMA
))
2371 for (list
= nreverse (list
); list
!= NULL_TREE
; list
= TREE_CHAIN (list
))
2372 shadow_record_fields (TREE_VALUE (list
));
2374 parse_semi_colon ();
2375 parse_opt_actions ();
2376 expect (OD
, "missing 'OD' in 'DO WITH'");
2378 emit_line_note (input_filename
, lineno
);
2379 possibly_define_exit_label (label
);
2380 parse_opt_handler ();
2381 parse_opt_end_label_semi_colon (label
);
2385 token
= PEEK_TOKEN();
2386 if (token
!= FOR
&& token
!= WHILE
)
2389 parse_opt_actions ();
2390 expect (OD
, "Missing 'OD' after 'DO'");
2391 parse_opt_handler ();
2392 parse_opt_end_label_semi_colon (label
);
2396 emit_line_note (input_filename
, lineno
);
2398 if (check_token (FOR
))
2400 if (check_token (EVER
))
2403 build_loop_iterator (NULL_TREE
, NULL_TREE
,
2404 NULL_TREE
, NULL_TREE
,
2410 while (check_token (COMMA
))
2415 build_loop_iterator (NULL_TREE
, NULL_TREE
,
2416 NULL_TREE
, NULL_TREE
,
2419 begin_loop_scope ();
2421 build_loop_start (label
);
2422 condition
= check_token (WHILE
) ? parse_expression () : NULL_TREE
;
2424 top_loop_end_check (condition
);
2425 parse_semi_colon ();
2426 parse_opt_actions ();
2429 expect (OD
, "Missing 'OD' after 'DO'");
2430 /* Note that the handler is inside the reach of the DO. */
2431 parse_opt_handler ();
2432 end_loop_scope (label
);
2434 parse_opt_end_label_semi_colon (label
);
2437 /* Matches: '(' <signal name> [ 'IN' <defining occurrence list> ']' ')' ':'
2438 or: '(' <buffer location> IN (defining occurrence> ')' ':'
2439 or: returns NULL_TREE. */
2442 parse_receive_spec ()
2445 tree name_list
= NULL_TREE
;
2446 if (!check_token (LPRN
))
2448 val
= parse_primval ();
2449 if (check_token (IN
))
2452 if (flag_local_loop_counter
)
2453 name_list
= parse_defining_occurrence_list ();
2459 tree loc
= parse_primval ();
2461 name_list
= tree_cons (NULL_TREE
, loc
, name_list
);
2462 if (! check_token (COMMA
))
2467 if (! check_token (RPRN
))
2469 error ("missing ')' in signal/buffer receive alternative");
2472 if (check_token (COLON
))
2474 if (ignoring
|| val
== NULL_TREE
|| TREE_CODE (val
) == ERROR_MARK
)
2475 return error_mark_node
;
2477 return build_receive_case_label (val
, name_list
);
2480 /* We saw: '(' <primitive value> ')' not followed by ':'.
2481 Presumably the start of an action. Backup and fail. */
2482 if (name_list
!= NULL_TREE
)
2483 error ("misplaced 'IN' in signal/buffer receive alternative");
2484 pushback_paren_expr (val
);
2488 /* To understand the code generation for this, see ch-tasking.c,
2489 and the 2-page comments preceding the
2490 build_chill_receive_case_start () definition. */
2493 parse_receive_case_action (label
)
2496 tree instance_location
;
2497 tree have_else_actions
;
2499 tree alt_list
= NULL_TREE
;
2506 expand_exit_needed
= 0;
2509 if (check_token (SET
))
2511 instance_location
= parse_expression ();
2512 parse_semi_colon ();
2515 instance_location
= NULL_TREE
;
2517 instance_location
= build_receive_case_start (instance_location
);
2521 tree receive_spec
= parse_receive_spec ();
2525 alt_list
= tree_cons (NULL_TREE
, receive_spec
, alt_list
);
2528 else if (parse_action ())
2530 if (! spec_seen
&& pass
== 1)
2531 error ("missing RECEIVE alternative");
2533 expand_exit_needed
= 1;
2539 if (check_token (ELSE
))
2543 emit_line_note (input_filename
, lineno
);
2544 if (build_receive_case_if_generated ())
2545 expand_start_else ();
2547 parse_opt_actions ();
2548 have_else_actions
= integer_one_node
;
2551 have_else_actions
= integer_zero_node
;
2552 expect (ESAC
, "missing 'ESAC' matching 'RECEIVE CASE'");
2555 build_receive_case_end (nreverse (alt_list
), have_else_actions
);
2557 possibly_define_exit_label (label
);
2562 parse_send_action ()
2564 tree signal
= NULL_TREE
;
2565 tree buffer
= NULL_TREE
;
2567 tree with_expr
, to_expr
, priority
;
2569 /* The tricky part is distinguishing between a SEND buffer action,
2570 and a SEND signal action. */
2571 if (pass
!= 2 || PEEK_TOKEN () != NAME
)
2573 /* If this is pass 2, it's a SEND buffer action.
2574 If it's pass 1, we don't care. */
2575 buffer
= parse_primval ();
2579 /* We have to specifically check for signalname followed by
2580 a '(', since we allow a signalname to be used (syntactically)
2582 tree name
= parse_name ();
2583 if (TREE_CODE (name
) == TYPE_DECL
&& CH_DECL_SIGNAL (name
))
2584 signal
= name
; /* It's a SEND signal action! */
2587 /* It's not a legal SEND signal action.
2588 Back up and try as a SEND buffer action. */
2589 pushback_token (EXPR
, name
);
2590 buffer
= parse_primval ();
2593 if (check_token (LPRN
))
2595 value_list
= NULL_TREE
;
2598 tree expr
= parse_untyped_expr ();
2600 value_list
= tree_cons (NULL_TREE
, expr
, value_list
);
2601 if (! check_token (COMMA
))
2604 value_list
= nreverse (value_list
);
2605 expect (RPRN
, "missing ')'");
2608 value_list
= NULL_TREE
;
2609 if (check_token (WITH
))
2610 with_expr
= parse_expression ();
2612 with_expr
= NULL_TREE
;
2613 if (check_token (TO
))
2614 to_expr
= parse_expression ();
2616 to_expr
= NULL_TREE
;
2617 if (check_token (PRIORITY
))
2618 priority
= parse_expression ();
2620 priority
= NULL_TREE
;
2626 { /* It's a <send signal action>! */
2627 tree sigdesc
= build_signal_descriptor (signal
, value_list
);
2628 if (sigdesc
!= NULL_TREE
&& TREE_CODE (sigdesc
) != ERROR_MARK
)
2630 tree sendto
= to_expr
? to_expr
: IDENTIFIER_SIGNAL_DEST (signal
);
2631 expand_send_signal (sigdesc
, with_expr
,
2632 sendto
, priority
, DECL_NAME (signal
));
2637 /* all checks are done in expand_send_buffer */
2638 expand_send_buffer (buffer
, value_list
, priority
, with_expr
, to_expr
);
2643 parse_start_action ()
2645 tree name
, copy_number
, param_list
, startset
;
2647 name
= parse_name_string ();
2648 expect (LPRN
, "missing '(' in START action");
2650 /* copy number is a required parameter */
2651 copy_number
= parse_expression ();
2653 && (copy_number
== NULL_TREE
2654 || TREE_CODE (copy_number
) == ERROR_MARK
2655 || TREE_CODE (TREE_TYPE (copy_number
)) != INTEGER_TYPE
))
2657 error ("PROCESS copy number must be integer");
2658 copy_number
= integer_zero_node
;
2660 if (check_token (COMMA
))
2661 param_list
= parse_expr_list (); /* user parameters */
2663 param_list
= NULL_TREE
;
2664 expect (RPRN
, "missing ')'");
2665 startset
= check_token (SET
) ? parse_primval () : NULL
;
2666 build_start_process (name
, copy_number
, param_list
, startset
);
2670 parse_opt_actions ()
2672 while (parse_action ()) ;
2678 tree label
= NULL_TREE
;
2679 tree expr
, rhs
, loclist
;
2682 if (current_function_decl
== global_function_decl
2683 && PEEK_TOKEN () != SC
2684 && PEEK_TOKEN () != END
)
2685 seen_action
= 1, build_constructor
= 1;
2687 if (PEEK_TOKEN () == NAME
&& PEEK_TOKEN1 () == COLON
)
2689 label
= parse_defining_occurrence ();
2692 define_label (input_filename
, lineno
, label
);
2695 switch (PEEK_TOKEN ())
2701 expr
= parse_primval ();
2702 delay
= check_token (DELAY
);
2703 expect (IN
, "missing 'IN'");
2706 build_after_start (expr
, delay
);
2707 parse_opt_actions ();
2708 expect (TIMEOUT
, "missing 'TIMEOUT'");
2709 build_after_timeout_start ();
2710 parse_opt_actions ();
2711 expect (END
, "missing 'END'");
2713 possibly_define_exit_label (label
);
2716 goto bracketed_action
;
2718 parse_asm_action ();
2719 goto no_handler_action
;
2723 expr
= parse_expression ();
2725 { tree assertfail
= ridpointers
[(int) RID_ASSERTFAIL
];
2726 expr
= build (TRUTH_ORIF_EXPR
, void_type_node
, expr
,
2727 build_cause_exception (assertfail
, 0));
2728 expand_expr_stmt (fold (expr
));
2730 goto handler_action
;
2734 expr
= parse_primval ();
2735 expect (IN
, "missing 'IN'");
2738 build_at_action (expr
);
2739 parse_opt_actions ();
2740 expect (TIMEOUT
, "missing 'TIMEOUT'");
2742 expand_start_else ();
2743 parse_opt_actions ();
2744 expect (END
, "missing 'END'");
2747 possibly_define_exit_label (label
);
2749 goto bracketed_action
;
2751 parse_begin_end_block (label
);
2754 parse_case_action (label
);
2755 goto bracketed_action
;
2758 expr
= parse_name_string ();
2760 if (! ignoring
&& TREE_CODE (expr
) != ERROR_MARK
)
2761 expand_cause_exception (expr
);
2762 goto no_handler_action
;
2765 expr
= parse_expression ();
2768 expand_continue_event (expr
);
2769 goto handler_action
;
2773 expr
= parse_primval ();
2774 expect (IN
, "missing 'IN' after 'CYCLE'");
2776 /* We a tree list where TREE_VALUE is the label
2777 and TREE_PURPOSE is the variable denotes the timeout id. */
2778 expr
= build_cycle_start (expr
);
2779 parse_opt_actions ();
2780 expect (END
, "missing 'END'");
2782 build_cycle_end (expr
);
2783 possibly_define_exit_label (label
);
2785 goto bracketed_action
;
2787 if (PEEK_TOKEN1 () == CASE
)
2789 parse_delay_case_action (label
);
2790 goto bracketed_action
;
2794 expr
= parse_primval ();
2795 rhs
= check_token (PRIORITY
) ? parse_expression () : NULL_TREE
;
2797 build_delay_action (expr
, rhs
);
2798 goto handler_action
;
2800 parse_do_action (label
);
2804 expr
= parse_name_string ();
2806 lookup_and_handle_exit (expr
);
2807 goto no_handler_action
;
2810 expr
= parse_name_string ();
2812 lookup_and_expand_goto (expr
);
2813 goto no_handler_action
;
2815 parse_if_action (label
);
2816 goto bracketed_action
;
2818 if (PEEK_TOKEN1 () != CASE
)
2820 parse_receive_case_action (label
);
2821 goto bracketed_action
;
2825 expr
= parse_untyped_expr ();
2827 chill_expand_result (expr
, 1);
2828 goto handler_action
;
2832 expr
= parse_opt_untyped_expr ();
2835 /* Do this as RESULT expr and RETURN to get exceptions */
2836 chill_expand_result (expr
, 0);
2837 expand_goto_except_cleanup (proc_action_level
);
2838 chill_expand_return (NULL_TREE
, 0);
2841 goto handler_action
;
2843 goto no_handler_action
;
2848 parse_send_action ();
2849 goto handler_action
;
2851 parse_start_action ();
2852 goto handler_action
;
2857 { tree func
= lookup_name (get_identifier ("__stop_process"));
2858 tree result
= build_chill_function_call (func
, NULL_TREE
);
2859 expand_expr_stmt (result
);
2861 goto no_handler_action
;
2864 /* Fall through to here ... */
2868 /* This handles calls and assignments. */
2870 expr
= parse_primval ();
2871 switch (PEEK_TOKEN ())
2874 parse_semi_colon (); /* Emits error message. */
2877 if (!ignoring
&& TREE_CODE (expr
) != ERROR_MARK
)
2879 if (TREE_CODE (expr
) != CALL_EXPR
2880 && TREE_TYPE (expr
) != void_type_node
2881 && ! TREE_SIDE_EFFECTS (expr
))
2883 if (TREE_CODE (expr
) == FUNCTION_DECL
)
2884 error ("missing parenthesis for procedure call");
2886 error ("expression is not an action");
2887 expr
= error_mark_node
;
2890 expand_expr_stmt (expr
);
2892 goto handler_action
;
2895 = ignoring
? NULL_TREE
: build_tree_list (NULL_TREE
, expr
);
2896 while (PEEK_TOKEN () == COMMA
)
2899 expr
= parse_primval ();
2900 if (!ignoring
&& TREE_CODE (expr
) != ERROR_MARK
)
2901 loclist
= tree_cons (NULL_TREE
, expr
, loclist
);
2904 switch (PEEK_TOKEN ())
2906 case OR
: op
= BIT_IOR_EXPR
; break;
2907 case XOR
: op
= BIT_XOR_EXPR
; break;
2908 case ORIF
: op
= TRUTH_ORIF_EXPR
; break;
2909 case AND
: op
= BIT_AND_EXPR
; break;
2910 case ANDIF
: op
= TRUTH_ANDIF_EXPR
; break;
2911 case PLUS
: op
= PLUS_EXPR
; break;
2912 case SUB
: op
= MINUS_EXPR
; break;
2913 case CONCAT
: op
= CONCAT_EXPR
; break;
2914 case MUL
: op
= MULT_EXPR
; break;
2915 case DIV
: op
= TRUNC_DIV_EXPR
; break;
2916 case MOD
: op
= FLOOR_MOD_EXPR
; break;
2917 case REM
: op
= TRUNC_MOD_EXPR
; break;
2920 error ("syntax error in action");
2922 case ASGN
: op
= NOP_EXPR
; break;
2926 /* Looks like it was an assignment action. */
2929 expect (ASGN
, "expected ':=' here");
2930 rhs
= parse_untyped_expr ();
2932 expand_assignment_action (loclist
, op
, rhs
);
2933 goto handler_action
;
2940 /* We've parsed a bracketed action. */
2941 parse_opt_handler ();
2942 parse_opt_end_label_semi_colon (label
);
2946 if (parse_opt_handler () != NULL_TREE
&& pass
== 1)
2947 error ("no handler is permitted on this action.");
2948 parse_semi_colon ();
2952 parse_opt_handler ();
2953 parse_semi_colon ();
2961 while (parse_definition (0)) ;
2963 while (parse_action ()) ;
2965 if (parse_definition (0))
2968 pedwarn ("definition follows action");
2974 parse_opt_untyped_expr ()
2976 switch (PEEK_TOKEN ())
2986 return parse_untyped_expr ();
2991 parse_call (function
)
2994 tree arg1
, arg2
, arg_list
= NULL_TREE
;
2997 arg1
= parse_opt_untyped_expr ();
2998 if (arg1
!= NULL_TREE
)
3000 tok
= PEEK_TOKEN ();
3001 if (tok
== UP
|| tok
== COLON
)
3005 /* check that arg1 isn't untyped (or mode);*/
3007 arg2
= parse_expression ();
3008 expect (RPRN
, "expected ')' to terminate slice");
3010 return integer_zero_node
;
3012 return build_chill_slice_with_length (function
, arg1
, arg2
);
3014 return build_chill_slice_with_range (function
, arg1
, arg2
);
3017 arg_list
= build_tree_list (NULL_TREE
, arg1
);
3018 while (check_token (COMMA
))
3020 arg2
= parse_untyped_expr ();
3022 arg_list
= tree_cons (NULL_TREE
, arg2
, arg_list
);
3026 expect (RPRN
, "expected ')' here");
3027 return ignoring
? function
3028 : build_generalized_call (function
, nreverse (arg_list
));
3031 /* Matches: <field name list>
3032 Returns: A list of IDENTIFIER_NODEs (or NULL_TREE if ignoring),
3033 in reverse order. */
3036 parse_tuple_fieldname_list ()
3038 tree list
= NULL_TREE
;
3042 if (!check_token (DOT
))
3044 error ("bad tuple field name list");
3047 name
= parse_simple_name_string ();
3048 list
= ignoring
? NULL_TREE
: tree_cons (NULL_TREE
, name
, list
);
3049 } while (check_token (COMMA
));
3053 /* Returns one or nore TREE_LIST nodes, in reverse order. */
3056 parse_tuple_element ()
3058 /* The tupleelement chain is built in reverse order,
3059 and put in forward order when the list is used. */
3061 if (PEEK_TOKEN () == DOT
)
3063 /* Parse a labelled structure tuple. */
3064 tree list
= parse_tuple_fieldname_list (), field
;
3065 expect (COLON
, "missing ':' in tuple");
3066 value
= parse_untyped_expr ();
3069 /* FIXME: Should use save_expr(value), but that
3070 confuses nested calls to digest_init! */
3071 /* Re-use the list of field names as a list of name-value pairs. */
3072 for (field
= list
; field
!= NULL_TREE
; field
= TREE_CHAIN (field
))
3073 { tree field_name
= TREE_VALUE (field
);
3074 TREE_PURPOSE (field
) = field_name
;
3075 TREE_VALUE (field
) = value
;
3076 TUPLE_NAMED_FIELD (field
) = 1;
3081 label
= parse_case_label_list (NULL_TREE
, 1);
3084 expect (COLON
, "missing ':' in tuple");
3085 value
= parse_untyped_expr ();
3086 if (ignoring
|| label
== NULL_TREE
)
3088 if (TREE_CODE (label
) != TREE_LIST
)
3090 error ("invalid syntax for label in tuple");
3095 /* FIXME: Should use save_expr(value), but that
3096 confuses nested calls to digest_init! */
3098 for (; link
!= NULL_TREE
; link
= TREE_CHAIN (link
))
3099 { tree index
= TREE_VALUE (link
);
3100 if (pass
== 1 && TREE_CODE (index
) != TREE_LIST
)
3101 index
= build1 (PAREN_EXPR
, NULL_TREE
, index
);
3102 TREE_VALUE (link
) = value
;
3103 TREE_PURPOSE (link
) = index
;
3105 return nreverse (label
);
3109 value
= parse_untyped_expr ();
3110 if (check_token (COLON
))
3112 /* A powerset range [or possibly a labeled Array?] */
3113 tree value2
= parse_untyped_expr ();
3114 return ignoring
? NULL_TREE
: build_tree_list (value
, value2
);
3116 return ignoring
? NULL_TREE
: build_tree_list (NULL_TREE
, value
);
3119 /* Matches: a COMMA-separated list of tuple elements.
3120 Returns a list (of TREE_LIST nodes). */
3122 parse_opt_element_list ()
3124 tree list
= NULL_TREE
;
3125 if (PEEK_TOKEN () == RPC
)
3129 tree element
= parse_tuple_element ();
3130 list
= chainon (element
, list
); /* Built in reverse order */
3131 if (PEEK_TOKEN () == RPC
)
3133 if (!check_token (COMMA
))
3135 error ("bad syntax in tuple");
3139 return nreverse (list
);
3142 /* Parses: '[' elements ']'
3143 If modename is non-NULL it prefixed the tuple. */
3146 parse_tuple (modename
)
3151 list
= parse_opt_element_list ();
3152 expect (RPC
, "missing ']' after tuple");
3154 return integer_zero_node
;
3155 list
= build_nt (CONSTRUCTOR
, NULL_TREE
, list
);
3156 if (modename
== NULL_TREE
)
3159 TREE_TYPE (list
) = modename
;
3160 else if (TREE_CODE (modename
) != TYPE_DECL
)
3162 error ("non-mode name before tuple");
3163 return error_mark_node
;
3166 list
= chill_expand_tuple (TREE_TYPE (modename
), list
);
3174 switch (PEEK_TOKEN ())
3187 val
= build_chill_function_call (PEEK_TREE (), NULL_TREE
);
3192 val
= parse_expression ();
3193 expect (RPRN
, "missing right parenthesis");
3194 if (pass
== 1 && ! ignoring
)
3195 val
= build1 (PAREN_EXPR
, NULL_TREE
, val
);
3198 val
= parse_tuple (NULL_TREE
);
3201 val
= parse_name ();
3202 if (PEEK_TOKEN() == LPC
)
3203 val
= parse_tuple (val
); /* Matched: <mode_name> <tuple> */
3207 error ("invalid expression/location syntax");
3208 val
= error_mark_node
;
3213 switch (PEEK_TOKEN ())
3217 name
= parse_simple_name_string ();
3218 val
= ignoring
? val
: build_chill_component_ref (val
, name
);
3222 name
= parse_opt_name_string (0);
3223 val
= ignoring
? val
: build_chill_indirect_ref (val
, name
, 1);
3226 /* The SEND buffer action syntax is ambiguous, at least when
3227 parsed left-to-right. In the example 'SEND foo(v) ...' the
3228 phrase 'foo(v)' could be a buffer location procedure call
3229 (which then must be followed by the value to send).
3230 On the other hand, if 'foo' is a buffer, stop parsing
3231 after 'foo', and let parse_send_action pick up '(v) as
3234 We handle the ambiguity for SEND signal action differently,
3235 since we allow (as an extension) a signal to be used as
3236 a "function" (see build_generalized_call). */
3237 if (TREE_TYPE (val
) != NULL_TREE
3238 && CH_IS_BUFFER_MODE (TREE_TYPE (val
)))
3240 val
= parse_call (val
);
3246 /* Handle string repetition. (See comment in parse_operand5.) */
3247 args
= parse_primval ();
3248 val
= ignoring
? val
: build_generalized_call (val
, args
);
3261 if (check_token (RECEIVE
))
3263 tree location ATTRIBUTE_UNUSED
= parse_primval ();
3264 sorry ("RECEIVE expression");
3265 return integer_one_node
;
3267 else if (check_token (ARROW
))
3269 tree location
= parse_primval ();
3270 return ignoring
? location
: build_chill_arrow_expr (location
, 0);
3273 return parse_primval();
3280 /* We are supposed to be looking for a <string repetition operator>,
3281 but in general we can't distinguish that from a parenthesized
3282 expression. This is especially difficult if we allow the
3283 string operand to be a constant expression (as requested by
3284 some users), and not just a string literal.
3285 Consider: LPRN expr RPRN LPRN expr RPRN
3286 Is that a function call or string repetition?
3287 Instead, we handle string repetition in parse_primval,
3288 and build_generalized_call. */
3290 switch (PEEK_TOKEN())
3292 case NOT
: op
= BIT_NOT_EXPR
; break;
3293 case SUB
: op
= NEGATE_EXPR
; break;
3299 rarg
= parse_operand6();
3300 return (op
== NOP_EXPR
|| ignoring
) ? rarg
3301 : build_chill_unary_op (op
, rarg
);
3307 tree larg
= parse_operand5(), rarg
;
3311 switch (PEEK_TOKEN())
3313 case MUL
: op
= MULT_EXPR
; break;
3314 case DIV
: op
= TRUNC_DIV_EXPR
; break;
3315 case MOD
: op
= FLOOR_MOD_EXPR
; break;
3316 case REM
: op
= TRUNC_MOD_EXPR
; break;
3321 rarg
= parse_operand5();
3323 larg
= build_chill_binary_op (op
, larg
, rarg
);
3330 tree larg
= parse_operand4 (), rarg
;
3334 switch (PEEK_TOKEN())
3336 case PLUS
: op
= PLUS_EXPR
; break;
3337 case SUB
: op
= MINUS_EXPR
; break;
3338 case CONCAT
: op
= CONCAT_EXPR
; break;
3343 rarg
= parse_operand4();
3345 larg
= build_chill_binary_op (op
, larg
, rarg
);
3352 tree larg
= parse_operand3 (), rarg
;
3356 if (check_token (IN
))
3358 rarg
= parse_operand3();
3360 larg
= build_chill_binary_op (SET_IN_EXPR
, larg
, rarg
);
3364 switch (PEEK_TOKEN())
3366 case GT
: op
= GT_EXPR
; break;
3367 case GTE
: op
= GE_EXPR
; break;
3368 case LT
: op
= LT_EXPR
; break;
3369 case LTE
: op
= LE_EXPR
; break;
3370 case EQL
: op
= EQ_EXPR
; break;
3371 case NE
: op
= NE_EXPR
; break;
3376 rarg
= parse_operand3();
3378 larg
= build_compare_expr (op
, larg
, rarg
);
3386 tree larg
= parse_operand2 (), rarg
;
3390 switch (PEEK_TOKEN())
3392 case AND
: op
= BIT_AND_EXPR
; break;
3393 case ANDIF
: op
= TRUTH_ANDIF_EXPR
; break;
3398 rarg
= parse_operand2();
3400 larg
= build_chill_binary_op (op
, larg
, rarg
);
3407 tree larg
= parse_operand1(), rarg
;
3411 switch (PEEK_TOKEN())
3413 case OR
: op
= BIT_IOR_EXPR
; break;
3414 case XOR
: op
= BIT_XOR_EXPR
; break;
3415 case ORIF
: op
= TRUTH_ORIF_EXPR
; break;
3420 rarg
= parse_operand1();
3422 larg
= build_chill_binary_op (op
, larg
, rarg
);
3429 return parse_operand0 ();
3433 parse_case_expression ()
3438 tree case_alt_list
= NULL_TREE
;
3441 selector_list
= parse_expr_list ();
3442 selector_list
= nreverse (selector_list
);
3444 expect (OF
, "missing 'OF'");
3445 while (PEEK_TOKEN () == LPRN
)
3447 tree label_spec
= parse_case_label_specification (selector_list
);
3449 expect (COLON
, "missing ':' in value case alternative");
3450 sub_expr
= parse_expression ();
3451 expect (SC
, "missing ';'");
3453 case_alt_list
= tree_cons (label_spec
, sub_expr
, case_alt_list
);
3455 if (check_token (ELSE
))
3457 else_expr
= parse_expression ();
3458 if (check_token (SC
) && pass
== 1)
3459 warning("there should not be a ';' here");
3462 else_expr
= NULL_TREE
;
3463 expect (ESAC
, "missing 'ESAC' in 'CASE' expression");
3466 return integer_zero_node
;
3468 /* If this is a multi dimension case, then transform it into an COND_EXPR
3469 here. This must be done before store_expr is called since it has some
3470 special handling for COND_EXPR expressions. */
3471 if (TREE_CHAIN (selector_list
) != NULL_TREE
)
3473 case_alt_list
= nreverse (case_alt_list
);
3474 compute_else_ranges (selector_list
, case_alt_list
);
3476 build_chill_multi_dimension_case_expr (selector_list
, case_alt_list
, else_expr
);
3479 case_expr
= build_chill_case_expr (selector_list
, case_alt_list
, else_expr
);
3485 parse_then_alternative ()
3487 expect (THEN
, "missing 'THEN' in 'IF' expression");
3488 return parse_expression ();
3492 parse_else_alternative ()
3494 if (check_token (ELSIF
))
3495 return parse_if_expression_body ();
3496 else if (check_token (ELSE
))
3497 return parse_expression ();
3498 error ("missing ELSE/ELSIF in IF expression");
3499 return error_mark_node
;
3502 /* Matches: <boolean expression> <then alternative> <else alternative> */
3505 parse_if_expression_body ()
3507 tree bool_expr
, then_expr
, else_expr
;
3508 bool_expr
= parse_expression ();
3509 then_expr
= parse_then_alternative ();
3510 else_expr
= parse_else_alternative ();
3512 return integer_zero_node
;
3514 return build_nt (COND_EXPR
, bool_expr
, then_expr
, else_expr
);
3518 parse_if_expression ()
3522 expr
= parse_if_expression_body ();
3523 expect (FI
, "missing 'FI' at end of conditional expression");
3527 /* An <untyped_expr> is a superset of <expr>. It also includes
3528 <conditional expressions> and untyped <tuples>, whose types
3529 are not given by their constituents. Hence, these are only
3530 allowed in certain contexts that expect a certain type.
3531 You should call convert() to fix up the <untyped_expr>. */
3534 parse_untyped_expr ()
3537 switch (PEEK_TOKEN())
3540 return parse_if_expression ();
3542 return parse_case_expression ();
3544 switch (PEEK_TOKEN1())
3549 pedwarn ("conditional expression not allowed inside parentheses");
3553 pedwarn ("mode-less tuple not allowed inside parentheses");
3556 val
= parse_untyped_expr ();
3557 expect (RPRN
, "missing ')'");
3563 return parse_operand0 ();
3567 /* Matches: <index mode> */
3572 /* This is another one that is nasty to parse!
3573 Let's feel our way ahead ... */
3575 if (PEEK_TOKEN () == NAME
)
3577 tree name
= parse_name ();
3578 switch (PEEK_TOKEN ())
3582 case SC
: /* An error */
3583 /* This can only (legally) be a discrete mode name. */
3586 /* This could be named discrete range,
3587 a cast, or some other expression (maybe). */
3589 lower
= parse_expression ();
3590 if (check_token (COLON
))
3592 upper
= parse_expression ();
3593 expect (RPRN
, "missing ')'");
3594 /* Matched: <mode_name> '(' <expr> ':' <expr> ')' */
3598 return build_chill_range_type (name
, lower
, upper
);
3600 /* Looks like a cast or procedure call or something.
3601 Backup, and try again. */
3602 pushback_token (EXPR
, lower
);
3603 pushback_token (LPRN
, NULL_TREE
);
3604 lower
= parse_call (name
);
3605 goto parse_literal_range_colon
;
3607 /* This has to be the start of an expression. */
3608 pushback_token (EXPR
, name
);
3609 goto parse_literal_range
;
3612 /* It's not a name. But it could still be a discrete mode. */
3613 lower
= parse_opt_mode ();
3616 parse_literal_range
:
3617 /* Nope, it's a discrete literal range. */
3618 lower
= parse_expression ();
3619 parse_literal_range_colon
:
3620 expect (COLON
, "expected ':' here");
3622 upper
= parse_expression ();
3623 return ignoring
? NULL_TREE
3624 : build_chill_range_type (NULL_TREE
, lower
, upper
);
3630 int set_name_cnt
= 0; /* count of named set elements */
3631 int set_is_numbered
= 0; /* TRUE if set elements have explicit values */
3632 int set_is_not_numbered
= 0;
3633 tree list
= NULL_TREE
;
3634 tree mode
= ignoring
? void_type_node
: start_enum (NULL_TREE
);
3636 expect (LPRN
, "missing left parenthesis after SET");
3639 tree name
, value
= NULL_TREE
;
3640 if (check_token (MUL
))
3644 name
= parse_defining_occurrence ();
3645 if (check_token (EQL
))
3647 value
= parse_expression ();
3648 set_is_numbered
= 1;
3651 set_is_not_numbered
= 1;
3654 name
= build_enumerator (name
, value
);
3656 list
= chainon (name
, list
);
3657 if (! check_token (COMMA
))
3660 expect (RPRN
, "missing right parenthesis after SET");
3663 if (set_is_numbered
&& set_is_not_numbered
)
3664 /* Z.200 doesn't allow mixed numbered and unnumbered set elements,
3665 but we can do it. Print a warning */
3666 pedwarn ("mixed numbered and unnumbered set elements is not standard");
3667 mode
= finish_enum (mode
, list
);
3668 if (set_name_cnt
== 0)
3669 error ("SET mode must define at least one named value");
3670 CH_ENUM_IS_NUMBERED(mode
) = set_is_numbered
? 1 : 0;
3675 /* parse layout POS:
3676 returns a tree with following layout
3679 pupose=treelist value=NULL_TREE (to indicate POS)
3680 pupose=word value=treelist | NULL_TREE
3681 pupose=startbit value=treelist | NULL_TREE
3683 integer_zero | integer_one length | endbit
3689 tree startbit
= NULL_TREE
, endbit
= NULL_TREE
;
3690 tree what
= NULL_TREE
;
3693 word
= parse_untyped_expr ();
3694 if (check_token (COMMA
))
3696 startbit
= parse_untyped_expr ();
3697 if (check_token (COMMA
))
3699 what
= integer_zero_node
;
3700 endbit
= parse_untyped_expr ();
3702 else if (check_token (COLON
))
3704 what
= integer_one_node
;
3705 endbit
= parse_untyped_expr ();
3710 /* build the tree as described above */
3711 if (what
!= NULL_TREE
)
3712 what
= tree_cons (what
, endbit
, NULL_TREE
);
3713 if (startbit
!= NULL_TREE
)
3714 startbit
= tree_cons (startbit
, what
, NULL_TREE
);
3715 endbit
= tree_cons (word
, startbit
, NULL_TREE
);
3716 return tree_cons (endbit
, NULL_TREE
, NULL_TREE
);
3719 /* parse layout STEP
3720 returns a tree with the following layout
3723 pupose=NULL_TREE value=treelist (to indicate STEP)
3724 pupose=POS(see baove) value=stepsize | NULL_TREE
3730 tree stepsize
= NULL_TREE
;
3735 if (check_token (COMMA
))
3736 stepsize
= parse_untyped_expr ();
3738 TREE_VALUE (pos
) = stepsize
;
3739 return tree_cons (NULL_TREE
, pos
, NULL_TREE
);
3742 /* returns layout for fields or array elements.
3743 NULL_TREE no layout specified
3744 integer_one_node PACK specified
3745 integer_zero_node NOPACK specified
3746 tree_list PURPOSE POS
3747 tree_list VALUE STEP
3750 parse_opt_layout (in
)
3751 int in
; /* 0 ... parse structure, 1 ... parse array */
3753 tree val
= NULL_TREE
;
3755 if (check_token (PACK
))
3757 return integer_one_node
;
3759 else if (check_token (NOPACK
))
3761 return integer_zero_node
;
3763 else if (check_token (POS
))
3766 if (in
== 1 && pass
== 1)
3768 error ("POS not allowed for ARRAY");
3773 else if (check_token (STEP
))
3775 val
= parse_step ();
3776 if (in
== 0 && pass
== 1)
3778 error ("STEP not allowed in field definition");
3788 parse_field_name_list ()
3790 tree chain
= NULL_TREE
;
3791 tree name
= parse_defining_occurrence ();
3792 if (name
== NULL_TREE
)
3794 error("missing field name");
3797 chain
= build_tree_list (NULL_TREE
, name
);
3798 while (check_token (COMMA
))
3800 name
= parse_defining_occurrence ();
3803 error ("bad field name following ','");
3807 chain
= tree_cons (NULL_TREE
, name
, chain
);
3812 /* Matches: <fixed field> or <variant field>, i.e.:
3813 <field name defining occurrence list> <mode> [ <field layout> ].
3814 Returns: A chain of FIELD_DECLs.
3815 NULL_TREE is returned if ignoring is true or an error is seen. */
3818 parse_fixed_field ()
3820 tree field_names
= parse_field_name_list ();
3821 tree mode
= parse_mode ();
3822 tree layout
= parse_opt_layout (0);
3823 return ignoring
? NULL_TREE
3824 : grok_chill_fixedfields (field_names
, mode
, layout
);
3828 /* Matches: [ <variant field> { "," <variant field> }* ]
3829 Returns: A chain of FIELD_DECLs.
3830 NULL_TREE is returned if ignoring is true or an error is seen. */
3833 parse_variant_field_list ()
3835 tree fields
= NULL_TREE
;
3836 if (PEEK_TOKEN () != NAME
)
3840 fields
= chainon (fields
, parse_fixed_field ());
3841 if (PEEK_TOKEN () != COMMA
|| PEEK_TOKEN1 () != NAME
)
3848 /* Matches: <variant alternative>
3849 Returns a TREE_LIST node, whose TREE_PURPOSE (if non-NULL) is the label,
3850 and whose TREE_VALUE is the list of FIELD_DECLs. */
3853 parse_variant_alternative ()
3857 if (PEEK_TOKEN () == LPRN
)
3858 labels
= parse_case_label_specification (NULL_TREE
);
3861 if (! check_token (COLON
))
3863 error ("expected ':' in structure variant alternative");
3867 /* We now read a list a variant fields, until we come to the end
3868 of the variant alternative. But since both variant fields
3869 *and* variant alternatives are separated by COMMAs,
3870 we will have to look ahead to distinguish the start of a variant
3871 field from the start of a new variant alternative.
3872 We use the fact that a variant alternative must start with
3873 either a LPRN or a COLON, while a variant field must start with a NAME.
3874 This look-ahead is handled by parse_simple_fields. */
3875 return build_tree_list (labels
, parse_variant_field_list ());
3878 /* Parse <field> (which is <fixed field> or <alternative field>).
3879 Returns: A chain of FIELD_DECLs (or NULL_TREE on error or if ignoring). */
3884 if (check_token (CASE
))
3886 tree tag_list
= NULL_TREE
, variants
, opt_variant_else
;
3887 if (PEEK_TOKEN () == NAME
)
3889 tag_list
= nreverse (parse_field_name_list ());
3891 tag_list
= lookup_tag_fields (tag_list
, current_fieldlist
);
3893 expect (OF
, "missing 'OF' in alternative structure field");
3895 variants
= parse_variant_alternative ();
3896 while (check_token (COMMA
))
3897 variants
= chainon (parse_variant_alternative (), variants
);
3898 variants
= nreverse (variants
);
3900 if (check_token (ELSE
))
3901 opt_variant_else
= parse_variant_field_list ();
3903 opt_variant_else
= NULL_TREE
;
3904 expect (ESAC
, "missing 'ESAC' following alternative structure field");
3907 return grok_chill_variantdefs (tag_list
, variants
, opt_variant_else
);
3909 else if (PEEK_TOKEN () == NAME
)
3910 return parse_fixed_field ();
3914 error ("missing field");
3920 parse_structure_mode ()
3922 tree save_fieldlist
= current_fieldlist
;
3925 expect (LPRN
, "expected '(' after STRUCT");
3926 current_fieldlist
= fields
= parse_field ();
3927 while (check_token (COMMA
))
3928 fields
= chainon (fields
, parse_field ());
3929 expect (RPRN
, "expected ')' after STRUCT");
3930 current_fieldlist
= save_fieldlist
;
3931 return ignoring
? void_type_node
: build_chill_struct_type (fields
);
3935 parse_opt_queue_size ()
3937 if (check_token (LPRN
))
3939 tree size
= parse_expression ();
3940 expect (RPRN
, "missing ')'");
3948 parse_procedure_mode ()
3950 tree param_types
= NULL_TREE
, result_spec
, except_list
, recursive
;
3952 expect (LPRN
, "missing '(' after PROC");
3953 if (! check_token (RPRN
))
3957 tree pmode
= parse_mode ();
3958 tree paramattr
= parse_param_attr ();
3961 pmode
= get_type_of (pmode
);
3962 param_types
= tree_cons (paramattr
, pmode
, param_types
);
3964 if (! check_token (COMMA
))
3967 expect (RPRN
, "missing ')' after PROC");
3969 result_spec
= parse_opt_result_spec ();
3970 except_list
= parse_opt_except ();
3971 recursive
= parse_opt_recursive ();
3973 return void_type_node
;
3974 return build_chill_pointer_type (build_chill_function_type
3975 (result_spec
, nreverse (param_types
),
3976 except_list
, recursive
));
3980 A NAME will be assumed to be a <mode name>, and thus a <mode>.
3981 Returns NULL_TREE if no mode is seen.
3982 (If ignoring is true, the return value may be an arbitrary tree node,
3983 but will be non-NULL if something that could be a mode is seen.) */
3988 switch (PEEK_TOKEN ())
3992 tree index_mode
, record_mode
;
3995 if (check_token (LPRN
))
3997 index_mode
= parse_index_mode ();
3998 expect (RPRN
, "mssing ')'");
4001 index_mode
= NULL_TREE
;
4002 record_mode
= parse_opt_mode ();
4004 dynamic
= check_token (DYNAMIC
);
4005 return ignoring
? void_type_node
4006 : build_access_mode (index_mode
, record_mode
, dynamic
);
4010 tree index_list
= NULL_TREE
, base_mode
;
4012 int num_index_modes
= 0;
4014 tree layouts
= NULL_TREE
;
4016 expect (LPRN
, "missing '(' after ARRAY");
4019 tree index
= parse_index_mode ();
4022 index_list
= tree_cons (NULL_TREE
, index
, index_list
);
4023 if (! check_token (COMMA
))
4026 expect (RPRN
, "missing ')' after ARRAY");
4027 varying
= check_token (VARYING
);
4028 base_mode
= parse_mode ();
4029 /* Allow a layout specification for each index mode */
4030 for (i
= 0; i
< num_index_modes
; ++i
)
4032 tree new_layout
= parse_opt_layout (1);
4033 if (new_layout
== NULL_TREE
)
4036 layouts
= tree_cons (NULL_TREE
, new_layout
, layouts
);
4040 return build_chill_array_type (get_type_of (base_mode
),
4041 index_list
, varying
, layouts
);
4044 require (ASSOCIATION
);
4045 return association_type_node
;
4049 expect (LPRN
, "missing left parenthesis after BIN");
4050 length
= parse_expression ();
4051 expect (RPRN
, "missing right parenthesis after BIN");
4052 return ignoring
? void_type_node
: build_chill_bin_type (length
);
4058 expect (LPRN
, "missing '(' after BOOLS");
4059 length
= parse_expression ();
4060 expect (RPRN
, "missing ')' after BOOLS");
4061 if (check_token (VARYING
))
4062 error ("VARYING bit-strings not implemented");
4063 return ignoring
? void_type_node
: build_bitstring_type (length
);
4067 tree qsize
, element_mode
;
4069 qsize
= parse_opt_queue_size ();
4070 element_mode
= parse_mode ();
4071 return ignoring
? element_mode
4072 : build_buffer_type (element_mode
, qsize
);
4080 expect (LPRN
, "missing '(' after CHARS");
4081 length
= parse_expression ();
4082 expect (RPRN
, "missing ')' after CHARS");
4083 varying
= check_token (VARYING
);
4085 return void_type_node
;
4086 type
= build_string_type (char_type_node
, length
);
4088 type
= build_varying_struct (type
);
4095 qsize
= parse_opt_queue_size ();
4096 return ignoring
? void_type_node
: build_event_type (qsize
);
4100 tree mode
= get_type_of (parse_name ());
4101 if (check_token (LPRN
))
4103 tree min_value
= parse_expression ();
4104 if (check_token (COLON
))
4106 tree max_value
= parse_expression ();
4107 expect (RPRN
, "syntax error - expected ')'");
4108 /* Matched: <mode_name> '(' <expr> ':' <expr> ')' */
4112 return build_chill_range_type (mode
, min_value
, max_value
);
4114 if (check_token (RPRN
))
4116 int varying
= check_token (VARYING
);
4119 if (mode
== char_type_node
|| varying
)
4121 if (mode
!= char_type_node
4122 && mode
!= ridpointers
[(int) RID_CHAR
])
4123 error ("strings must be composed of chars");
4124 mode
= build_string_type (char_type_node
, min_value
);
4126 mode
= build_varying_struct (mode
);
4130 /* Parameterized mode,
4131 or old-fashioned CHAR(N) string declaration.. */
4132 tree pmode
= make_node (LANG_TYPE
);
4133 TREE_TYPE (pmode
) = mode
;
4134 TYPE_DOMAIN (pmode
) = min_value
;
4145 mode
= parse_mode ();
4146 if (ignoring
|| TREE_CODE (mode
) == ERROR_MARK
)
4148 return build_powerset_type (get_type_of (mode
));
4151 return parse_procedure_mode ();
4155 expect (LPRN
, "missing left parenthesis after RANGE");
4156 low
= parse_expression ();
4157 expect (COLON
, "missing colon");
4158 high
= parse_expression ();
4159 expect (RPRN
, "missing right parenthesis after RANGE");
4160 return ignoring
? void_type_node
4161 : build_chill_range_type (NULL_TREE
, low
, high
);
4166 tree mode2
= get_type_of (parse_mode ());
4167 if (ignoring
|| TREE_CODE (mode2
) == ERROR_MARK
)
4170 && TREE_CODE_CLASS (TREE_CODE (mode2
)) == 'd'
4171 && CH_IS_BUFFER_MODE (mode2
))
4173 error ("BUFFER modes may not be readonly");
4177 && TREE_CODE_CLASS (TREE_CODE (mode2
)) == 'd'
4178 && CH_IS_EVENT_MODE (mode2
))
4180 error ("EVENT modes may not be readonly");
4183 return build_readonly_type (mode2
);
4189 mode
= parse_mode ();
4192 mode
= get_type_of (mode
);
4193 return (TREE_CODE (mode
) == ERROR_MARK
) ? mode
4194 : build_chill_pointer_type (mode
);
4197 return parse_set_mode ();
4200 error ("SIGNAL is not a valid mode");
4201 return generic_signal_type_node
;
4203 return parse_structure_mode ();
4206 tree length
, index_mode
;
4209 expect (LPRN
, "missing '('");
4210 length
= parse_expression ();
4211 expect (RPRN
, "missing ')'");
4212 /* FIXME: This should actually look for an optional index_mode,
4213 but that is tricky to do. */
4214 index_mode
= parse_opt_mode ();
4215 dynamic
= check_token (DYNAMIC
);
4216 return ignoring
? void_type_node
4217 : build_text_mode (length
, index_mode
, dynamic
);
4221 return usage_type_node
;
4224 return where_type_node
;
4233 tree mode
= parse_opt_mode ();
4234 if (mode
== NULL_TREE
)
4237 error ("syntax error - missing mode");
4238 mode
= error_mark_node
;
4246 /* Initialize global variables for current pass. */
4248 expand_exit_needed
= 0;
4249 label
= NULL_TREE
; /* for statement labels */
4250 current_module
= NULL
;
4251 current_function_decl
= NULL_TREE
;
4252 in_pseudo_module
= 0;
4254 for (i
= 0; i
<= MAX_LOOK_AHEAD
; i
++)
4255 terminal_buffer
[i
] = TOKEN_NOT_READ
;
4258 /* skip some junk */
4259 while (PEEK_TOKEN() == HEADEREL
)
4263 start_outer_function ();
4267 tree label
= parse_optlabel ();
4268 if (PEEK_TOKEN() == MODULE
|| PEEK_TOKEN() == REGION
)
4269 parse_modulion (label
);
4270 else if (PEEK_TOKEN() == SPEC
)
4271 parse_spec_module (label
);
4275 finish_outer_function ();
4282 if (PEEK_TOKEN() != END_PASS_1
)
4284 error ("syntax error - expected a module or end of file");
4287 chill_finish_compile ();
4289 exit (FATAL_EXIT_CODE
);
4290 switch_to_pass_2 ();
4292 except_init_pass_2 ();
4295 chill_finish_compile ();
4305 * We've had an error. Move the compiler's state back to
4306 * the global binding level. This prevents the loop in
4307 * compile_file in toplev.c from looping forever, since the
4308 * CHILL poplevel() has *no* effect on the value returned by
4309 * global_bindings_p().
4312 to_global_binding_level ()
4314 while (! global_bindings_p ())
4315 current_function_decl
= DECL_CONTEXT (current_function_decl
);
4321 /* Sets the value of the 'yydebug' variable to VALUE.
4322 This is a function so we don't have to have YYDEBUG defined
4323 in order to build the compiler. */
4331 warning ("YYDEBUG not defined.");