| /* Parser for GNU CHILL (CCITT High-Level Language) -*- C -*- |
| Copyright (C) 1992, 1993, 1998, 1999, 2000, 2001 |
| Free Software Foundation, Inc. |
| |
| This file is part of GNU CC. |
| |
| GNU CC is free software; you can redistribute it and/or modify |
| it under the terms of the GNU General Public License as published by |
| the Free Software Foundation; either version 2, or (at your option) |
| any later version. |
| |
| GNU CC is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU General Public License for more details. |
| |
| You should have received a copy of the GNU General Public License |
| along with GNU CC; see the file COPYING. If not, write to |
| the Free Software Foundation, 59 Temple Place - Suite 330, |
| Boston, MA 02111-1307, USA. */ |
| |
| /* |
| * This is a two-pass parser. In pass 1, we collect declarations, |
| * ignoring actions and most expressions. We store only the |
| * declarations and close, open and re-lex the input file to save |
| * main memory. We anticipate that the compiler will be processing |
| * *very* large single programs which are mechanically generated, |
| * and so we want to store a minimum of information between passes. |
| * |
| * yylex detects the end of the main input file and returns the |
| * END_PASS_1 token. We then re-initialize each CHILL compiler |
| * module's global variables and re-process the input file. The |
| * grant file is output. If the user has requested it, GNU CHILL |
| * exits at this time - its only purpose was to generate the grant |
| * file. Optionally, the compiler may exit if errors were detected |
| * in pass 1. |
| * |
| * As each symbol scope is entered, we install its declarations into |
| * the symbol table. Undeclared types and variables are announced |
| * now. |
| * |
| * Then code is generated. |
| */ |
| |
| #include "config.h" |
| #include "system.h" |
| #include "tree.h" |
| #include "ch-tree.h" |
| #include "lex.h" |
| #include "actions.h" |
| #include "tasking.h" |
| #include "parse.h" |
| #include "toplev.h" |
| |
| /* Since parsers are distinct for each language, put the |
| language string definition here. (fnf) */ |
| const char * const language_string = "GNU CHILL"; |
| |
| /* Common code to be done before expanding any action. */ |
| #define INIT_ACTION { \ |
| if (! ignoring) emit_line_note (input_filename, lineno); } |
| |
| /* Pop a scope for an ON handler. */ |
| #define POP_USED_ON_CONTEXT pop_handler(1) |
| |
| /* Pop a scope for an ON handler that wasn't there. */ |
| #define POP_UNUSED_ON_CONTEXT pop_handler(0) |
| |
| #define PUSH_ACTION push_action() |
| |
| /* Cause the `yydebug' variable to be defined. */ |
| #define YYDEBUG 1 |
| |
| extern struct rtx_def* gen_label_rtx PARAMS ((void)); |
| extern void emit_jump PARAMS ((struct rtx_def *)); |
| extern struct rtx_def* emit_label PARAMS ((struct rtx_def *)); |
| |
| /* This is a hell of a lot easier than getting expr.h included in |
| by parse.c. */ |
| extern struct rtx_def *expand_expr PARAMS ((tree, struct rtx_def *, |
| enum machine_mode, int)); |
| |
| static int parse_action PARAMS ((void)); |
| static void ch_parse_init PARAMS ((void)); |
| static void check_end_label PARAMS ((tree, tree)); |
| static void end_function PARAMS ((void)); |
| static tree build_prefix_clause PARAMS ((tree)); |
| static enum terminal PEEK_TOKEN PARAMS ((void)); |
| static int peek_token_ PARAMS ((int)); |
| static void pushback_token PARAMS ((int, tree)); |
| static void forward_token_ PARAMS ((void)); |
| static void require PARAMS ((enum terminal)); |
| static int check_token PARAMS ((enum terminal)); |
| static int expect PARAMS ((enum terminal, const char *)); |
| static void define__PROCNAME__ PARAMS ((void)); |
| |
| extern int lineno; |
| extern tree generic_signal_type_node; |
| extern tree signal_code; |
| extern int all_static_flag; |
| extern int ignore_case; |
| |
| #if 0 |
| static int quasi_signal = 0; /* 1 if processing a quasi signal decl */ |
| #endif |
| |
| int parsing_newmode; /* 0 while parsing SYNMODE; |
| 1 while parsing NEWMODE. */ |
| int expand_exit_needed = 0; |
| |
| /* Gets incremented if we see errors such that we don't want to run pass 2. */ |
| |
| int serious_errors = 0; |
| |
| static tree current_fieldlist; |
| |
| /* We don't care about expressions during pass 1, except while we're |
| parsing the RHS of a SYN definition, or while parsing a mode that |
| we need. NOTE: This also causes mode expressions to be ignored. */ |
| int ignoring = 1; /* 1 to ignore expressions */ |
| |
| /* True if we have seen an action not in a (user) function. */ |
| int seen_action = 0; |
| int build_constructor = 0; |
| |
| /* The action_nesting_level of the current procedure body. */ |
| int proc_action_level = 0; |
| |
| /* This is the identifier of the label that prefixes the current action, |
| or NULL if there was none. It is cleared at the end of an action, |
| or when starting a nested action list, so get it while you can! */ |
| static tree label = NULL_TREE; /* for statement labels */ |
| |
| #if 0 |
| static tree current_block; |
| #endif |
| |
| int in_pseudo_module = 0; |
| int pass = 0; /* 0 for init_decl_processing, |
| 1 for pass 1, 2 for pass 2 */ |
| |
| /* re-initialize global variables for pass 2 */ |
| static void |
| ch_parse_init () |
| { |
| expand_exit_needed = 0; |
| label = NULL_TREE; /* for statement labels */ |
| current_module = NULL; |
| in_pseudo_module = 0; |
| } |
| |
| static void |
| check_end_label (start, end) |
| tree start, end; |
| { |
| if (end != NULL_TREE) |
| { |
| if (start == NULL_TREE && pass == 1) |
| error ("there was no start label to match the end label '%s'", |
| IDENTIFIER_POINTER(end)); |
| else if (start != end && pass == 1) |
| error ("start label '%s' does not match end label '%s'", |
| IDENTIFIER_POINTER(start), |
| IDENTIFIER_POINTER(end)); |
| } |
| } |
| |
| |
| /* |
| * given a tree which is an id, a type or a decl, |
| * return the associated type, or issue an error and |
| * return error_mark_node. |
| */ |
| tree |
| get_type_of (id_or_decl) |
| tree id_or_decl; |
| { |
| tree type = id_or_decl; |
| |
| if (id_or_decl == NULL_TREE |
| || TREE_CODE (id_or_decl) == ERROR_MARK) |
| return error_mark_node; |
| |
| if (pass == 1 || ignoring == 1) |
| return id_or_decl; |
| |
| if (TREE_CODE (type) == IDENTIFIER_NODE) |
| { |
| type = lookup_name (id_or_decl); |
| if (type == NULL_TREE) |
| { |
| error ("`%s' not declared", IDENTIFIER_POINTER (id_or_decl)); |
| type = error_mark_node; |
| } |
| } |
| if (TREE_CODE (type) == TYPE_DECL) |
| type = TREE_TYPE (type); |
| return type; /* was a type all along */ |
| } |
| |
| |
| static void |
| end_function () |
| { |
| if (CH_DECL_PROCESS (current_function_decl)) |
| { |
| /* finishing a process */ |
| if (! ignoring) |
| { |
| tree result = |
| build_chill_function_call |
| (lookup_name (get_identifier ("__stop_process")), |
| NULL_TREE); |
| expand_expr_stmt (result); |
| emit_line_note (input_filename, lineno); |
| } |
| } |
| else |
| { |
| /* finishing a procedure.. */ |
| if (! ignoring) |
| { |
| if (result_never_set |
| && TREE_CODE (TREE_TYPE (TREE_TYPE (current_function_decl))) |
| != VOID_TYPE) |
| warning ("no RETURN or RESULT in procedure"); |
| chill_expand_return (NULL_TREE, 1); |
| } |
| } |
| finish_chill_function (); |
| pop_chill_function_context (); |
| } |
| |
| static tree |
| build_prefix_clause (id) |
| tree id; |
| { |
| if (!id) |
| { |
| if (current_module && current_module->name) |
| { const char *module_name = IDENTIFIER_POINTER (current_module->name); |
| if (module_name[0] && module_name[0] != '_') |
| return current_module->name; |
| } |
| error ("PREFIXED clause with no prelix in unlabeled module"); |
| } |
| return id; |
| } |
| |
| void |
| possibly_define_exit_label (label) |
| tree label; |
| { |
| if (label) |
| define_label (input_filename, lineno, munge_exit_label (label)); |
| } |
| |
| #define MAX_LOOK_AHEAD 2 |
| static enum terminal terminal_buffer[MAX_LOOK_AHEAD+1]; |
| YYSTYPE yylval; |
| static YYSTYPE val_buffer[MAX_LOOK_AHEAD+1]; |
| |
| /*enum terminal current_token, lookahead_token;*/ |
| |
| #define TOKEN_NOT_READ dummy_last_terminal |
| |
| #ifdef __GNUC__ |
| __inline__ |
| #endif |
| static enum terminal |
| PEEK_TOKEN() |
| { |
| if (terminal_buffer[0] == TOKEN_NOT_READ) |
| { |
| terminal_buffer[0] = yylex(); |
| val_buffer[0] = yylval; |
| } |
| return terminal_buffer[0]; |
| } |
| #define PEEK_TREE() val_buffer[0].ttype |
| #define PEEK_TOKEN1() peek_token_ (1) |
| #define PEEK_TOKEN2() peek_token_ (2) |
| |
| static int |
| peek_token_ (i) |
| int i; |
| { |
| if (i > MAX_LOOK_AHEAD) |
| abort (); |
| if (terminal_buffer[i] == TOKEN_NOT_READ) |
| { |
| terminal_buffer[i] = yylex(); |
| val_buffer[i] = yylval; |
| } |
| return terminal_buffer[i]; |
| } |
| |
| static void |
| pushback_token (code, node) |
| int code; |
| tree node; |
| { |
| int i; |
| if (terminal_buffer[MAX_LOOK_AHEAD] != TOKEN_NOT_READ) |
| abort (); |
| for (i = MAX_LOOK_AHEAD; i > 0; i--) |
| { |
| terminal_buffer[i] = terminal_buffer[i - 1]; |
| val_buffer[i] = val_buffer[i - 1]; |
| } |
| terminal_buffer[0] = code; |
| val_buffer[0].ttype = node; |
| } |
| |
| static void |
| forward_token_() |
| { |
| int i; |
| for (i = 0; i < MAX_LOOK_AHEAD; i++) |
| { |
| terminal_buffer[i] = terminal_buffer[i+1]; |
| val_buffer[i] = val_buffer[i+1]; |
| } |
| terminal_buffer[MAX_LOOK_AHEAD] = TOKEN_NOT_READ; |
| } |
| #define FORWARD_TOKEN() forward_token_ () |
| |
| /* Skip the next token. |
| if it isn't TOKEN, the parser is broken. */ |
| |
| static void |
| require (token) |
| enum terminal token; |
| { |
| if (PEEK_TOKEN() != token) |
| internal_error ("internal parser error - expected token %d", (int) token); |
| FORWARD_TOKEN(); |
| } |
| |
| static int |
| check_token (token) |
| enum terminal token; |
| { |
| if (PEEK_TOKEN() != token) |
| return 0; |
| FORWARD_TOKEN (); |
| return 1; |
| } |
| |
| /* return 0 if expected token was not found, |
| else return 1. |
| */ |
| static int |
| expect(token, message) |
| enum terminal token; |
| const char *message; |
| { |
| if (PEEK_TOKEN() != token) |
| { |
| if (pass == 1) |
| error("%s", message ? message : "syntax error"); |
| return 0; |
| } |
| else |
| FORWARD_TOKEN(); |
| return 1; |
| } |
| |
| /* define a SYNONYM __PROCNAME__ (__procname__) which holds |
| the name of the current procedure. |
| This should be quit the same as __FUNCTION__ in C */ |
| static void |
| define__PROCNAME__ () |
| { |
| const char *fname; |
| tree string; |
| tree procname; |
| |
| if (current_function_decl == NULL_TREE) |
| fname = "toplevel"; |
| else |
| fname = IDENTIFIER_POINTER (DECL_NAME (current_function_decl)); |
| |
| string = build_chill_string (strlen (fname), fname); |
| procname = get_identifier (ignore_case ? "__procname__" : "__PROCNAME__"); |
| push_syndecl (procname, NULL_TREE, string); |
| } |
| |
| /* Forward declarations. */ |
| static tree parse_expression PARAMS ((void)); |
| static tree parse_primval PARAMS ((void)); |
| static tree parse_mode PARAMS ((void)); |
| static tree parse_opt_mode PARAMS ((void)); |
| static tree parse_untyped_expr PARAMS ((void)); |
| static tree parse_opt_untyped_expr PARAMS ((void)); |
| static int parse_definition PARAMS ((int)); |
| static void parse_opt_actions PARAMS ((void)); |
| static void parse_body PARAMS ((void)); |
| static tree parse_if_expression_body PARAMS ((void)); |
| static tree parse_opt_handler PARAMS ((void)); |
| static tree parse_opt_name_string PARAMS ((int)); |
| static tree parse_simple_name_string PARAMS ((void)); |
| static tree parse_name_string PARAMS ((void)); |
| static tree parse_defining_occurrence PARAMS ((void)); |
| static tree parse_name PARAMS ((void)); |
| static tree parse_optlabel PARAMS ((void)); |
| static void parse_opt_end_label_semi_colon PARAMS ((tree)); |
| static void parse_modulion PARAMS ((tree)); |
| static void parse_spec_module PARAMS ((tree)); |
| static void parse_semi_colon PARAMS ((void)); |
| static tree parse_defining_occurrence_list PARAMS ((void)); |
| static void parse_mode_definition PARAMS ((int)); |
| static void parse_mode_definition_statement PARAMS ((int)); |
| static void parse_synonym_definition PARAMS ((void)); |
| static void parse_synonym_definition_statement PARAMS ((void)); |
| static tree parse_on_exception_list PARAMS ((void)); |
| static void parse_on_alternatives PARAMS ((void)); |
| static void parse_loc_declaration PARAMS ((int)); |
| static void parse_declaration_statement PARAMS ((int)); |
| static tree parse_optforbid PARAMS ((void)); |
| static tree parse_postfix PARAMS ((enum terminal)); |
| static tree parse_postfix_list PARAMS ((enum terminal)); |
| static void parse_rename_clauses PARAMS ((enum terminal)); |
| static tree parse_opt_prefix_clause PARAMS ((void)); |
| static void parse_grant_statement PARAMS ((void)); |
| static void parse_seize_statement PARAMS ((void)); |
| static tree parse_param_name_list PARAMS ((void)); |
| static tree parse_param_attr PARAMS ((void)); |
| static tree parse_formpar PARAMS ((void)); |
| static tree parse_formparlist PARAMS ((void)); |
| static tree parse_opt_result_spec PARAMS ((void)); |
| static tree parse_opt_except PARAMS ((void)); |
| static tree parse_opt_recursive PARAMS ((void)); |
| static tree parse_procedureattr PARAMS ((void)); |
| static void parse_proc_body PARAMS ((tree, tree)); |
| static void parse_procedure_definition PARAMS ((int)); |
| static tree parse_processpar PARAMS ((void)); |
| static tree parse_processparlist PARAMS ((void)); |
| static void parse_process_definition PARAMS ((int)); |
| static void parse_signal_definition PARAMS ((void)); |
| static void parse_signal_definition_statement PARAMS ((void)); |
| static void parse_then_clause PARAMS ((void)); |
| static void parse_opt_else_clause PARAMS ((void)); |
| static tree parse_expr_list PARAMS ((void)); |
| static tree parse_range_list_clause PARAMS ((void)); |
| static void pushback_paren_expr PARAMS ((tree)); |
| static tree parse_case_label PARAMS ((void)); |
| static tree parse_case_label_list PARAMS ((tree, int)); |
| static tree parse_case_label_specification PARAMS ((tree)); |
| static void parse_single_dimension_case_action PARAMS ((tree)); |
| static void parse_multi_dimension_case_action PARAMS ((tree)); |
| static void parse_case_action PARAMS ((tree)); |
| static tree parse_asm_operands PARAMS ((void)); |
| static tree parse_asm_clobbers PARAMS ((void)); |
| static void ch_expand_asm_operands PARAMS ((tree, tree, tree, tree, |
| int, const char *, int)); |
| static void parse_asm_action PARAMS ((void)); |
| static void parse_begin_end_block PARAMS ((tree)); |
| static void parse_if_action PARAMS ((tree)); |
| static void parse_iteration PARAMS ((void)); |
| static tree parse_delay_case_event_list PARAMS ((void)); |
| static void parse_delay_case_action PARAMS ((tree)); |
| static void parse_do_action PARAMS ((tree)); |
| static tree parse_receive_spec PARAMS ((void)); |
| static void parse_receive_case_action PARAMS ((tree)); |
| static void parse_send_action PARAMS ((void)); |
| static void parse_start_action PARAMS ((void)); |
| static tree parse_call PARAMS ((tree)); |
| static tree parse_tuple_fieldname_list PARAMS ((void)); |
| static tree parse_tuple_element PARAMS ((void)); |
| static tree parse_opt_element_list PARAMS ((void)); |
| static tree parse_tuple PARAMS ((tree)); |
| static tree parse_operand6 PARAMS ((void)); |
| static tree parse_operand5 PARAMS ((void)); |
| static tree parse_operand4 PARAMS ((void)); |
| static tree parse_operand3 PARAMS ((void)); |
| static tree parse_operand2 PARAMS ((void)); |
| static tree parse_operand1 PARAMS ((void)); |
| static tree parse_operand0 PARAMS ((void)); |
| static tree parse_case_expression PARAMS ((void)); |
| static tree parse_then_alternative PARAMS ((void)); |
| static tree parse_else_alternative PARAMS ((void)); |
| static tree parse_if_expression PARAMS ((void)); |
| static tree parse_index_mode PARAMS ((void)); |
| static tree parse_set_mode PARAMS ((void)); |
| static tree parse_pos PARAMS ((void)); |
| static tree parse_step PARAMS ((void)); |
| static tree parse_opt_layout PARAMS ((int)); |
| static tree parse_field_name_list PARAMS ((void)); |
| static tree parse_fixed_field PARAMS ((void)); |
| static tree parse_variant_field_list PARAMS ((void)); |
| static tree parse_variant_alternative PARAMS ((void)); |
| static tree parse_field PARAMS ((void)); |
| static tree parse_structure_mode PARAMS ((void)); |
| static tree parse_opt_queue_size PARAMS ((void)); |
| static tree parse_procedure_mode PARAMS ((void)); |
| static void parse_program PARAMS ((void)); |
| static void parse_pass_1_2 PARAMS ((void)); |
| |
| static tree |
| parse_opt_name_string (allow_all) |
| int allow_all; /* 1 if ALL is allowed as a postfix */ |
| { |
| enum terminal token = PEEK_TOKEN(); |
| tree name; |
| if (token != NAME) |
| { |
| if (token == ALL && allow_all) |
| { |
| FORWARD_TOKEN (); |
| return ALL_POSTFIX; |
| } |
| return NULL_TREE; |
| } |
| name = PEEK_TREE(); |
| for (;;) |
| { |
| FORWARD_TOKEN (); |
| token = PEEK_TOKEN(); |
| if (token != '!') |
| return name; |
| FORWARD_TOKEN(); |
| token = PEEK_TOKEN(); |
| if (token == ALL && allow_all) |
| return get_identifier3(IDENTIFIER_POINTER (name), "!", "*"); |
| if (token != NAME) |
| { |
| if (pass == 1) |
| error ("'%s!' is not followed by an identifier", |
| IDENTIFIER_POINTER (name)); |
| return name; |
| } |
| name = get_identifier3(IDENTIFIER_POINTER(name), |
| "!", IDENTIFIER_POINTER(PEEK_TREE())); |
| } |
| } |
| |
| static tree |
| parse_simple_name_string () |
| { |
| enum terminal token = PEEK_TOKEN(); |
| tree name; |
| if (token != NAME) |
| { |
| error ("expected a name here"); |
| return error_mark_node; |
| } |
| name = PEEK_TREE (); |
| FORWARD_TOKEN (); |
| return name; |
| } |
| |
| static tree |
| parse_name_string () |
| { |
| tree name = parse_opt_name_string (0); |
| if (name) |
| return name; |
| if (pass == 1) |
| error ("expected a name string here"); |
| return error_mark_node; |
| } |
| |
| static tree |
| parse_defining_occurrence () |
| { |
| if (PEEK_TOKEN () == NAME) |
| { |
| tree id = PEEK_TREE(); |
| FORWARD_TOKEN (); |
| return id; |
| } |
| return NULL; |
| } |
| |
| /* Matches: <name_string> |
| Returns if pass 1: the identifier. |
| Returns if pass 2: a decl or value for identifier. */ |
| |
| static tree |
| parse_name () |
| { |
| tree name = parse_name_string (); |
| if (pass == 1 || ignoring) |
| return name; |
| else |
| { |
| tree decl = lookup_name (name); |
| if (decl == NULL_TREE) |
| { |
| error ("`%s' undeclared", IDENTIFIER_POINTER (name)); |
| return error_mark_node; |
| } |
| else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK) |
| return error_mark_node; |
| else if (TREE_CODE (decl) == CONST_DECL) |
| return DECL_INITIAL (decl); |
| else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE) |
| return convert_from_reference (decl); |
| else |
| return decl; |
| } |
| } |
| |
| static tree |
| parse_optlabel() |
| { |
| tree label = parse_defining_occurrence(); |
| if (label != NULL) |
| expect(COLON, "expected a ':' here"); |
| return label; |
| } |
| |
| static void |
| parse_semi_colon () |
| { |
| enum terminal token = PEEK_TOKEN (); |
| if (token == SC) |
| FORWARD_TOKEN (); |
| else if (pass == 1) |
| (token == END ? pedwarn : error) ("expected ';' here"); |
| label = NULL_TREE; |
| } |
| |
| static void |
| parse_opt_end_label_semi_colon (start_label) |
| tree start_label; |
| { |
| if (PEEK_TOKEN() == NAME) |
| { |
| tree end_label = parse_name_string (); |
| check_end_label (start_label, end_label); |
| } |
| parse_semi_colon (); |
| } |
| |
| static void |
| parse_modulion (label) |
| tree label; |
| { |
| tree module_name; |
| |
| label = set_module_name (label); |
| module_name = push_module (label, 0); |
| FORWARD_TOKEN(); |
| |
| push_action (); |
| parse_body(); |
| expect(END, "expected END here"); |
| parse_opt_handler (); |
| parse_opt_end_label_semi_colon (label); |
| find_granted_decls (); |
| pop_module (); |
| } |
| |
| static void |
| parse_spec_module (label) |
| tree label; |
| { |
| int save_ignoring = ignoring; |
| |
| push_module (set_module_name (label), 1); |
| ignoring = pass == 2; |
| FORWARD_TOKEN(); /* SKIP SPEC */ |
| expect (MODULE, "expected 'MODULE' here"); |
| |
| while (parse_definition (1)) { } |
| if (parse_action ()) |
| error ("action not allowed in SPEC MODULE"); |
| expect(END, "expected END here"); |
| parse_opt_end_label_semi_colon (label); |
| find_granted_decls (); |
| pop_module (); |
| ignoring = save_ignoring; |
| } |
| |
| /* Matches: <name_string> ( "," <name_string> )* |
| Returns either a single IDENTIFIER_NODE, |
| or a chain (TREE_LIST) of IDENTIFIER_NODES. |
| (Since a single identifier is the common case, we avoid wasting space |
| (twice, once for each pass) with extra TREE_LIST nodes in that case.) |
| (Will not return NULL_TREE even if ignoring is true.) */ |
| |
| static tree |
| parse_defining_occurrence_list () |
| { |
| tree chain = NULL_TREE; |
| tree name = parse_defining_occurrence (); |
| if (name == NULL_TREE) |
| { |
| error("missing defining occurrence"); |
| return NULL_TREE; |
| } |
| if (! check_token (COMMA)) |
| return name; |
| chain = build_tree_list (NULL_TREE, name); |
| for (;;) |
| { |
| name = parse_defining_occurrence (); |
| if (name == NULL) |
| { |
| error ("bad defining occurrence following ','"); |
| break; |
| } |
| chain = tree_cons (NULL_TREE, name, chain); |
| if (! check_token (COMMA)) |
| break; |
| } |
| return nreverse (chain); |
| } |
| |
| static void |
| parse_mode_definition (is_newmode) |
| int is_newmode; |
| { |
| tree mode, names; |
| int save_ignoring = ignoring; |
| ignoring = pass == 2; |
| names = parse_defining_occurrence_list (); |
| expect (EQL, "missing '=' in mode definition"); |
| mode = parse_mode (); |
| if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST) |
| { |
| for ( ; names != NULL_TREE; names = TREE_CHAIN (names)) |
| push_modedef (names, mode, is_newmode); |
| } |
| else |
| push_modedef (names, mode, is_newmode); |
| ignoring = save_ignoring; |
| } |
| |
| static void |
| parse_mode_definition_statement (is_newmode) |
| int is_newmode; |
| { |
| FORWARD_TOKEN (); /* skip SYNMODE or NEWMODE */ |
| parse_mode_definition (is_newmode); |
| while (PEEK_TOKEN () == COMMA) |
| { |
| FORWARD_TOKEN (); |
| parse_mode_definition (is_newmode); |
| } |
| parse_semi_colon (); |
| } |
| |
| static void |
| parse_synonym_definition () |
| { tree expr = NULL_TREE; |
| tree names = parse_defining_occurrence_list (); |
| tree mode = parse_opt_mode (); |
| if (! expect (EQL, "missing '=' in synonym definition")) |
| mode = error_mark_node; |
| else |
| { |
| if (mode) |
| expr = parse_untyped_expr (); |
| else |
| expr = parse_expression (); |
| } |
| if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST) |
| { |
| for ( ; names != NULL_TREE; names = TREE_CHAIN (names)) |
| push_syndecl (names, mode, expr); |
| } |
| else |
| push_syndecl (names, mode, expr); |
| } |
| |
| static void |
| parse_synonym_definition_statement() |
| { |
| int save_ignoring= ignoring; |
| ignoring = pass == 2; |
| require (SYN); |
| parse_synonym_definition (); |
| while (PEEK_TOKEN () == COMMA) |
| { |
| FORWARD_TOKEN (); |
| parse_synonym_definition (); |
| } |
| ignoring = save_ignoring; |
| parse_semi_colon (); |
| } |
| |
| /* Attempts to match: "(" <exception list> ")" ":". |
| Return NULL_TREE on failure, and non-NULL on success. |
| On success, if pass 1, return a TREE_LIST of IDENTIFIER_NODEs. */ |
| |
| static tree |
| parse_on_exception_list () |
| { |
| tree name; |
| tree list = NULL_TREE; |
| int tok1 = PEEK_TOKEN (); |
| int tok2 = PEEK_TOKEN1 (); |
| |
| /* This requires a lot of look-ahead, because we cannot |
| easily a priori distinguish an exception-list from an expression. */ |
| if (tok1 != LPRN || tok2 != NAME) |
| { |
| if (tok1 == NAME && tok2 == COLON && pass == 1) |
| error ("missing '(' in exception list"); |
| return 0; |
| } |
| require (LPRN); |
| name = parse_name_string (); |
| if (PEEK_TOKEN () == RPRN && PEEK_TOKEN1 () == COLON) |
| { |
| /* Matched: '(' <name_string> ')' ':' */ |
| FORWARD_TOKEN (); FORWARD_TOKEN (); |
| return pass == 1 ? build_tree_list (NULL_TREE, name) : name; |
| } |
| if (PEEK_TOKEN() == COMMA) |
| { |
| if (pass == 1) |
| list = build_tree_list (NULL_TREE, name); |
| while (check_token (COMMA)) |
| { |
| tree old_names = list; |
| name = parse_name_string (); |
| if (pass == 1) |
| { |
| for ( ; old_names != NULL_TREE; old_names = TREE_CHAIN (old_names)) |
| { |
| if (TREE_VALUE (old_names) == name) |
| { |
| error ("ON exception names must be unique"); |
| goto continue_parsing; |
| } |
| } |
| list = tree_cons (NULL_TREE, name, list); |
| continue_parsing: |
| ; |
| } |
| } |
| if (! check_token (RPRN) || ! check_token(COLON)) |
| error ("syntax error in exception list"); |
| return pass == 1 ? nreverse (list) : name; |
| } |
| /* Matched: '(' name_string |
| but it doesn't match the syntax of an exception list. |
| It could be the beginning of an expression, so back up. */ |
| pushback_token (NAME, name); |
| pushback_token (LPRN, 0); |
| return NULL_TREE; |
| } |
| |
| static void |
| parse_on_alternatives () |
| { |
| for (;;) |
| { |
| tree except_list = parse_on_exception_list (); |
| if (except_list != NULL) |
| chill_handle_on_labels (except_list); |
| else if (parse_action ()) |
| expand_exit_needed = 1; |
| else |
| break; |
| } |
| } |
| |
| static tree |
| parse_opt_handler () |
| { |
| if (! check_token (ON)) |
| { |
| POP_UNUSED_ON_CONTEXT; |
| return NULL_TREE; |
| } |
| if (check_token (END)) |
| { |
| pedwarn ("empty ON-condition"); |
| POP_UNUSED_ON_CONTEXT; |
| return NULL_TREE; |
| } |
| if (! ignoring) |
| { |
| chill_start_on (); |
| expand_exit_needed = 0; |
| } |
| if (PEEK_TOKEN () != ELSE) |
| { |
| parse_on_alternatives (); |
| if (! ignoring && expand_exit_needed) |
| expand_exit_something (); |
| } |
| if (check_token (ELSE)) |
| { |
| chill_start_default_handler (); |
| label = NULL_TREE; |
| parse_opt_actions (); |
| if (! ignoring) |
| { |
| emit_line_note (input_filename, lineno); |
| expand_exit_something (); |
| } |
| } |
| expect (END, "missing 'END' after"); |
| if (! ignoring) |
| chill_finish_on (); |
| POP_USED_ON_CONTEXT; |
| return integer_zero_node; |
| } |
| |
| static void |
| parse_loc_declaration (in_spec_module) |
| int in_spec_module; |
| { |
| tree names = parse_defining_occurrence_list (); |
| int save_ignoring = ignoring; |
| int is_static, lifetime_bound; |
| tree mode, init_value = NULL_TREE; |
| int loc_decl = 0; |
| |
| ignoring = pass == 2; |
| mode = parse_mode (); |
| ignoring = save_ignoring; |
| is_static = check_token (STATIC); |
| if (check_token (BASED)) |
| { |
| expect(LPRN, "BASED must be followed by (NAME)"); |
| do_based_decls (names, mode, parse_name_string ()); |
| expect(RPRN, "BASED must be followed by (NAME)"); |
| return; |
| } |
| if (check_token (LOC)) |
| { |
| /* loc-identity declaration */ |
| if (pass == 1) |
| mode = build_chill_reference_type (mode); |
| loc_decl = 1; |
| } |
| lifetime_bound = check_token (INIT); |
| if (lifetime_bound && loc_decl) |
| { |
| if (pass == 1) |
| error ("INIT not allowed at loc-identity declaration"); |
| lifetime_bound = 0; |
| } |
| if (PEEK_TOKEN () == ASGN || PEEK_TOKEN() == EQL) |
| { |
| save_ignoring = ignoring; |
| ignoring = pass == 1; |
| if (PEEK_TOKEN() == EQL) |
| { |
| if (pass == 1) |
| error ("'=' used where ':=' is required"); |
| } |
| FORWARD_TOKEN(); |
| if (! lifetime_bound) |
| push_handler (); |
| init_value = parse_untyped_expr (); |
| if (in_spec_module) |
| { |
| error ("initialization is not allowed in spec module"); |
| init_value = NULL_TREE; |
| } |
| if (! lifetime_bound) |
| parse_opt_handler (); |
| ignoring = save_ignoring; |
| } |
| if (init_value == NULL_TREE && loc_decl && pass == 1) |
| error ("loc-identity declaration without initialization"); |
| do_decls (names, mode, |
| is_static || global_bindings_p () |
| /* the variable becomes STATIC if all_static_flag is set and |
| current functions doesn't have the RECURSIVE attribute */ |
| || (all_static_flag && !CH_DECL_RECURSIVE (current_function_decl)), |
| lifetime_bound, init_value, in_spec_module); |
| |
| /* Free any temporaries we made while initializing the decl. */ |
| free_temp_slots (); |
| } |
| |
| static void |
| parse_declaration_statement (in_spec_module) |
| int in_spec_module; |
| { |
| int save_ignoring = ignoring; |
| ignoring = pass == 2; |
| require (DCL); |
| parse_loc_declaration (in_spec_module); |
| while (PEEK_TOKEN () == COMMA) |
| { |
| FORWARD_TOKEN (); |
| parse_loc_declaration (in_spec_module); |
| } |
| ignoring = save_ignoring; |
| parse_semi_colon (); |
| } |
| |
| static tree |
| parse_optforbid () |
| { |
| if (check_token (FORBID) == 0) |
| return NULL_TREE; |
| if (check_token (ALL)) |
| return ignoring ? NULL_TREE : build_int_2 (-1, -1); |
| #if 0 |
| if (check_token (LPRN)) |
| { |
| tree list = parse_forbidlist (); |
| expect (RPRN, "missing ')' after FORBID list"); |
| return list; |
| } |
| #endif |
| error ("bad syntax following FORBID"); |
| return NULL_TREE; |
| } |
| |
| /* Matches: <grant postfix> or <seize postfix> |
| Returns: A (singleton) TREE_LIST. */ |
| |
| static tree |
| parse_postfix (grant_or_seize) |
| enum terminal grant_or_seize; |
| { |
| tree name = parse_opt_name_string (1); |
| tree forbid = NULL_TREE; |
| if (name == NULL_TREE) |
| { |
| error ("expected a postfix name here"); |
| name = error_mark_node; |
| } |
| if (grant_or_seize == GRANT) |
| forbid = parse_optforbid (); |
| return build_tree_list (forbid, name); |
| } |
| |
| static tree |
| parse_postfix_list (grant_or_seize) |
| enum terminal grant_or_seize; |
| { |
| tree list = parse_postfix (grant_or_seize); |
| while (check_token (COMMA)) |
| list = chainon (list, parse_postfix (grant_or_seize)); |
| return list; |
| } |
| |
| static void |
| parse_rename_clauses (grant_or_seize) |
| enum terminal grant_or_seize; |
| { |
| for (;;) |
| { |
| tree rename_old_prefix, rename_new_prefix, postfix; |
| require (LPRN); |
| rename_old_prefix = parse_opt_name_string (0); |
| expect (ARROW, "missing '->' in rename clause"); |
| rename_new_prefix = parse_opt_name_string (0); |
| expect (RPRN, "missing ')' in rename clause"); |
| expect ('!', "missing '!' in rename clause"); |
| postfix = parse_postfix (grant_or_seize); |
| |
| if (grant_or_seize == GRANT) |
| chill_grant (rename_old_prefix, rename_new_prefix, |
| TREE_VALUE (postfix), TREE_PURPOSE (postfix)); |
| else |
| chill_seize (rename_old_prefix, rename_new_prefix, |
| TREE_VALUE (postfix)); |
| |
| if (PEEK_TOKEN () != COMMA) |
| break; |
| FORWARD_TOKEN (); |
| if (PEEK_TOKEN () != LPRN) |
| { |
| error ("expected another rename clause"); |
| break; |
| } |
| } |
| } |
| |
| static tree |
| parse_opt_prefix_clause () |
| { |
| if (check_token (PREFIXED) == 0) |
| return NULL_TREE; |
| return build_prefix_clause (parse_opt_name_string (0)); |
| } |
| |
| static void |
| parse_grant_statement () |
| { |
| require (GRANT); |
| if (PEEK_TOKEN () == LPRN) |
| parse_rename_clauses (GRANT); |
| else |
| { |
| tree window = parse_postfix_list (GRANT); |
| tree new_prefix = parse_opt_prefix_clause (); |
| tree t; |
| for (t = window; t; t = TREE_CHAIN (t)) |
| chill_grant (NULL_TREE, new_prefix, TREE_VALUE (t), TREE_PURPOSE (t)); |
| } |
| } |
| |
| static void |
| parse_seize_statement () |
| { |
| require (SEIZE); |
| if (PEEK_TOKEN () == LPRN) |
| parse_rename_clauses (SEIZE); |
| else |
| { |
| tree seize_window = parse_postfix_list (SEIZE); |
| tree old_prefix = parse_opt_prefix_clause (); |
| tree t; |
| for (t = seize_window; t; t = TREE_CHAIN (t)) |
| chill_seize (old_prefix, NULL_TREE, TREE_VALUE (t)); |
| } |
| } |
| |
| /* In pass 1, this returns a TREE_LIST, one node for each parameter. |
| In pass 2, we get a list of PARM_DECLs chained together. |
| In either case, the list is in reverse order. */ |
| |
| static tree |
| parse_param_name_list () |
| { |
| tree list = NULL_TREE; |
| do |
| { |
| tree new_link; |
| tree name = parse_defining_occurrence (); |
| if (name == NULL_TREE) |
| { |
| error ("syntax error in parameter name list"); |
| return list; |
| } |
| if (pass == 1) |
| new_link = build_tree_list (NULL_TREE, name); |
| /* else if (current_module->is_spec_module) ; nothing */ |
| else /* pass == 2 */ |
| { |
| new_link = make_node (PARM_DECL); |
| DECL_NAME (new_link) = name; |
| DECL_ASSEMBLER_NAME (new_link) = name; |
| } |
| |
| TREE_CHAIN (new_link) = list; |
| list = new_link; |
| } while (check_token (COMMA)); |
| return list; |
| } |
| |
| static tree |
| parse_param_attr () |
| { |
| tree attr; |
| switch (PEEK_TOKEN ()) |
| { |
| case PARAMATTR: /* INOUT is returned here */ |
| attr = PEEK_TREE (); |
| FORWARD_TOKEN (); |
| return attr; |
| case IN: |
| FORWARD_TOKEN (); |
| return ridpointers[(int) RID_IN]; |
| case LOC: |
| FORWARD_TOKEN (); |
| return ridpointers[(int) RID_LOC]; |
| #if 0 |
| case DYNAMIC: |
| FORWARD_TOKEN (); |
| return ridpointers[(int) RID_DYNAMIC]; |
| #endif |
| default: |
| return NULL_TREE; |
| } |
| } |
| |
| /* We wrap CHILL array parameters in a STRUCT. The original parameter |
| name is unpacked from the struct at get_identifier time */ |
| |
| /* In pass 1, returns list of types; in pass 2: chain of PARM_DECLs. */ |
| |
| static tree |
| parse_formpar () |
| { |
| tree names = parse_param_name_list (); |
| tree mode = parse_mode (); |
| tree paramattr = parse_param_attr (); |
| return chill_munge_params (nreverse (names), mode, paramattr); |
| } |
| |
| /* |
| * Note: build_process_header depends upon the *exact* |
| * representation of STRUCT fields and of formal parameter |
| * lists. If either is changed, build_process_header will |
| * also need change. Push_extern_process is affected as well. |
| */ |
| static tree |
| parse_formparlist () |
| { |
| tree list = NULL_TREE; |
| if (PEEK_TOKEN() == RPRN) |
| return NULL_TREE; |
| for (;;) |
| { |
| list = chainon (list, parse_formpar ()); |
| if (! check_token (COMMA)) |
| break; |
| } |
| return list; |
| } |
| |
| static tree |
| parse_opt_result_spec () |
| { |
| tree mode; |
| int is_nonref, is_loc, is_dynamic; |
| if (!check_token (RETURNS)) |
| return void_type_node; |
| expect (LPRN, "expected '(' after RETURNS"); |
| mode = parse_mode (); |
| is_nonref = check_token (NONREF); |
| is_loc = check_token (LOC); |
| is_dynamic = check_token (DYNAMIC); |
| if (is_nonref && !is_loc) |
| error ("NONREF specific without LOC in result attribute"); |
| if (is_dynamic && !is_loc) |
| error ("DYNAMIC specific without LOC in result attribute"); |
| mode = get_type_of (mode); |
| if (is_loc && ! ignoring) |
| mode = build_chill_reference_type (mode); |
| expect (RPRN, "expected ')' after RETURNS"); |
| return mode; |
| } |
| |
| static tree |
| parse_opt_except () |
| { |
| tree list = NULL_TREE; |
| if (!check_token (EXCEPTIONS)) |
| return NULL_TREE; |
| expect (LPRN, "expected '(' after EXCEPTIONS"); |
| do |
| { |
| tree except_name = parse_name_string (); |
| tree name; |
| for (name = list; name != NULL_TREE; name = TREE_CHAIN (name)) |
| if (TREE_VALUE (name) == except_name && pass == 1) |
| { |
| error ("exception names must be unique"); |
| break; |
| } |
| if (name == NULL_TREE && !ignoring) |
| list = tree_cons (NULL_TREE, except_name, list); |
| } while (check_token (COMMA)); |
| expect (RPRN, "expected ')' after EXCEPTIONS"); |
| return list; |
| } |
| |
| static tree |
| parse_opt_recursive () |
| { |
| if (check_token (RECURSIVE)) |
| return ridpointers[RID_RECURSIVE]; |
| else |
| return NULL_TREE; |
| } |
| |
| static tree |
| parse_procedureattr () |
| { |
| tree generality; |
| tree optrecursive; |
| switch (PEEK_TOKEN ()) |
| { |
| case GENERAL: |
| FORWARD_TOKEN (); |
| generality = ridpointers[RID_GENERAL]; |
| break; |
| case SIMPLE: |
| FORWARD_TOKEN (); |
| generality = ridpointers[RID_SIMPLE]; |
| break; |
| case INLINE: |
| FORWARD_TOKEN (); |
| generality = ridpointers[RID_INLINE]; |
| break; |
| default: |
| generality = NULL_TREE; |
| } |
| optrecursive = parse_opt_recursive (); |
| if (pass != 1) |
| return NULL_TREE; |
| if (generality) |
| generality = build_tree_list (NULL_TREE, generality); |
| if (optrecursive) |
| generality = tree_cons (NULL_TREE, optrecursive, generality); |
| return generality; |
| } |
| |
| /* Parse the body and last part of a procedure or process definition. */ |
| |
| static void |
| parse_proc_body (name, exceptions) |
| tree name; |
| tree exceptions; |
| { |
| int save_proc_action_level = proc_action_level; |
| proc_action_level = action_nesting_level; |
| if (exceptions != NULL_TREE) |
| /* set up a handler for reraising exceptions */ |
| push_handler (); |
| push_action (); |
| define__PROCNAME__ (); |
| parse_body (); |
| proc_action_level = save_proc_action_level; |
| expect (END, "'END' was expected here"); |
| parse_opt_handler (); |
| if (exceptions != NULL_TREE) |
| chill_reraise_exceptions (exceptions); |
| parse_opt_end_label_semi_colon (name); |
| end_function (); |
| } |
| |
| static void |
| parse_procedure_definition (in_spec_module) |
| int in_spec_module; |
| { |
| int save_ignoring = ignoring; |
| tree name = parse_defining_occurrence (); |
| tree params, result, exceptlist, attributes; |
| int save_chill_at_module_level = chill_at_module_level; |
| chill_at_module_level = 0; |
| if (!in_spec_module) |
| ignoring = pass == 2; |
| require (COLON); require (PROC); |
| expect (LPRN, "missing '(' after PROC"); |
| params = parse_formparlist (); |
| expect (RPRN, "missing ')' in PROC"); |
| result = parse_opt_result_spec (); |
| exceptlist = parse_opt_except (); |
| attributes = parse_procedureattr (); |
| ignoring = save_ignoring; |
| if (in_spec_module) |
| { |
| expect (END, "missing 'END'"); |
| parse_opt_end_label_semi_colon (name); |
| push_extern_function (name, result, params, exceptlist, 0); |
| return; |
| } |
| push_chill_function_context (); |
| start_chill_function (name, result, params, exceptlist, attributes); |
| current_module->procedure_seen = 1; |
| parse_proc_body (name, TYPE_RAISES_EXCEPTIONS (TREE_TYPE (current_function_decl))); |
| chill_at_module_level = save_chill_at_module_level; |
| } |
| |
| static tree |
| parse_processpar () |
| { |
| tree names = parse_defining_occurrence_list (); |
| tree mode = parse_mode (); |
| tree paramattr = parse_param_attr (); |
| |
| if (names && TREE_CODE (names) == IDENTIFIER_NODE) |
| names = build_tree_list (NULL_TREE, names); |
| return tree_cons (tree_cons (paramattr, mode, NULL_TREE), names, NULL_TREE); |
| } |
| |
| static tree |
| parse_processparlist () |
| { |
| tree list = NULL_TREE; |
| if (PEEK_TOKEN() == RPRN) |
| return NULL_TREE; |
| for (;;) |
| { |
| list = chainon (list, parse_processpar ()); |
| if (! check_token (COMMA)) |
| break; |
| } |
| return list; |
| } |
| |
| static void |
| parse_process_definition (in_spec_module) |
| int in_spec_module; |
| { |
| int save_ignoring = ignoring; |
| tree name = parse_defining_occurrence (); |
| tree params; |
| tree tmp; |
| if (!in_spec_module) |
| ignoring = 0; |
| require (COLON); require (PROCESS); |
| expect (LPRN, "missing '(' after PROCESS"); |
| params = parse_processparlist (); |
| expect (RPRN, "missing ')' in PROCESS"); |
| ignoring = save_ignoring; |
| if (in_spec_module) |
| { |
| expect (END, "missing 'END'"); |
| parse_opt_end_label_semi_colon (name); |
| push_extern_process (name, params, NULL_TREE, 0); |
| return; |
| } |
| tmp = build_process_header (name, params); |
| parse_proc_body (name, NULL_TREE); |
| build_process_wrapper (name, tmp); |
| } |
| |
| static void |
| parse_signal_definition () |
| { |
| tree signame = parse_defining_occurrence (); |
| tree modes = NULL_TREE; |
| tree dest = NULL_TREE; |
| |
| if (check_token (EQL)) |
| { |
| expect (LPRN, "missing '(' after 'SIGNAL <name> ='"); |
| for (;;) |
| { |
| tree mode = parse_mode (); |
| modes = tree_cons (NULL_TREE, mode, modes); |
| if (! check_token (COMMA)) |
| break; |
| } |
| expect (RPRN, "missing ')'"); |
| modes = nreverse (modes); |
| } |
| |
| if (check_token (TO)) |
| { |
| tree decl; |
| int save_ignoring = ignoring; |
| ignoring = 0; |
| decl = parse_name (); |
| ignoring = save_ignoring; |
| if (pass > 1) |
| { |
| if (decl == NULL_TREE |
| || TREE_CODE (decl) == ERROR_MARK |
| || TREE_CODE (decl) != FUNCTION_DECL |
| || !CH_DECL_PROCESS (decl)) |
| error ("must specify a PROCESS name"); |
| else |
| dest = decl; |
| } |
| } |
| |
| if (! global_bindings_p ()) |
| error ("SIGNAL must be in global reach"); |
| else |
| { |
| tree struc = build_signal_struct_type (signame, modes, dest); |
| tree decl = |
| generate_tasking_code_variable (signame, |
| &signal_code, |
| current_module->is_spec_module); |
| /* remember the code variable in the struct type */ |
| DECL_TASKING_CODE_DECL (struc) = (struct lang_decl *)decl; |
| CH_DECL_SIGNAL (struc) = 1; |
| add_taskstuff_to_list (decl, "_TT_Signal", |
| current_module->is_spec_module ? |
| NULL_TREE : signal_code, struc, NULL_TREE); |
| } |
| |
| } |
| |
| static void |
| parse_signal_definition_statement () |
| { |
| int save_ignoring = ignoring; |
| ignoring = pass == 2; |
| require (SIGNAL); |
| for (;;) |
| { |
| parse_signal_definition (); |
| if (! check_token (COMMA)) |
| break; |
| if (PEEK_TOKEN () == SC) |
| { |
| error ("syntax error while parsing signal definition statement"); |
| break; |
| } |
| } |
| parse_semi_colon (); |
| ignoring = save_ignoring; |
| } |
| |
| static int |
| parse_definition (in_spec_module) |
| int in_spec_module; |
| { |
| switch (PEEK_TOKEN ()) |
| { |
| case NAME: |
| if (PEEK_TOKEN1() == COLON) |
| { |
| if (PEEK_TOKEN2() == PROC) |
| { |
| parse_procedure_definition (in_spec_module); |
| return 1; |
| } |
| else if (PEEK_TOKEN2() == PROCESS) |
| { |
| parse_process_definition (in_spec_module); |
| return 1; |
| } |
| } |
| return 0; |
| case DCL: |
| parse_declaration_statement(in_spec_module); |
| break; |
| case GRANT: |
| parse_grant_statement (); |
| break; |
| case NEWMODE: |
| parse_mode_definition_statement(1); |
| break; |
| case SC: |
| label = NULL_TREE; |
| FORWARD_TOKEN(); |
| return 1; |
| case SEIZE: |
| parse_seize_statement (); |
| break; |
| case SIGNAL: |
| parse_signal_definition_statement (); |
| break; |
| case SYN: |
| parse_synonym_definition_statement(); |
| break; |
| case SYNMODE: |
| parse_mode_definition_statement(0); |
| break; |
| default: |
| return 0; |
| } |
| return 1; |
| } |
| |
| static void |
| parse_then_clause () |
| { |
| expect (THEN, "expected 'THEN' after 'IF'"); |
| if (! ignoring) |
| emit_line_note (input_filename, lineno); |
| parse_opt_actions (); |
| } |
| |
| static void |
| parse_opt_else_clause () |
| { |
| while (check_token (ELSIF)) |
| { |
| tree cond = parse_expression (); |
| if (! ignoring) |
| expand_start_elseif (truthvalue_conversion (cond)); |
| parse_then_clause (); |
| } |
| if (check_token (ELSE)) |
| { |
| if (! ignoring) |
| { emit_line_note (input_filename, lineno); |
| expand_start_else (); |
| } |
| parse_opt_actions (); |
| } |
| } |
| |
| static tree parse_expr_list () |
| { |
| tree expr = parse_expression (); |
| tree list = ignoring ? NULL_TREE : build_tree_list (NULL_TREE, expr); |
| while (check_token (COMMA)) |
| { |
| expr = parse_expression (); |
| if (! ignoring) |
| list = tree_cons (NULL_TREE, expr, list); |
| } |
| return list; |
| } |
| |
| static tree |
| parse_range_list_clause () |
| { |
| tree name = parse_opt_name_string (0); |
| if (name == NULL_TREE) |
| return NULL_TREE; |
| while (check_token (COMMA)) |
| { |
| name = parse_name_string (); |
| } |
| if (check_token (SC)) |
| { |
| sorry ("case range list"); |
| return error_mark_node; |
| } |
| pushback_token (NAME, name); |
| return NULL_TREE; |
| } |
| |
| static void |
| pushback_paren_expr (expr) |
| tree expr; |
| { |
| if (pass == 1 && !ignoring) |
| expr = build1 (PAREN_EXPR, NULL_TREE, expr); |
| pushback_token (EXPR, expr); |
| } |
| |
| /* Matches: <case label> */ |
| |
| static tree |
| parse_case_label () |
| { |
| tree expr; |
| if (check_token (ELSE)) |
| return case_else_node; |
| /* Does this also handle the case of a mode name? FIXME */ |
| expr = parse_expression (); |
| if (check_token (COLON)) |
| { |
| tree max_expr = parse_expression (); |
| if (! ignoring) |
| expr = build (RANGE_EXPR, NULL_TREE, expr, max_expr); |
| } |
| return expr; |
| } |
| |
| /* Parses: <case_label_list> |
| Fails if not followed by COMMA or COLON. |
| If it fails, it backs up if needed, and returns NULL_TREE. |
| IN_TUPLE is true if we are parsing a tuple element, |
| and 0 if we are parsing a case label specification. */ |
| |
| static tree |
| parse_case_label_list (selector, in_tuple) |
| tree selector; |
| int in_tuple; |
| { |
| tree expr, list; |
| if (! check_token (LPRN)) |
| return NULL_TREE; |
| if (check_token (MUL)) |
| { |
| expect (RPRN, "missing ')' after '*' case label list"); |
| if (ignoring) |
| return integer_zero_node; |
| expr = build (RANGE_EXPR, NULL_TREE, NULL_TREE, NULL_TREE); |
| expr = build_tree_list (NULL_TREE, expr); |
| return expr; |
| } |
| expr = parse_case_label (); |
| if (check_token (RPRN)) |
| { |
| if ((in_tuple || PEEK_TOKEN () != COMMA) && PEEK_TOKEN () != COLON) |
| { |
| /* Ooops! It looks like it was the start of an action or |
| unlabelled tuple element, and not a case label, so back up. */ |
| if (expr != NULL_TREE && TREE_CODE (expr) == RANGE_EXPR) |
| { |
| error ("misplaced colon in case label"); |
| expr = error_mark_node; |
| } |
| pushback_paren_expr (expr); |
| return NULL_TREE; |
| } |
| list = build_tree_list (NULL_TREE, expr); |
| if (expr == case_else_node && selector != NULL_TREE) |
| ELSE_LABEL_SPECIFIED (selector) = 1; |
| return list; |
| } |
| list = build_tree_list (NULL_TREE, expr); |
| if (expr == case_else_node && selector != NULL_TREE) |
| ELSE_LABEL_SPECIFIED (selector) = 1; |
| |
| while (check_token (COMMA)) |
| { |
| expr = parse_case_label (); |
| list = tree_cons (NULL_TREE, expr, list); |
| if (expr == case_else_node && selector != NULL_TREE) |
| ELSE_LABEL_SPECIFIED (selector) = 1; |
| } |
| expect (RPRN, "missing ')' at end of case label list"); |
| return nreverse (list); |
| } |
| |
| /* Parses: <case_label_specification> |
| Must be followed by a COLON. |
| If it fails, it backs up if needed, and returns NULL_TREE. */ |
| |
| static tree |
| parse_case_label_specification (selectors) |
| tree selectors; |
| { |
| tree list_list = NULL_TREE; |
| tree list; |
| list = parse_case_label_list (selectors, 0); |
| if (list == NULL_TREE) |
| return NULL_TREE; |
| list_list = build_tree_list (NULL_TREE, list); |
| while (check_token (COMMA)) |
| { |
| if (selectors != NULL_TREE) |
| selectors = TREE_CHAIN (selectors); |
| list = parse_case_label_list (selectors, 0); |
| if (list == NULL_TREE) |
| { |
| error ("unrecognized case label list after ','"); |
| return list_list; |
| } |
| list_list = tree_cons (NULL_TREE, list, list_list); |
| } |
| return nreverse (list_list); |
| } |
| |
| static void |
| parse_single_dimension_case_action (selector) |
| tree selector; |
| { |
| int no_completeness_check = 0; |
| |
| /* The case label/action toggle. It is 0 initially, and when an action |
| was last seen. It is 1 integer_zero_node when a label was last seen. */ |
| int caseaction_flag = 0; |
| |
| if (! ignoring) |
| { |
| expand_exit_needed = 0; |
| selector = check_case_selector (selector); |
| expand_start_case (1, selector, TREE_TYPE (selector), "CASE statement"); |
| push_momentary (); |
| } |
| |
| for (;;) |
| { |
| tree label_spec = parse_case_label_specification (selector); |
| if (label_spec != NULL_TREE) |
| { |
| expect (COLON, "missing ':' in case alternative"); |
| if (! ignoring) |
| { |
| no_completeness_check |= chill_handle_single_dimension_case_label ( |
| selector, label_spec, &expand_exit_needed, &caseaction_flag); |
| } |
| } |
| else if (parse_action ()) |
| { |
| expand_exit_needed = 1; |
| caseaction_flag = 0; |
| } |
| else |
| break; |
| } |
| |
| if (! ignoring) |
| { |
| if (expand_exit_needed || caseaction_flag == 1) |
| expand_exit_something (); |
| } |
| if (check_token (ELSE)) |
| { |
| if (! ignoring) |
| chill_handle_case_default (); |
| parse_opt_actions (); |
| if (! ignoring) |
| { |
| emit_line_note (input_filename, lineno); |
| expand_exit_something (); |
| } |
| } |
| else if (! ignoring && TREE_CODE (selector) != ERROR_MARK && |
| ! no_completeness_check) |
| check_missing_cases (TREE_TYPE (selector)); |
| |
| expect (ESAC, "missing 'ESAC' after 'CASE'"); |
| if (! ignoring) |
| { |
| expand_end_case (selector); |
| pop_momentary (); |
| } |
| } |
| |
| static void |
| parse_multi_dimension_case_action (selector) |
| tree selector; |
| { |
| struct rtx_def *begin_test_label = 0, *end_case_label = 0, *new_label; |
| tree action_labels = NULL_TREE; |
| tree tests = NULL_TREE; |
| int save_lineno = lineno; |
| const char *save_filename = input_filename; |
| |
| /* We can't compute the range of an (ELSE) label until all of the CASE |
| label specifications have been seen, however, the code for the actions |
| between them is generated on the fly. We can still generate everything in |
| one pass is we use the following form: |
| |
| Compile a CASE of the form |
| |
| case S1,...,Sn of |
| (X11),...,(X1n): A1; |
| ... |
| (Xm1),...,(Xmn): Am; |
| else Ae; |
| esac; |
| |
| into: |
| |
| goto L0; |
| L1: A1; goto L99; |
| ... |
| Lm: Am; goto L99; |
| Le: Ae; goto L99; |
| L0: |
| T1 := s1; ...; Tn := Sn; |
| if (T1 = X11 and ... and Tn = X1n) GOTO L1; |
| ... |
| if (T1 = Xm1 and ... and Tn = Xmn) GOTO Lm; |
| GOTO Le; |
| L99; |
| */ |
| |
| if (! ignoring) |
| { |
| selector = check_case_selector_list (selector); |
| begin_test_label = gen_label_rtx (); |
| end_case_label = gen_label_rtx (); |
| emit_jump (begin_test_label); |
| } |
| |
| for (;;) |
| { |
| tree label_spec = parse_case_label_specification (selector); |
| if (label_spec != NULL_TREE) |
| { |
| expect (COLON, "missing ':' in case alternative"); |
| if (! ignoring) |
| { |
| tests = tree_cons (label_spec, NULL_TREE, tests); |
| |
| if (action_labels != NULL_TREE) |
| emit_jump (end_case_label); |
| |
| new_label = gen_label_rtx (); |
| emit_label (new_label); |
| emit_line_note (input_filename, lineno); |
| action_labels = tree_cons (NULL_TREE, NULL_TREE, action_labels); |
| TREE_CST_RTL (action_labels) = new_label; |
| } |
| } |
| else if (! parse_action ()) |
| { |
| if (action_labels != NULL_TREE) |
| emit_jump (end_case_label); |
| break; |
| } |
| } |
| |
| if (check_token (ELSE)) |
| { |
| if (! ignoring) |
| { |
| new_label = gen_label_rtx (); |
| emit_label (new_label); |
| emit_line_note (input_filename, lineno); |
| action_labels = tree_cons (NULL_TREE, NULL_TREE, action_labels); |
| TREE_CST_RTL (action_labels) = new_label; |
| } |
| parse_opt_actions (); |
| if (! ignoring) |
| emit_jump (end_case_label); |
| } |
| |
| expect (ESAC, "missing 'ESAC' after 'CASE'"); |
| |
| if (! ignoring) |
| { |
| emit_label (begin_test_label); |
| emit_line_note (save_filename, save_lineno); |
| if (tests != NULL_TREE) |
| { |
| tree cond; |
| tests = nreverse (tests); |
| action_labels = nreverse (action_labels); |
| compute_else_ranges (selector, tests); |
| |
| cond = build_multi_case_selector_expression (selector, TREE_PURPOSE (tests)); |
| expand_start_cond (truthvalue_conversion (cond), label ? 1 : 0); |
| emit_jump (TREE_CST_RTL (action_labels)); |
| |
| for (tests = TREE_CHAIN (tests), action_labels = TREE_CHAIN (action_labels); |
| tests != NULL_TREE && action_labels != NULL_TREE; |
| tests = TREE_CHAIN (tests), action_labels = TREE_CHAIN (action_labels)) |
| { |
| cond = |
| build_multi_case_selector_expression (selector, TREE_PURPOSE (tests)); |
| expand_start_elseif (truthvalue_conversion (cond)); |
| emit_jump (TREE_CST_RTL (action_labels)); |
| } |
| if (action_labels != NULL_TREE) |
| { |
| expand_start_else (); |
| emit_jump (TREE_CST_RTL (action_labels)); |
| } |
| expand_end_cond (); |
| } |
| emit_label (end_case_label); |
| } |
| } |
| |
| static void |
| parse_case_action (label) |
| tree label; |
| { |
| tree selector; |
| int multi_dimension_case = 0; |
| |
| require (CASE); |
| selector = parse_expr_list (); |
| selector = nreverse (selector); |
| expect (OF, "missing 'OF' after 'CASE'"); |
| parse_range_list_clause (); |
| |
| PUSH_ACTION; |
| if (label) |
| pushlevel (1); |
| |
| if (! ignoring) |
| { |
| expand_exit_needed = 0; |
| if (TREE_CODE (selector) == TREE_LIST) |
| { |
| if (TREE_CHAIN (selector) != NULL_TREE) |
| multi_dimension_case = 1; |
| else |
| selector = TREE_VALUE (selector); |
| } |
| } |
| |
| /* We want to use the regular CASE support for the single dimension case. The |
| multi dimension case requires different handling. Note that when "ignoring" |
| is true we parse using the single dimension code. This is OK since it will |
| still parse correctly. */ |
| if (multi_dimension_case) |
| parse_multi_dimension_case_action (selector); |
| else |
| parse_single_dimension_case_action (selector); |
| |
| if (label) |
| { |
| possibly_define_exit_label (label); |
| poplevel (0, 0, 0); |
| } |
| } |
| |
| /* Matches: [ <asm_operand> { "," <asm_operand> }* ], |
| where <asm_operand> = STRING '(' <expression> ')' |
| These are the operands other than the first string and colon |
| in asm ("addextend %2,%1": "=dm" (x), "0" (y), "g" (*x)) */ |
| |
| static tree |
| parse_asm_operands () |
| { |
| tree list = NULL_TREE; |
| if (PEEK_TOKEN () != STRING) |
| return NULL_TREE; |
| for (;;) |
| { |
| tree string, expr; |
| if (PEEK_TOKEN () != STRING) |
| { |
| error ("bad ASM operand"); |
| return list; |
| } |
| string = PEEK_TREE(); |
| FORWARD_TOKEN (); |
| expect (LPRN, "missing '(' in ASM operand"); |
| expr = parse_expression (); |
| expect (RPRN, "missing ')' in ASM operand"); |
| list = tree_cons (string, expr, list); |
| if (! check_token (COMMA)) |
| break; |
| } |
| return nreverse (list); |
| } |
| |
| /* Matches: STRING { ',' STRING }* */ |
| |
| static tree |
| parse_asm_clobbers () |
| { |
| tree list = NULL_TREE; |
| for (;;) |
| { |
| tree string; |
| if (PEEK_TOKEN () != STRING) |
| { |
| error ("bad ASM operand"); |
| return list; |
| } |
| string = PEEK_TREE(); |
| FORWARD_TOKEN (); |
| list = tree_cons (NULL_TREE, string, list); |
| if (! check_token (COMMA)) |
| break; |
| } |
| return list; |
| } |
| |
| static void |
| ch_expand_asm_operands (string, outputs, inputs, clobbers, vol, filename, line) |
| tree string, outputs, inputs, clobbers; |
| int vol; |
| const char *filename; |
| int line; |
| { |
| int noutputs = list_length (outputs); |
| register int i; |
| /* o[I] is the place that output number I should be written. */ |
| register tree *o = (tree *) alloca (noutputs * sizeof (tree)); |
| register tree tail; |
| |
| if (TREE_CODE (string) == ADDR_EXPR) |
| string = TREE_OPERAND (string, 0); |
| if (TREE_CODE (string) != STRING_CST) |
| { |
| error ("asm template is not a string constant"); |
| return; |
| } |
| |
| /* Record the contents of OUTPUTS before it is modified. */ |
| for (i = 0, tail = outputs; tail; tail = TREE_CHAIN (tail), i++) |
| o[i] = TREE_VALUE (tail); |
| |
| #if 0 |
| /* Perform default conversions on array and function inputs. */ |
| /* Don't do this for other types-- |
| it would screw up operands expected to be in memory. */ |
| for (i = 0, tail = inputs; tail; tail = TREE_CHAIN (tail), i++) |
| if (TREE_CODE (TREE_TYPE (TREE_VALUE (tail))) == ARRAY_TYPE |
| || TREE_CODE (TREE_TYPE (TREE_VALUE (tail))) == FUNCTION_TYPE) |
| TREE_VALUE (tail) = default_conversion (TREE_VALUE (tail)); |
| #endif |
| |
| /* Generate the ASM_OPERANDS insn; |
| store into the TREE_VALUEs of OUTPUTS some trees for |
| where the values were actually stored. */ |
| expand_asm_operands (string, outputs, inputs, clobbers, vol, filename, line); |
| |
| /* Copy all the intermediate outputs into the specified outputs. */ |
| for (i = 0, tail = outputs; tail; tail = TREE_CHAIN (tail), i++) |
| { |
| if (o[i] != TREE_VALUE (tail)) |
| { |
| expand_expr (build_chill_modify_expr (o[i], TREE_VALUE (tail)), |
| 0, VOIDmode, 0); |
| free_temp_slots (); |
| } |
| /* Detect modification of read-only values. |
| (Otherwise done by build_modify_expr.) */ |
| else |
| { |
| tree type = TREE_TYPE (o[i]); |
| if (TYPE_READONLY (type) |
| || ((TREE_CODE (type) == RECORD_TYPE |
| || TREE_CODE (type) == UNION_TYPE) |
| && TYPE_FIELDS_READONLY (type))) |
| warning ("readonly location modified by 'asm'"); |
| } |
| } |
| |
| /* Those MODIFY_EXPRs could do autoincrements. */ |
| emit_queue (); |
| } |
| |
| static void |
| parse_asm_action () |
| { |
| tree insn; |
| require (ASM_KEYWORD); |
| expect (LPRN, "missing '('"); |
| PUSH_ACTION; |
| if (!ignoring) |
| emit_line_note (input_filename, lineno); |
| insn = parse_expression (); |
| if (check_token (COLON)) |
| { |
| tree output_operand, input_operand, clobbered_regs; |
| output_operand = parse_asm_operands (); |
| if (check_token (COLON)) |
| input_operand = parse_asm_operands (); |
| else |
| input_operand = NULL_TREE; |
| if (check_token (COLON)) |
| clobbered_regs = parse_asm_clobbers (); |
| else |
| clobbered_regs = NULL_TREE; |
| expect (RPRN, "missing ')'"); |
| if (!ignoring) |
| ch_expand_asm_operands (insn, output_operand, input_operand, |
| clobbered_regs, FALSE, |
| input_filename, lineno); |
| } |
| else |
| { |
| expect (RPRN, "missing ')'"); |
| STRIP_NOPS (insn); |
| if (ignoring) { } |
| else if ((TREE_CODE (insn) == ADDR_EXPR |
| && TREE_CODE (TREE_OPERAND (insn, 0)) == STRING_CST) |
| || TREE_CODE (insn) == STRING_CST) |
| expand_asm (insn); |
| else |
| error ("argument of `asm' is not a constant string"); |
| } |
| } |
| |
| static void |
| parse_begin_end_block (label) |
| tree label; |
| { |
| require (BEGINTOKEN); |
| #if 0 |
| /* don't make a linenote at BEGIN */ |
| INIT_ACTION; |
| #endif |
| pushlevel (1); |
| if (! ignoring) |
| { |
| clear_last_expr (); |
| push_momentary (); |
| expand_start_bindings (label ? 1 : 0); |
| } |
| push_handler (); |
| parse_body (); |
| expect (END, "missing 'END'"); |
| /* Note that the opthandler comes before the poplevel |
| - hence a handler is in the scope of the block. */ |
| parse_opt_handler (); |
| possibly_define_exit_label (label); |
| if (! ignoring) |
| { |
| emit_line_note (input_filename, lineno); |
| expand_end_bindings (getdecls (), kept_level_p (), 0); |
| } |
| poplevel (kept_level_p (), 0, 0); |
| if (! ignoring) |
| pop_momentary (); |
| parse_opt_end_label_semi_colon (label); |
| } |
| |
| static void |
| parse_if_action (label) |
| tree label; |
| { |
| tree cond; |
| require (IF); |
| PUSH_ACTION; |
| cond = parse_expression (); |
| if (label) |
| pushlevel (1); |
| if (! ignoring) |
| { |
| expand_start_cond (truthvalue_conversion (cond), |
| label ? 1 : 0); |
| } |
| parse_then_clause (); |
| parse_opt_else_clause (); |
| expect (FI, "expected 'FI' after 'IF'"); |
| if (! ignoring) |
| { |
| emit_line_note (input_filename, lineno); |
| expand_end_cond (); |
| } |
| if (label) |
| { |
| possibly_define_exit_label (label); |
| poplevel (0, 0, 0); |
| } |
| } |
| |
| /* Matches: <iteration> (as in a <for control>). */ |
| |
| static void |
| parse_iteration () |
| { |
| tree loop_counter = parse_defining_occurrence (); |
| if (check_token (ASGN)) |
| { |
| tree start_value = parse_expression (); |
| tree step_value |
| = check_token (BY) ? parse_expression () : NULL_TREE; |
| int going_down = check_token (DOWN); |
| tree end_value; |
| if (check_token (TO)) |
| end_value = parse_expression (); |
| else |
| { |
| error ("expected 'TO' in step enumeration"); |
| end_value = error_mark_node; |
| } |
| if (!ignoring) |
| build_loop_iterator (loop_counter, start_value, step_value, |
| end_value, going_down, 0, 0); |
| } |
| else |
| { |
| int going_down = check_token (DOWN); |
| tree expr; |
| if (check_token (IN)) |
| expr = parse_expression (); |
| else |
| { |
| error ("expected 'IN' in FOR control here"); |
| expr = error_mark_node; |
| } |
| if (!ignoring) |
| { |
| tree low_bound, high_bound; |
| if (expr && TREE_CODE (expr) == TYPE_DECL) |
| { |
| expr = TREE_TYPE (expr); |
| /* FIXME: expr must be an array or powerset */ |
| low_bound = convert (expr, TYPE_MIN_VALUE (expr)); |
| high_bound = convert (expr, TYPE_MAX_VALUE (expr)); |
| } |
| else |
| { |
| low_bound = expr; |
| high_bound = NULL_TREE; |
| } |
| build_loop_iterator (loop_counter, low_bound, |
| NULL_TREE, high_bound, |
| going_down, 1, 0); |
| } |
| } |
| } |
| |
| /* Matches: '(' <event list> ')' ':'. |
| Or; returns NULL_EXPR. */ |
| |
| static tree |
| parse_delay_case_event_list () |
| { |
| tree event_list = NULL_TREE; |
| tree event; |
| if (! check_token (LPRN)) |
| return NULL_TREE; |
| event = parse_expression (); |
| if (PEEK_TOKEN () == ')' && PEEK_TOKEN1 () != ':') |
| { |
| /* Oops. */ |
| require (RPRN); |
| pushback_paren_expr (event); |
| return NULL_TREE; |
| } |
| for (;;) |
| { |
| if (! ignoring) |
| event_list = tree_cons (NULL_TREE, event, event_list); |
| if (! check_token (COMMA)) |
| break; |
| event = parse_expression (); |
| } |
| expect (RPRN, "missing ')'"); |
| expect (COLON, "missing ':'"); |
| return ignoring ? error_mark_node : event_list; |
| } |
| |
| static void |
| parse_delay_case_action (label) |
| tree label; |
| { |
| tree label_cnt = NULL_TREE, set_location, priority; |
| tree combined_event_list = NULL_TREE; |
| require (DELAY); |
| require (CASE); |
| PUSH_ACTION; |
| pushlevel (1); |
| expand_exit_needed = 0; |
| if (check_token (SET)) |
| { |
| set_location = parse_expression (); |
| parse_semi_colon (); |
| } |
| else |
| set_location = NULL_TREE; |
| if (check_token (PRIORITY)) |
| { |
| priority = parse_expression (); |
| parse_semi_colon (); |
| } |
| else |
| priority = NULL_TREE; |
| if (! ignoring) |
| label_cnt = build_delay_case_start (set_location, priority); |
| for (;;) |
| { |
| tree event_list = parse_delay_case_event_list (); |
| if (event_list) |
| { |
| if (! ignoring ) |
| { |
| int if_or_elseif = combined_event_list == NULL_TREE; |
| build_delay_case_label (event_list, if_or_elseif); |
| combined_event_list = chainon (combined_event_list, event_list); |
| } |
| } |
| else if (parse_action ()) |
| { |
| if (! ignoring) |
| { |
| expand_exit_needed = 1; |
| if (combined_event_list == NULL_TREE) |
| error ("missing DELAY CASE alternative"); |
| } |
| } |
| else |
| break; |
| } |
| expect (ESAC, "missing 'ESAC' in DELAY CASE'"); |
| if (! ignoring) |
| build_delay_case_end (combined_event_list); |
| possibly_define_exit_label (label); |
| poplevel (0, 0, 0); |
| } |
| |
| static void |
| parse_do_action (label) |
| tree label; |
| { |
| tree condition; |
| int token; |
| require (DO); |
| if (check_token (WITH)) |
| { |
| tree list = NULL_TREE; |
| for (;;) |
| { |
| tree name = parse_primval (); |
| if (! ignoring && TREE_CODE (name) != ERROR_MARK) |
| { |
| if (TREE_CODE (TREE_TYPE (name)) == REFERENCE_TYPE) |
| name = convert (TREE_TYPE (TREE_TYPE (name)), name); |
| else |
| { |
| int is_loc = chill_location (name); |
| if (is_loc == 1) /* This is probably not possible */ |
| warning ("non-referable location in DO WITH"); |
| |
| if (is_loc > 1) |
| name = build_chill_arrow_expr (name, 1); |
| name = decl_temp1 (get_identifier ("__with_element"), |
| TREE_TYPE (name), |
| 0, name, 0, 0); |
| if (is_loc > 1) |
| name = build_chill_indirect_ref (name, NULL_TREE, 0); |
| |
| } |
| if (TREE_CODE (TREE_TYPE (name)) != RECORD_TYPE) |
| error ("WITH element must be of STRUCT mode"); |
| else |
| list = tree_cons (NULL_TREE, name, list); |
| } |
| if (! check_token (COMMA)) |
| break; |
| } |
| pushlevel (1); |
| push_action (); |
| for (list = nreverse (list); list != NULL_TREE; list = TREE_CHAIN (list)) |
| shadow_record_fields (TREE_VALUE (list)); |
| |
| parse_semi_colon (); |
| parse_opt_actions (); |
| expect (OD, "missing 'OD' in 'DO WITH'"); |
| if (! ignoring) |
| emit_line_note (input_filename, lineno); |
| possibly_define_exit_label (label); |
| parse_opt_handler (); |
| parse_opt_end_label_semi_colon (label); |
| poplevel (0, 0, 0); |
| return; |
| } |
| token = PEEK_TOKEN(); |
| if (token != FOR && token != WHILE) |
| { |
| push_handler (); |
| parse_opt_actions (); |
| expect (OD, "missing 'OD' after 'DO'"); |
| parse_opt_handler (); |
| parse_opt_end_label_semi_colon (label); |
| return; |
| } |
| if (! ignoring) |
| emit_line_note (input_filename, lineno); |
| push_loop_block (); |
| if (check_token (FOR)) |
| { |
| if (check_token (EVER)) |
| { |
| if (!ignoring) |
| build_loop_iterator (NULL_TREE, NULL_TREE, |
| NULL_TREE, NULL_TREE, |
| 0, 0, 1); |
| } |
| else |
| { |
| parse_iteration (); |
| while (check_token (COMMA)) |
| parse_iteration (); |
| } |
| } |
| else if (!ignoring) |
| build_loop_iterator (NULL_TREE, NULL_TREE, |
| NULL_TREE, NULL_TREE, |
| 0, 0, 1); |
| |
| begin_loop_scope (); |
| if (! ignoring) |
| build_loop_start (label); |
| condition = check_token (WHILE) ? parse_expression () : NULL_TREE; |
| if (! ignoring) |
| top_loop_end_check (condition); |
| parse_semi_colon (); |
| parse_opt_actions (); |
| if (! ignoring) |
| build_loop_end (); |
| expect (OD, "missing 'OD' after 'DO'"); |
| /* Note that the handler is inside the reach of the DO. */ |
| parse_opt_handler (); |
| end_loop_scope (label); |
| pop_loop_block (); |
| parse_opt_end_label_semi_colon (label); |
| } |
| |
| /* Matches: '(' <signal name> [ 'IN' <defining occurrence list> ']' ')' ':' |
| or: '(' <buffer location> IN (defining occurrence> ')' ':' |
| or: returns NULL_TREE. */ |
| |
| static tree |
| parse_receive_spec () |
| { |
| tree val; |
| tree name_list = NULL_TREE; |
| if (!check_token (LPRN)) |
| return NULL_TREE; |
| val = parse_primval (); |
| if (check_token (IN)) |
| { |
| #if 0 |
| if (flag_local_loop_counter) |
| name_list = parse_defining_occurrence_list (); |
| else |
| #endif |
| { |
| for (;;) |
| { |
| tree loc = parse_primval (); |
| if (! ignoring) |
| name_list = tree_cons (NULL_TREE, loc, name_list); |
| if (! check_token (COMMA)) |
| break; |
| } |
| } |
| } |
| if (! check_token (RPRN)) |
| { |
| error ("missing ')' in signal/buffer receive alternative"); |
| return NULL_TREE; |
| } |
| if (check_token (COLON)) |
| { |
| if (ignoring || val == NULL_TREE || TREE_CODE (val) == ERROR_MARK) |
| return error_mark_node; |
| else |
| return build_receive_case_label (val, name_list); |
| } |
| |
| /* We saw: '(' <primitive value> ')' not followed by ':'. |
| Presumably the start of an action. Backup and fail. */ |
| if (name_list != NULL_TREE) |
| error ("misplaced 'IN' in signal/buffer receive alternative"); |
| pushback_paren_expr (val); |
| return NULL_TREE; |
| } |
| |
| /* To understand the code generation for this, see ch-tasking.c, |
| and the 2-page comments preceding the |
| build_chill_receive_case_start () definition. */ |
| |
| static void |
| parse_receive_case_action (label) |
| tree label; |
| { |
| tree instance_location; |
| tree have_else_actions; |
| int spec_seen = 0; |
| tree alt_list = NULL_TREE; |
| require (RECEIVE); |
| require (CASE); |
| push_action (); |
| pushlevel (1); |
| if (! ignoring) |
| { |
| expand_exit_needed = 0; |
| } |
| |
| if (check_token (SET)) |
| { |
| instance_location = parse_expression (); |
| parse_semi_colon (); |
| } |
| else |
| instance_location = NULL_TREE; |
| if (! ignoring) |
| instance_location = build_receive_case_start (instance_location); |
| |
| for (;;) |
| { |
| tree receive_spec = parse_receive_spec (); |
| if (receive_spec) |
| { |
| if (! ignoring) |
| alt_list = tree_cons (NULL_TREE, receive_spec, alt_list); |
| spec_seen++; |
| } |
| else if (parse_action ()) |
| { |
| if (! spec_seen && pass == 1) |
| error ("missing RECEIVE alternative"); |
| if (! ignoring) |
| expand_exit_needed = 1; |
| spec_seen = 1; |
| } |
| else |
| break; |
| } |
| if (check_token (ELSE)) |
| { |
| if (! ignoring) |
| { |
| emit_line_note (input_filename, lineno); |
| if (build_receive_case_if_generated ()) |
| expand_start_else (); |
| } |
| parse_opt_actions (); |
| have_else_actions = integer_one_node; |
| } |
| else |
| have_else_actions = integer_zero_node; |
| expect (ESAC, "missing 'ESAC' matching 'RECEIVE CASE'"); |
| if (! ignoring) |
| { |
| build_receive_case_end (nreverse (alt_list), have_else_actions); |
| } |
| possibly_define_exit_label (label); |
| poplevel (0, 0, 0); |
| } |
| |
| static void |
| parse_send_action () |
| { |
| tree signal = NULL_TREE; |
| tree buffer = NULL_TREE; |
| tree value_list; |
| tree with_expr, to_expr, priority; |
| require (SEND); |
| /* The tricky part is distinguishing between a SEND buffer action, |
| and a SEND signal action. */ |
| if (pass != 2 || PEEK_TOKEN () != NAME) |
| { |
| /* If this is pass 2, it's a SEND buffer action. |
| If it's pass 1, we don't care. */ |
| buffer = parse_primval (); |
| } |
| else |
| { |
| /* We have to specifically check for signalname followed by |
| a '(', since we allow a signalname to be used (syntactically) |
| as a "function". */ |
| tree name = parse_name (); |
| if (TREE_CODE (name) == TYPE_DECL && CH_DECL_SIGNAL (name)) |
| signal = name; /* It's a SEND signal action! */ |
| else |
| { |
| /* It's not a legal SEND signal action. |
| Back up and try as a SEND buffer action. */ |
| pushback_token (EXPR, name); |
| buffer = parse_primval (); |
| } |
| } |
| if (check_token (LPRN)) |
| { |
| value_list = NULL_TREE; |
| for (;;) |
| { |
| tree expr = parse_untyped_expr (); |
| if (! ignoring) |
| value_list = tree_cons (NULL_TREE, expr, value_list); |
| if (! check_token (COMMA)) |
| break; |
| } |
| value_list = nreverse (value_list); |
| expect (RPRN, "missing ')'"); |
| } |
| else |
| value_list = NULL_TREE; |
| if (check_token (WITH)) |
| with_expr = parse_expression (); |
| else |
| with_expr = NULL_TREE; |
| if (check_token (TO)) |
| to_expr = parse_expression (); |
| else |
| to_expr = NULL_TREE; |
| if (check_token (PRIORITY)) |
| priority = parse_expression (); |
| else |
| priority = NULL_TREE; |
| PUSH_ACTION; |
| if (ignoring) |
| return; |
| |
| if (signal) |
| { /* It's a <send signal action>! */ |
| tree sigdesc = build_signal_descriptor (signal, value_list); |
| if (sigdesc != NULL_TREE && TREE_CODE (sigdesc) != ERROR_MARK) |
| { |
| tree sendto = to_expr ? to_expr : IDENTIFIER_SIGNAL_DEST (signal); |
| expand_send_signal (sigdesc, with_expr, |
| sendto, priority, DECL_NAME (signal)); |
| } |
| } |
| else |
| { |
| /* all checks are done in expand_send_buffer */ |
| expand_send_buffer (buffer, value_list, priority, with_expr, to_expr); |
| } |
| } |
| |
| static void |
| parse_start_action () |
| { |
| tree name, copy_number, param_list, startset; |
| require (START); |
| name = parse_name_string (); |
| expect (LPRN, "missing '(' in START action"); |
| PUSH_ACTION; |
| /* copy number is a required parameter */ |
| copy_number = parse_expression (); |
| if (!ignoring |
| && (copy_number == NULL_TREE |
| || TREE_CODE (copy_number) == ERROR_MARK |
| || TREE_CODE (TREE_TYPE (copy_number)) != INTEGER_TYPE)) |
| { |
| error ("PROCESS copy number must be integer"); |
| copy_number = integer_zero_node; |
| } |
| if (check_token (COMMA)) |
| param_list = parse_expr_list (); /* user parameters */ |
| else |
| param_list = NULL_TREE; |
| expect (RPRN, "missing ')'"); |
| startset = check_token (SET) ? parse_primval () : NULL; |
| build_start_process (name, copy_number, param_list, startset); |
| } |
| |
| static void |
| parse_opt_actions () |
| { |
| while (parse_action ()) ; |
| } |
| |
| static int |
| parse_action () |
| { |
| tree label = NULL_TREE; |
| tree expr, rhs, loclist; |
| enum tree_code op; |
| |
| if (current_function_decl == global_function_decl |
| && PEEK_TOKEN () != SC |
| && PEEK_TOKEN () != END) |
| seen_action = 1, build_constructor = 1; |
| |
| if (PEEK_TOKEN () == NAME && PEEK_TOKEN1 () == COLON) |
| { |
| label = parse_defining_occurrence (); |
| require (COLON); |
| INIT_ACTION; |
| define_label (input_filename, lineno, label); |
| } |
| |
| switch (PEEK_TOKEN ()) |
| { |
| case AFTER: |
| { |
| int delay; |
| require (AFTER); |
| expr = parse_primval (); |
| delay = check_token (DELAY); |
| expect (IN, "missing 'IN'"); |
| push_action (); |
| pushlevel (1); |
| build_after_start (expr, delay); |
| parse_opt_actions (); |
| expect (TIMEOUT, "missing 'TIMEOUT'"); |
| build_after_timeout_start (); |
| parse_opt_actions (); |
| expect (END, "missing 'END'"); |
| build_after_end (); |
| possibly_define_exit_label (label); |
| poplevel (0, 0, 0); |
| } |
| goto bracketed_action; |
| case ASM_KEYWORD: |
| parse_asm_action (); |
| goto no_handler_action; |
| case ASSERT: |
| require (ASSERT); |
| PUSH_ACTION; |
| expr = parse_expression (); |
| if (! ignoring) |
| { tree assertfail = ridpointers[(int) RID_ASSERTFAIL]; |
| expr = build (TRUTH_ORIF_EXPR, void_type_node, expr, |
| build_cause_exception (assertfail, 0)); |
| expand_expr_stmt (fold (expr)); |
| } |
| goto handler_action; |
| case AT: |
| require (AT); |
| PUSH_ACTION; |
| expr = parse_primval (); |
| expect (IN, "missing 'IN'"); |
| pushlevel (1); |
| if (! ignoring) |
| build_at_action (expr); |
| parse_opt_actions (); |
| expect (TIMEOUT, "missing 'TIMEOUT'"); |
| if (! ignoring) |
| expand_start_else (); |
| parse_opt_actions (); |
| expect (END, "missing 'END'"); |
| if (! ignoring) |
| expand_end_cond (); |
| possibly_define_exit_label (label); |
| poplevel (0, 0, 0); |
| goto bracketed_action; |
| case BEGINTOKEN: |
| parse_begin_end_block (label); |
| return 1; |
| case CASE: |
| parse_case_action (label); |
| goto bracketed_action; |
| case CAUSE: |
| require (CAUSE); |
| expr = parse_name_string (); |
| PUSH_ACTION; |
| if (! ignoring && TREE_CODE (expr) != ERROR_MARK) |
| expand_cause_exception (expr); |
| goto no_handler_action; |
| case CONTINUE: |
| require (CONTINUE); |
| expr = parse_expression (); |
| PUSH_ACTION; |
| if (! ignoring) |
| expand_continue_event (expr); |
| goto handler_action; |
| case CYCLE: |
| require (CYCLE); |
| PUSH_ACTION; |
| expr = parse_primval (); |
| expect (IN, "missing 'IN' after 'CYCLE'"); |
| pushlevel (1); |
| /* We a tree list where TREE_VALUE is the label |
| and TREE_PURPOSE is the variable denotes the timeout id. */ |
| expr = build_cycle_start (expr); |
| parse_opt_actions (); |
| expect (END, "missing 'END'"); |
| if (! ignoring) |
| build_cycle_end (expr); |
| possibly_define_exit_label (label); |
| poplevel (0, 0, 0); |
| goto bracketed_action; |
| case DELAY: |
| if (PEEK_TOKEN1 () == CASE) |
| { |
| parse_delay_case_action (label); |
| goto bracketed_action; |
| } |
| require (DELAY); |
| PUSH_ACTION; |
| expr = parse_primval (); |
| rhs = check_token (PRIORITY) ? parse_expression () : NULL_TREE; |
| if (! ignoring) |
| build_delay_action (expr, rhs); |
| goto handler_action; |
| case DO: |
| parse_do_action (label); |
| return 1; |
| case EXIT: |
| require (EXIT); |
| expr = parse_name_string (); |
| PUSH_ACTION; |
| lookup_and_handle_exit (expr); |
| goto no_handler_action; |
| case GOTO: |
| require (GOTO); |
| expr = parse_name_string (); |
| PUSH_ACTION; |
| lookup_and_expand_goto (expr); |
| goto no_handler_action; |
| case IF: |
| parse_if_action (label); |
| goto bracketed_action; |
| case RECEIVE: |
| if (PEEK_TOKEN1 () != CASE) |
| return 0; |
| parse_receive_case_action (label); |
| goto bracketed_action; |
| case RESULT: |
| require (RESULT); |
| PUSH_ACTION; |
| expr = parse_untyped_expr (); |
| if (! ignoring) |
| chill_expand_result (expr, 1); |
| goto handler_action; |
| case RETURN: |
| require (RETURN); |
| PUSH_ACTION; |
| expr = parse_opt_untyped_expr (); |
| if (! ignoring) |
| { |
| /* Do this as RESULT expr and RETURN to get exceptions */ |
| chill_expand_result (expr, 0); |
| expand_goto_except_cleanup (proc_action_level); |
| chill_expand_return (NULL_TREE, 0); |
| } |
| if (expr) |
| goto handler_action; |
| else |
| goto no_handler_action; |
| case SC: |
| require (SC); |
| return 1; |
| case SEND: |
| parse_send_action (); |
| goto handler_action; |
| case START: |
| parse_start_action (); |
| goto handler_action; |
| case STOP: |
| require (STOP); |
| PUSH_ACTION; |
| if (! ignoring) |
| { tree func = lookup_name (get_identifier ("__stop_process")); |
| tree result = build_chill_function_call (func, NULL_TREE); |
| expand_expr_stmt (result); |
| } |
| goto no_handler_action; |
| case CALL: |
| require (CALL); |
| /* Fall through to here ... */ |
| case EXPR: |
| case LPRN: |
| case NAME: |
| /* This handles calls and assignments. */ |
| PUSH_ACTION; |
| expr = parse_primval (); |
| switch (PEEK_TOKEN ()) |
| { |
| case END: |
| parse_semi_colon (); /* Emits error message. */ |
| case ON: |
| case SC: |
| if (!ignoring && TREE_CODE (expr) != ERROR_MARK) |
| { |
| if (TREE_CODE (expr) != CALL_EXPR |
| && TREE_TYPE (expr) != void_type_node |
| && ! TREE_SIDE_EFFECTS (expr)) |
| { |
| if (TREE_CODE (expr) == FUNCTION_DECL) |
| error ("missing parenthesis for procedure call"); |
| else |
| error ("expression is not an action"); |
| expr = error_mark_node; |
| } |
| else |
| expand_expr_stmt (expr); |
| } |
| goto handler_action; |
| default: |
| loclist |
| = ignoring ? NULL_TREE : build_tree_list (NULL_TREE, expr); |
| while (PEEK_TOKEN () == COMMA) |
| { |
| FORWARD_TOKEN (); |
| expr = parse_primval (); |
| if (!ignoring && TREE_CODE (expr) != ERROR_MARK) |
| loclist = tree_cons (NULL_TREE, expr, loclist); |
| } |
| } |
| switch (PEEK_TOKEN ()) |
| { |
| case OR: op = BIT_IOR_EXPR; break; |
| case XOR: op = BIT_XOR_EXPR; break; |
| case ORIF: op = TRUTH_ORIF_EXPR; break; |
| case AND: op = BIT_AND_EXPR; break; |
| case ANDIF: op = TRUTH_ANDIF_EXPR; break; |
| case PLUS: op = PLUS_EXPR; break; |
| case SUB: op = MINUS_EXPR; break; |
| case CONCAT: op = CONCAT_EXPR; break; |
| case MUL: op = MULT_EXPR; break; |
| case DIV: op = TRUNC_DIV_EXPR; break; |
| case MOD: op = FLOOR_MOD_EXPR; break; |
| case REM: op = TRUNC_MOD_EXPR; break; |
| |
| default: |
| error ("syntax error in action"); |
| case SC: case ON: |
| case ASGN: op = NOP_EXPR; break; |
| ; |
| } |
| |
| /* Looks like it was an assignment action. */ |
| FORWARD_TOKEN (); |
| if (op != NOP_EXPR) |
| expect (ASGN, "expected ':=' here"); |
| rhs = parse_untyped_expr (); |
| if (!ignoring) |
| expand_assignment_action (loclist, op, rhs); |
| goto handler_action; |
| |
| default: |
| return 0; |
| } |
| |
| bracketed_action: |
| /* We've parsed a bracketed action. */ |
| parse_opt_handler (); |
| parse_opt_end_label_semi_colon (label); |
| return 1; |
| |
| no_handler_action: |
| if (parse_opt_handler () != NULL_TREE && pass == 1) |
| error ("no handler is permitted on this action"); |
| parse_semi_colon (); |
| return 1; |
| |
| handler_action: |
| parse_opt_handler (); |
| parse_semi_colon (); |
| return 1; |
| } |
| |
| static void |
| parse_body () |
| { |
| again: |
| while (parse_definition (0)) ; |
| |
| while (parse_action ()) ; |
| |
| if (parse_definition (0)) |
| { |
| if (pass == 1) |
| pedwarn ("definition follows action"); |
| goto again; |
| } |
| } |
| |
| static tree |
| parse_opt_untyped_expr () |
| { |
| switch (PEEK_TOKEN ()) |
| { |
| case ON: |
| case END: |
| case SC: |
| case COMMA: |
| case COLON: |
| case RPRN: |
| return NULL_TREE; |
| default: |
| return parse_untyped_expr (); |
| } |
| } |
| |
| static tree |
| parse_call (function) |
| tree function; |
| { |
| tree arg1, arg2, arg_list = NULL_TREE; |
| enum terminal tok; |
| require (LPRN); |
| arg1 = parse_opt_untyped_expr (); |
| if (arg1 != NULL_TREE) |
| { |
| tok = PEEK_TOKEN (); |
| if (tok == UP || tok == COLON) |
| { |
| FORWARD_TOKEN (); |
| #if 0 |
| /* check that arg1 isn't untyped (or mode);*/ |
| #endif |
| arg2 = parse_expression (); |
| expect (RPRN, "expected ')' to terminate slice"); |
| if (ignoring) |
| return integer_zero_node; |
| else if (tok == UP) |
| return build_chill_slice_with_length (function, arg1, arg2); |
| else |
| return build_chill_slice_with_range (function, arg1, arg2); |
| } |
| if (!ignoring) |
| arg_list = build_tree_list (NULL_TREE, arg1); |
| while (check_token (COMMA)) |
| { |
| arg2 = parse_untyped_expr (); |
| if (!ignoring) |
| arg_list = tree_cons (NULL_TREE, arg2, arg_list); |
| } |
| } |
| |
| expect (RPRN, "expected ')' here"); |
| return ignoring ? function |
| : build_generalized_call (function, nreverse (arg_list)); |
| } |
| |
| /* Matches: <field name list> |
| Returns: A list of IDENTIFIER_NODEs (or NULL_TREE if ignoring), |
| in reverse order. */ |
| |
| static tree |
| parse_tuple_fieldname_list () |
| { |
| tree list = NULL_TREE; |
| do |
| { |
| tree name; |
| if (!check_token (DOT)) |
| { |
| error ("bad tuple field name list"); |
| return NULL_TREE; |
| } |
| name = parse_simple_name_string (); |
| list = ignoring ? NULL_TREE : tree_cons (NULL_TREE, name, list); |
| } while (check_token (COMMA)); |
| return list; |
| } |
| |
| /* Returns one or nore TREE_LIST nodes, in reverse order. */ |
| |
| static tree |
| parse_tuple_element () |
| { |
| /* The tupleelement chain is built in reverse order, |
| and put in forward order when the list is used. */ |
| tree value, label; |
| if (PEEK_TOKEN () == DOT) |
| { |
| /* Parse a labelled structure tuple. */ |
| tree list = parse_tuple_fieldname_list (), field; |
| expect (COLON, "missing ':' in tuple"); |
| value = parse_untyped_expr (); |
| if (ignoring) |
| return NULL_TREE; |
| /* FIXME: Should use save_expr(value), but that |
| confuses nested calls to digest_init! */ |
| /* Re-use the list of field names as a list of name-value pairs. */ |
| for (field = list; field != NULL_TREE; field = TREE_CHAIN (field)) |
| { tree field_name = TREE_VALUE (field); |
| TREE_PURPOSE (field) = field_name; |
| TREE_VALUE (field) = value; |
| TUPLE_NAMED_FIELD (field) = 1; |
| } |
| return list; |
| } |
| |
| label = parse_case_label_list (NULL_TREE, 1); |
| if (label) |
| { |
| expect (COLON, "missing ':' in tuple"); |
| value = parse_untyped_expr (); |
| if (ignoring || label == NULL_TREE) |
| return NULL_TREE; |
| if (TREE_CODE (label) != TREE_LIST) |
| { |
| error ("invalid syntax for label in tuple"); |
| return NULL_TREE; |
| } |
| else |
| { |
| /* FIXME: Should use save_expr(value), but that |
| confuses nested calls to digest_init! */ |
| tree link = label; |
| for (; link != NULL_TREE; link = TREE_CHAIN (link)) |
| { tree index = TREE_VALUE (link); |
| if (pass == 1 && TREE_CODE (index) != TREE_LIST) |
| index = build1 (PAREN_EXPR, NULL_TREE, index); |
| TREE_VALUE (link) = value; |
| TREE_PURPOSE (link) = index; |
| } |
| return nreverse (label); |
| } |
| } |
| |
| value = parse_untyped_expr (); |
| if (check_token (COLON)) |
| { |
| /* A powerset range [or possibly a labeled Array?] */ |
| tree value2 = parse_untyped_expr (); |
| return ignoring ? NULL_TREE : build_tree_list (value, value2); |
| } |
| return ignoring ? NULL_TREE : build_tree_list (NULL_TREE, value); |
| } |
| |
| /* Matches: a COMMA-separated list of tuple elements. |
| Returns a list (of TREE_LIST nodes). */ |
| static tree |
| parse_opt_element_list () |
| { |
| tree list = NULL_TREE; |
| if (PEEK_TOKEN () == RPC) |
| return NULL_TREE; |
| for (;;) |
| { |
| tree element = parse_tuple_element (); |
| list = chainon (element, list); /* Built in reverse order */ |
| if (PEEK_TOKEN () == RPC) |
| break; |
| if (!check_token (COMMA)) |
| { |
| error ("bad syntax in tuple"); |
| return NULL_TREE; |
| } |
| } |
| return nreverse (list); |
| } |
| |
| /* Parses: '[' elements ']' |
| If modename is non-NULL it prefixed the tuple. */ |
| |
| static tree |
| parse_tuple (modename) |
| tree modename; |
| { |
| tree list; |
| require (LPC); |
| list = parse_opt_element_list (); |
| expect (RPC, "missing ']' after tuple"); |
| if (ignoring) |
| return integer_zero_node; |
| list = build_nt (CONSTRUCTOR, NULL_TREE, list); |
| if (modename == NULL_TREE) |
| return list; |
| else if (pass == 1) |
| TREE_TYPE (list) = modename; |
| else if (TREE_CODE (modename) != TYPE_DECL) |
| { |
| error ("non-mode name before tuple"); |
| return error_mark_node; |
| } |
| else |
| list = chill_expand_tuple (TREE_TYPE (modename), list); |
| return list; |
| } |
| |
| static tree |
| parse_primval () |
| { |
| tree val; |
| switch (PEEK_TOKEN ()) |
| { |
| case NUMBER: |
| case FLOATING: |
| case STRING: |
| case SINGLECHAR: |
| case BITSTRING: |
| case CONST: |
| case EXPR: |
| val = PEEK_TREE(); |
| FORWARD_TOKEN (); |
| break; |
| case THIS: |
| val = build_chill_function_call (PEEK_TREE (), NULL_TREE); |
| FORWARD_TOKEN (); |
| break; |
| case LPRN: |
| FORWARD_TOKEN (); |
| val = parse_expression (); |
| expect (RPRN, "missing right parenthesis"); |
| if (pass == 1 && ! ignoring) |
| val = build1 (PAREN_EXPR, NULL_TREE, val); |
| break; |
| case LPC: |
| val = parse_tuple (NULL_TREE); |
| break; |
| case NAME: |
| val = parse_name (); |
| if (PEEK_TOKEN() == LPC) |
| val = parse_tuple (val); /* Matched: <mode_name> <tuple> */ |
| break; |
| default: |
| if (!ignoring) |
| error ("invalid expression/location syntax"); |
| val = error_mark_node; |
| } |
| for (;;) |
| { |
| tree name, args; |
| switch (PEEK_TOKEN ()) |
| { |
| case DOT: |
| FORWARD_TOKEN (); |
| name = parse_simple_name_string (); |
| val = ignoring ? val : build_chill_component_ref (val, name); |
| continue; |
| case ARROW: |
| FORWARD_TOKEN (); |
| name = parse_opt_name_string (0); |
| val = ignoring ? val : build_chill_indirect_ref (val, name, 1); |
| continue; |
| case LPRN: |
| /* The SEND buffer action syntax is ambiguous, at least when |
| parsed left-to-right. In the example 'SEND foo(v) ...' the |
| phrase 'foo(v)' could be a buffer location procedure call |
| (which then must be followed by the value to send). |
| On the other hand, if 'foo' is a buffer, stop parsing |
| after 'foo', and let parse_send_action pick up '(v) as |
| the value ot send. |
| |
| We handle the ambiguity for SEND signal action differently, |
| since we allow (as an extension) a signal to be used as |
| a "function" (see build_generalized_call). */ |
| if (TREE_TYPE (val) != NULL_TREE |
| && CH_IS_BUFFER_MODE (TREE_TYPE (val))) |
| return val; |
| val = parse_call (val); |
| continue; |
| case STRING: |
| case BITSTRING: |
| case SINGLECHAR: |
| case NAME: |
| /* Handle string repetition. (See comment in parse_operand5.) */ |
| args = parse_primval (); |
| val = ignoring ? val : build_generalized_call (val, args); |
| continue; |
| default: |
| break; |
| } |
| break; |
| } |
| return val; |
| } |
| |
| static tree |
| parse_operand6 () |
| { |
| if (check_token (RECEIVE)) |
| { |
| tree location ATTRIBUTE_UNUSED = parse_primval (); |
| sorry ("RECEIVE expression"); |
| return integer_one_node; |
| } |
| else if (check_token (ARROW)) |
| { |
| tree location = parse_primval (); |
| return ignoring ? location : build_chill_arrow_expr (location, 0); |
| } |
| else |
| return parse_primval(); |
| } |
| |
| static tree |
| parse_operand5() |
| { |
| enum tree_code op; |
| /* We are supposed to be looking for a <string repetition operator>, |
| but in general we can't distinguish that from a parenthesized |
| expression. This is especially difficult if we allow the |
| string operand to be a constant expression (as requested by |
| some users), and not just a string literal. |
| Consider: LPRN expr RPRN LPRN expr RPRN |
| Is that a function call or string repetition? |
| Instead, we handle string repetition in parse_primval, |
| and build_generalized_call. */ |
| tree rarg; |
| switch (PEEK_TOKEN()) |
| { |
| case NOT: op = BIT_NOT_EXPR; break; |
| case SUB: op = NEGATE_EXPR; break; |
| default: |
| op = NOP_EXPR; |
| } |
| if (op != NOP_EXPR) |
| FORWARD_TOKEN(); |
| rarg = parse_operand6(); |
| return (op == NOP_EXPR || ignoring) ? rarg |
| : build_chill_unary_op (op, rarg); |
| } |
| |
| static tree |
| parse_operand4 () |
| { |
| tree larg = parse_operand5(), rarg; |
| enum tree_code op; |
| for (;;) |
| { |
| switch (PEEK_TOKEN()) |
| { |
| case MUL: op = MULT_EXPR; break; |
| case DIV: op = TRUNC_DIV_EXPR; break; |
| case MOD: op = FLOOR_MOD_EXPR; break; |
| case REM: op = TRUNC_MOD_EXPR; break; |
| default: |
| return larg; |
| } |
| FORWARD_TOKEN(); |
| rarg = parse_operand5(); |
| if (!ignoring) |
| larg = build_chill_binary_op (op, larg, rarg); |
| } |
| } |
| |
| static tree |
| parse_operand3 () |
| { |
| tree larg = parse_operand4 (), rarg; |
| enum tree_code op; |
| for (;;) |
| { |
| switch (PEEK_TOKEN()) |
| { |
| case PLUS: op = PLUS_EXPR; break; |
| case SUB: op = MINUS_EXPR; break; |
| case CONCAT: op = CONCAT_EXPR; break; |
| default: |
| return larg; |
| } |
| FORWARD_TOKEN(); |
| rarg = parse_operand4(); |
| if (!ignoring) |
| larg = build_chill_binary_op (op, larg, rarg); |
| } |
| } |
| |
| static tree |
| parse_operand2 () |
| { |
| tree larg = parse_operand3 (), rarg; |
| enum tree_code op; |
| for (;;) |
| { |
| if (check_token (IN)) |
| { |
| rarg = parse_operand3(); |
| if (! ignoring) |
| larg = build_chill_binary_op (SET_IN_EXPR, larg, rarg); |
| } |
| else |
| { |
| switch (PEEK_TOKEN()) |
| { |
| case GT: op = GT_EXPR; break; |
| case GTE: op = GE_EXPR; break; |
| case LT: op = LT_EXPR; break; |
| case LTE: op = LE_EXPR; break; |
| case EQL: op = EQ_EXPR; break; |
| case NE: op = NE_EXPR; break; |
| default: |
| return larg; |
| } |
| FORWARD_TOKEN(); |
| rarg = parse_operand3(); |
| if (!ignoring) |
| larg = build_compare_expr (op, larg, rarg); |
| } |
| } |
| } |
| |
| static tree |
| parse_operand1 () |
| { |
| tree larg = parse_operand2 (), rarg; |
| enum tree_code op; |
| for (;;) |
| { |
| switch (PEEK_TOKEN()) |
| { |
| case AND: op = BIT_AND_EXPR; break; |
| case ANDIF: op = TRUTH_ANDIF_EXPR; break; |
| default: |
| return larg; |
| } |
| FORWARD_TOKEN(); |
| rarg = parse_operand2(); |
| if (!ignoring) |
| larg = build_chill_binary_op (op, larg, rarg); |
| } |
| } |
| |
| static tree |
| parse_operand0 () |
| { |
| tree larg = parse_operand1(), rarg; |
| enum tree_code op; |
| for (;;) |
| { |
| switch (PEEK_TOKEN()) |
| { |
| case OR: op = BIT_IOR_EXPR; break; |
| case XOR: op = BIT_XOR_EXPR; break; |
| case ORIF: op = TRUTH_ORIF_EXPR; break; |
| default: |
| return larg; |
| } |
| FORWARD_TOKEN(); |
| rarg = parse_operand1(); |
| if (!ignoring) |
| larg = build_chill_binary_op (op, larg, rarg); |
| } |
| } |
| |
| static tree |
| parse_expression () |
| { |
| return parse_operand0 (); |
| } |
| |
| static tree |
| parse_case_expression () |
| { |
| tree selector_list; |
| tree else_expr; |
| tree case_expr; |
| tree case_alt_list = NULL_TREE; |
| |
| require (CASE); |
| selector_list = parse_expr_list (); |
| selector_list = nreverse (selector_list); |
| |
| expect (OF, "missing 'OF'"); |
| while (PEEK_TOKEN () == LPRN) |
| { |
| tree label_spec = parse_case_label_specification (selector_list); |
| tree sub_expr; |
| expect (COLON, "missing ':' in value case alternative"); |
| sub_expr = parse_expression (); |
| expect (SC, "missing ';'"); |
| if (! ignoring) |
| case_alt_list = tree_cons (label_spec, sub_expr, case_alt_list); |
| } |
| if (check_token (ELSE)) |
| { |
| else_expr = parse_expression (); |
| if (check_token (SC) && pass == 1) |
| warning("there should not be a ';' here"); |
| } |
| else |
| else_expr = NULL_TREE; |
| expect (ESAC, "missing 'ESAC' in 'CASE' expression"); |
| |
| if (ignoring) |
| return integer_zero_node; |
| |
| /* If this is a multi dimension case, then transform it into an COND_EXPR |
| here. This must be done before store_expr is called since it has some |
| special handling for COND_EXPR expressions. */ |
| if (TREE_CHAIN (selector_list) != NULL_TREE) |
| { |
| case_alt_list = nreverse (case_alt_list); |
| compute_else_ranges (selector_list, case_alt_list); |
| case_expr = |
| build_chill_multi_dimension_case_expr (selector_list, case_alt_list, else_expr); |
| } |
| else |
| case_expr = build_chill_case_expr (selector_list, case_alt_list, else_expr); |
| |
| return case_expr; |
| } |
| |
| static tree |
| parse_then_alternative () |
| { |
| expect (THEN, "missing 'THEN' in 'IF' expression"); |
| return parse_expression (); |
| } |
| |
| static tree |
| parse_else_alternative () |
| { |
| if (check_token (ELSIF)) |
| return parse_if_expression_body (); |
| else if (check_token (ELSE)) |
| return parse_expression (); |
| error ("missing ELSE/ELSIF in IF expression"); |
| return error_mark_node; |
| } |
| |
| /* Matches: <boolean expression> <then alternative> <else alternative> */ |
| |
| static tree |
| parse_if_expression_body () |
| { |
| tree bool_expr, then_expr, else_expr; |
| bool_expr = parse_expression (); |
| then_expr = parse_then_alternative (); |
| else_expr = parse_else_alternative (); |
| if (ignoring) |
| return integer_zero_node; |
| else |
| return build_nt (COND_EXPR, bool_expr, then_expr, else_expr); |
| } |
| |
| static tree |
| parse_if_expression () |
| { |
| tree expr; |
| require (IF); |
| expr = parse_if_expression_body (); |
| expect (FI, "missing 'FI' at end of conditional expression"); |
| return expr; |
| } |
| |
| /* An <untyped_expr> is a superset of <expr>. It also includes |
| <conditional expressions> and untyped <tuples>, whose types |
| are not given by their constituents. Hence, these are only |
| allowed in certain contexts that expect a certain type. |
| You should call convert() to fix up the <untyped_expr>. */ |
| |
| static tree |
| parse_untyped_expr () |
| { |
| tree val; |
| switch (PEEK_TOKEN()) |
| { |
| case IF: |
| return parse_if_expression (); |
| case CASE: |
| return parse_case_expression (); |
| case LPRN: |
| switch (PEEK_TOKEN1()) |
| { |
| case IF: |
| case CASE: |
| if (pass == 1) |
| pedwarn ("conditional expression not allowed inside parentheses"); |
| goto skip_lprn; |
| case LPC: |
| if (pass == 1) |
| pedwarn ("mode-less tuple not allowed inside parentheses"); |
| skip_lprn: |
| FORWARD_TOKEN (); |
| val = parse_untyped_expr (); |
| expect (RPRN, "missing ')'"); |
| return val; |
| default: ; |
| /* fall through */ |
| } |
| default: |
| return parse_operand0 (); |
| } |
| } |
| |
| /* Matches: <index mode> */ |
| |
| static tree |
| parse_index_mode () |
| { |
| /* This is another one that is nasty to parse! |
| Let's feel our way ahead ... */ |
| tree lower, upper; |
| if (PEEK_TOKEN () == NAME) |
| { |
| tree name = parse_name (); |
| switch (PEEK_TOKEN ()) |
| { |
| case COMMA: |
| case RPRN: |
| case SC: /* An error */ |
| /* This can only (legally) be a discrete mode name. */ |
| return name; |
| case LPRN: |
| /* This could be named discrete range, |
| a cast, or some other expression (maybe). */ |
| require (LPRN); |
| lower = parse_expression (); |
| if (check_token (COLON)) |
| { |
| upper = parse_expression (); |
| expect (RPRN, "missing ')'"); |
| /* Matched: <mode_name> '(' <expr> ':' <expr> ')' */ |
| if (ignoring) |
| return NULL_TREE; |
| else |
| return build_chill_range_type (name, lower, upper); |
| } |
| /* Looks like a cast or procedure call or something. |
| Backup, and try again. */ |
| pushback_token (EXPR, lower); |
| pushback_token (LPRN, NULL_TREE); |
| lower = parse_call (name); |
| goto parse_literal_range_colon; |
| default: |
| /* This has to be the start of an expression. */ |
| pushback_token (EXPR, name); |
| goto parse_literal_range; |
| } |
| } |
| /* It's not a name. But it could still be a discrete mode. */ |
| lower = parse_opt_mode (); |
| if (lower) |
| return lower; |
| parse_literal_range: |
| /* Nope, it's a discrete literal range. */ |
| lower = parse_expression (); |
| parse_literal_range_colon: |
| expect (COLON, "expected ':' here"); |
| |
| upper = parse_expression (); |
| return ignoring ? NULL_TREE |
| : build_chill_range_type (NULL_TREE, lower, upper); |
| } |
| |
| static tree |
| parse_set_mode () |
| { |
| int set_name_cnt = 0; /* count of named set elements */ |
| int set_is_numbered = 0; /* TRUE if set elements have explicit values */ |
| int set_is_not_numbered = 0; |
| tree list = NULL_TREE; |
| tree mode = ignoring ? void_type_node : start_enum (NULL_TREE); |
| require (SET); |
| expect (LPRN, "missing left parenthesis after SET"); |
| for (;;) |
| { |
| tree name, value = NULL_TREE; |
| if (check_token (MUL)) |
| name = NULL_TREE; |
| else |
| { |
| name = parse_defining_occurrence (); |
| if (check_token (EQL)) |
| { |
| value = parse_expression (); |
| set_is_numbered = 1; |
| } |
| else |
| set_is_not_numbered = 1; |
| set_name_cnt++; |
| } |
| name = build_enumerator (name, value); |
| if (pass == 1) |
| list = chainon (name, list); |
| if (! check_token (COMMA)) |
| break; |
| } |
| expect (RPRN, "missing right parenthesis after SET"); |
| if (!ignoring) |
| { |
| if (set_is_numbered && set_is_not_numbered) |
| /* Z.200 doesn't allow mixed numbered and unnumbered set elements, |
| but we can do it. Print a warning */ |
| pedwarn ("mixed numbered and unnumbered set elements is not standard"); |
| mode = finish_enum (mode, list); |
| if (set_name_cnt == 0) |
| error ("SET mode must define at least one named value"); |
| CH_ENUM_IS_NUMBERED(mode) = set_is_numbered ? 1 : 0; |
| } |
| return mode; |
| } |
| |
| /* parse layout POS: |
| returns a tree with following layout |
| |
| treelist |
| pupose=treelist value=NULL_TREE (to indicate POS) |
| pupose=word value=treelist | NULL_TREE |
| pupose=startbit value=treelist | NULL_TREE |
| purpose= value= |
| integer_zero | integer_one length | endbit |
| */ |
| static tree |
| parse_pos () |
| { |
| tree word; |
| tree startbit = NULL_TREE, endbit = NULL_TREE; |
| tree what = NULL_TREE; |
| |
| require (LPRN); |
| word = parse_untyped_expr (); |
| if (check_token (COMMA)) |
| { |
| startbit = parse_untyped_expr (); |
| if (check_token (COMMA)) |
| { |
| what = integer_zero_node; |
| endbit = parse_untyped_expr (); |
| } |
| else if (check_token (COLON)) |
| { |
| what = integer_one_node; |
| endbit = parse_untyped_expr (); |
| } |
| } |
| require (RPRN); |
| |
| /* build the tree as described above */ |
| if (what != NULL_TREE) |
| what = tree_cons (what, endbit, NULL_TREE); |
| if (startbit != NULL_TREE) |
| startbit = tree_cons (startbit, what, NULL_TREE); |
| endbit = tree_cons (word, startbit, NULL_TREE); |
| return tree_cons (endbit, NULL_TREE, NULL_TREE); |
| } |
| |
| /* parse layout STEP |
| returns a tree with the following layout |
| |
| treelist |
| pupose=NULL_TREE value=treelist (to indicate STEP) |
| pupose=POS(see baove) value=stepsize | NULL_TREE |
| */ |
| static tree |
| parse_step () |
| { |
| tree pos; |
| tree stepsize = NULL_TREE; |
| |
| require (LPRN); |
| require (POS); |
| pos = parse_pos (); |
| if (check_token (COMMA)) |
| stepsize = parse_untyped_expr (); |
| require (RPRN); |
| TREE_VALUE (pos) = stepsize; |
| return tree_cons (NULL_TREE, pos, NULL_TREE); |
| } |
| |
| /* returns layout for fields or array elements. |
| NULL_TREE no layout specified |
| integer_one_node PACK specified |
| integer_zero_node NOPACK specified |
| tree_list PURPOSE POS |
| tree_list VALUE STEP |
| */ |
| static tree |
| parse_opt_layout (in) |
| int in; /* 0 ... parse structure, 1 ... parse array */ |
| { |
| tree val = NULL_TREE; |
| |
| if (check_token (PACK)) |
| { |
| return integer_one_node; |
| } |
| else if (check_token (NOPACK)) |
| { |
| return integer_zero_node; |
| } |
| else if (check_token (POS)) |
| { |
| val = parse_pos (); |
| if (in == 1 && pass == 1) |
| { |
| error ("POS not allowed for ARRAY"); |
| val = NULL_TREE; |
| } |
| return val; |
| } |
| else if (check_token (STEP)) |
| { |
| val = parse_step (); |
| if (in == 0 && pass == 1) |
| { |
| error ("STEP not allowed in field definition"); |
| val = NULL_TREE; |
| } |
| return val; |
| } |
| else |
| return NULL_TREE; |
| } |
| |
| static tree |
| parse_field_name_list () |
| { |
| tree chain = NULL_TREE; |
| tree name = parse_defining_occurrence (); |
| if (name == NULL_TREE) |
| { |
| error("missing field name"); |
| return NULL_TREE; |
| } |
| chain = build_tree_list (NULL_TREE, name); |
| while (check_token (COMMA)) |
| { |
| name = parse_defining_occurrence (); |
| if (name == NULL) |
| { |
| error ("bad field name following ','"); |
| break; |
| } |
| if (! ignoring) |
| chain = tree_cons (NULL_TREE, name, chain); |
| } |
| return chain; |
| } |
| |
| /* Matches: <fixed field> or <variant field>, i.e.: |
| <field name defining occurrence list> <mode> [ <field layout> ]. |
| Returns: A chain of FIELD_DECLs. |
| NULL_TREE is returned if ignoring is true or an error is seen. */ |
| |
| static tree |
| parse_fixed_field () |
| { |
| tree field_names = parse_field_name_list (); |
| tree mode = parse_mode (); |
| tree layout = parse_opt_layout (0); |
| return ignoring ? NULL_TREE |
| : grok_chill_fixedfields (field_names, mode, layout); |
| } |
| |
| |
| /* Matches: [ <variant field> { "," <variant field> }* ] |
| Returns: A chain of FIELD_DECLs. |
| NULL_TREE is returned if ignoring is true or an error is seen. */ |
| |
| static tree |
| parse_variant_field_list () |
| { |
| tree fields = NULL_TREE; |
| if (PEEK_TOKEN () != NAME) |
| return NULL_TREE; |
| for (;;) |
| { |
| fields = chainon (fields, parse_fixed_field ()); |
| if (PEEK_TOKEN () != COMMA || PEEK_TOKEN1 () != NAME) |
| break; |
| require (COMMA); |
| } |
| return fields; |
| } |
| |
| /* Matches: <variant alternative> |
| Returns a TREE_LIST node, whose TREE_PURPOSE (if non-NULL) is the label, |
| and whose TREE_VALUE is the list of FIELD_DECLs. */ |
| |
| static tree |
| parse_variant_alternative () |
| { |
| tree labels; |
| |
| if (PEEK_TOKEN () == LPRN) |
| labels = parse_case_label_specification (NULL_TREE); |
| else |
| labels = NULL_TREE; |
| if (! check_token (COLON)) |
| { |
| error ("expected ':' in structure variant alternative"); |
| return NULL_TREE; |
| } |
| |
| /* We now read a list a variant fields, until we come to the end |
| of the variant alternative. But since both variant fields |
| *and* variant alternatives are separated by COMMAs, |
| we will have to look ahead to distinguish the start of a variant |
| field from the start of a new variant alternative. |
| We use the fact that a variant alternative must start with |
| either a LPRN or a COLON, while a variant field must start with a NAME. |
| This look-ahead is handled by parse_simple_fields. */ |
| return build_tree_list (labels, parse_variant_field_list ()); |
| } |
| |
| /* Parse <field> (which is <fixed field> or <alternative field>). |
| Returns: A chain of FIELD_DECLs (or NULL_TREE on error or if ignoring). */ |
| |
| static tree |
| parse_field () |
| { |
| if (check_token (CASE)) |
| { |
| tree tag_list = NULL_TREE, variants, opt_variant_else; |
| if (PEEK_TOKEN () == NAME) |
| { |
| tag_list = nreverse (parse_field_name_list ()); |
| if (pass == 1) |
| tag_list = lookup_tag_fields (tag_list, current_fieldlist); |
| } |
| expect (OF, "missing 'OF' in alternative structure field"); |
| |
| variants = parse_variant_alternative (); |
| while (check_token (COMMA)) |
| variants = chainon (parse_variant_alternative (), variants); |
| variants = nreverse (variants); |
| |
| if (check_token (ELSE)) |
| opt_variant_else = parse_variant_field_list (); |
| else |
| opt_variant_else = NULL_TREE; |
| expect (ESAC, "missing 'ESAC' following alternative structure field"); |
| if (ignoring) |
| return NULL_TREE; |
| return grok_chill_variantdefs (tag_list, variants, opt_variant_else); |
| } |
| else if (PEEK_TOKEN () == NAME) |
| return parse_fixed_field (); |
| else |
| { |
| if (pass == 1) |
| error ("missing field"); |
| return NULL_TREE; |
| } |
| } |
| |
| static tree |
| parse_structure_mode () |
| { |
| tree save_fieldlist = current_fieldlist; |
| tree fields; |
| require (STRUCT); |
| expect (LPRN, "expected '(' after STRUCT"); |
| current_fieldlist = fields = parse_field (); |
| while (check_token (COMMA)) |
| fields = chainon (fields, parse_field ()); |
| expect (RPRN, "expected ')' after STRUCT"); |
| current_fieldlist = save_fieldlist; |
| return ignoring ? void_type_node : build_chill_struct_type (fields); |
| } |
| |
| static tree |
| parse_opt_queue_size () |
| { |
| if (check_token (LPRN)) |
| { |
| tree size = parse_expression (); |
| expect (RPRN, "missing ')'"); |
| return size; |
| } |
| else |
| return NULL_TREE; |
| } |
| |
| static tree |
| parse_procedure_mode () |
| { |
| tree param_types = NULL_TREE, result_spec, except_list, recursive; |
| require (PROC); |
| expect (LPRN, "missing '(' after PROC"); |
| if (! check_token (RPRN)) |
| { |
| for (;;) |
| { |
| tree pmode = parse_mode (); |
| tree paramattr = parse_param_attr (); |
| if (! ignoring) |
| { |
| pmode = get_type_of (pmode); |
| param_types = tree_cons (paramattr, pmode, param_types); |
| } |
| if (! check_token (COMMA)) |
| break; |
| } |
| expect (RPRN, "missing ')' after PROC"); |
| } |
| result_spec = parse_opt_result_spec (); |
| except_list = parse_opt_except (); |
| recursive = parse_opt_recursive (); |
| if (ignoring) |
| return void_type_node; |
| return build_chill_pointer_type (build_chill_function_type |
| (result_spec, nreverse (param_types), |
| except_list, recursive)); |
| } |
| |
| /* Matches: <mode> |
| A NAME will be assumed to be a <mode name>, and thus a <mode>. |
| Returns NULL_TREE if no mode is seen. |
| (If ignoring is true, the return value may be an arbitrary tree node, |
| but will be non-NULL if something that could be a mode is seen.) */ |
| |
| static tree |
| parse_opt_mode () |
| { |
| switch (PEEK_TOKEN ()) |
| { |
| case ACCESS: |
| { |
| tree index_mode, record_mode; |
| int dynamic = 0; |
| require (ACCESS); |
| if (check_token (LPRN)) |
| { |
| index_mode = parse_index_mode (); |
| expect (RPRN, "mssing ')'"); |
| } |
| else |
| index_mode = NULL_TREE; |
| record_mode = parse_opt_mode (); |
| if (record_mode) |
| dynamic = check_token (DYNAMIC); |
| return ignoring ? void_type_node |
| : build_access_mode (index_mode, record_mode, dynamic); |
| } |
| case ARRAY: |
| { |
| tree index_list = NULL_TREE, base_mode; |
| int varying; |
| int num_index_modes = 0; |
| int i; |
| tree layouts = NULL_TREE; |
| FORWARD_TOKEN (); |
| expect (LPRN, "missing '(' after ARRAY"); |
| for (;;) |
| { |
| tree index = parse_index_mode (); |
| num_index_modes++; |
| if (!ignoring) |
| index_list = tree_cons (NULL_TREE, index, index_list); |
| if (! check_token (COMMA)) |
| break; |
| } |
| expect (RPRN, "missing ')' after ARRAY"); |
| varying = check_token (VARYING); |
| base_mode = parse_mode (); |
| /* Allow a layout specification for each index mode */ |
| for (i = 0; i < num_index_modes; ++i) |
| { |
| tree new_layout = parse_opt_layout (1); |
| if (new_layout == NULL_TREE) |
| break; |
| if (!ignoring) |
| layouts = tree_cons (NULL_TREE, new_layout, layouts); |
| } |
| if (ignoring) |
| return base_mode; |
| return build_chill_array_type (get_type_of (base_mode), |
| index_list, varying, layouts); |
| } |
| case ASSOCIATION: |
| require (ASSOCIATION); |
| return association_type_node; |
| case BIN: |
| { tree length; |
| FORWARD_TOKEN(); |
| expect (LPRN, "missing left parenthesis after BIN"); |
| length = parse_expression (); |
| expect (RPRN, "missing right parenthesis after BIN"); |
| return ignoring ? void_type_node : build_chill_bin_type (length); |
| } |
| case BOOLS: |
| { |
| tree length; |
| FORWARD_TOKEN (); |
| expect (LPRN, "missing '(' after BOOLS"); |
| length = parse_expression (); |
| expect (RPRN, "missing ')' after BOOLS"); |
| if (check_token (VARYING)) |
| error ("VARYING bit-strings not implemented"); |
| return ignoring ? void_type_node : build_bitstring_type (length); |
| } |
| case BUFFER: |
| { |
| tree qsize, element_mode; |
| require (BUFFER); |
| qsize = parse_opt_queue_size (); |
| element_mode = parse_mode (); |
| return ignoring ? element_mode |
| : build_buffer_type (element_mode, qsize); |
| } |
| case CHARS: |
| { |
| tree length; |
| int varying; |
| tree type; |
| FORWARD_TOKEN (); |
| expect (LPRN, "missing '(' after CHARS"); |
| length = parse_expression (); |
| expect (RPRN, "missing ')' after CHARS"); |
| varying = check_token (VARYING); |
| if (ignoring) |
| return void_type_node; |
| type = build_string_type (char_type_node, length); |
| if (varying) |
| type = build_varying_struct (type); |
| return type; |
| } |
| case EVENT: |
| { |
| tree qsize; |
| require (EVENT); |
| qsize = parse_opt_queue_size (); |
| return ignoring ? void_type_node : build_event_type (qsize); |
| } |
| case NAME: |
| { |
| tree mode = get_type_of (parse_name ()); |
| if (check_token (LPRN)) |
| { |
| tree min_value = parse_expression (); |
| if (check_token (COLON)) |
| { |
| tree max_value = parse_expression (); |
| expect (RPRN, "syntax error - expected ')'"); |
| /* Matched: <mode_name> '(' <expr> ':' <expr> ')' */ |
| if (ignoring) |
| return mode; |
| else |
| return build_chill_range_type (mode, min_value, max_value); |
| } |
| if (check_token (RPRN)) |
| { |
| int varying = check_token (VARYING); |
| if (! ignoring) |
| { |
| if (mode == char_type_node || varying) |
| { |
| if (mode != char_type_node |
| && mode != ridpointers[(int) RID_CHAR]) |
| error ("strings must be composed of chars"); |
| mode = build_string_type (char_type_node, min_value); |
| if (varying) |
| mode = build_varying_struct (mode); |
| } |
| else |
| { |
| /* Parameterized mode, |
| or old-fashioned CHAR(N) string declaration.. */ |
| tree pmode = make_node (LANG_TYPE); |
| TREE_TYPE (pmode) = mode; |
| TYPE_DOMAIN (pmode) = min_value; |
| mode = pmode; |
| } |
| } |
| } |
| } |
| return mode; |
| } |
| case POWERSET: |
| { tree mode; |
| FORWARD_TOKEN (); |
| mode = parse_mode (); |
| if (ignoring || TREE_CODE (mode) == ERROR_MARK) |
| return mode; |
| return build_powerset_type (get_type_of (mode)); |
| } |
| case PROC: |
| return parse_procedure_mode (); |
| case RANGE: |
| { tree low, high; |
| FORWARD_TOKEN(); |
| expect (LPRN, "missing left parenthesis after RANGE"); |
| low = parse_expression (); |
| expect (COLON, "missing colon"); |
| high = parse_expression (); |
| expect (RPRN, "missing right parenthesis after RANGE"); |
| return ignoring ? void_type_node |
| : build_chill_range_type (NULL_TREE, low, high); |
| } |
| case READ: |
| FORWARD_TOKEN (); |
| { |
| tree mode2 = get_type_of (parse_mode ()); |
| if (ignoring || TREE_CODE (mode2) == ERROR_MARK) |
| return mode2; |
| if (mode2 |
| && TREE_CODE_CLASS (TREE_CODE (mode2)) == 'd' |
| && CH_IS_BUFFER_MODE (mode2)) |
| { |
| error ("BUFFER modes may not be readonly"); |
| return mode2; |
| } |
| if (mode2 |
| && TREE_CODE_CLASS (TREE_CODE (mode2)) == 'd' |
| && CH_IS_EVENT_MODE (mode2)) |
| { |
| error ("EVENT modes may not be readonly"); |
| return mode2; |
| } |
| return build_readonly_type (mode2); |
| |
| } |
| case REF: |
| { tree mode; |
| FORWARD_TOKEN (); |
| mode = parse_mode (); |
| if (ignoring) |
| return mode; |
| mode = get_type_of (mode); |
| return (TREE_CODE (mode) == ERROR_MARK) ? mode |
| : build_chill_pointer_type (mode); |
| } |
| case SET: |
| return parse_set_mode (); |
| case SIGNAL: |
| if (pedantic) |
| error ("SIGNAL is not a valid mode"); |
| return generic_signal_type_node; |
| case STRUCT: |
| return parse_structure_mode (); |
| case TEXT: |
| { |
| tree length, index_mode; |
| int dynamic; |
| require (TEXT); |
| expect (LPRN, "missing '('"); |
| length = parse_expression (); |
| expect (RPRN, "missing ')'"); |
| /* FIXME: This should actually look for an optional index_mode, |
| but that is tricky to do. */ |
| index_mode = parse_opt_mode (); |
| dynamic = check_token (DYNAMIC); |
| return ignoring ? void_type_node |
| : build_text_mode (length, index_mode, dynamic); |
| } |
| case USAGE: |
| require (USAGE); |
| return usage_type_node; |
| case WHERE: |
| require (WHERE); |
| return where_type_node; |
| default: |
| return NULL_TREE; |
| } |
| } |
| |
| static tree |
| parse_mode () |
| { |
| tree mode = parse_opt_mode (); |
| if (mode == NULL_TREE) |
| { |
| if (pass == 1) |
| error ("syntax error - missing mode"); |
| mode = error_mark_node; |
| } |
| return mode; |
| } |
| |
| static void |
| parse_program() |
| { |
| /* Initialize global variables for current pass. */ |
| int i; |
| expand_exit_needed = 0; |
| label = NULL_TREE; /* for statement labels */ |
| current_module = NULL; |
| current_function_decl = NULL_TREE; |
| in_pseudo_module = 0; |
| |
| for (i = 0; i <= MAX_LOOK_AHEAD; i++) |
| terminal_buffer[i] = TOKEN_NOT_READ; |
| |
| #if 0 |
| /* skip some junk */ |
| while (PEEK_TOKEN() == HEADEREL) |
| FORWARD_TOKEN(); |
| #endif |
| |
| start_outer_function (); |
| |
| for (;;) |
| { |
| tree label = parse_optlabel (); |
| if (PEEK_TOKEN() == MODULE || PEEK_TOKEN() == REGION) |
| parse_modulion (label); |
| else if (PEEK_TOKEN() == SPEC) |
| parse_spec_module (label); |
| else break; |
| } |
| |
| finish_outer_function (); |
| } |
| |
| static void |
| parse_pass_1_2() |
| { |
| parse_program(); |
| if (PEEK_TOKEN() != END_PASS_1) |
| { |
| error ("syntax error - expected a module or end of file"); |
| serious_errors++; |
| } |
| chill_finish_compile (); |
| if (serious_errors) |
| exit (FATAL_EXIT_CODE); |
| switch_to_pass_2 (); |
| ch_parse_init (); |
| except_init_pass_2 (); |
| ignoring = 0; |
| parse_program(); |
| chill_finish_compile (); |
| } |
| |
| int yyparse () |
| { |
| parse_pass_1_2 (); |
| return 0; |
| } |
| |
| /* |
| * We've had an error. Move the compiler's state back to |
| * the global binding level. This prevents the loop in |
| * compile_file in toplev.c from looping forever, since the |
| * CHILL poplevel() has *no* effect on the value returned by |
| * global_bindings_p(). |
| */ |
| void |
| to_global_binding_level () |
| { |
| while (! global_bindings_p ()) |
| current_function_decl = DECL_CONTEXT (current_function_decl); |
| serious_errors++; |
| } |
| |
| #if 1 |
| int yydebug; |
| /* Sets the value of the 'yydebug' variable to VALUE. |
| This is a function so we don't have to have YYDEBUG defined |
| in order to build the compiler. */ |
| void |
| set_yydebug (value) |
| int value; |
| { |
| #if YYDEBUG != 0 |
| yydebug = value; |
| #else |
| warning ("YYDEBUG not defined"); |
| #endif |
| } |
| #endif |