�

Migrate from devo/gcc/ch.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@22038 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 4237 insertions, 0 deletions

diff --git a/gcc/ch/parse.c b/gcc/ch/parse.c
new file mode 100644
index 00000000000..32f72e5d249
--- /dev/null
+++ b/gcc/ch/parse.c
@@ -0,0 +1,4237 @@
+/* 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 <stdio.h>
+#include "config.h"
+#include "tree.h"
+#include "ch-tree.h"
+#include "lex.h"
+#include "actions.h"
+#include "tasking.h"
+#include "parse.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 void assemble_external                 PROTO((tree));
+extern void chill_check_no_handlers           PROTO((void));
+extern void chill_finish_on                   PROTO((void));
+extern void chill_handle_case_default         PROTO((void));
+extern void chill_handle_on_labels            PROTO((tree));
+extern tree chill_initializer_constant_valid_p PROTO((tree, tree));
+extern void chill_start_default_handler       PROTO((void));
+extern void chill_start_on                    PROTO((void));
+extern struct rtx_def* emit_line_note         PROTO((char *, int));
+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 *));
+extern void error                             PROTO((char *, ...));
+extern int  expand_exit_labelled              PROTO((tree));
+extern void lookup_and_expand_goto            PROTO((tree));
+extern void lookup_and_handle_exit            PROTO((tree));
+
+extern void push_granted                      PROTO((tree, tree));
+extern void sorry                             PROTO((char *, ...));
+extern void warning                           PROTO((char *, ...));
+
+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;
+     
+static int  quasi_signal = 0;  /* 1 if processing a quasi signal decl */
+
+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 int
+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: <name_string>
+   Returns if pass 1: the identifier.
+   Returns if pass 2: a decl or value for identifier. */
+
+static tree
+parse_name ()
+{
+  tree name = parse_name_string ();
+  if (pass == 1 || ignoring)
+    return name;
+  else
+    {
+      tree decl = lookup_name (name);
+      if (decl == NULL_TREE)
+	{
+	  error ("`%s' undeclared", IDENTIFIER_POINTER (name));
+	  return error_mark_node;
+	}
+      else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK)
+	return error_mark_node;
+      else if (TREE_CODE (decl) == CONST_DECL)
+	return DECL_INITIAL (decl);
+      else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE)
+	return convert_from_reference (decl);
+      else
+	return decl;
+    } 
+}
+
+static tree
+parse_optlabel()
+{
+  tree label = parse_defining_occurrence();
+  if (label != NULL)
+    expect(COLON, "expected a ':' here");
+  return label;
+}
+
+static void
+parse_semi_colon ()
+{
+  enum terminal token = PEEK_TOKEN ();
+  if (token == SC)
+    FORWARD_TOKEN ();
+  else if (pass == 1)
+    (token == END ? pedwarn : error) ("expected ';' here");
+  label = NULL_TREE;
+}
+
+static void
+parse_opt_end_label_semi_colon (start_label)
+     tree start_label;
+{
+  if (PEEK_TOKEN() == NAME)
+    {
+      tree end_label = parse_name_string ();
+      check_end_label (start_label, end_label);
+    }
+  parse_semi_colon ();
+}
+
+extern tree set_module_name ();
+
+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:  <name_string> ( "," <name_string> )*
+   Returns either a single IDENTIFIER_NODE,
+   or a chain (TREE_LIST) of IDENTIFIER_NODES.
+   (Since a single identifier is the common case, we avoid wasting space
+   (twice, once for each pass) with extra TREE_LIST nodes in that case.)
+   (Will not return NULL_TREE even if ignoring is true.) */
+
+static tree
+parse_defining_occurrence_list ()
+{
+  tree chain = NULL_TREE;
+  tree name = parse_defining_occurrence ();
+  if (name == NULL_TREE)
+    {
+      error("missing defining occurrence");
+      return NULL_TREE;
+    }
+  if (! check_token (COMMA))
+    return name;
+  chain = build_tree_list (NULL_TREE, name);
+  for (;;)
+    {
+      name = parse_defining_occurrence ();
+      if (name == NULL)
+	{
+	  error ("bad defining occurrence following ','");
+	  break;
+	}
+      chain = tree_cons (NULL_TREE, name, chain);
+      if (! check_token (COMMA))
+	break;
+    }
+  return nreverse (chain);
+}
+
+static void
+parse_mode_definition (is_newmode)
+     int is_newmode;
+{
+  tree mode, names;
+  int save_ignoring = ignoring;
+  ignoring = pass == 2;
+  names = parse_defining_occurrence_list ();
+  expect (EQL, "missing '=' in mode definition");
+  mode = parse_mode ();
+  if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
+    {
+      for ( ; names != NULL_TREE; names = TREE_CHAIN (names))
+	push_modedef (names, mode, is_newmode);
+    }
+  else
+    push_modedef (names, mode, is_newmode);
+  ignoring = save_ignoring;
+}
+
+void
+parse_mode_definition_statement (is_newmode)
+     int is_newmode;
+{
+  tree names;
+  FORWARD_TOKEN (); /* skip SYNMODE or NEWMODE */
+  parse_mode_definition (is_newmode);
+  while (PEEK_TOKEN () == COMMA)
+    {
+      FORWARD_TOKEN ();
+      parse_mode_definition (is_newmode);
+    }
+  parse_semi_colon ();
+}
+
+static void
+parse_synonym_definition ()
+{ tree expr = NULL_TREE;
+  tree names = parse_defining_occurrence_list ();
+  tree mode = parse_opt_mode ();
+  if (! expect (EQL, "missing '=' in synonym definition"))
+    mode = error_mark_node;
+  else
+    {
+      if (mode)
+	expr = parse_untyped_expr ();
+      else
+	expr = parse_expression ();
+    }
+  if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
+    {
+      for ( ; names != NULL_TREE; names = TREE_CHAIN (names))
+	push_syndecl (names, mode, expr);
+    }
+  else
+    push_syndecl (names, mode, expr);
+}
+
+static void
+parse_synonym_definition_statement()
+{
+  int save_ignoring= ignoring;
+  ignoring = pass == 2;
+  require (SYN);
+  parse_synonym_definition ();
+  while (PEEK_TOKEN () == COMMA)
+    {
+      FORWARD_TOKEN ();
+      parse_synonym_definition ();
+    }
+  ignoring = save_ignoring;
+  parse_semi_colon ();
+}
+
+/* Attempts to match: "(" <exception list> ")" ":".
+   Return NULL_TREE on failure, and non-NULL on success.
+   On success, if pass 1, return a TREE_LIST of IDENTIFIER_NODEs. */
+
+static tree
+parse_on_exception_list ()
+{
+  tree name;
+  tree list = NULL_TREE;
+  int tok1 = PEEK_TOKEN ();
+  int tok2 = PEEK_TOKEN1 ();
+
+  /* This requires a lot of look-ahead, because we cannot
+     easily a priori distinguish an exception-list from an expression. */
+  if (tok1 != LPRN || tok2 != NAME)
+    {
+      if (tok1 == NAME && tok2 == COLON && pass == 1)
+	error ("missing '(' in exception list");
+      return 0;
+    }
+  require (LPRN);
+  name = parse_name_string ();
+  if (PEEK_TOKEN () == RPRN && PEEK_TOKEN1 () == COLON)
+    {
+      /* Matched: '(' <name_string> ')' ':' */
+      FORWARD_TOKEN (); FORWARD_TOKEN ();
+      return pass == 1 ? build_tree_list (NULL_TREE, name) : name;
+    }
+  if (PEEK_TOKEN() == COMMA)
+    {
+      if (pass == 1)
+	list = build_tree_list (NULL_TREE, name);
+      while (check_token (COMMA))
+	{
+	  tree old_names = list;
+	  name = parse_name_string ();
+	  if (pass == 1)
+	    {
+	      for ( ; old_names != NULL_TREE; old_names = TREE_CHAIN (old_names))
+		{
+		  if (TREE_VALUE (old_names) == name)
+		    {
+		      error ("ON exception names must be unique");
+		      goto continue_parsing;
+		    }
+		}
+	      list = tree_cons (NULL_TREE, name, list);
+	    continue_parsing:
+	      ;
+	    }
+	}
+      if (! check_token (RPRN) || ! check_token(COLON))
+	error ("syntax error in exception list");
+      return pass == 1 ? nreverse (list) : name;
+    }
+  /* Matched: '(' name_string
+     but it doesn't match the syntax of an exception list.
+     It could be the beginning of an expression, so back up. */
+  pushback_token (NAME, name);
+  pushback_token (LPRN, 0);
+  return NULL_TREE;
+}
+
+static void
+parse_on_alternatives ()
+{
+  for (;;)
+    {
+      tree except_list = parse_on_exception_list ();
+      if (except_list != NULL)
+	chill_handle_on_labels (except_list);
+      else if (parse_action ())
+	expand_exit_needed = 1;
+      else
+	break;
+    }
+}
+
+static tree
+parse_opt_handler ()
+{
+  if (! check_token (ON))
+    {
+      POP_UNUSED_ON_CONTEXT;
+      return NULL_TREE;
+    }
+  if (check_token (END))
+    {
+      pedwarn ("empty ON-condition"); 
+      POP_UNUSED_ON_CONTEXT;
+      return NULL_TREE;
+    } 
+  if (! ignoring)
+    {
+      chill_start_on ();
+      expand_exit_needed = 0;
+    }
+  if (PEEK_TOKEN () != ELSE)
+    {
+      parse_on_alternatives ();
+      if (! ignoring && expand_exit_needed)
+	expand_exit_something (); 
+    }
+  if (check_token (ELSE))
+    {
+      chill_start_default_handler ();
+      label = NULL_TREE;
+      parse_opt_actions ();
+      if (! ignoring)
+	{
+	  emit_line_note (input_filename, lineno); 
+	  expand_exit_something (); 
+	} 
+    }
+  expect (END, "missing 'END' after");
+  if (! ignoring)
+    chill_finish_on ();
+  POP_USED_ON_CONTEXT;
+  return integer_zero_node; 
+}
+
+static void
+parse_loc_declaration (in_spec_module)
+     int in_spec_module;
+{
+  tree names = parse_defining_occurrence_list ();
+  int save_ignoring = ignoring;
+  int is_static, lifetime_bound;
+  tree mode, init_value = NULL_TREE;
+  int loc_decl = 0;
+
+  ignoring = pass == 2;
+  mode = parse_mode ();
+  ignoring = save_ignoring;
+  is_static = check_token (STATIC);
+  if (check_token (BASED))
+    {
+      expect(LPRN, "BASED must be followed by (NAME)");
+      do_based_decls (names, mode, parse_name_string ());
+      expect(RPRN, "BASED must be followed by (NAME)");
+      return;
+    }
+  if (check_token (LOC))
+    {
+      /* loc-identity declaration */
+      if (pass == 1)
+	mode = build_chill_reference_type (mode);
+      loc_decl = 1;
+    }
+  lifetime_bound = check_token (INIT);
+  if (lifetime_bound && loc_decl)
+    {
+      if (pass == 1)
+	error ("INIT not allowed at loc-identity declaration");
+      lifetime_bound = 0;
+    }
+  if (PEEK_TOKEN () == ASGN || PEEK_TOKEN() == EQL)
+    {
+      save_ignoring = ignoring;
+      ignoring = pass == 1;
+      if (PEEK_TOKEN() == EQL)
+	{
+	  if (pass == 1)
+	    error ("'=' used where ':=' is required");
+	}
+      FORWARD_TOKEN();
+      if (! lifetime_bound)
+	push_handler ();
+      init_value = parse_untyped_expr ();
+      if (in_spec_module)
+	{
+	  error ("initialization is not allowed in spec module");
+	  init_value = NULL_TREE;
+	}
+      if (! lifetime_bound)
+	parse_opt_handler ();
+      ignoring = save_ignoring;
+    }
+  if (init_value == NULL_TREE && loc_decl && pass == 1)
+    error ("loc-identity declaration without 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: <grant postfix> or <seize postfix>
+   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 (in_spec_module)
+     int in_spec_module;
+{
+  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 (in_spec_module)
+     int in_spec_module;
+{
+  tree list = NULL_TREE;
+  if (PEEK_TOKEN() == RPRN)
+    return NULL_TREE;
+  for (;;)
+    {
+      list = chainon (list, parse_formpar (in_spec_module));
+      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 (in_spec_module);
+  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 ();
+  tree parms = NULL_TREE;
+  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)
+    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, *end_case_label, *new_label;
+  tree action_labels = NULL_TREE;
+  tree tests = NULL_TREE;
+  tree new_test;
+  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;
+
+/* 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;
+
+  require (CASE);
+  selector = parse_expr_list ();
+  selector = nreverse (selector);
+  expect (OF, "missing 'OF' after 'CASE'");
+  parse_range_list_clause ();
+
+  PUSH_ACTION;
+  if (label)
+    pushlevel (1);
+
+  if (! ignoring)
+    {
+      expand_exit_needed = 0;
+      if (TREE_CODE (selector) == TREE_LIST)
+	{
+	  if (TREE_CHAIN (selector) != NULL_TREE)
+            multi_dimension_case = 1;
+          else
+	    selector = TREE_VALUE (selector);
+	}
+    }
+
+  /* We want to use the regular CASE support for the single dimension case. The
+     multi dimension case requires different handling. Note that when "ignoring"
+     is true we parse using the single dimension code. This is OK since it will
+     still parse correctly. */
+  if (multi_dimension_case)
+    parse_multi_dimension_case_action (selector);
+  else
+    parse_single_dimension_case_action (selector);
+
+  if (label)
+    {
+      possibly_define_exit_label (label);
+      poplevel (0, 0, 0);
+    }
+}
+
+/* Matches: [ <asm_operand> { "," <asm_operand> }* ],
+   where <asm_operand> = STRING '(' <expression> ')'
+   These are the operands other than the first string and colon
+   in  asm ("addextend %2,%1": "=dm" (x), "0" (y), "g" (*x))  */
+
+static tree
+parse_asm_operands ()
+{
+  tree list = NULL_TREE;
+  if (PEEK_TOKEN () != STRING)
+    return NULL_TREE;
+  for (;;)
+    {
+      tree string, expr;
+      if (PEEK_TOKEN () != STRING)
+	{
+	  error ("bad ASM operand");
+	  return list;
+	}
+      string = PEEK_TREE();
+      FORWARD_TOKEN ();
+      expect (LPRN, "missing '(' in ASM operand");
+      expr = parse_expression ();
+      expect (RPRN, "missing ')' in ASM operand");
+      list = tree_cons (string, expr, list);
+      if (! check_token (COMMA))
+	break;
+    }
+  return nreverse (list);
+}
+
+/* Matches:  STRING { ',' STRING }* */
+
+static tree
+parse_asm_clobbers ()
+{
+  tree list = NULL_TREE;
+  for (;;)
+    {
+      tree string, expr;
+      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:  <iteration>  (as in a <for control>). */
+
+static void
+parse_iteration ()
+{
+  tree loop_counter = parse_defining_occurrence ();
+  if (check_token (ASGN))
+    {
+      tree start_value = parse_expression ();
+      tree step_value
+	= check_token (BY) ? parse_expression () : NULL_TREE;
+      int going_down = check_token (DOWN);
+      tree end_value;
+      if (check_token (TO))
+	end_value = parse_expression ();
+      else
+	{
+	  error ("expected 'TO' in step enumeration");
+	  end_value = error_mark_node;
+	}
+      if (!ignoring)
+	build_loop_iterator (loop_counter, start_value, step_value,
+			     end_value, going_down, 0, 0);
+    }
+  else
+    {
+      int going_down = check_token (DOWN);
+      tree expr;
+      if (check_token (IN))
+	expr = parse_expression ();
+      else
+	{
+	  error ("expected 'IN' in FOR control here");
+	  expr = error_mark_node;
+	}
+      if (!ignoring)
+	{
+	  tree low_bound, high_bound;
+	  if (expr && TREE_CODE (expr) == TYPE_DECL)
+	    {
+	      expr = TREE_TYPE (expr);
+	      /* FIXME: expr must be an array or powerset */
+	      low_bound = convert (expr, TYPE_MIN_VALUE (expr));
+	      high_bound = convert (expr, TYPE_MAX_VALUE (expr));
+	    }
+	  else
+	    {
+	      low_bound = expr;
+	      high_bound = NULL_TREE;
+	    }
+	  build_loop_iterator (loop_counter, low_bound,
+			       NULL_TREE, high_bound,
+			       going_down, 1, 0);
+	}
+    }
+}
+
+/* Matches: '(' <event list> ')' ':'.
+   Or; returns NULL_EXPR. */
+
+static tree
+parse_delay_case_event_list ()
+{
+  tree event_list = NULL_TREE;
+  tree event;
+  if (! check_token (LPRN))
+    return NULL_TREE;
+  event = parse_expression ();
+  if (PEEK_TOKEN () == ')' && PEEK_TOKEN1 () != ':')
+    {
+      /* Oops. */
+      require (RPRN);
+      pushback_paren_expr (event);
+      return NULL_TREE;
+    }
+  for (;;)
+    {
+      if (! ignoring)
+	event_list = tree_cons (NULL_TREE, event, event_list);
+      if (! check_token (COMMA))
+	break;
+      event = parse_expression ();
+    }
+  expect (RPRN, "missing ')'");
+  expect (COLON, "missing ':'");
+  return ignoring ? error_mark_node : event_list;
+}
+
+static void
+parse_delay_case_action (label)
+     tree label;
+{
+  tree label_cnt, 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: '(' <signal name> [ 'IN' <defining occurrence list> ']' ')' ':'
+   or: '(' <buffer location> IN (defining occurrence> ')' ':'
+   or: returns NULL_TREE. */
+
+static tree
+parse_receive_spec ()
+{
+  tree val;
+  tree name_list = NULL_TREE;
+  if (!check_token (LPRN))
+    return NULL_TREE;
+  val = parse_primval ();
+  if (check_token (IN))
+    {
+#if 0
+      if (flag_local_loop_counter)
+	name_list = parse_defining_occurrence_list ();
+      else
+#endif
+	{
+	  for (;;)
+	    {
+	      tree loc = parse_primval ();
+	      if (! ignoring)
+		name_list = tree_cons (NULL_TREE, loc, name_list);
+	      if (! check_token (COMMA))
+		break;
+	    }
+	}
+    }
+  if (! check_token (RPRN))
+    {
+      error ("missing ')' in signal/buffer receive alternative");
+      return NULL_TREE;
+    }
+  if (check_token (COLON))
+    {
+      if (ignoring || val == NULL_TREE || TREE_CODE (val) == ERROR_MARK)
+	return error_mark_node;
+      else
+	return build_receive_case_label (val, name_list);
+    }
+
+  /* We saw: '(' <primitive value> ')' not followed by ':'.
+     Presumably the start of an action.  Backup and fail. */
+  if (name_list != NULL_TREE)
+    error ("misplaced 'IN' in signal/buffer receive alternative");
+  pushback_paren_expr (val);
+  return NULL_TREE;
+}
+
+/* To understand the code generation for this, see ch-tasking.c,
+   and the 2-page comments preceding the
+   build_chill_receive_case_start () definition. */
+
+static void
+parse_receive_case_action (label)
+     tree label;
+{
+  tree instance_location;
+  tree have_else_actions;
+  int spec_seen = 0;
+  tree alt_list = NULL_TREE;
+  require (RECEIVE);
+  require (CASE);
+  push_action ();
+  pushlevel (1);
+  if (! ignoring)
+    {
+      expand_exit_needed = 0;
+    }
+
+  if (check_token (SET))
+    {
+      instance_location = parse_expression ();
+      parse_semi_colon ();
+    }
+  else
+    instance_location = NULL_TREE;
+  if (! ignoring)
+    instance_location = build_receive_case_start (instance_location);
+
+  for (;;)
+    {
+      tree receive_spec = parse_receive_spec ();
+      if (receive_spec)
+	{
+	  if (! ignoring)
+	    alt_list = tree_cons (NULL_TREE, receive_spec, alt_list);
+	  spec_seen++;
+	}
+      else if (parse_action ())
+	{
+	  if (! spec_seen && pass == 1)
+	    error ("missing RECEIVE alternative");
+	  if (! ignoring)
+	    expand_exit_needed = 1;
+	  spec_seen = 1;
+	}
+      else
+	break;
+    }
+  if (check_token (ELSE))
+    {
+      if (! ignoring)
+	{
+	  emit_line_note (input_filename, lineno); 
+	  if (build_receive_case_if_generated ())
+	    expand_start_else ();
+	}
+      parse_opt_actions ();
+      have_else_actions = integer_one_node;
+    }
+  else
+    have_else_actions = integer_zero_node;
+  expect (ESAC, "missing 'ESAC' matching 'RECEIVE CASE'");
+  if (! ignoring)
+    {
+      build_receive_case_end (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 <send signal action>! */
+      tree sigdesc = build_signal_descriptor (signal, value_list);
+      if (sigdesc != NULL_TREE && TREE_CODE (sigdesc) != ERROR_MARK)
+	{
+	  tree sendto = to_expr ? to_expr : IDENTIFIER_SIGNAL_DEST (signal);
+	  expand_send_signal (sigdesc, with_expr,
+			      sendto, priority, DECL_NAME (signal));
+	}
+    }
+  else
+    {
+      /* all checks are done in expand_send_buffer */
+      expand_send_buffer (buffer, value_list, priority, with_expr, to_expr);
+    }
+}
+
+static void
+parse_start_action ()
+{
+  tree name, copy_number, param_list, startset;
+  require (START);
+  name = parse_name_string ();
+  expect (LPRN, "missing '(' in START action");
+  PUSH_ACTION;
+  /* copy number is a required parameter */
+  copy_number = parse_expression ();
+  if (!ignoring
+      && (copy_number == NULL_TREE 
+	  || TREE_CODE (copy_number) == ERROR_MARK
+	  || TREE_CODE (TREE_TYPE (copy_number)) != INTEGER_TYPE))
+    {
+      error ("PROCESS copy number must be integer");
+      copy_number = integer_zero_node;
+    }
+  if (check_token (COMMA))
+    param_list = parse_expr_list (); /* user parameters */
+  else
+    param_list = NULL_TREE;
+  expect (RPRN, "missing ')'");
+  startset = check_token (SET) ? parse_primval () : NULL;
+  build_start_process (name, copy_number, param_list, startset);
+}
+
+static void
+parse_opt_actions ()
+{
+  while (parse_action ()) ;
+}
+
+int
+parse_action ()
+{
+  tree label = NULL_TREE;
+  tree expr, rhs, loclist;
+  enum tree_code op;
+
+  if (current_function_decl == global_function_decl
+      && PEEK_TOKEN () != SC
+      && PEEK_TOKEN () != END)
+    seen_action = 1, build_constructor = 1;
+
+  if (PEEK_TOKEN () == NAME && PEEK_TOKEN1 () == COLON)
+    {
+      label = parse_defining_occurrence ();
+      require (COLON);
+      INIT_ACTION;
+      define_label (input_filename, lineno, label);
+    }
+
+  switch (PEEK_TOKEN ())
+    {
+    case AFTER:
+      {
+	int delay;
+	require (AFTER);
+	expr = parse_primval ();
+	delay = check_token (DELAY);
+	expect (IN, "missing 'IN'");
+	push_action ();
+	pushlevel (1);
+	build_after_start (expr, delay);
+	parse_opt_actions ();
+	expect (TIMEOUT, "missing 'TIMEOUT'");
+	build_after_timeout_start ();
+	parse_opt_actions ();
+	expect (END, "missing 'END'");
+	build_after_end ();
+	possibly_define_exit_label (label);
+	poplevel (0, 0, 0); 
+      }
+      goto bracketed_action;
+    case ASM_KEYWORD:
+      parse_asm_action ();
+      goto no_handler_action;
+    case ASSERT:
+      require (ASSERT);
+      PUSH_ACTION;
+      expr = parse_expression ();
+      if (! ignoring)
+	{ tree assertfail = ridpointers[(int) RID_ASSERTFAIL];
+	  expr = build (TRUTH_ORIF_EXPR, void_type_node, expr,
+			build_cause_exception (assertfail, 0));
+	  expand_expr_stmt (fold (expr));
+	}
+      goto handler_action;
+    case AT:
+      require (AT);
+      PUSH_ACTION;
+      expr = parse_primval ();
+      expect (IN, "missing 'IN'");
+      pushlevel (1);
+      if (! ignoring)
+	build_at_action (expr);
+      parse_opt_actions ();
+      expect (TIMEOUT, "missing 'TIMEOUT'");
+      if (! ignoring)
+	expand_start_else ();
+      parse_opt_actions ();
+      expect (END, "missing 'END'");
+      if (! ignoring)
+	expand_end_cond ();
+      possibly_define_exit_label (label);
+      poplevel (0, 0, 0);
+      goto bracketed_action;
+    case BEGINTOKEN:
+      parse_begin_end_block (label);
+      return 1;
+    case CASE:
+      parse_case_action (label);
+      goto bracketed_action;
+    case CAUSE:
+      require (CAUSE);
+      expr = parse_name_string ();
+      PUSH_ACTION;
+      if (! ignoring && TREE_CODE (expr) != ERROR_MARK)
+	expand_cause_exception (expr);
+      goto no_handler_action;
+    case CONTINUE:
+      require (CONTINUE);
+      expr = parse_expression ();
+      PUSH_ACTION;
+      if (! ignoring)
+	expand_continue_event (expr);
+      goto handler_action;
+    case CYCLE:
+      require (CYCLE);
+      PUSH_ACTION;
+      expr = parse_primval ();
+      expect (IN, "missing 'IN' after 'CYCLE'");
+      pushlevel (1);
+      /* We a tree list where TREE_VALUE is the label
+	 and TREE_PURPOSE is the variable denotes the timeout id. */
+      expr = build_cycle_start (expr);
+      parse_opt_actions ();
+      expect (END, "missing 'END'");
+      if (! ignoring)
+	build_cycle_end (expr);
+      possibly_define_exit_label (label);
+      poplevel (0, 0, 0);
+      goto bracketed_action;
+    case DELAY:
+      if (PEEK_TOKEN1 () == CASE)
+	{
+	  parse_delay_case_action (label);
+	  goto bracketed_action;
+	}
+      require (DELAY);
+      PUSH_ACTION;
+      expr = parse_primval ();
+      rhs = check_token (PRIORITY) ? parse_expression () : NULL_TREE;
+      if (! ignoring)
+	build_delay_action (expr, rhs);
+      goto handler_action;
+    case DO:
+      parse_do_action (label);
+      return 1;
+    case EXIT:
+      require (EXIT);
+      expr = parse_name_string ();
+      PUSH_ACTION;
+      lookup_and_handle_exit (expr);
+      goto no_handler_action;
+    case GOTO:
+      require (GOTO);
+      expr = parse_name_string ();
+      PUSH_ACTION;
+      lookup_and_expand_goto (expr);
+      goto no_handler_action;
+    case IF:
+      parse_if_action (label);
+      goto bracketed_action;
+    case RECEIVE:
+      if (PEEK_TOKEN1 () != CASE)
+	return 0;
+      parse_receive_case_action (label);
+      goto bracketed_action;
+    case RESULT:
+      require (RESULT);
+      PUSH_ACTION;
+      expr = parse_untyped_expr ();
+      if (! ignoring)
+	chill_expand_result (expr, 1);
+      goto handler_action;
+    case RETURN:
+      require (RETURN);
+      PUSH_ACTION;
+      expr = parse_opt_untyped_expr ();
+      if (! ignoring)
+	{
+	  /* Do this as RESULT expr and RETURN to get exceptions */
+	  chill_expand_result (expr, 0);
+	  expand_goto_except_cleanup (proc_action_level);
+	  chill_expand_return (NULL_TREE, 0);
+	}
+      if (expr)
+	goto handler_action;
+      else
+	goto no_handler_action;
+    case SC:
+      require (SC);
+      return 1;
+    case SEND:
+      parse_send_action ();
+      goto handler_action;
+    case START:
+      parse_start_action ();
+      goto handler_action;
+    case STOP:
+      require (STOP);
+      PUSH_ACTION;
+      if (! ignoring)
+	{ tree func = lookup_name (get_identifier ("__stop_process"));
+	  tree result = build_chill_function_call (func, NULL_TREE);
+	  expand_expr_stmt (result);
+	} 
+      goto no_handler_action;
+    case CALL:
+      require (CALL);
+      /* Fall through to here ... */
+    case EXPR:
+    case LPRN:
+    case NAME:
+      /* This handles calls and assignments. */
+      PUSH_ACTION;
+      expr = parse_primval ();
+      switch (PEEK_TOKEN ())
+	{
+	case END:
+	  parse_semi_colon ();  /* Emits error message. */
+	case ON:
+	case SC:
+	  if (!ignoring && TREE_CODE (expr) != ERROR_MARK)
+	    {
+	      if (TREE_CODE (expr) != CALL_EXPR
+		  && TREE_TYPE (expr) != void_type_node
+		  && ! TREE_SIDE_EFFECTS (expr))
+		{
+		  if (TREE_CODE (expr) == FUNCTION_DECL)
+		    error ("missing parenthesis for procedure call");
+		  else
+		    error ("expression is not an action");
+		  expr = error_mark_node;
+		}
+	      else
+		expand_expr_stmt (expr);
+	    }
+	  goto handler_action;
+	default:
+	  loclist
+	    = ignoring ? NULL_TREE : build_tree_list (NULL_TREE, expr);
+	  while (PEEK_TOKEN () == COMMA)
+	    {
+	      FORWARD_TOKEN ();
+	      expr = parse_primval ();
+	      if (!ignoring && TREE_CODE (expr) != ERROR_MARK)
+		loclist = tree_cons (NULL_TREE, expr, loclist);
+	    }
+	}
+      switch (PEEK_TOKEN ())
+	{
+	case OR:	op = BIT_IOR_EXPR;	break;
+	case XOR:	op = BIT_XOR_EXPR;	break;
+	case ORIF:	op = TRUTH_ORIF_EXPR;	break;
+	case AND:	op = BIT_AND_EXPR;	break;
+	case ANDIF:	op = TRUTH_ANDIF_EXPR;	break;
+	case PLUS:	op = PLUS_EXPR;		break;
+	case SUB:	op = MINUS_EXPR;	break;
+	case CONCAT:	op = CONCAT_EXPR;	break;
+	case MUL:	op = MULT_EXPR;		break;
+	case DIV:	op = TRUNC_DIV_EXPR;	break;
+	case MOD:	op = FLOOR_MOD_EXPR;	break;
+	case REM:	op = TRUNC_MOD_EXPR;	break;
+
+	default:
+	  error ("syntax error in action");
+	case SC:  case ON:
+	case ASGN:	op = NOP_EXPR;		break;
+	  ;
+	}
+
+      /* Looks like it was an assignment action. */
+      FORWARD_TOKEN ();
+      if (op != NOP_EXPR)
+	expect (ASGN, "expected ':=' here");
+      rhs = parse_untyped_expr ();
+      if (!ignoring)
+	expand_assignment_action (loclist, op, rhs);
+      goto handler_action;
+
+    default:
+      return 0;
+    }
+
+ bracketed_action:
+  /* We've parsed a bracketed action. */
+  parse_opt_handler ();
+  parse_opt_end_label_semi_colon (label);
+  return 1;
+
+ no_handler_action:
+  if (parse_opt_handler () != NULL_TREE && pass == 1)
+    error ("no handler is permitted on this action.");
+  parse_semi_colon ();
+  return 1;
+
+ handler_action:
+  parse_opt_handler ();
+  parse_semi_colon ();
+  return 1;
+}
+
+static void
+parse_body ()
+{
+ again:
+  while (parse_definition (0)) ;
+
+  while (parse_action ()) ;
+
+  if (parse_definition (0))
+    {
+      if (pass == 1)
+	pedwarn ("definition follows action");
+      goto again;
+    }
+}
+
+static tree
+parse_opt_untyped_expr ()
+{
+  switch (PEEK_TOKEN ())
+    {
+    case ON:
+    case END:
+    case SC:
+    case COMMA:
+    case COLON:
+    case RPRN:
+      return NULL_TREE;
+    default:
+      return parse_untyped_expr ();
+    }
+}
+
+static tree
+parse_call (function)
+     tree function;
+{
+  tree arg1, arg2, arg_list = NULL_TREE;
+  enum terminal tok;
+  require (LPRN);
+  arg1 = parse_opt_untyped_expr ();
+  if (arg1 != NULL_TREE)
+    {
+      tok = PEEK_TOKEN ();
+      if (tok == UP || tok == COLON)
+	{
+	  FORWARD_TOKEN ();
+#if 0
+	  /* check that arg1 isn't untyped (or mode);*/
+#endif
+	  arg2 = parse_expression ();
+	  expect (RPRN, "expected ')' to terminate slice");
+	  if (ignoring)
+	    return integer_zero_node;
+	  else if (tok == UP)
+	    return build_chill_slice_with_length (function, arg1, arg2);
+	  else
+	    return build_chill_slice_with_range (function, arg1, arg2);
+	}
+      if (!ignoring)
+	arg_list = build_tree_list (NULL_TREE, arg1);
+      while (check_token (COMMA))
+	{
+	  arg2 = parse_untyped_expr ();
+	  if (!ignoring)
+	    arg_list = tree_cons (NULL_TREE, arg2, arg_list);
+	}
+    }
+     
+  expect (RPRN, "expected ')' here");
+  return ignoring ? function
+    : build_generalized_call (function, nreverse (arg_list));
+}
+
+/* Matches:  <field name list>
+   Returns:  A list of IDENTIFIER_NODEs (or NULL_TREE if ignoring),
+   in reverse order. */
+
+static tree
+parse_tuple_fieldname_list ()
+{
+  tree list = NULL_TREE;
+  do
+    {
+      tree name;
+      if (!check_token (DOT))
+	{
+	  error ("bad tuple field name list");
+	  return NULL_TREE;
+	}
+      name = parse_simple_name_string ();
+      list = ignoring ? NULL_TREE : tree_cons (NULL_TREE, name, list);
+    }  while (check_token (COMMA));
+  return list;
+}
+
+/* Returns one or nore TREE_LIST nodes, in reverse order. */
+
+static tree
+parse_tuple_element ()
+{
+  /* The tupleelement chain is built in reverse order,
+     and put in forward order when the list is used.  */
+  tree value, list, label;
+  if (PEEK_TOKEN () == DOT)
+    {
+      /* Parse a labelled structure tuple. */
+      tree list = parse_tuple_fieldname_list (), field;
+      expect (COLON, "missing ':' in tuple");
+      value = parse_untyped_expr ();
+      if (ignoring)
+	return NULL_TREE;
+      /* FIXME:  Should use save_expr(value), but that
+	 confuses nested calls to digest_init! */
+      /* Re-use the list of field names as a list of name-value pairs. */
+      for (field = list; field != NULL_TREE; field = TREE_CHAIN (field))
+	{ tree field_name = TREE_VALUE (field);
+	  TREE_PURPOSE (field) = field_name;
+	  TREE_VALUE (field) = value;
+	  TUPLE_NAMED_FIELD (field) = 1;
+	}
+      return list;
+    }
+
+  label = parse_case_label_list (NULL_TREE, 1);
+  if (label)
+    {
+      expect (COLON, "missing ':' in tuple");
+      value = parse_untyped_expr ();
+      if (ignoring || label == NULL_TREE)
+	return NULL_TREE;
+      if (TREE_CODE (label) != TREE_LIST)
+	{
+	  error ("invalid syntax for label in tuple");
+	  return NULL_TREE;
+	}
+      else
+	{
+	  /* FIXME:  Should use save_expr(value), but that
+	     confuses nested calls to digest_init! */
+	  tree link = label;
+	  for (; link != NULL_TREE; link = TREE_CHAIN (link))
+	    { tree index = TREE_VALUE (link);
+	      if (pass == 1 && TREE_CODE (index) != TREE_LIST)
+		index = build1 (PAREN_EXPR, NULL_TREE, index);
+	      TREE_VALUE (link) = value;
+	      TREE_PURPOSE (link) = index;
+	    }
+	  return nreverse (label);
+	}
+    }
+  
+  value = parse_untyped_expr ();
+  if (check_token (COLON))
+    {
+      /* A powerset range [or possibly a labeled Array?] */
+      tree value2 = parse_untyped_expr ();
+      return ignoring ? NULL_TREE : build_tree_list (value, value2);
+    }
+  return ignoring ? NULL_TREE : build_tree_list (NULL_TREE, value);
+}
+
+/* Matches:  a COMMA-separated list of tuple elements.
+   Returns a list (of TREE_LIST nodes). */
+static tree
+parse_opt_element_list ()
+{
+  tree list = NULL_TREE;
+  if (PEEK_TOKEN () == RPC)
+    return NULL_TREE;
+  for (;;)
+    {
+      tree element = parse_tuple_element ();
+      list = chainon (element, list); /* Built in reverse order */
+      if (PEEK_TOKEN () == RPC)
+	break;
+      if (!check_token (COMMA))
+	{
+	  error ("bad syntax in tuple");
+	  return NULL_TREE;
+	}
+    }
+  return nreverse (list);
+}
+
+/* Parses: '[' elements ']'
+   If modename is non-NULL it prefixed the tuple.  */
+
+static tree
+parse_tuple (modename)
+     tree modename;
+{
+  tree list;
+  require (LPC);
+  list = parse_opt_element_list ();
+  expect (RPC, "missing ']' after tuple");
+  if (ignoring)
+    return integer_zero_node;
+  list =  build_nt (CONSTRUCTOR, NULL_TREE, list);
+  if (modename == NULL_TREE)
+    return list;
+  else if (pass == 1)
+    TREE_TYPE (list) = modename;
+  else if (TREE_CODE (modename) != TYPE_DECL)
+    {
+      error ("non-mode name before tuple");
+      return error_mark_node;
+    }
+  else
+    list = chill_expand_tuple (TREE_TYPE (modename), list);
+  return list;
+}
+
+static tree
+parse_primval ()
+{
+  tree val;
+  switch (PEEK_TOKEN ())
+    {
+    case NUMBER:
+    case FLOATING:
+    case STRING:
+    case SINGLECHAR:
+    case BITSTRING:
+    case CONST:
+    case EXPR:
+      val = PEEK_TREE();
+      FORWARD_TOKEN ();
+      break;
+    case THIS:
+      val = build_chill_function_call (PEEK_TREE (), NULL_TREE);
+      FORWARD_TOKEN ();
+      break;
+    case LPRN:
+      FORWARD_TOKEN ();
+      val = parse_expression ();
+      expect (RPRN, "missing right parenthesis");
+      if (pass == 1 && ! ignoring)
+	val = build1 (PAREN_EXPR, NULL_TREE, val);
+      break;
+    case LPC:
+      val = parse_tuple (NULL_TREE);
+      break;
+    case NAME:
+      val = parse_name ();
+      if (PEEK_TOKEN() == LPC)
+	val = parse_tuple (val); /* Matched:  <mode_name> <tuple> */
+      break;
+    default: 
+      if (!ignoring)
+	error ("invalid expression/location syntax");
+      val = error_mark_node;
+    }
+  for (;;)
+    {
+      tree name, args;
+      switch (PEEK_TOKEN ())
+	{
+	case DOT:
+	  FORWARD_TOKEN ();
+	  name = parse_simple_name_string ();
+	  val = ignoring ? val : build_chill_component_ref (val, name);
+	  continue;
+	case ARROW:
+	  FORWARD_TOKEN ();
+	  name = parse_opt_name_string (0);
+	  val = ignoring ? val : build_chill_indirect_ref (val, name, 1);
+	  continue;
+	case LPRN:
+	  /* The SEND buffer action syntax is ambiguous, at least when
+	     parsed left-to-right.  In the example 'SEND foo(v) ...' the
+	     phrase 'foo(v)' could be a buffer location procedure call
+	     (which then must be followed by the value to send).
+	     On the other hand, if 'foo' is a buffer, stop parsing
+	     after 'foo', and let parse_send_action pick up '(v) as
+	     the value ot send.
+
+	     We handle the ambiguity for SEND signal action differently,
+	     since we allow (as an extension) a signal to be used as
+	     a "function" (see build_generalized_call). */
+	  if (TREE_TYPE (val) != NULL_TREE
+	      && CH_IS_BUFFER_MODE (TREE_TYPE (val)))
+	    return val;
+	  val = parse_call (val);
+	  continue;
+	case STRING:
+	case BITSTRING:
+	case SINGLECHAR:
+	case NAME:
+	  /* Handle string repetition. (See comment in parse_operand5.) */
+	  args = parse_primval ();
+	  val = ignoring ? val : build_generalized_call (val, args);
+	  continue;
+	}
+      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 <string repetition operator>,
+     but in general we can't distinguish that from a parenthesized
+     expression.  This is especially difficult if we allow the
+     string operand to be a constant expression (as requested by
+     some users), and not just a string literal.
+     Consider:  LPRN expr RPRN LPRN expr RPRN
+     Is that a function call or string repetition?
+     Instead, we handle string repetition in parse_primval,
+     and build_generalized_call. */
+  tree rarg;
+  switch (PEEK_TOKEN())
+    {
+    case NOT:  op = BIT_NOT_EXPR; break;
+    case SUB:  op = NEGATE_EXPR; break;
+    default:
+      op = NOP_EXPR;
+    }
+    if (op != NOP_EXPR)
+      FORWARD_TOKEN();
+    rarg = parse_operand6();
+    return (op == NOP_EXPR || ignoring) ? rarg
+      : build_chill_unary_op (op, rarg);
+}
+
+static tree
+parse_operand4 ()
+{
+  tree larg = parse_operand5(), rarg;
+  enum tree_code op;
+  for (;;)
+    {
+      switch (PEEK_TOKEN())
+	{
+	case MUL:  op = MULT_EXPR; break;
+	case DIV:  op = TRUNC_DIV_EXPR; break;
+	case MOD:  op = FLOOR_MOD_EXPR; break;
+	case REM:  op = TRUNC_MOD_EXPR; break;
+	default:
+	return larg;
+	}
+      FORWARD_TOKEN();
+      rarg = parse_operand5();
+      if (!ignoring)
+	larg = build_chill_binary_op (op, larg, rarg);
+    }
+}
+
+static tree
+parse_operand3 ()
+{
+  tree larg = parse_operand4 (), rarg;
+  enum tree_code op;
+  for (;;)
+    {
+      switch (PEEK_TOKEN())
+	{
+	case PLUS:   op = PLUS_EXPR; break;
+	case SUB:    op = MINUS_EXPR; break;
+	case CONCAT: op = CONCAT_EXPR; break;
+	default:
+	return larg;
+	}
+      FORWARD_TOKEN();
+      rarg = parse_operand4();
+      if (!ignoring)
+	larg = build_chill_binary_op (op, larg, rarg);
+    }
+}
+
+static tree
+parse_operand2 ()
+{
+  tree larg = parse_operand3 (), rarg;
+  enum tree_code op;
+  for (;;)
+    {
+      if (check_token (IN))
+	{
+	  rarg = parse_operand3();
+	  if (! ignoring)
+	    larg = build_chill_binary_op (SET_IN_EXPR, larg, rarg);
+	}
+      else
+	{
+	  switch (PEEK_TOKEN())
+	    {
+	    case GT:  op = GT_EXPR; break;
+	    case GTE: op = GE_EXPR; break;
+	    case LT:  op = LT_EXPR; break;
+	    case LTE: op = LE_EXPR; break;
+	    case EQL: op = EQ_EXPR; break;
+	    case NE:  op = NE_EXPR; break;
+	    default:
+	      return larg;
+	    }
+	  FORWARD_TOKEN();
+	  rarg = parse_operand3();
+	  if (!ignoring)
+	    larg = build_compare_expr (op, larg, rarg);
+	}
+    }
+}
+
+static tree
+parse_operand1 ()
+{
+  tree larg = parse_operand2 (), rarg;
+  enum tree_code op;
+  for (;;)
+    {
+      switch (PEEK_TOKEN())
+	{
+	case AND:   op = BIT_AND_EXPR; break;
+	case ANDIF: op = TRUTH_ANDIF_EXPR; break;
+	default:
+	  return larg;
+	}
+      FORWARD_TOKEN();
+      rarg = parse_operand2();
+      if (!ignoring)
+	larg = build_chill_binary_op (op, larg, rarg);
+    }
+}
+
+static tree
+parse_operand0 ()
+{
+  tree larg = parse_operand1(), rarg;
+  enum tree_code op;
+  for (;;)
+    {
+      switch (PEEK_TOKEN())
+	{
+	case OR:  op = BIT_IOR_EXPR; break;
+	case XOR:  op = BIT_XOR_EXPR; break;
+	case ORIF:  op = TRUTH_ORIF_EXPR; break;
+	default:
+	  return larg;
+	}
+      FORWARD_TOKEN();
+      rarg = parse_operand1();
+      if (!ignoring)
+	larg = build_chill_binary_op (op, larg, rarg);
+    }
+}
+
+static tree
+parse_expression ()
+{
+    return parse_operand0 ();
+}
+
+static tree
+parse_case_expression ()
+{
+  tree selector_list;
+  tree else_expr;
+  tree case_expr;
+  tree case_alt_list = NULL_TREE;
+
+  require (CASE);
+  selector_list = parse_expr_list ();
+  selector_list = nreverse (selector_list);
+
+  expect (OF, "missing 'OF'");
+  while (PEEK_TOKEN () == LPRN)
+    {
+      tree label_spec = parse_case_label_specification (selector_list);
+      tree sub_expr;
+      expect (COLON, "missing ':' in value case alternative");
+      sub_expr = parse_expression ();
+      expect (SC, "missing ';'");
+      if (! ignoring)
+	case_alt_list = tree_cons (label_spec, sub_expr, case_alt_list);
+    }
+  if (check_token (ELSE))
+    {
+      else_expr = parse_expression ();
+      if (check_token (SC) && pass == 1)
+	warning("there should not be a ';' here"); 
+    }
+  else
+    else_expr = NULL_TREE;
+  expect (ESAC, "missing 'ESAC' in 'CASE' expression");
+
+  if (ignoring)
+    return integer_zero_node;
+
+  /* If this is a multi dimension case, then transform it into an COND_EXPR
+     here. This must be done before store_expr is called since it has some
+     special handling for COND_EXPR expressions. */
+  if (TREE_CHAIN (selector_list) != NULL_TREE)
+    {
+      case_alt_list = nreverse (case_alt_list);
+      compute_else_ranges (selector_list, case_alt_list);
+      case_expr =
+	build_chill_multi_dimension_case_expr (selector_list, case_alt_list, else_expr);
+    }
+  else
+    case_expr = build_chill_case_expr (selector_list, case_alt_list, else_expr);
+
+  return case_expr;
+}
+
+static tree
+parse_then_alternative ()
+{
+  expect (THEN, "missing 'THEN' in 'IF' expression");
+  return parse_expression ();
+}
+
+static tree
+parse_else_alternative ()
+{
+  if (check_token (ELSIF))
+    return parse_if_expression_body ();
+  else if (check_token (ELSE))
+    return parse_expression ();
+  error ("missing ELSE/ELSIF in IF expression");
+  return error_mark_node;
+}
+
+/* Matches: <boolean expression> <then alternative> <else alternative> */
+
+static tree
+parse_if_expression_body ()
+{
+  tree bool_expr, then_expr, else_expr;
+  bool_expr = parse_expression ();
+  then_expr = parse_then_alternative ();
+  else_expr = parse_else_alternative ();
+  if (ignoring)
+    return integer_zero_node;
+  else
+    return build_nt (COND_EXPR, bool_expr, then_expr, else_expr);
+}
+
+static tree
+parse_if_expression ()
+{
+  tree expr;
+  require (IF);
+  expr = parse_if_expression_body ();
+  expect (FI, "missing 'FI' at end of conditional expression");
+  return expr;
+}
+
+/* An <untyped_expr> is a superset of <expr>.  It also includes
+   <conditional expressions> and untyped <tuples>, whose types
+   are not given by their constituents.  Hence, these are only
+   allowed in certain contexts that expect a certain type.
+   You should call convert() to fix up the <untyped_expr>. */
+
+static tree
+parse_untyped_expr ()
+{
+  tree val;
+  switch (PEEK_TOKEN())
+    {
+    case IF:
+      return parse_if_expression ();
+    case CASE:
+      return parse_case_expression ();
+    case LPRN:
+      switch (PEEK_TOKEN1())
+	{
+	case IF:
+	case CASE:
+	  if (pass == 1)
+	    pedwarn ("conditional expression not allowed inside parentheses");
+	  goto skip_lprn;
+	case LPC:
+	  if (pass == 1)
+	    pedwarn ("mode-less tuple not allowed inside parentheses");
+	skip_lprn:
+	  FORWARD_TOKEN ();
+	  val = parse_untyped_expr ();
+	  expect (RPRN, "missing ')'");
+	  return val;
+	default: ;
+	  /* fall through */
+	}
+    default:
+      return parse_operand0 ();
+    }
+}
+
+/* Matches:  <index mode> */
+
+static tree
+parse_index_mode ()
+{
+  /* This is another one that is nasty to parse!
+   Let's feel our way ahead ... */
+  tree lower, upper;
+  if (PEEK_TOKEN () == NAME)
+    {
+      tree name = parse_name ();
+      switch (PEEK_TOKEN ())
+	{
+	case COMMA:
+	case RPRN:
+	case SC: /* An error */
+	  /* This can only (legally) be a discrete mode name. */
+	  return name;
+	case LPRN:
+	  /* This could be named discrete range,
+	     a cast, or some other expression (maybe). */
+	  require (LPRN);
+	  lower = parse_expression ();
+	  if (check_token (COLON))
+	    {
+	      upper = parse_expression ();
+	      expect (RPRN, "missing ')'");
+	      /* Matched: <mode_name> '(' <expr> ':' <expr> ')' */
+	      if (ignoring)
+		return NULL_TREE;
+	      else
+		return build_chill_range_type (name, lower, upper);
+	    }
+	  /* Looks like a cast or procedure call or something.
+	     Backup, and try again. */
+	  pushback_token (EXPR, lower);
+	  pushback_token (LPRN, NULL_TREE);
+	  lower = parse_call (name);
+	  goto parse_literal_range_colon;
+	default:
+	  /* This has to be the start of an expression. */
+	  pushback_token (EXPR, name);
+	  goto parse_literal_range;
+	}
+    }
+  /* It's not a name.  But it could still be a discrete mode. */
+  lower = parse_opt_mode ();
+  if (lower)
+    return lower;
+ parse_literal_range:
+  /* Nope, it's a discrete literal range. */
+  lower = parse_expression ();
+ parse_literal_range_colon:
+  expect (COLON, "expected ':' here");
+  
+  upper = parse_expression ();
+  return ignoring ? NULL_TREE
+    : build_chill_range_type (NULL_TREE, lower, upper);
+}
+
+static tree
+parse_set_mode ()
+{
+  int  set_name_cnt = 0;          /* count of named set elements */
+  int  set_is_numbered = 0;     /* TRUE if set elements have explicit values */
+  int  set_is_not_numbered = 0;
+  tree list = NULL_TREE;
+  tree mode = ignoring ? void_type_node : start_enum (NULL_TREE);
+  require (SET);
+  expect (LPRN, "missing left parenthesis after SET");
+  for (;;)
+    {
+      tree name, value = NULL_TREE;
+      if (check_token (MUL))
+	name = NULL_TREE;
+      else
+	{
+	  name = parse_defining_occurrence ();
+	  if (check_token (EQL))
+	    {
+	      value = parse_expression ();
+	      set_is_numbered = 1;
+	    }
+	  else
+	    set_is_not_numbered = 1;
+	  set_name_cnt++;
+	}
+      name = build_enumerator (name, value);
+      if (pass == 1)
+	list = chainon (name, list);
+      if (! check_token (COMMA))
+	break;
+    }
+  expect (RPRN, "missing right parenthesis after SET");
+  if (!ignoring)
+    {
+      if (set_is_numbered && set_is_not_numbered)
+	/* Z.200 doesn't allow mixed numbered and unnumbered set elements,
+	   but we can do it. Print a warning */
+	pedwarn ("mixed numbered and unnumbered set elements is not standard");
+      mode = finish_enum (mode, list); 
+      if (set_name_cnt == 0)
+	error ("SET mode must define at least one named value");
+      CH_ENUM_IS_NUMBERED(mode) = set_is_numbered ? 1 : 0;
+    }
+  return mode;
+}
+
+/* parse layout POS:
+   returns a tree with following layout
+
+                treelist
+       pupose=treelist  value=NULL_TREE (to indicate POS)
+     pupose=word  value=treelist | NULL_TREE
+           pupose=startbit  value=treelist | NULL_TREE
+                      purpose=                      value=
+               integer_zero | integer_one    length | endbit
+*/
+static tree
+parse_pos ()
+{
+  tree word;
+  tree startbit = NULL_TREE, endbit = NULL_TREE;
+  tree what = NULL_TREE;
+  
+  require (LPRN);
+  word = parse_untyped_expr ();
+  if (check_token (COMMA))
+    {
+      startbit = parse_untyped_expr ();
+      if (check_token (COMMA))
+	{
+	  what = integer_zero_node;
+	  endbit = parse_untyped_expr ();
+	}
+      else if (check_token (COLON))
+	{
+	  what = integer_one_node;
+	  endbit = parse_untyped_expr ();
+	}
+    }
+  require (RPRN);
+  
+  /* build the tree as described above */
+  if (what != NULL_TREE)
+    what = tree_cons (what, endbit, NULL_TREE);
+  if (startbit != NULL_TREE)
+    startbit = tree_cons (startbit, what, NULL_TREE);
+  endbit = tree_cons (word, startbit, NULL_TREE);
+  return tree_cons (endbit, NULL_TREE, NULL_TREE);
+}
+
+/* parse layout STEP
+   returns a tree with the following layout
+
+                treelist
+     pupose=NULL_TREE value=treelist (to indicate STEP)
+         pupose=POS(see baove)  value=stepsize | NULL_TREE
+*/
+static tree
+parse_step ()
+{
+  tree pos;
+  tree stepsize = NULL_TREE;
+  
+  require (LPRN);
+  require (POS);
+  pos = parse_pos ();
+  if (check_token (COMMA))
+    stepsize = parse_untyped_expr ();
+  require (RPRN);
+  TREE_VALUE (pos) = stepsize;
+  return tree_cons (NULL_TREE, pos, NULL_TREE);
+}
+
+/* returns layout for fields or array elements.
+   NULL_TREE            no layout specified
+   integer_one_node     PACK specified
+   integer_zero_node    NOPACK specified
+   tree_list PURPOSE    POS
+   tree_list VALUE      STEP
+*/
+static tree
+parse_opt_layout (in)
+     int in;     /* 0 ... parse structure, 1 ... parse array */
+{
+  tree val = NULL_TREE;
+
+  if (check_token (PACK))
+    {
+      return integer_one_node;
+    }
+  else if (check_token (NOPACK))
+    {
+      return integer_zero_node;
+    }
+  else if (check_token (POS))
+    {
+      val = parse_pos ();
+      if (in == 1 && pass == 1)
+	{
+	  error ("POS not allowed for ARRAY");
+	  val = NULL_TREE;
+	}
+      return val;
+    }
+  else if (check_token (STEP))
+    {
+      val = parse_step ();
+      if (in == 0 && pass == 1)
+	{
+	  error ("STEP not allowed in field definition");
+	  val = NULL_TREE;
+	}
+      return val;
+    }
+  else
+    return NULL_TREE;
+}
+
+static tree
+parse_field_name_list ()
+{
+  tree chain = NULL_TREE;
+  tree name = parse_defining_occurrence ();
+  if (name == NULL_TREE)
+    {
+      error("missing field name");
+      return NULL_TREE;
+    }
+  chain = build_tree_list (NULL_TREE, name);
+  while (check_token (COMMA))
+    {
+      name = parse_defining_occurrence ();
+      if (name == NULL)
+	{
+	  error ("bad field name following ','");
+	  break;
+	}
+      if (! ignoring)
+	chain = tree_cons (NULL_TREE, name, chain);
+    }
+  return chain;
+}
+
+/* Matches: <fixed field> or <variant field>, i.e.:
+   <field name defining occurrence list> <mode> [ <field layout> ].
+   Returns:  A chain of FIELD_DECLs.
+   NULL_TREE is returned if ignoring is true or an error is seen. */
+
+static tree
+parse_fixed_field ()
+{
+  tree field_names = parse_field_name_list ();
+  tree mode = parse_mode ();
+  tree layout = parse_opt_layout (0);
+  return ignoring ? NULL_TREE
+    : grok_chill_fixedfields (field_names, mode, layout);
+}
+
+
+/* Matches: [ <variant field> { "," <variant field> }* ]
+   Returns:  A chain of FIELD_DECLs.
+   NULL_TREE is returned if ignoring is true or an error is seen. */
+
+static tree
+parse_variant_field_list ()
+{
+  tree fields = NULL_TREE;
+  if (PEEK_TOKEN () != NAME)
+    return NULL_TREE;
+  for (;;)
+    {
+      fields = chainon (fields, parse_fixed_field ());
+      if (PEEK_TOKEN () != COMMA || PEEK_TOKEN1 () != NAME)
+	break;
+      require (COMMA);
+    }
+  return fields;
+}
+
+/* Matches: <variant alternative>
+   Returns a TREE_LIST node, whose TREE_PURPOSE (if non-NULL) is the label,
+   and whose TREE_VALUE is the list of FIELD_DECLs. */
+
+static tree
+parse_variant_alternative ()
+{
+  tree labels, x;
+  tree variant_fields = NULL_TREE;
+  if (PEEK_TOKEN () == LPRN)
+    labels = parse_case_label_specification (NULL_TREE);
+  else
+    labels = NULL_TREE;
+  if (! check_token (COLON))
+    {
+      error ("expected ':' in structure variant alternative");
+      return NULL_TREE;
+    }
+
+  /* We now read a list a variant fields, until we come to the end
+     of the variant alternative.  But since both variant fields
+     *and* variant alternatives are separated by COMMAs,
+     we will have to look ahead to distinguish the start of a variant
+     field from the start of a new variant alternative.
+     We use the fact that a variant alternative must start with
+     either a LPRN or a COLON, while a variant field must start with a NAME.
+     This look-ahead is handled by parse_simple_fields. */
+  return build_tree_list (labels, parse_variant_field_list ());
+}
+
+/* Parse <field> (which is <fixed field> or <alternative field>).
+   Returns:  A chain of FIELD_DECLs (or NULL_TREE on error or if ignoring). */
+
+static tree
+parse_field ()
+{
+  if (check_token (CASE))
+    {
+      tree tag_list = NULL_TREE, variants, opt_variant_else;
+      if (PEEK_TOKEN () == NAME)
+	{
+	  tag_list = nreverse (parse_field_name_list ());
+	  if (pass == 1)
+	    tag_list = lookup_tag_fields (tag_list, current_fieldlist);
+	}
+      expect (OF, "missing 'OF' in alternative structure field");
+
+      variants = parse_variant_alternative ();
+      while (check_token (COMMA))
+	variants = chainon (parse_variant_alternative (), variants);
+      variants = nreverse (variants);
+
+      if (check_token (ELSE))
+	opt_variant_else = parse_variant_field_list ();
+      else
+	opt_variant_else = NULL_TREE;
+      expect (ESAC, "missing 'ESAC' following alternative structure field");
+      if (ignoring)
+	return NULL_TREE;
+      return grok_chill_variantdefs (tag_list, variants, opt_variant_else);
+    }
+  else if (PEEK_TOKEN () == NAME)
+    return parse_fixed_field ();
+  else
+    {
+      if (pass == 1)
+	error ("missing field");
+      return NULL_TREE;
+    }
+}
+
+static tree
+parse_structure_mode ()
+{
+  tree save_fieldlist = current_fieldlist;
+  tree fields;
+  require (STRUCT);
+  expect (LPRN, "expected '(' after STRUCT");
+  current_fieldlist = fields = parse_field ();
+  while (check_token (COMMA))
+    fields = chainon (fields, parse_field ());
+  expect (RPRN, "expected ')' after STRUCT");
+  current_fieldlist = save_fieldlist;
+  return ignoring ? void_type_node : build_chill_struct_type (fields);
+}
+
+static tree
+parse_opt_queue_size ()
+{
+  if (check_token (LPRN))
+    {
+      tree size = parse_expression ();
+      expect (RPRN, "missing ')'");
+      return size;
+    }
+  else
+    return NULL_TREE;
+}
+
+static tree
+parse_procedure_mode ()
+{
+  tree param_types = NULL_TREE, result_spec, except_list, recursive;
+  require (PROC);
+  expect (LPRN, "missing '(' after PROC");
+  if (! check_token (RPRN))
+    {
+      for (;;)
+	{
+	  tree pmode = parse_mode ();
+	  tree paramattr = parse_param_attr ();
+	  if (! ignoring)
+	    {
+	      pmode = get_type_of (pmode);
+	      param_types = tree_cons (paramattr, pmode, param_types);
+	    }
+	  if (! check_token (COMMA))
+	    break;
+	}
+      expect (RPRN, "missing ')' after PROC");
+    }
+  result_spec = parse_opt_result_spec ();
+  except_list = parse_opt_except ();
+  recursive = parse_opt_recursive ();
+  if (ignoring)
+    return void_type_node;
+  return build_chill_pointer_type (build_chill_function_type
+				   (result_spec, nreverse (param_types),
+				    except_list, recursive));
+}
+
+/* Matches: <mode>
+   A NAME will be assumed to be a <mode name>, and thus a <mode>.
+   Returns NULL_TREE if no mode is seen.
+   (If ignoring is true, the return value may be an arbitrary tree node,
+   but will be non-NULL if something that could be a mode is seen.) */
+
+static tree
+parse_opt_mode ()
+{
+  switch (PEEK_TOKEN ())
+    {
+    case ACCESS:
+      {
+	tree index_mode, record_mode;
+	int dynamic = 0;
+	require (ACCESS);
+	if (check_token (LPRN))
+	  {
+	    index_mode = parse_index_mode ();
+	    expect (RPRN, "mssing ')'");
+	  }
+	else
+	  index_mode = NULL_TREE;
+	record_mode = parse_opt_mode ();
+	if (record_mode)
+	  dynamic = check_token (DYNAMIC);
+	return ignoring ? void_type_node
+	                : build_access_mode (index_mode, record_mode, dynamic);
+      }
+    case ARRAY:
+      {
+	tree index_list = NULL_TREE, base_mode;
+	int varying;
+	int num_index_modes = 0;
+	int i;
+	tree layouts = NULL_TREE;
+	FORWARD_TOKEN ();
+	expect (LPRN, "missing '(' after ARRAY");
+	for (;;)
+	  {
+	    tree index = parse_index_mode ();
+	    num_index_modes++;
+	    if (!ignoring)
+	      index_list = tree_cons (NULL_TREE, index, index_list);
+	    if (! check_token (COMMA))
+	      break;
+	  }
+	expect (RPRN, "missing ')' after ARRAY");
+	varying = check_token (VARYING);
+	base_mode = parse_mode ();
+	/* Allow a layout specification for each index mode */
+	for (i = 0; i < num_index_modes; ++i)
+	  {
+	  tree new_layout = parse_opt_layout (1);
+	  if (new_layout == NULL_TREE)
+	    break;
+	  if (!ignoring)
+	    layouts = tree_cons (NULL_TREE, new_layout, layouts);
+	  }
+	if (ignoring)
+	  return base_mode;
+	return build_chill_array_type (get_type_of (base_mode),
+				       index_list, varying, layouts);
+      }
+    case ASSOCIATION:
+      require (ASSOCIATION);
+      return association_type_node;
+    case BIN:
+      { tree length;
+	FORWARD_TOKEN();
+	expect (LPRN, "missing left parenthesis after BIN");
+	length = parse_expression ();
+	expect (RPRN, "missing right parenthesis after BIN");
+	return ignoring ? void_type_node :  build_chill_bin_type (length);
+      } 
+    case BOOLS:
+      {
+	tree length;
+	FORWARD_TOKEN ();
+	expect (LPRN, "missing '(' after BOOLS");
+	length = parse_expression ();
+	expect (RPRN, "missing ')' after BOOLS");
+	if (check_token (VARYING))
+	  error ("VARYING bit-strings not implemented");
+	return ignoring ? void_type_node : build_bitstring_type (length);
+      }
+    case BUFFER:
+      {
+	tree qsize, element_mode;
+	require (BUFFER);
+	qsize = parse_opt_queue_size ();
+	element_mode = parse_mode ();
+	return ignoring ? element_mode
+	  : build_buffer_type (element_mode, qsize);
+      }
+    case CHARS:
+      {
+	tree length;
+	int varying;
+	tree type;
+	FORWARD_TOKEN ();
+	expect (LPRN, "missing '(' after CHARS");
+	length = parse_expression ();
+	expect (RPRN, "missing ')' after CHARS");
+	varying = check_token (VARYING);
+	if (ignoring)
+	  return void_type_node;
+	type = build_string_type (char_type_node, length);
+	if (varying)
+	  type = build_varying_struct (type);
+	return type;
+      }
+    case EVENT:
+      {
+	tree qsize;
+	require (EVENT);
+	qsize = parse_opt_queue_size ();
+	return ignoring ? void_type_node : build_event_type (qsize);
+      }
+    case NAME:
+      {
+	tree mode = get_type_of (parse_name ());
+	if (check_token (LPRN))
+	  {
+	    tree min_value = parse_expression ();
+	    if (check_token (COLON))
+	      {
+		tree max_value = parse_expression ();
+		expect (RPRN, "syntax error - expected ')'");
+		/* Matched: <mode_name> '(' <expr> ':' <expr> ')' */
+		if (ignoring)
+		  return mode;
+		else
+		  return build_chill_range_type (mode, min_value, max_value);
+	      }
+	    if (check_token (RPRN))
+	      {
+		int varying = check_token (VARYING);
+		if (! ignoring)
+		  {
+		    if (mode == char_type_node || varying)
+		      {
+			if (mode != char_type_node
+			    && mode != ridpointers[(int) RID_CHAR])
+			  error ("strings must be composed of chars");
+			mode = build_string_type (char_type_node, min_value);
+			if (varying)
+			  mode  = build_varying_struct (mode);
+		      }
+		    else
+		      {
+			/* Parameterized mode,
+			   or old-fashioned CHAR(N) string declaration.. */
+			tree pmode = make_node (LANG_TYPE);
+			TREE_TYPE (pmode) = mode;
+			TYPE_DOMAIN (pmode) = min_value;
+			mode = pmode;
+		      }
+		  }
+	      }
+	  }
+	return mode;
+      }
+    case POWERSET:
+      { tree mode;
+	FORWARD_TOKEN ();
+	mode = parse_mode ();
+	 if (ignoring || TREE_CODE (mode) == ERROR_MARK)
+	   return mode;
+	return build_powerset_type (get_type_of (mode)); 
+      }
+    case PROC:
+      return parse_procedure_mode ();
+    case RANGE:
+      { tree low, high;
+	FORWARD_TOKEN();
+	expect (LPRN, "missing left parenthesis after RANGE");
+	low = parse_expression ();
+	expect (COLON, "missing colon");
+	high = parse_expression ();
+	expect (RPRN, "missing right parenthesis after RANGE");
+	return ignoring ? void_type_node
+	  :  build_chill_range_type (NULL_TREE, low, high);
+      }
+    case READ:
+	FORWARD_TOKEN ();
+	{
+	  tree mode2 = get_type_of (parse_mode ());
+	  if (ignoring || TREE_CODE (mode2) == ERROR_MARK)
+	    return mode2;
+	  if (mode2
+	      && TREE_CODE_CLASS (TREE_CODE (mode2)) == 'd'
+	      && CH_IS_BUFFER_MODE (mode2))
+	    {
+	      error ("BUFFER modes may not be readonly");
+	      return mode2;
+	    }
+	  if (mode2
+	      && TREE_CODE_CLASS (TREE_CODE (mode2)) == 'd'
+	      && CH_IS_EVENT_MODE (mode2))
+	    {
+	      error ("EVENT modes may not be readonly");
+	      return mode2;
+	    }
+	  return build_readonly_type (mode2);
+
+      }
+    case REF:
+      { tree mode;
+	FORWARD_TOKEN ();
+	mode = parse_mode ();
+	 if (ignoring)
+	   return mode;
+	mode = get_type_of (mode);
+	return (TREE_CODE (mode) == ERROR_MARK) ? mode
+	  : build_chill_pointer_type (mode); 
+      }
+    case SET:
+      return parse_set_mode ();
+    case SIGNAL:
+      if (pedantic)
+	error ("SIGNAL is not a valid mode");
+      return generic_signal_type_node; 
+    case STRUCT:
+      return parse_structure_mode ();
+    case TEXT:
+      {
+	tree length, index_mode;
+	int dynamic;
+	require (TEXT);
+	expect (LPRN, "missing '('");
+	length = parse_expression ();
+	expect (RPRN, "missing ')'");
+	/* FIXME:  This should actually look for an optional index_mode,
+	   but that is tricky to do. */
+	index_mode = parse_opt_mode ();
+	dynamic = check_token (DYNAMIC);
+	return ignoring ? void_type_node
+	                : build_text_mode (length, index_mode, dynamic);
+      }
+    case USAGE:
+      require (USAGE);
+      return usage_type_node;
+    case WHERE:
+      require (WHERE);
+      return where_type_node;
+    default:
+      return NULL_TREE; 
+    }
+}
+
+static tree
+parse_mode ()
+{
+ tree mode = parse_opt_mode ();
+ if (mode == NULL_TREE)
+   {
+     if (pass == 1)
+       error ("syntax error - missing mode");
+     mode = error_mark_node;
+   }
+ return mode;
+}
+
+static void
+parse_program()
+{
+  /* Initialize global variables for current pass. */
+  int i;
+  expand_exit_needed = 0;
+  label = NULL_TREE;             /* for statement labels */
+  current_module = NULL;
+  current_function_decl = NULL_TREE;
+  in_pseudo_module = 0;
+  
+  for (i = 0; i <= MAX_LOOK_AHEAD; i++)
+    terminal_buffer[i] = TOKEN_NOT_READ;
+
+#if 0
+  /* skip some junk */
+  while (PEEK_TOKEN() == HEADEREL)
+    FORWARD_TOKEN();
+#endif
+
+  start_outer_function ();
+
+  for (;;)
+    {
+      tree label = parse_optlabel ();
+      if (PEEK_TOKEN() == MODULE || PEEK_TOKEN() == REGION)
+	parse_modulion (label);
+      else if (PEEK_TOKEN() == SPEC)
+	parse_spec_module (label);
+      else break;
+    }
+
+  finish_outer_function ();
+}
+
+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