/* Parser for GNU CHILL (CCITT High-Level Language) -*- C -*- Copyright (C) 1992, 1993 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, 675 Mass Ave, Cambridge, MA 02139, 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) */ char *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 PROTO((void)); extern void emit_jump PROTO((struct rtx_def *)); extern void emit_label PROTO((struct rtx_def *)); static int parse_action PROTO((void)); extern int lineno; extern char *input_filename; 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) { 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) fatal ("internal error - too much lookahead"); 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) fatal ("internal error - cannot pushback token"); 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. */ void require(token) enum terminal token; { if (PEEK_TOKEN() != token) { char buf[80]; sprintf (buf, "internal parser error - expected token %d", (int)token); fatal(buf); } FORWARD_TOKEN(); } 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. */ int expect(token, message) enum terminal token; char *message; { if (PEEK_TOKEN() != token) { if (pass == 1) error(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__ () { 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 (); static tree parse_primval (); static tree parse_mode PROTO((void)); static tree parse_opt_mode PROTO((void)); static tree parse_untyped_expr (); static tree parse_opt_untyped_expr (); static int parse_definition PROTO((int)); static void parse_opt_actions (); static void parse_body PROTO((void)); static tree parse_if_expression_body PROTO((void)); static tree parse_opt_handler PROTO((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: 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; { tree module_name = push_module (set_module_name (label), 1); int save_ignoring = ignoring; 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: ( "," )* 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; } 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: "(" ")" ":". 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: '(' ')' ':' */ 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 initialisation"); 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 (); } 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: or Returns: A (singleton) TREE_LIST. */ 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); } 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; } 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)); } 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)); } } 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 (in_spec_module); 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 ='"); 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 (0); } 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: */ 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: 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: 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, *new_label; tree action_labels = NULL_TREE; tree tests = NULL_TREE; int save_lineno = lineno; 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: [ { "," }* ], where = STRING '(' ')' 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; } void ch_expand_asm_operands (string, outputs, inputs, clobbers, vol, filename, line) tree string, outputs, inputs, clobbers; int vol; 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: (as in a ). */ 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: '(' ')' ':'. 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 (label_cnt, 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: '(' [ 'IN' ']' ')' ':' or: '(' 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: '(' ')' 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 (instance_location, 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 ! */ 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: 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: */ 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 = 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 , 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: */ 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 is a superset of . It also includes and untyped , 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 . */ 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: */ 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: '(' ':' ')' */ 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: or , i.e.: [ ]. 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: [ { "," }* ] 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: 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 (which is or ). 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: A NAME will be assumed to be a , and thus a . 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: '(' ':' ')' */ 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 (); } 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