parse.c

gcc-2.95.3 Linux下最常用的C编译器

    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 <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 (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: <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)