�

Migrate from devo/gcc/ch.

From-SVN: r22038

40 files changed, 28969 insertions, 0 deletions

diff --git a/gcc/ch/README b/gcc/ch/README
new file mode 100644
index 0000000..3dba977
--- /dev/null
+++ b/gcc/ch/README
@@ -0,0 +1,42 @@
+This directory contains the GNU front-end for the Chill language,
+contributed by Cygnus Solutions.
+
+Chill is the "CCITT High-Level Language", where CCITT is the old
+name for what is now ITU, the International Telecommunications Union.
+It is is language in the Modula2 family, and targets many of the
+same applications as Ada (especially large embedded systems).
+Chill was never used much in the United States, but is still
+being used in Europe, Brazil, Korea, and other places.
+
+Chill has been standardized by a series of reports/standards.
+The GNU implementation mostly follows the 1988 version of
+the language, with some backwards compatibility options for
+the 1984 version, and some other extensions.  However, it
+does not implement all of the features of any standard.
+The most recent standard is ?, available from ?.
+
+The GNU Chill implementation is not being actively developed.
+Cygnus has one customer we are maintaining Chill for,
+but we are not planning on putting major work into Chill.
+This Net release is for educational purposes (as an example
+of a different Gcc front-end), and for those who find it useful.
+It is an unsupported hacker release.  Bug reports without
+patches are likely to get ignored.  Questions may get answered or
+ignored depending on our mood!  If you want to try your luck,
+you can send a note to David Brolley <brolley@cygnus.com> or
+Per Bothner <bothner@cygnus.com>.
+
+One known problem is that we only support native builds of GNU Chill.
+If you need a cross-compiler, you will find various problems,
+including the directory structure, and the setjmp-based exception
+handling mechanism.
+
+The Chill run-time system is in the runtime sub-directory.
+Notice rts.c contains a poor main's implementation of Chill
+"processes" (threads).  It is not added to libchill.a.
+We only use it for testing.  (Our customer uses a different
+implementation for product work.)
+
+The GNU Chill implementation was primarily written by
+Per Bothner, along with Bill Cox, Wilfried Moser, Michael
+Tiemann, and David Brolley.
diff --git a/gcc/ch/actions.c b/gcc/ch/actions.c
new file mode 100644
index 0000000..79bacf0
--- /dev/null
+++ b/gcc/ch/actions.c
@@ -0,0 +1,1820 @@
+/* Implement actions for CHILL.
+   Copyright (C) 1992, 93, 1994 Free Software Foundation, Inc.
+   Authors: Per Bothner, Bill Cox, Michael Tiemann, Michael North
+
+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.  */
+
+#include <stdio.h>
+#include <limits.h>
+#include "config.h"
+#include "tree.h"
+#include "rtl.h"
+#include "expr.h"
+#include "ch-tree.h"
+#include "lex.h"
+#include "flags.h"
+#include "actions.h"
+#include "obstack.h"
+#include "assert.h"
+
+#define obstack_chunk_alloc xmalloc
+#define obstack_chunk_free free
+
+/* reserved tag definitions */
+
+#define TYPE_ID                 "id"
+#define TAG_OBJECT              "chill_object"
+#define TAG_CLASS               "chill_class"
+
+extern int flag_short_enums;
+extern int current_nesting_level;
+
+extern tree build_chill_compound_expr PROTO((tree));
+extern tree build_chill_exception_decl PROTO((char *));
+extern tree convert                   PROTO((tree, tree));
+extern rtx  emit_line_note_force      PROTO((char *, int));
+extern void error                     PROTO((char *, ...));
+extern void error_with_decl           PROTO((tree, char *, ...));
+extern rtx  gen_nop                   PROTO((void));
+extern tree get_identifier            PROTO((char *));
+extern void pedwarn                   PROTO((char *, ...));
+extern void sorry                     PROTO((char *, ...));
+extern void warning                   PROTO((char *, ...));
+
+extern struct obstack *expression_obstack, permanent_obstack;
+extern struct obstack *current_obstack, *saveable_obstack;
+
+/* This flag is checked throughout the non-CHILL-specific
+   in the front end. */
+tree chill_integer_type_node;
+tree chill_unsigned_type_node;
+
+/* Never used.  Referenced from c-typeck.c, which we use. */
+int current_function_returns_value = 0;
+int current_function_returns_null = 0;
+
+/* data imported from toplev.c  */
+
+extern char *dump_base_name;
+
+/* set from command line parameter, to exit after 
+   grant file written, generating no code. */
+int grant_only_flag = 0;
+
+char *
+lang_identify ()
+{
+  return "chill";
+}
+
+
+void
+init_chill ()
+{
+}
+
+void
+print_lang_statistics ()
+{
+}
+
+
+void
+lang_finish ()
+{
+#if 0
+    extern int errorcount, sorrycount;
+
+    /* this should be the last action in compiling a module.
+       If there are other actions to be performed at lang_finish
+       please insert before this */
+
+    /* FIXME: in case of a syntax error, this leaves the grant file incomplete */
+    /* for the moment we print a warning in case of errors and 
+       continue granting */
+    if ((errorcount || sorrycount) && grant_count)
+      {
+	warning ("%d errors, %d sorries, do granting", errorcount, sorrycount);
+	errorcount = sorrycount = 0;
+      }
+#endif
+}
+
+void
+chill_check_decl (decl)
+     tree decl;
+{
+  tree type = TREE_TYPE (decl);
+  static int alreadyWarned = 0;
+
+  if (TREE_CODE (type) == RECORD_TYPE) /* && TREE_STATIC_TEMPLATE (type)) */
+    {
+      if (!alreadyWarned)
+        {
+          error ("GNU compiler does not support statically allocated objects");          
+          alreadyWarned = 1;
+        }
+      error_with_decl (decl, "`%s' cannot be statically allocated");
+    }
+}
+
+/* Comparison function for sorting identifiers in RAISES lists.
+   Note that because IDENTIFIER_NODEs are unique, we can sort
+   them by address, saving an indirection.  */
+static int
+id_cmp (p1, p2)
+     tree *p1, *p2;
+{
+  return (int)TREE_VALUE (*p1) - (int)TREE_VALUE (*p2);
+}
+
+/* Build the FUNCTION_TYPE or METHOD_TYPE which may raise exceptions
+   listed in RAISES.  */
+tree
+build_exception_variant (type, raises)
+     tree type, raises;
+{
+  int i;
+  tree v = TYPE_MAIN_VARIANT (type);
+  tree t, t2;
+  int constp    = TYPE_READONLY (type);
+  int volatilep = TYPE_VOLATILE (type);
+
+  if (!raises)
+    return build_type_variant (v, constp, volatilep);
+
+  if (TREE_CHAIN (raises))
+    { /* Sort the list */
+      tree *a = (tree *)alloca ((list_length (raises)+1) * sizeof (tree));
+      for (i = 0, t = raises; t; t = TREE_CHAIN (t), i++)
+	a[i] = t;
+      /* NULL terminator for list.  */
+      a[i] = NULL_TREE;
+      qsort (a, i, sizeof (tree), id_cmp);
+      while (i--)
+	TREE_CHAIN (a[i]) = a[i+1];
+      raises = a[0];
+    }
+
+  for (v = TYPE_NEXT_VARIANT (v); v; v = TYPE_NEXT_VARIANT (v))
+    {
+      if (TYPE_READONLY (v) != constp
+	  || TYPE_VOLATILE (v) != volatilep)
+	continue;
+
+      t = raises;
+      t2 = TYPE_RAISES_EXCEPTIONS (v);
+      while (t && t2)
+	{
+	  if (TREE_TYPE (t) == TREE_TYPE (t2))
+	    {
+	      t = TREE_CHAIN (t);
+	      t2 = TREE_CHAIN (t2);
+	    }
+	  else break;
+	}
+      if (t || t2)
+	continue;
+      /* List of exceptions raised matches previously found list.
+
+         @@ Nice to free up storage used in consing up the
+	 @@ list of exceptions raised.  */
+      return v;
+    }
+
+  /* Need to build a new variant.  */
+  if (TREE_PERMANENT (type))
+    {
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+      v = copy_node (type);
+      pop_obstacks ();
+    }
+  else
+    v = copy_node (type);
+
+  TYPE_NEXT_VARIANT (v) = TYPE_NEXT_VARIANT (type);
+  TYPE_NEXT_VARIANT (type) = v;
+  if (raises && ! TREE_PERMANENT (raises))
+    {
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+      raises = copy_list (raises);
+      pop_obstacks ();
+    }
+  TYPE_RAISES_EXCEPTIONS (v) = raises;
+  return v;
+}
+#if 0
+
+tree
+build_rts_call (name, type, args)
+     char *name;
+     tree type, args;
+{
+  tree decl = lookup_name (get_identifier (name));
+  tree converted_args = NULL_TREE;
+  tree result, length = NULL_TREE;
+
+  assert (decl != NULL_TREE);
+  while (args)
+    {
+      tree arg = TREE_VALUE (args);
+      if (TREE_CODE (TREE_TYPE (arg)) == SET_TYPE
+	  || TREE_CODE (TREE_TYPE (arg)) == ARRAY_TYPE)
+	{
+	  length = size_in_bytes (TREE_TYPE (arg));
+	  arg = build_chill_addr_expr (arg, (char *)0);
+	}
+      converted_args = tree_cons (NULL_TREE, arg, converted_args);
+      args = TREE_CHAIN (args);
+    }
+  if (length != NULL_TREE)
+    converted_args = tree_cons (NULL_TREE, length, converted_args);
+  converted_args = nreverse (converted_args);
+  result = build_chill_function_call (decl, converted_args);
+  if (TREE_CODE (type) == SET_TYPE || TREE_CODE (type) == ARRAY_TYPE)
+    result = build1 (INDIRECT_REF, type, result);
+  else
+    result = convert (type, result);
+  return result;
+}
+#endif
+
+/*
+ * queue name of unhandled exception
+ * to avoid multiple unhandled warnings
+ * in one compilation module
+ */
+
+struct already_type
+{
+  struct already_type *next;
+  char *name;
+};
+
+static struct already_type *already_warned = 0;
+
+static void
+warn_unhandled (ex)
+     char *ex;
+{
+  struct already_type *p = already_warned;
+
+  while (p)
+    {
+      if (!strcmp (p->name, ex))
+	return;
+      p = p->next;
+    }
+  
+  /* not yet warned */
+  p = (struct already_type *)xmalloc (sizeof (struct already_type));
+  p->next = already_warned;
+  p->name = (char *)xmalloc (strlen (ex) + 1);
+  strcpy (p->name, ex);
+  already_warned = p;
+  pedwarn ("causing unhandled exception `%s' (this is flaged only once)", ex);
+}
+
+/*
+ * build a call to the following function:
+ *   void   __cause_ex1 (char* ex, const char *file, 
+ *                       const unsigned lineno);
+ * if the exception is handled or
+ *   void __unhandled_ex (char *ex, char *file, unsigned lineno)
+ * if the exception is not handled.
+ */
+tree
+build_cause_exception (exp_name, warn_if_unhandled)
+     tree exp_name;
+     int warn_if_unhandled;
+{
+  /* We don't use build_rts_call() here, because the string (array of char)
+     would be followed by its length in the parameter list built by
+     build_rts_call, and the runtime routine doesn't want a length parameter.*/
+  tree exp_decl = build_chill_exception_decl (IDENTIFIER_POINTER (exp_name));
+  tree function, fname, lineno, result;
+  int handled = is_handled (exp_name);
+
+  switch (handled)
+    {
+    case 0:
+      /* no handler */
+      if (warn_if_unhandled)
+	warn_unhandled (IDENTIFIER_POINTER (exp_name));
+      function = lookup_name (get_identifier ("__unhandled_ex"));
+      fname = force_addr_of (get_chill_filename ());
+      lineno = get_chill_linenumber ();
+      break;
+    case 1:
+      /* local handler */
+      function = lookup_name (get_identifier ("__cause_ex1"));
+      fname = force_addr_of (get_chill_filename ());
+      lineno = get_chill_linenumber ();
+      break;
+    case 2:
+      /* function may propagate this exception */
+      function = lookup_name (get_identifier ("__cause_ex1"));
+      fname = lookup_name (get_identifier (CALLER_FILE));
+      if (fname == NULL_TREE)
+	fname = error_mark_node;
+      lineno = lookup_name (get_identifier (CALLER_LINE));
+      if (lineno == NULL_TREE)
+	lineno = error_mark_node;
+      break;
+    }
+  result =
+    build_chill_function_call (function,
+      tree_cons (NULL_TREE, build_chill_addr_expr (exp_decl, (char *)0),
+	tree_cons (NULL_TREE,  fname,
+	  tree_cons (NULL_TREE, lineno, NULL_TREE))));
+  return result;
+}
+
+void
+expand_cause_exception (exp_name)
+     tree exp_name;
+{
+  expand_expr_stmt (build_cause_exception (exp_name, 1));
+}
+
+/* If CONDITION is true, raise EXCEPTION (an IDENTIFIER_NODE);
+   otherwise return EXPR. */
+
+tree
+check_expression (expr, condition, exception)
+     tree expr, condition, exception;
+{
+  if (integer_zerop (condition))
+    return expr;
+  else
+    return build (COMPOUND_EXPR, TREE_TYPE (expr),
+		  fold (build (TRUTH_ANDIF_EXPR, boolean_type_node,
+			       condition, build_cause_exception (exception, 0))),
+		  expr);
+}
+
+/* Return an expression for VALUE < LO_LIMIT || VALUE > HI_LIMIT,
+   somewhat optimized and with some warnings suppressed.
+   If LO_LIMIT or HI_LIMIT is NULL_TREE, assume that (sub-)test passes.  */
+
+tree
+test_range (value, lo_limit, hi_limit)
+     tree value, lo_limit, hi_limit;
+{
+  if (lo_limit || hi_limit)
+    {
+      int old_inhibit_warnings = inhibit_warnings;
+      tree lo_check, hi_check, check;
+
+      /* This is a hack so that `shorten_compare' doesn't warn the
+	 user about useless range checks that are too much work to
+	 optimize away here.  */
+      inhibit_warnings = 1;
+
+      lo_check = lo_limit ? 
+	fold (build_compare_discrete_expr (LT_EXPR, value, lo_limit)) :
+	  boolean_false_node;   /* fake passing the check */
+
+      hi_check = hi_limit ? 
+	fold (build_compare_discrete_expr (GT_EXPR, value, hi_limit)) :
+	  boolean_false_node;   /* fake passing the check */
+
+      if (lo_check == boolean_false_node)
+	check = hi_check;
+      else if (hi_check == boolean_false_node)
+	check = lo_check;
+      else
+	check = fold (build (TRUTH_ORIF_EXPR, boolean_type_node,
+			     lo_check, hi_check));
+
+      inhibit_warnings = old_inhibit_warnings;
+      return check;
+    }
+  else
+    return boolean_false_node;
+}
+
+/* Return EXPR, except if range_checking is on, return an expression
+   that also checks that value >= low_limit && value <= hi_limit.
+   If LO_LIMIT or HI_LIMIT is NULL_TREE, assume that test passes.  */
+
+tree
+check_range (expr, value, lo_limit, hi_limit)
+     tree expr, value, lo_limit, hi_limit;
+{
+  tree check = test_range (value, lo_limit, hi_limit);
+  if (!integer_zerop (check))
+    {
+      if (current_function_decl == NULL_TREE)
+	{
+	  if (TREE_CODE (check) == INTEGER_CST)
+	    error ("range failure (not inside function)");
+	  else
+	    warning ("possible range failure (not inside function)");
+	}
+      else
+	{
+	  if (TREE_CODE (check) == INTEGER_CST)
+	    warning ("expression will always cause RANGEFAIL");
+	  if (range_checking)
+	    expr = check_expression (expr, check,
+				     ridpointers[(int) RID_RANGEFAIL]);
+	}
+    }
+  return expr;
+}
+
+/* Same as EXPR, except raise EMPTY if EXPR is NULL. */
+
+tree
+check_non_null (expr)
+     tree expr;
+{
+  if (empty_checking)
+    {
+      expr = save_if_needed (expr);
+      return check_expression (expr,
+			       build_compare_expr (EQ_EXPR,
+						   expr, null_pointer_node),
+			       ridpointers[(int) RID_EMPTY]);
+    }
+  return expr;
+}
+
+/*
+ * There are four conditions to generate a runtime check:
+ *    1) assigning a longer INT to a shorter (signs irrelevant)
+ *    2) assigning a signed to an unsigned
+ *    3) assigning an unsigned to a signed of the same size.
+ *    4) TYPE is a discrete subrange
+ */
+tree
+chill_convert_for_assignment (type, expr, place)
+     tree type, expr;
+     char *place; /* location description for error messages */
+{
+  tree ttype = type;
+  tree etype = TREE_TYPE (expr);
+  tree result;
+
+  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+    return error_mark_node;
+  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+    return expr;
+  if (TREE_CODE (expr) == TYPE_DECL)
+    {
+      error ("right hand side of assignment is a mode");
+      return error_mark_node;
+    }
+
+  if (! CH_COMPATIBLE (expr, type))
+    {
+      error ("incompatible modes in %s", place);
+      return error_mark_node;
+    }
+
+  if (TREE_CODE (type) == REFERENCE_TYPE)
+    ttype = TREE_TYPE (ttype);
+  if (etype && TREE_CODE (etype) == REFERENCE_TYPE)
+    etype = TREE_TYPE (etype);
+
+  if (etype
+      && (CH_STRING_TYPE_P (ttype)
+	  || (chill_varying_type_p (ttype)
+	      && CH_STRING_TYPE_P (CH_VARYING_ARRAY_TYPE (ttype))))
+      && (CH_STRING_TYPE_P (etype)
+	  || (chill_varying_type_p (etype)
+	      && CH_STRING_TYPE_P (CH_VARYING_ARRAY_TYPE (etype)))))
+    {
+      tree cond;
+      if (range_checking)
+	expr = save_if_needed (expr);
+      cond = string_assignment_condition (ttype, expr);
+      if (TREE_CODE (cond) == INTEGER_CST)
+	{
+	  if (integer_zerop (cond))
+	    {
+	      error ("bad string length in %s", place);
+	      return error_mark_node;
+	    }
+	  /* Otherwise, the condition is always true, so no runtime test. */
+	}
+      else if (range_checking)
+	expr = check_expression (expr,
+				 invert_truthvalue (cond),
+				 ridpointers[(int) RID_RANGEFAIL]);
+    }
+
+  if (range_checking 
+      && discrete_type_p (ttype) 
+      && etype != NULL_TREE
+      && discrete_type_p (etype))
+    {
+      int cond1 = tree_int_cst_lt (TYPE_SIZE (ttype),
+				   TYPE_SIZE (etype));
+      int cond2 = TREE_UNSIGNED (ttype) 
+	          && (! TREE_UNSIGNED (etype));
+      int cond3 = (! TREE_UNSIGNED (type))
+	          && TREE_UNSIGNED (etype) 
+		  && tree_int_cst_equal (TYPE_SIZE (ttype),
+					 TYPE_SIZE (etype));
+      int cond4 = TREE_TYPE (ttype) 
+	          && discrete_type_p (TREE_TYPE (ttype));
+
+      if (cond1 || cond2 || cond3 || cond4)
+	{
+	  tree type_min = TYPE_MIN_VALUE (ttype);
+	  tree type_max = TYPE_MAX_VALUE (ttype);
+
+	  expr = save_if_needed (expr);
+	  if (expr && type_min && type_max)
+	    expr = check_range (expr, expr, type_min, type_max);
+	}
+    }
+  result = convert (type, expr);
+
+  /* If the type is a array of PACK bits and the expression is an array constructor,
+     then build a CONSTRUCTOR for a bitstring.  Bitstrings are zero based, so
+     decrement the value of each CONSTRUCTOR element by the amount of the lower
+     bound of the array.  */
+  if (TREE_CODE (type) == ARRAY_TYPE && TYPE_PACKED (type)
+      && TREE_CODE (result) == CONSTRUCTOR)
+    {
+      tree domain_min = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
+      tree new_list = NULL_TREE;
+      long index;
+      tree element;
+      for (element = TREE_OPERAND (result, 1);
+	   element != NULL_TREE;
+	   element = TREE_CHAIN (element))
+	{
+	  if (!tree_int_cst_equal (TREE_VALUE (element), integer_zero_node))
+	    {
+	      tree purpose = TREE_PURPOSE (element);
+	      switch (TREE_CODE (purpose))
+		{
+		case INTEGER_CST:
+		  new_list = tree_cons (NULL_TREE,
+					size_binop (MINUS_EXPR, purpose, domain_min),
+					new_list);
+		  break;
+		case RANGE_EXPR:
+		  for (index  = TREE_INT_CST_LOW (TREE_OPERAND (purpose, 0));
+		       index <= TREE_INT_CST_LOW (TREE_OPERAND (purpose, 1));
+		       index++)
+		    new_list = tree_cons (NULL_TREE,
+					  size_binop (MINUS_EXPR,
+						      build_int_2 (index, 0),
+						      domain_min),
+					  new_list);
+		  break;
+		default:
+		  abort ();
+		}
+	    }
+	}
+      TREE_OPERAND (result, 1) = nreverse (new_list);
+      TREE_TYPE (result) = build_bitstring_type (TYPE_SIZE (type));
+    }
+
+  return result;
+}
+
+/* Check that EXPR has valid type for a RETURN or RESULT expression,
+   converting to the right type.  ACTION is "RESULT" or "RETURN". */
+
+static tree
+adjust_return_value (expr, action)
+     tree expr;
+     char *action;
+{
+  tree type = TREE_TYPE (TREE_TYPE (current_function_decl));
+
+  if (TREE_CODE (type) == REFERENCE_TYPE)
+    {
+      if (CH_LOCATION_P (expr))
+	{
+	  if (! CH_READ_COMPATIBLE (TREE_TYPE (type), 
+				    TREE_TYPE (expr)))
+	    {
+	      error ("mode mismatch in %s expression", action);
+	      return error_mark_node;
+	    }
+	  return convert (type, expr);
+	}
+      else
+	{
+	  error ("%s expression must be referable", action);
+	  return error_mark_node;
+	}
+    }
+  else if (! CH_COMPATIBLE (expr, type))
+    {
+      error ("mode mismatch in %s expression", action);
+      return error_mark_node;
+    }
+  return convert (type, expr);
+}
+
+void
+chill_expand_result (expr, result_or_return)
+     tree expr;
+     int result_or_return;
+{
+  tree type;
+  char *action_name = result_or_return ? "RESULT" : "RETURN";
+  
+  if (pass == 1)
+    return;
+
+  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+    return;
+
+  CH_FUNCTION_SETS_RESULT (current_function_decl) = 1;
+
+  if (chill_at_module_level || global_bindings_p ())
+    error ("%s not allowed outside a PROC", action_name);
+
+  result_never_set = 0;
+
+  if (chill_result_decl == NULL_TREE)
+    {
+      error ("%s action in PROC with no declared RESULTS", action_name);
+      return;
+    }
+  type = TREE_TYPE (chill_result_decl);
+
+  if (TREE_CODE (type) == ERROR_MARK)
+    return;
+
+  expr = adjust_return_value (expr, action_name);
+
+  expand_expr_stmt (build_chill_modify_expr (chill_result_decl, expr));
+}
+
+/*
+ * error if EXPR not NULL and procedure doesn't
+ * have a return type; 
+ * warning if EXPR NULL,
+ * procedure *has* a return type, and a previous
+ * RESULT actions hasn't saved a return value.
+ */
+void
+chill_expand_return (expr, implicit)
+     tree expr;
+     int implicit; /* 1 if an implicit return at end of function. */
+{
+  tree valtype;
+
+  if (expr != NULL_TREE && TREE_CODE (expr) == ERROR_MARK)
+    return;
+  if (chill_at_module_level || global_bindings_p ())
+    {
+      error ("RETURN not allowed outside PROC");
+      return;
+    }
+
+  if (pass == 1)
+    return;
+
+  result_never_set = 0;
+
+  valtype = TREE_TYPE (TREE_TYPE (current_function_decl));
+  if (TREE_CODE (valtype) == VOID_TYPE)
+    {
+      if (expr != NULL_TREE)
+	error ("RETURN with a value, in PROC returning void");
+      expand_null_return ();
+    }
+  else if (TREE_CODE (valtype) != ERROR_MARK)
+    {
+      if (expr == NULL_TREE)
+	{
+	  if (!CH_FUNCTION_SETS_RESULT (current_function_decl)
+	      && !implicit)
+	    warning ("RETURN with no value and no RESULT action in procedure");
+	  expr = chill_result_decl;
+	}
+      else
+	expr = adjust_return_value (expr, "RETURN");
+      expr = build (MODIFY_EXPR, valtype,
+		    DECL_RESULT (current_function_decl),
+		    expr);
+      TREE_SIDE_EFFECTS (expr) = 1;
+      expand_return (expr);
+    }
+}
+
+void
+lookup_and_expand_goto (name)
+     tree name;
+{
+  if (name == NULL_TREE ||  TREE_CODE (name) == ERROR_MARK)
+    return;
+  if (!ignoring)
+    {
+      tree decl = lookup_name (name);
+      if (decl == NULL || TREE_CODE (decl) != LABEL_DECL)
+	error ("no label named `%s'", IDENTIFIER_POINTER (name));
+      else if (DECL_CONTEXT (decl) != current_function_decl)
+	error ("cannot GOTO label `%s' outside current function",
+	       IDENTIFIER_POINTER (name));
+      else
+	{
+	  TREE_USED (decl) = 1;
+	  expand_goto_except_cleanup (DECL_ACTION_NESTING_LEVEL (decl));
+	  expand_goto (decl);
+	}
+    }
+}
+
+void
+lookup_and_handle_exit (name)
+     tree name;
+{
+  if (name == NULL_TREE ||  TREE_CODE (name) == ERROR_MARK)
+    return;
+  if (!ignoring)
+    {
+      tree label = munge_exit_label (name);
+      tree decl = lookup_name (label);
+      if (decl == NULL || TREE_CODE (decl) != LABEL_DECL)
+	error ("no EXITable label named `%s'", IDENTIFIER_POINTER (name));
+      else if (DECL_CONTEXT (decl) != current_function_decl)
+	error ("cannot EXIT label `%s' outside current function",
+	       IDENTIFIER_POINTER (name));
+      else
+	{
+	  TREE_USED (decl) = 1;
+	  expand_goto_except_cleanup (DECL_ACTION_NESTING_LEVEL (decl));
+	  expand_goto (decl);
+	}
+    }
+}
+
+/* ELSE-range handling: The else-range is a chain of trees which collectively
+   represent the ranges to be tested for the (ELSE) case label. Each element in
+   the chain represents a range to be tested. The boundaries of the range are
+   represented by INTEGER_CST trees in the PURPOSE and VALUE fields. */
+
+/* This function updates the else-range by removing the given integer constant. */
+static tree
+update_else_range_for_int_const (else_range, label)
+     tree else_range, label;
+{
+  int  lowval, highval;
+  int  label_value = TREE_INT_CST_LOW (label);
+  tree this_range, prev_range, new_range;
+
+  /* First, find the range element containing the integer, if it exists. */
+  prev_range = NULL_TREE;
+  for (this_range = else_range ;
+       this_range != NULL_TREE;
+       this_range = TREE_CHAIN (this_range))
+    {
+      lowval  = TREE_INT_CST_LOW (TREE_PURPOSE (this_range));
+      highval = TREE_INT_CST_LOW (TREE_VALUE (this_range));
+      if (label_value >= lowval && label_value <= highval)
+	break;
+      prev_range = this_range;
+    }
+
+  /* If a range element containing the integer was found, then update the range. */
+  if (this_range != NULL_TREE)
+    {
+      tree next = TREE_CHAIN (this_range);
+      if (label_value == lowval)
+	{
+	  /* The integer is the lower bound of the range element. If it is also the
+	     upper bound, then remove this range element, otherwise update it. */
+	  if (label_value == highval)
+	    {
+	      if (prev_range == NULL_TREE)
+		else_range = next;
+	      else
+		TREE_CHAIN (prev_range) = next;
+	    }
+	  else
+	    TREE_PURPOSE (this_range) = build_int_2 (label_value + 1, 0);
+	}
+      else if (label_value == highval)
+	{
+	  /* The integer is the upper bound of the range element, so ajust it. */
+	  TREE_VALUE (this_range) = build_int_2 (label_value - 1, 0);
+	}
+      else
+	{
+	  /* The integer is in the middle of the range element, so split it. */
+	  new_range = tree_cons (
+            build_int_2 (label_value + 1, 0), TREE_VALUE (this_range), next);
+	  TREE_VALUE (this_range) = build_int_2 (label_value - 1, 0);
+	  TREE_CHAIN (this_range) = new_range;
+	}
+    }
+  return else_range;
+}
+
+/* Update the else-range to remove a range of values/ */
+static tree
+update_else_range_for_range (else_range, low_target, high_target)
+     tree else_range, low_target, high_target;
+{
+  tree this_range, prev_range, new_range, next_range;
+  int  low_range_val, high_range_val;
+  int  low_target_val  = TREE_INT_CST_LOW (low_target);
+  int  high_target_val = TREE_INT_CST_LOW (high_target);
+
+  /* find the first else-range element which overlaps the target range. */
+  prev_range = NULL_TREE;
+  for (this_range = else_range ;
+       this_range != NULL_TREE;
+       this_range = TREE_CHAIN (this_range))
+    {
+      low_range_val  = TREE_INT_CST_LOW (TREE_PURPOSE (this_range));
+      high_range_val = TREE_INT_CST_LOW (TREE_VALUE (this_range));
+      if (low_target_val >= low_range_val && low_target_val <= high_range_val
+	  || high_target_val >= low_range_val && high_target_val <= high_range_val)
+	break;
+      prev_range = this_range;
+    }
+  if (this_range == NULL_TREE)
+    return else_range;
+
+  /* This first else-range element might be truncated at the top or completely
+     contain the target range. */
+  if (low_range_val < low_target_val)
+    {
+      next_range = TREE_CHAIN (this_range);
+      if (high_range_val > high_target_val)
+	{
+	  new_range = tree_cons (
+            build_int_2 (high_target_val + 1, 0), TREE_VALUE (this_range), next_range);
+	  TREE_VALUE (this_range) = build_int_2 (low_target_val - 1, 0);
+	  TREE_CHAIN (this_range) = new_range;
+	  return else_range;
+	}
+
+      TREE_VALUE (this_range) = build_int_2 (low_target_val - 1, 0);
+      if (next_range == NULL_TREE)
+	return else_range;
+
+      prev_range = this_range;
+      this_range = next_range;
+      high_range_val = TREE_INT_CST_LOW (TREE_VALUE (this_range));
+    }
+
+  /* There may then follow zero or more else-range elements which are completely
+     contained in the target range. */
+  while (high_range_val <= high_target_val)
+    {
+      this_range = TREE_CHAIN (this_range);
+      if (prev_range == NULL_TREE)
+	else_range = this_range;
+      else
+	TREE_CHAIN (prev_range) = this_range;
+
+      if (this_range == NULL_TREE)
+	return else_range;
+      high_range_val = TREE_INT_CST_LOW (TREE_VALUE (this_range));
+    }
+
+  /* Finally, there may be a else-range element which is truncated at the bottom. */
+  low_range_val = TREE_INT_CST_LOW (TREE_PURPOSE (this_range));
+  if (low_range_val <= high_target_val)
+    TREE_PURPOSE (this_range) = build_int_2 (high_target_val + 1, 0);
+
+  return else_range;
+}
+
+static tree
+update_else_range_for_range_expr (else_range, label)
+     tree else_range, label;
+{
+  if (TREE_OPERAND (label, 0) == NULL_TREE)
+    {
+      if (TREE_OPERAND (label, 1) == NULL_TREE)
+	else_range = NULL_TREE; /* (*) -- matches everything */
+    }
+  else
+    else_range = update_else_range_for_range (
+      else_range, TREE_OPERAND (label, 0), TREE_OPERAND (label, 1));
+
+  return else_range;
+}
+
+static tree
+update_else_range_for_type (else_range, label)
+     tree else_range, label;
+{
+  tree type = TREE_TYPE (label);
+  else_range = update_else_range_for_range (
+    else_range, TYPE_MIN_VALUE (type), TYPE_MAX_VALUE (type));
+  return else_range;
+}
+
+static tree
+compute_else_range (selector, alternatives, selector_no)
+     tree selector, alternatives;
+     int selector_no;
+{
+  /* Start with an else-range that spans the entire range of the selector type. */
+  tree type = TREE_TYPE (TREE_VALUE (selector));
+  tree range = tree_cons (TYPE_MIN_VALUE (type), TYPE_MAX_VALUE (type), NULL_TREE);
+
+  /* Now remove the values represented by each case lebel specified for that
+     selector. The remaining range is the else-range. */
+  for ( ; alternatives != NULL_TREE; alternatives = TREE_CHAIN (alternatives))
+    {
+      tree label;
+      tree label_list = TREE_PURPOSE (alternatives);
+      int  this_selector;
+      for (this_selector = 0; this_selector < selector_no ; ++this_selector)
+	label_list = TREE_CHAIN (label_list);
+
+      for (label = TREE_VALUE (label_list);
+	   label != NULL_TREE;
+	   label = TREE_CHAIN (label))
+	{
+	  tree label_value = TREE_VALUE (label);
+	  if (TREE_CODE (label_value) == INTEGER_CST)
+	    range = update_else_range_for_int_const (range, label_value);
+	  else if (TREE_CODE (label_value) == RANGE_EXPR)
+	    range = update_else_range_for_range_expr (range, label_value);
+	  else if (TREE_CODE (label_value) == TYPE_DECL)
+	    range = update_else_range_for_type (range, label_value);
+
+	  if (range == NULL_TREE)
+	    break;
+	}
+    }
+
+  return range;
+}
+
+void
+compute_else_ranges (selectors, alternatives)
+     tree selectors, alternatives;
+{
+  tree selector;
+  int selector_no = 0;
+
+  for (selector = selectors; selector != NULL_TREE; selector = TREE_CHAIN (selector))
+    {
+      if (ELSE_LABEL_SPECIFIED (selector))
+	TREE_PURPOSE (selector) =
+	  compute_else_range (selector, alternatives, selector_no);
+      selector_no++;
+    }
+}
+
+static tree
+check_case_value (label_value, selector)
+     tree label_value, selector;
+{
+  if (TREE_CODE (label_value) == ERROR_MARK)
+    return label_value;
+  if (TREE_CODE (selector) == ERROR_MARK)
+    return selector;    
+
+  /* Z.200 (6.4 Case action) says:  "The class of any discrete expression
+     in the case selector list must be compatible with the corresponding
+     (by position) class of the resulting list of classes of the case label
+     list occurrences ...".  We don't actually construct the resulting
+     list of classes, but this test should be more-or-less equivalent.
+     I think... */
+  if (!CH_COMPATIBLE_CLASSES (selector, label_value))
+    {
+      error ("case selector not compatible with label");
+      return error_mark_node;
+    }
+
+  /* Strip NON_LVALUE_EXPRs since we aren't using as an lvalue.  */
+  STRIP_TYPE_NOPS (label_value);
+
+  if (TREE_CODE (label_value) != INTEGER_CST)
+    {
+      error ("case label does not reduce to an integer constant");
+      return error_mark_node;
+    }
+
+  constant_expression_warning (label_value);
+  return label_value;
+}
+
+void
+chill_handle_case_default ()
+{
+  tree duplicate;
+  register tree label = build_decl (LABEL_DECL, NULL_TREE, 
+				    NULL_TREE);
+  int success = pushcase (NULL_TREE, 0, label, &duplicate);
+
+  if (success == 1)
+    error ("ELSE label not within a CASE statement");
+#if 0
+  else if (success == 2)
+    {
+      error ("multiple default labels found in a CASE statement"); 
+      error_with_decl (duplicate, "this is the first ELSE label");
+    }
+#endif
+}
+
+/* Handle cases label such as (I:J):  or (modename): */
+
+static void
+chill_handle_case_label_range (min_value, max_value, selector)
+     tree min_value, max_value, selector;
+{
+  register tree label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+  min_value = check_case_value (min_value, selector);
+  max_value = check_case_value (max_value, selector);
+  if (TREE_CODE (min_value) != ERROR_MARK
+      && TREE_CODE (max_value) != ERROR_MARK)
+    {
+      tree duplicate;
+      int success = pushcase_range (min_value, max_value,
+				    convert, label, &duplicate);
+      if (success == 1)
+	error ("label found outside of CASE statement");
+      else if (success == 2)
+	{
+	  error ("duplicate CASE value");
+	  error_with_decl (duplicate, "this is the first entry for that value");
+	}
+      else if (success == 3)
+	error ("CASE value out of range");
+      else if (success == 4)
+	error ("empty range");
+      else if (success == 5)
+	error ("label within scope of cleanup or variable array");
+    }
+}
+
+void
+chill_handle_case_label (label_value, selector)
+     tree label_value, selector;
+{
+  if (label_value == NULL_TREE 
+      || TREE_CODE (label_value) == ERROR_MARK)
+    return;
+  if (TREE_CODE (label_value) == RANGE_EXPR)
+    {
+      if (TREE_OPERAND (label_value, 0) == NULL_TREE)
+	chill_handle_case_default ();  /* i.e. (ELSE): or (*): */
+      else
+	chill_handle_case_label_range (TREE_OPERAND (label_value, 0),
+				       TREE_OPERAND (label_value, 1),
+				       selector);
+    }
+  else if (TREE_CODE (label_value) == TYPE_DECL)
+    {
+      tree type = TREE_TYPE (label_value);
+      if (! discrete_type_p (type))
+	error ("mode in label is not discrete");
+      else
+	chill_handle_case_label_range (TYPE_MIN_VALUE (type),
+				       TYPE_MAX_VALUE (type),
+				       selector);
+    }
+  else
+    {
+      register tree label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+
+      label_value = check_case_value (label_value, selector);
+
+      if (TREE_CODE (label_value) != ERROR_MARK)
+	{
+	  tree duplicate;
+	  int success = pushcase (label_value, convert, label, &duplicate);
+	  if (success == 1)
+	    error ("label not within a CASE statement");
+	  else if (success == 2)
+	    {
+	      error ("duplicate case value");
+	      error_with_decl (duplicate, 
+			       "this is the first entry for that value");
+	    }
+	  else if (success == 3)
+	    error ("CASE value out of range");
+	  else if (success == 4)
+	    error ("empty range");
+	  else if (success == 5)
+	    error ("label within scope of cleanup or variable array");
+        }
+    }
+}
+
+int
+chill_handle_single_dimension_case_label (
+  selector, label_spec, expand_exit_needed, caseaction_flag
+)
+  tree selector, label_spec;
+  int *expand_exit_needed, *caseaction_flag;
+{
+  tree labels, one_label;
+  int  no_completeness_check = 0;
+
+  if (*expand_exit_needed || *caseaction_flag == 1)
+    {
+      expand_exit_something ();
+      *expand_exit_needed = 0;
+    }
+
+  for (labels = label_spec; labels != NULL_TREE; labels = TREE_CHAIN (labels))
+    for (one_label = TREE_VALUE (labels); one_label != NULL_TREE;
+         one_label = TREE_CHAIN (one_label))
+      {
+        if (TREE_VALUE (one_label) == case_else_node)
+          no_completeness_check = 1;
+
+        chill_handle_case_label (TREE_VALUE (one_label), selector);
+      }
+
+  *caseaction_flag = 1;
+
+  return no_completeness_check;
+}
+
+static tree
+chill_handle_multi_case_label_range (low, high, selector)
+  tree low, high, selector;
+{
+  tree low_expr, high_expr, and_expr;
+  tree selector_type;
+  int  low_target_val, high_target_val;
+  int  low_type_val, high_type_val;
+
+  /* we can eliminate some tests is the low and/or high value in the given range
+     are outside the range of the selector type. */
+  low_target_val  = TREE_INT_CST_LOW (low);
+  high_target_val = TREE_INT_CST_LOW (high);
+  selector_type   = TREE_TYPE (selector);
+  low_type_val    = TREE_INT_CST_LOW (TYPE_MIN_VALUE (selector_type));
+  high_type_val   = TREE_INT_CST_LOW (TYPE_MAX_VALUE (selector_type));
+
+  if (low_target_val > high_type_val || high_target_val < low_type_val)
+    return boolean_false_node; /* selector never in range */
+
+  if (low_type_val >= low_target_val)
+    {
+      if (high_type_val <= high_target_val)
+	return boolean_true_node; /* always in the range */
+      return build_compare_expr (LE_EXPR, selector, high);
+    }
+
+  if (high_type_val <= high_target_val)
+    return build_compare_expr (GE_EXPR, selector, low);
+
+  /* The target range in completely within the range of the selector, but we
+     might be able to save a test if the upper bound is the same as the lower
+     bound. */
+  if (low_target_val == high_target_val)
+    return build_compare_expr (EQ_EXPR, selector, low);
+
+  /* No optimizations possible. Just generate tests against the upper and lower
+     bound of the target */
+  low_expr  = build_compare_expr (GE_EXPR, selector, low);
+  high_expr = build_compare_expr (LE_EXPR, selector, high);
+  and_expr  = build_chill_binary_op (TRUTH_ANDIF_EXPR, low_expr, high_expr);
+
+  return and_expr;
+}
+
+static tree
+chill_handle_multi_case_else_label (selector)
+     tree selector;
+{
+  tree else_range, selector_value, selector_type;
+  tree low, high, larg;
+
+  else_range = TREE_PURPOSE (selector);
+  if (else_range == NULL_TREE)
+    return boolean_false_node; /* no values in ELSE range */
+
+  /* Test each of the ranges in the else-range chain */
+  selector_value = TREE_VALUE (selector);
+  selector_type  = TREE_TYPE (selector_value);
+  low  = convert (selector_type, TREE_PURPOSE (else_range));
+  high = convert (selector_type, TREE_VALUE (else_range));
+  larg = chill_handle_multi_case_label_range (low, high, selector_value);
+
+  for (else_range = TREE_CHAIN (else_range);
+       else_range != NULL_TREE;
+       else_range = TREE_CHAIN (else_range))
+    {
+      tree rarg;
+      low  = convert (selector_type, TREE_PURPOSE (else_range));
+      high = convert (selector_type, TREE_VALUE (else_range));
+      rarg = chill_handle_multi_case_label_range (low, high, selector_value);
+      larg = build_chill_binary_op (TRUTH_ORIF_EXPR, larg, rarg);
+    }
+
+  return larg;
+}
+
+static tree
+chill_handle_multi_case_label (selector, label)
+  tree selector, label;
+{
+  tree expr;
+
+  if (label == NULL_TREE || TREE_CODE (label) == ERROR_MARK)
+    return;
+
+  if (TREE_CODE (label) == INTEGER_CST)
+    {
+      int  target_val = TREE_INT_CST_LOW (label);
+      tree selector_type = TREE_TYPE (TREE_VALUE (selector));
+      int  low_type_val  = TREE_INT_CST_LOW (TYPE_MIN_VALUE (selector_type));
+      int  high_type_val = TREE_INT_CST_LOW (TYPE_MAX_VALUE (selector_type));
+      if (target_val < low_type_val || target_val > high_type_val)
+	expr = boolean_false_node;
+      else
+	expr = build_compare_expr (EQ_EXPR, TREE_VALUE (selector), label);
+    }
+  else if (TREE_CODE (label) == RANGE_EXPR)
+    {
+      if (TREE_OPERAND (label, 0) == NULL_TREE)
+	{
+	  if (TREE_OPERAND (label, 1) == NULL_TREE)
+	    expr = boolean_true_node; /* (*) -- matches everything */
+	  else
+	    expr = chill_handle_multi_case_else_label (selector);
+	}
+      else
+	{
+	  tree low = TREE_OPERAND (label, 0);
+	  tree high = TREE_OPERAND (label, 1);
+	  if (TREE_CODE (low) != INTEGER_CST)
+	    {
+	      error ("Lower bound of range must be a discrete literal expression");
+	      expr = error_mark_node;
+	    }
+	  if (TREE_CODE (high) != INTEGER_CST)
+	    {
+	      error ("Upper bound of range must be a discrete literal expression");
+	      expr = error_mark_node;
+	    }
+	  if (expr != error_mark_node)
+	    {
+	      expr = chill_handle_multi_case_label_range (
+                       low, high, TREE_VALUE (selector));
+	    }
+	}
+    }
+  else if (TREE_CODE (label) == TYPE_DECL)
+    {
+      tree type = TREE_TYPE (label);
+      if (! discrete_type_p (type))
+	{
+	  error ("mode in label is not discrete");
+	  expr = error_mark_node;
+	}
+      else
+	expr = chill_handle_multi_case_label_range (
+		 TYPE_MIN_VALUE (type), TYPE_MAX_VALUE (type), TREE_VALUE (selector));
+    }
+  else
+    {
+      error ("The CASE label is not valid");
+      expr = error_mark_node;
+    }
+
+  return expr;
+}
+
+static tree
+chill_handle_multi_case_label_list (selector, labels)
+  tree selector, labels;
+{
+  tree one_label, selector_value, larg, rarg;
+
+  one_label = TREE_VALUE (labels);
+  larg = chill_handle_multi_case_label (selector, TREE_VALUE (one_label));
+
+  for (one_label = TREE_CHAIN (one_label);
+       one_label != NULL_TREE;
+       one_label = TREE_CHAIN (one_label))
+    {
+      rarg = chill_handle_multi_case_label (selector, TREE_VALUE (one_label));
+      larg = build_chill_binary_op (TRUTH_ORIF_EXPR, larg, rarg);
+    }
+
+  return larg;
+}
+
+tree
+build_multi_case_selector_expression (selector_list, label_spec)
+  tree selector_list, label_spec;
+{
+  tree labels, selector, larg, rarg;
+
+  labels   = label_spec;
+  selector = selector_list;
+  larg = chill_handle_multi_case_label_list(selector, labels);
+
+  for (labels = TREE_CHAIN (labels), selector = TREE_CHAIN (selector);
+       labels != NULL_TREE && selector != NULL_TREE;
+       labels = TREE_CHAIN (labels), selector = TREE_CHAIN (selector))
+    {
+      rarg = chill_handle_multi_case_label_list(selector, labels);
+      larg = build_chill_binary_op (TRUTH_ANDIF_EXPR, larg, rarg);
+    }
+
+  if (labels != NULL_TREE || selector != NULL_TREE)
+    error ("The number of CASE selectors does not match the number of CASE label lists");
+
+  return larg;
+}
+
+#define BITARRAY_TEST(ARRAY, INDEX) \
+  ((ARRAY)[(unsigned)(INDEX) / HOST_BITS_PER_CHAR]\
+			  & (1 << ((unsigned)(INDEX) % HOST_BITS_PER_CHAR)))
+#define BITARRAY_SET(ARRAY, INDEX) \
+  ((ARRAY)[(unsigned)(INDEX) / HOST_BITS_PER_CHAR]\
+			  |= 1 << ((unsigned)(INDEX) % HOST_BITS_PER_CHAR))
+
+extern HOST_WIDE_INT all_cases_count PROTO((tree, int*));
+extern void mark_seen_cases PROTO((tree, unsigned char*, long, int));
+
+/* CASES_SEEN is a set (bitarray) of length COUNT.
+   For each element that is zero, print an error message,
+   assume the element have the given TYPE. */
+
+static void
+print_missing_cases (type, cases_seen, count)
+     tree type;
+     unsigned char *cases_seen;
+     long count;
+{
+  long i;
+  for (i = 0;  i < count; i++)
+    {
+      if (BITARRAY_TEST(cases_seen, i) == 0)
+	{
+	  char buf[20];
+	  long x = i;
+	  long j;
+	  tree t = type;
+	  char *err_val_name = "???";
+	  if (TYPE_MIN_VALUE (t)
+	      && TREE_CODE (TYPE_MIN_VALUE (t)) == INTEGER_CST)
+	    x += TREE_INT_CST_LOW (TYPE_MIN_VALUE (t));
+	  while (TREE_TYPE (t) != NULL_TREE)
+	    t = TREE_TYPE (t);
+	  switch (TREE_CODE (t))
+	    {
+	      tree v;
+	    case BOOLEAN_TYPE:
+	      err_val_name = x ? "TRUE" : "FALSE";
+	      break;
+	    case CHAR_TYPE:
+	      if ((x >= ' ' && x < 127) && x != '\'' && x != '^')
+		sprintf (buf, "'%c'", x);
+	      else
+		sprintf (buf, "'^(%d)'", x);
+	      err_val_name = buf;
+	      j = i;
+	      while (j < count && !BITARRAY_TEST(cases_seen, j))
+		j++;
+	      if (j > i + 1)
+		{
+		  long y = x+j-i-1;
+		  err_val_name += strlen (err_val_name);
+		  if ((y >= ' ' && y < 127) && y != '\'' && y != '^')
+		    sprintf (err_val_name, "%s:'%c'", buf, y);
+		  else
+		    sprintf (err_val_name, "%s:'^(%d)'", buf, y);
+		  i = j - 1;      
+		}
+	      break;
+	    case ENUMERAL_TYPE:
+	      for (v = TYPE_VALUES (t);  v && x;  v = TREE_CHAIN (v))
+		x--;
+	      if (v)
+		err_val_name = IDENTIFIER_POINTER (TREE_PURPOSE (v));
+	      break;
+	    default:
+	      j = i;
+	      while (j < count && !BITARRAY_TEST(cases_seen, j))
+		j++;
+	      if (j == i + 1)
+		sprintf (buf, "%d", x);
+	      else
+		sprintf (buf, "%d:%d", x, x+j-i-1);
+	      i = j - 1;      
+	      err_val_name = buf;
+	      break;
+	    }
+	  error ("incomplete CASE - %s not handled", err_val_name);
+	}
+    }
+}
+
+void
+check_missing_cases (type)
+     tree type;
+{
+  int is_sparse;
+  /* For each possible selector value. a one iff it has been matched
+     by a case value alternative. */
+  unsigned char *cases_seen;
+  /* The number of possible selector values. */
+  HOST_WIDE_INT size = all_cases_count (type, &is_sparse);
+  long bytes_needed = (size+HOST_BITS_PER_CHAR)/HOST_BITS_PER_CHAR;
+
+  if (size == -1)
+    warning ("CASE selector with variable range");
+  else if (size < 0 || size > 600000
+	   /* We deliberately use malloc here - not xmalloc. */
+	   || (cases_seen = (char*) malloc (bytes_needed)) == NULL)
+    warning ("too many cases to do CASE completeness testing");
+  else
+    {
+      bzero (cases_seen, bytes_needed);
+      mark_seen_cases (type, cases_seen, size, is_sparse);
+      print_missing_cases (type, cases_seen, size);
+      free (cases_seen);
+    }
+}
+
+/*
+ * We build an expression tree here because, in many contexts,
+ * we don't know the type of result that's desired.  By the
+ * time we get to expanding the tree, we do know.
+ */
+tree
+build_chill_case_expr (exprlist, casealtlist_expr,
+		       optelsecase_expr)
+     tree exprlist, casealtlist_expr, optelsecase_expr;
+{
+  return build (CASE_EXPR, NULL_TREE, exprlist,
+		optelsecase_expr ?
+		  tree_cons (NULL_TREE,
+			     optelsecase_expr,
+			     casealtlist_expr) :
+		  casealtlist_expr);
+}
+
+/* This function transforms the selector_list and alternatives into a COND_EXPR. */
+tree
+build_chill_multi_dimension_case_expr (selector_list, alternatives, else_expr)
+  tree selector_list, alternatives, else_expr;
+{
+  tree expr;
+
+  selector_list = check_case_selector_list (selector_list);
+
+  if (alternatives == NULL_TREE)
+    return NULL_TREE;
+
+  alternatives = nreverse (alternatives);
+  /* alternatives represents the CASE label specifications and resulting values in
+     the reverse order in which they appeared.
+     If there is an ELSE expression, then use it. If there is no
+     ELSE expression, make the last alternative (which is the first in the list)
+     into the ELSE expression. This is safe because, if the CASE is complete
+     (as required), then the last condition need not be checked anyway. */
+  if (else_expr != NULL_TREE)
+    expr = else_expr;
+  else
+    {
+      expr = TREE_VALUE (alternatives);
+      alternatives = TREE_CHAIN (alternatives);
+    }
+
+  for ( ; alternatives != NULL_TREE; alternatives = TREE_CHAIN (alternatives))
+    { 
+      tree value  = TREE_VALUE (alternatives);
+      tree labels = TREE_PURPOSE (alternatives);
+      tree cond   = build_multi_case_selector_expression(selector_list, labels);
+      expr = build_nt (COND_EXPR, cond, value, expr);
+    }
+
+  return expr;
+}
+
+
+/* This is called with the assumption that RHS has been stabilized.  
+   It has one purpose:  to iterate through the CHILL list of LHS's */
+void
+expand_assignment_action (loclist, modifycode, rhs)
+     tree loclist;
+     enum chill_tree_code modifycode;
+     tree rhs;
+{
+  if (loclist == NULL_TREE || TREE_CODE (loclist) == ERROR_MARK
+      || rhs == NULL_TREE  || TREE_CODE (rhs) == ERROR_MARK)
+    return;
+
+  if (TREE_CHAIN (loclist) != NULL_TREE)
+    { /* Multiple assignment */
+      tree target;
+      if (TREE_TYPE (rhs) != NULL_TREE)
+	rhs = save_expr (rhs);
+      else if (TREE_CODE (rhs) == CONSTRUCTOR)
+	error ("type of tuple cannot be implicit in multiple assignent");
+      else if (TREE_CODE (rhs) == CASE_EXPR || TREE_CODE (rhs) == COND_EXPR)
+	error ("conditional expression cannot be used in multiple assignent");
+      else
+	error ("internal error - unknown type in multiple assignment");
+
+      if (modifycode != NOP_EXPR)
+	{
+	  error ("no operator allowed in multiple assignment,");
+	  modifycode = NOP_EXPR;
+	}
+
+      for (target = TREE_CHAIN (loclist); target; target = TREE_CHAIN (target))
+	{
+	  if (!CH_EQUIVALENT (TREE_TYPE (TREE_VALUE (target)),
+			      TREE_TYPE (TREE_VALUE (loclist))))
+	    {
+	      error
+		("location modes in multiple assignment are not equivalent");
+	      break;
+	    }
+	}
+    }
+  for ( ; loclist != NULL_TREE; loclist = TREE_CHAIN (loclist))
+    chill_expand_assignment (TREE_VALUE (loclist), modifycode, rhs);
+}
+
+void
+chill_expand_assignment (lhs, modifycode, rhs)
+     tree lhs;
+     enum chill_tree_code modifycode;
+     tree rhs;
+{
+  tree loc;
+
+  while (TREE_CODE (lhs) == COMPOUND_EXPR)
+    {
+      expand_expr (TREE_OPERAND (lhs, 0), const0_rtx, VOIDmode, 0);
+      emit_queue ();
+      lhs = TREE_OPERAND (lhs, 1);
+    }
+
+  if (TREE_CODE (lhs) == ERROR_MARK)
+    return;
+
+  /* errors for assignment to BUFFER, EVENT locations.
+     what about SIGNALs? FIXME: Need similar test in
+     build_chill_function_call. */
+  if (TREE_CODE (lhs) == IDENTIFIER_NODE)
+    {
+      tree decl = lookup_name (lhs);
+      if (decl)
+	{
+	  tree type = TREE_TYPE (decl);
+	  if (CH_IS_BUFFER_MODE (type) || CH_IS_EVENT_MODE (type))
+	    {
+	      error ("You may not assign a value to a BUFFER or EVENT location");
+	      return;
+	    }
+	}
+    }
+
+  if (TYPE_READONLY_PROPERTY (TREE_TYPE (lhs)) || TREE_READONLY (lhs))
+    {
+      error ("can't assign value to READonly location");
+      return;
+    }
+  if (CH_TYPE_NONVALUE_P (TREE_TYPE (lhs)))
+    {
+      error ("cannot assign to location with non-value property");
+      return;
+    }
+
+  if (TREE_CODE (TREE_TYPE (lhs)) == REFERENCE_TYPE)
+    lhs = convert_from_reference (lhs);
+
+  /* check for lhs is a location */
+  loc = lhs;
+  while (1)
+    {
+      if (TREE_CODE (loc) == SLICE_EXPR)
+	loc = TREE_OPERAND (loc, 0);
+      else if (TREE_CODE (loc) == SET_IN_EXPR)
+	loc = TREE_OPERAND (loc, 1);
+      else
+	break;
+    }
+  if (! CH_LOCATION_P (loc))
+    {
+      error ("lefthand side of assignment is not a location");
+      return;
+    }
+
+  /* If a binary op has been requested, combine the old LHS value with
+     the RHS producing the value we should actually store into the LHS. */
+
+  if (modifycode != NOP_EXPR)
+    {
+      lhs = stabilize_reference (lhs);
+      /* This is to handle border-line cases such
+	 as: LHS OR := [I].  This seems to be permitted
+	 by the letter of Z.200, though it violates
+	 its spirit, since LHS:=LHS OR [I] is
+	 *not* legal. */
+      if (TREE_TYPE (rhs) == NULL_TREE)
+	rhs = convert (TREE_TYPE (lhs), rhs);
+      rhs = build_chill_binary_op (modifycode, lhs, rhs);
+    }
+
+  rhs = chill_convert_for_assignment (TREE_TYPE (lhs), rhs, "assignment");
+
+  /* handle the LENGTH (vary_array) := expr action */
+  loc = lhs;
+  if (TREE_CODE (loc) == NOP_EXPR)
+    loc = TREE_OPERAND (loc, 0);
+  if (TREE_CODE (loc) == COMPONENT_REF
+      && chill_varying_type_p (TREE_TYPE (TREE_OPERAND (loc, 0)))
+      && DECL_NAME (TREE_OPERAND (loc, 1)) == var_length_id)
+    {
+      expand_varying_length_assignment (TREE_OPERAND (loc, 0), rhs);
+    }
+  else if (TREE_CODE (lhs) == SLICE_EXPR)
+    {
+      tree func = lookup_name (get_identifier ("__pscpy"));
+      tree dst = TREE_OPERAND (lhs, 0);
+      tree dst_offset = TREE_OPERAND (lhs, 1);
+      tree length = TREE_OPERAND (lhs, 2);
+      tree src, src_offset;
+      if (TREE_CODE (rhs) == SLICE_EXPR)
+	{
+	  src = TREE_OPERAND (rhs, 0);
+	  /* Should check that the TREE_OPERAND (src, 0) is
+	     the same as length and powerserlen (src).  FIXME */
+	  src_offset = TREE_OPERAND (rhs, 1);
+	}
+      else
+	{
+	  src = rhs;
+	  src_offset = integer_zero_node;
+	}
+      expand_expr_stmt (build_chill_function_call (func,
+	tree_cons (NULL_TREE, force_addr_of (dst),
+	  tree_cons (NULL_TREE, powersetlen (dst),
+	    tree_cons (NULL_TREE, convert (long_unsigned_type_node, dst_offset),
+	      tree_cons (NULL_TREE, force_addr_of (src),
+		tree_cons (NULL_TREE, powersetlen (src),
+		  tree_cons (NULL_TREE, convert (long_unsigned_type_node, src_offset),
+		    tree_cons (NULL_TREE, convert (long_unsigned_type_node, length),
+		       NULL_TREE)))))))));
+    }
+
+  else if (TREE_CODE (lhs) == SET_IN_EXPR)
+    {
+      tree from_pos = save_expr (TREE_OPERAND (lhs, 0));
+      tree set = TREE_OPERAND (lhs, 1);
+      tree domain = TYPE_DOMAIN (TREE_TYPE (set));
+      tree set_length = size_binop (PLUS_EXPR,
+				    size_binop (MINUS_EXPR,
+						TYPE_MAX_VALUE (domain),
+						TYPE_MIN_VALUE (domain)),
+				    integer_one_node);
+      tree filename = force_addr_of (get_chill_filename());
+      
+      if (TREE_CODE (TREE_TYPE (lhs)) != BOOLEAN_TYPE)
+	sorry("bitstring slice");
+      expand_expr_stmt (
+	build_chill_function_call (lookup_name (
+	  get_identifier ("__setbitpowerset")),
+	      tree_cons (NULL_TREE, build_chill_addr_expr (set, "powerset"),
+		  tree_cons (NULL_TREE, set_length,
+		    tree_cons (NULL_TREE, TYPE_MIN_VALUE (domain),
+		      tree_cons (NULL_TREE, convert (long_integer_type_node, from_pos),
+			tree_cons (NULL_TREE, rhs,
+			  tree_cons (NULL_TREE, filename,
+			    tree_cons (NULL_TREE, get_chill_linenumber(),
+  			      NULL_TREE)))))))));
+    }
+
+  /* Handle arrays of packed bitfields. Currently, this is limited to bitfields
+     which are 1 bit wide, so use the powerset runtime function. */
+  else if (TREE_CODE (lhs) == PACKED_ARRAY_REF)
+    {
+      tree from_pos = save_expr (TREE_OPERAND (lhs, 1));
+      tree array = TREE_OPERAND (lhs, 0);
+      tree domain = TYPE_DOMAIN (TREE_TYPE (array));
+      tree array_length = size_binop (PLUS_EXPR,
+				    size_binop (MINUS_EXPR,
+						TYPE_MAX_VALUE (domain),
+						TYPE_MIN_VALUE (domain)),
+				    integer_one_node);
+      tree filename = force_addr_of (get_chill_filename());
+      expand_expr_stmt (
+	build_chill_function_call (lookup_name (
+	  get_identifier ("__setbitpowerset")),
+            tree_cons (NULL_TREE, build_chill_addr_expr (array, "packed bitfield array"),
+		tree_cons (NULL_TREE, convert (long_unsigned_type_node, array_length),
+		  tree_cons (NULL_TREE, convert (long_integer_type_node,
+						 TYPE_MIN_VALUE (domain)),
+		    tree_cons (NULL_TREE, convert (long_integer_type_node, from_pos),
+		      tree_cons (NULL_TREE, build1 (CONVERT_EXPR, boolean_type_node, rhs),
+			tree_cons (NULL_TREE, filename,
+			  tree_cons (NULL_TREE, get_chill_linenumber(),
+  			    NULL_TREE)))))))));
+    }
+
+  /* The following is probably superceded by the
+     above code for SET_IN_EXPR. FIXME! */
+  else if (TREE_CODE (lhs) == BIT_FIELD_REF)
+    {
+      tree set = TREE_OPERAND (lhs, 0);
+      tree numbits = TREE_OPERAND (lhs, 1);
+      tree from_pos = save_expr (TREE_OPERAND (lhs, 2));
+      tree domain = TYPE_DOMAIN (TREE_TYPE (set));
+      tree set_length = size_binop (PLUS_EXPR,
+				    size_binop (MINUS_EXPR,
+						TYPE_MAX_VALUE (domain),
+						TYPE_MIN_VALUE (domain)),
+				    integer_one_node);
+      tree filename = force_addr_of (get_chill_filename());
+      tree to_pos;
+      switch (TREE_CODE (TREE_TYPE (rhs)))
+	{
+	case SET_TYPE:
+	  to_pos = size_binop (MINUS_EXPR,
+			       size_binop (PLUS_EXPR, from_pos, numbits),
+			       integer_one_node);
+	  break;
+	case BOOLEAN_TYPE:
+	  to_pos = from_pos;
+	  break;
+	default:
+	  abort ();
+	}
+      
+      if (TREE_CODE (TREE_TYPE (lhs)) != BOOLEAN_TYPE)
+	sorry("bitstring slice");
+      expand_expr_stmt (
+	  build_chill_function_call( lookup_name (
+	      get_identifier ("__setbitpowerset")),
+		tree_cons (NULL_TREE, build_chill_addr_expr (set, "powerset"),
+		  tree_cons (NULL_TREE, set_length,
+		    tree_cons (NULL_TREE, TYPE_MIN_VALUE (domain),
+		      tree_cons (NULL_TREE, from_pos,
+			tree_cons (NULL_TREE, rhs,
+			  tree_cons (NULL_TREE, filename,
+			    tree_cons (NULL_TREE, get_chill_linenumber(),
+	  		      NULL_TREE)))))))));
+    }
+
+  else
+    expand_expr_stmt (build_chill_modify_expr (lhs, rhs));
+}
+
+/* Also assumes that rhs has been stabilized */
+void
+expand_varying_length_assignment (lhs, rhs)
+     tree lhs, rhs;
+{
+  tree base_array, min_domain_val;
+
+  pedwarn ("LENGTH on left-hand-side is non-portable");
+      
+  if (! CH_LOCATION_P (lhs))
+    {
+      error ("Can only set LENGTH of array location");
+      return;
+    }
+
+  /* cause a RANGE exception if rhs would cause a 'hole' in the array. */
+  rhs = valid_array_index_p (lhs, rhs, "new array length too large", 1);
+
+  base_array     = CH_VARYING_ARRAY_TYPE (TREE_TYPE (lhs));
+  min_domain_val = TYPE_MIN_VALUE (TYPE_DOMAIN (base_array));
+
+  lhs = build_component_ref (lhs, var_length_id);
+  rhs = size_binop (MINUS_EXPR, rhs, min_domain_val);
+
+  expand_expr_stmt (build_chill_modify_expr (lhs, rhs));
+}
+
+void
+push_action ()
+{
+  push_handler ();
+  if (ignoring)
+    return;
+  emit_line_note (input_filename, lineno);
+}
diff --git a/gcc/ch/chill.in b/gcc/ch/chill.in
new file mode 100644
index 0000000..62b73d5
--- /dev/null
+++ b/gcc/ch/chill.in
@@ -0,0 +1,130 @@
+#!/bin/sh
+# Compile GNU Chill programs.
+: || exec /bin/sh -f $0 $argv:q
+
+# The compiler name might be different when doing cross-compilation
+# (this should be configured)
+gcc_name=gcc
+whatgcc=gcc
+speclang=-xnone
+startfile=chillrt0
+gnuchill_script_flags=
+gnuchill_version=unknown
+extraflags=
+
+# replace the command name by the name of the new command
+progname=`basename $0`
+case "$0" in
+  */*)
+    gcc=`echo $0 | sed -e "s;/[^/]*$;;"`/$gcc_name
+    ;;
+  *)
+    gcc=$gcc_name
+    ;;
+esac
+
+# $first is yes for first arg, no afterwards.
+first=yes
+# If next arg is the argument of an option, $quote is non-empty.
+# More precisely, it is the option that wants an argument.
+quote=
+# $library is made empty to disable use of libchill.
+library="-lchill"
+libpath=chillrt
+numargs=$#
+
+for arg
+do
+  if [ $first = yes ]
+  then
+    # Need some 1st arg to `set' which does not begin with `-'.
+    # We get rid of it after the loop ends.
+    set gcc
+    first=no
+  fi
+  # If you have to ask what this does, you should not edit this file. :-)
+  # The ``S'' at the start is so that echo -nostdinc does not eat the
+  # -nostdinc.
+  arg=`echo "S$arg" | sed "s/^S//; s/'/'\\\\\\\\''/g"`
+  if [ x$quote != x ]
+  then
+    quote=
+  else
+    quote=
+    case $arg in
+      -nostdlib)
+	# Inhibit linking with -lchill.
+	library=
+	libpath=
+	startfile=
+	;;
+      -B*)
+	gcc=`echo $arg | sed -e "s/^-B//"`$gcc_name
+	;;
+      -[bBVDUoeTuIYmLiA] | -Tdata | -Xlinker)
+	# these switches take following word as argument,
+	# so don't treat it as a file name.
+	quote=$arg
+	;;
+      -[cSEM] | -MM)
+	# Don't specify libraries if we won't link,
+	# since that would cause a warning.
+	library=
+	libpath=
+	startfile=
+	;;
+      -x*)
+	speclang=$arg
+	;;
+      -v)
+	# catch `chill -v'
+	if [ $numargs = 1 ] ; then
+	  library=
+	  libpath=
+	  startfile=
+	fi
+	echo "GNUCHILL version $gnuchill_version"
+	;;
+      -fgrant-only | -fchill-grant-only)
+        #inhibit production of an object file
+        extraflags="-S -o /dev/null"
+	library=
+	libpath=
+	startfile=
+        ;;
+      -*)
+	# Pass other options through; they don't need -x and aren't inputs.
+	;;
+      *)
+	# If file ends in .i, put options around it.
+	# But not if a specified -x option is currently active.
+	case "$speclang $arg" in -xnone\ *.[i])
+	  set "$@" -xchill "'$arg'" -xnone
+	  continue
+	esac
+	;;
+    esac
+  fi
+  set "$@" "'$arg'"
+done
+
+# Get rid of that initial 1st arg
+if [ $first = no ]; then
+  shift
+else
+  echo "$0: No input files specified."
+  exit 1
+fi
+
+if [ x$quote != x ]
+then
+  echo "$0: argument to \`$quote' missing"
+  exit 1
+fi
+
+# The '-ansi' flag prevents cpp from changing this:
+#  NEWMODE x = SET (sun, mon, thu, wed, thu, fri, sat);
+#to this:
+#  NEWMODE x = SET (1, mon, thu, wed, thu, fri, sat);
+#which is a CHILL syntax error.
+eval $whatgcc -ansi $gnuchill_script_flags $startfile "$@" $libpath $library $extraflags
diff --git a/gcc/ch/config-lang.in b/gcc/ch/config-lang.in
new file mode 100644
index 0000000..48be2d9
--- /dev/null
+++ b/gcc/ch/config-lang.in
@@ -0,0 +1,34 @@
+# Top level configure fragment for GNU CHILL.
+#   Copyright (C) 1994 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.
+
+# Configure looks for the existence of this file to auto-config each language.
+# We define several parameters used by configure:
+#
+# language	- name of language as it would appear in $(LANGUAGES)
+# compilers	- value to add to $(COMPILERS)
+# stagestuff	- files to add to $(STAGESTUFF)
+# diff_excludes	- files to ignore when building diffs between two versions.
+
+language="CHILL"
+
+compilers="cc1chill"
+
+stagestuff="chill chill-cross cc1chill"
+
+diff_excludes="-x -x ch/chill.info*"
diff --git a/gcc/ch/configure b/gcc/ch/configure
new file mode 100755
index 0000000..1179770
--- /dev/null
+++ b/gcc/ch/configure
@@ -0,0 +1,644 @@
+#!/bin/sh
+# Configuration script for GNU CHILL
+#   Copyright (C) 1994 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.
+
+#
+# Shell script to create proper links to machine-dependent files in
+# preparation for compiling gcc.
+#
+# Options: --srcdir=DIR		specifies directory where sources are.
+# 	   --host=HOST		specifies host configuration.
+#	   --target=TARGET	specifies target configuration.
+#	   --build=TARGET	specifies configuration of machine you are
+#				using to compile GCC.
+#	   --prefix=DIR		specifies directory to install in.
+#	   --local-prefix=DIR	specifies directory to put local ./include in.
+#	   --exec-prefix=DIR	specifies directory to install executables in.
+#	   --with-gnu-ld	arrange to work with GNU ld.
+#	   --with-gnu-as	arrange to work with GAS.
+#	   --with-stabs		arrange to use stabs instead of host debug format.
+#	   --with-elf		arrange to use elf instead of host debug format.
+#	   --nfp		assume system has no FPU.
+#
+# If configure succeeds, it leaves its status in config.status.
+# If configure fails after disturbing the status quo, 
+# 	config.status is removed.
+#
+
+progname=$0
+# Configure the runtime and regression-test directories
+SUBDIRS="runtime utils"
+SUBDIRS="$SUBDIRS testsuite/compile"
+SUBDIRS="$SUBDIRS testsuite/execute"
+SUBDIRS="$SUBDIRS testsuite/execute/telebras"
+SUBDIRS="$SUBDIRS testsuite/noncompile"
+SUBDIRS="$SUBDIRS testsuite/examples"
+SUBDIRS="$SUBDIRS testsuite/execute/oe"
+SUBDIRS="$SUBDIRS testsuite/compile/elektra"
+SUBDIRS="$SUBDIRS testsuite/compile/votrics"
+
+# Default --srcdir to the directory where the script is found, 
+# if a directory was specified.
+# The second sed call is to convert `.//configure' to `./configure'.
+srcdir=`echo $0 | sed 's|//|/|' | sed 's|/[^/]*$||'`
+if [ x$srcdir = x$0 ]
+then
+srcdir=
+fi
+
+host=
+
+# Default prefix to /usr/local.
+prefix=/usr/local
+
+# local_prefix specifies where to find the directory /usr/local/include
+# We don't use $(prefix) for this
+# because we always want GCC to search /usr/local/include
+# even if GCC is installed somewhere other than /usr/local.
+# Think THREE TIMES before specifying any other value for this!
+# DO NOT make this use $prefix!
+local_prefix=/usr/local
+# CYGNUS LOCAL: for our purposes, this must be prefix.  This is apparently
+# only done for the benefit of glibc, and we don't use glibc.
+local_prefix='$(prefix)'
+# Default is to let the Makefile set exec_prefix from $(prefix)
+exec_prefix='$(prefix)'
+
+# CYGNUS LOCAL.  Default to nothing.
+program_transform_name=
+program_transform_set=
+site=
+
+remove=rm
+hard_link=ln
+symbolic_link='ln -s'
+copy=cp
+
+# Record all the arguments, to write them in config.status.
+arguments=$*
+
+#for Test
+#remove="echo rm"
+#hard_link="echo ln"
+#symbolic_link="echo ln -s"
+
+target=
+host=
+build=
+
+for arg in $*;
+do
+  case $next_arg in
+  --srcdir)
+    srcdir=$arg
+    next_arg=
+    ;;
+  --host)
+    host=$arg
+    next_arg=
+    ;;
+  --target)
+    target=$arg
+    next_arg=
+    ;;
+  --build)
+    build=$arg
+    next_arg=
+    ;;
+  --prefix)
+    prefix=$arg
+    next_arg=
+    ;;
+  --local-prefix)
+    local_prefix=$arg
+    next_arg=
+    ;;
+  --exec-prefix)
+    exec_prefix=$arg
+    next_arg=
+    ;;
+  --program-transform-name) # CYGNUS LOCAL
+    # Double any backslashes or dollar signs in the argument.
+    if [ -n "${arg}" ] ; then
+      program_transform_name="${program_transform_name} -e `echo ${arg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`"
+    fi
+    program_transform_set=yes
+    next_arg=
+    ;;    
+  --program-prefix) # CYGNUS LOCAL
+    if [ -n "${arg}" ]; then
+      program_transform_name="${program_transform_name} -e s,^,`echo ${arg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`,"
+    fi
+    program_transform_set=yes
+    next_arg=
+    ;;
+  --program-suffix) # CYGNUS LOCAL
+    if [ -n "${arg}" ]; then
+      program_transform_name="${program_transform_name} -e s,\$\$,`echo ${arg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`,"
+    fi
+    program_transform_set=yes
+    next_arg=
+    ;;
+  --site) # CYGNUS LOCAL
+    site=${arg}
+    next_arg=
+    ;;
+  --x-*)
+    next_arg=
+    ;;
+  *)
+    case $arg in
+     -srcdir | --srcdir | --srcdi | --srcd | --src | --sr | --s)
+	next_arg=--srcdir
+	;;
+     -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=* | --s=*)
+	srcdir=`echo $arg | sed 's/-*s[a-z]*=//'`
+	;;
+     -host | --host | --hos | --ho | --h)
+	next_arg=--host
+	;;
+     -host=* | --host=* | --hos=* | --ho=* | --h=*)
+	host=`echo $arg | sed 's/-*h[a-z]*=//'`
+	;; 
+     -target | --target | --targe | --targ | --tar | --ta | --t)
+	next_arg=--target
+	;;
+     -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+	target=`echo $arg | sed 's/-*t[a-z]*=//'`
+	;; 
+     -build | --build | --buil | --bui | --bu | --b)
+	next_arg=--build
+	;;
+     -build=* | --build=* | --buil=* | --bui=* | --bu=* | --b=*)
+	build=`echo $arg | sed 's/-*b[a-z]*=//'`
+	;; 
+     -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+	next_arg=--prefix
+	;;
+     -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+	prefix=`echo $arg | sed 's/-*p[a-z]*=//'`
+	;;
+     -local-prefix | --local-prefix | --local-prefi | --local-pref | --local-pre \
+	| --local-pr | --local-p | --local- | --local | --loc | --lo | --l)
+	next_arg=--local-prefix
+	;;
+     -local-prefix=* | --local-prefix=* | --local-prefi=* | --local-pref=* \
+	| --local-pre=* | --local-pr=* | --local-p=* | --local-=* | --local=* \
+	| --loc=* | --lo=* | --l=*)
+	local_prefix=`echo $arg | sed 's/-*l[-a-z]*=//'`
+	;;
+     -exec-prefix | --exec-prefix | --exec-prefi | --exec-pref | --exec-pre \
+	| --exec-pr | --exec-p | --exec- | --exec | --exe | --ex | --e)
+	next_arg=--exec-prefix
+	;;
+     -exec-prefix=* | --exec-prefix=* | --exec-prefi=* | --exec-pref=* \
+	| --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* | --exec=* \
+	| --exe=* | --ex=* | --e=*)
+	exec_prefix=`echo $arg | sed 's/-*e[-a-z]*=//'`
+	;;
+     -program-transform-name | --program-transform-name \
+	| --program-transform-nam | --program-transform-na \
+	| --program-transform-n | --program-transform- | --program-transform \
+	| --program-transfor | --program-transfo | --program-transf \
+	| --program-trans | --program-tran | --program-tra \
+	| --program-tr | --program-t)
+	next_arg=--program-transform-name
+	# CYGNUS LOCAL
+	;;
+     -program-transform-name=* | --program-transform-name=* \
+	| --program-transform-nam=* | --program-transform-na=* \
+	| --program-transform-n=* | --program-transform-=* \
+	| --program-transform=* | --program-transfor=* | --program-transfo=* \
+	| --program-transf=* | --program-trans=* | --program-tran=* \
+	| --program-tra=* | --program-tr=* | --program-t=*)
+	# CYGNUS LOCAL
+	arg=`echo ${arg} | sed -e 's/^[-a-z_]*=//'`
+	# Double any \ or $ in the argument.
+	if [ -n "${arg}" ] ; then
+	  program_transform_name="${program_transform_name} -e `echo ${arg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`"
+	fi
+	program_transform_set=yes
+	;;
+     -program-prefix | --program-prefix | --program-prefi \
+	| --program-pref | --program-pre | --program-pr \
+	| --program-p)
+	next_arg=--program-prefix
+	# CYGNUS LOCAL
+	;;
+     -program-prefix=* | --program-prefix=* | --program-prefi=* \
+	| --program-pref=* | --program-pre=* | --program-pr=* \
+	| --program-p=*)
+	# CYGNUS LOCAL
+	arg=`echo ${arg} | sed -e 's/^[-a-z_]*=//'`
+	if [ -n "${arg}" ]; then
+	  program_transform_name="${program_transform_name} -e s,^,`echo ${arg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`,"
+	fi
+	program_transform_set=yes
+	;;
+     -program-suffix | --program-suffix | --program-suffi \
+	| --program-suff | --program-suf | --program-su \
+	| --program-s)
+	next_arg=--program-suffix
+	# CYGNUS LOCAL
+	;;
+     -program-suffix=* | --program-suffix=* | --program-suffi=* \
+	| --program-suff=* | --program-suf=* | --program-su=* \
+	| --program-s=*)
+	# CYGNUS LOCAL
+	arg=`echo ${arg} | sed -e 's/^[-a-z_]*=//'`
+	if [ -n "${arg}" ]; then
+	  program_transform_name="${program_transform_name} -e s,\$\$,`echo ${arg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`,"
+	fi
+	program_transform_set=yes
+	;;
+     -site | --site | --sit) # CYGNUS LOCAL
+	next_arg=--site
+	;;
+     -site=* | --site=* | --sit=* | --si=*) # CYGNUS LOCAL
+	site=`echo ${arg} | sed 's/^[-a-z]*=//'`
+	;;
+     -with-gnu-ld | --with-gnu-ld | --with-gnu-l)
+	gnu_ld=yes
+	;;
+     -gas | --gas | --ga | --g | -with-gnu-as | --with-gnu-as | -with-gnu-a)
+        gas=yes
+	;;
+     -nfp | --nfp | --nf | --n)
+	nfp=yes
+	;;
+     -with-stabs | -with-stab | -with-sta | -with-st | -with-s \
+	| --with-stabs | --with-stab | --with-sta | --with-st | --with-s \
+	| -stabs | -stab | -sta | -st  \
+	| --stabs | --stab | --sta | --st)
+	stabs=yes
+	;;
+     -with-elf | -with-el | -with-se \
+	| --with-elf | --with-el | --with-e \
+	| -elf | -el | -e \
+	|--elf | --el | --e)
+	elf=yes
+	;;
+     -with-* | --with-*) ;; #ignored
+     -without-* | --without-*) ;; #ignored
+     -enable-* | --enable-*) ;; #ignored
+     -x | --x) ;; # ignored
+     -x-*=* | --x-*=*) ;; # ignored
+     -x-* | --x-*)
+	next_arg=--x-ignored # ignored
+	;;
+     --he*) ;; # ignored for now (--help)
+     --vers*) ;; # ignored for now (--version)
+     -v | -verb* | --verb*) ;; # ignored for now (--verbose)
+     --program-*) ;; #ignored (--program-prefix, --program-suffix)
+     --c*) ;; #ignored (--cache-file)
+     --q*) ;; #ignored (--quiet)
+     --si*) ;; #ignored (--silent)
+     -*)
+	echo "Invalid option \`$arg'" 1>&2
+	exit 1
+	;;
+     *)
+# Allow configure HOST TARGET
+	if [ x$host = x ]
+	then
+		host=$target
+	fi
+	target=$arg
+	;;
+    esac
+  esac
+done
+
+# Find the source files, if location was not specified.
+if [ x$srcdir = x ]
+then
+	srcdirdefaulted=1
+	srcdir=.
+	if [ ! -r tree.c ]
+	then
+		srcdir=..
+	fi
+fi
+
+if [ ! -r ${srcdir}/grant.c ]
+then
+	if [ x$srcdirdefaulted = x ]
+	then
+	  echo "$progname: Can't find CHILL frontend sources in \`${srcdir}'" 1>&2
+	else
+	  echo "$progname: Can't find CHILL frontend sources in \`.' or \`..'" 1>&2
+	fi
+	exit 1
+fi
+
+# Make sure that scripts are executable
+[ -w ${srcdir} -a -f ${srcdir}/regression.sh   ] && \
+  chmod +x ${srcdir}/regression.sh 
+[ -w ${srcdir} -a -f ${srcdir}/regression.prpt ] && \
+  chmod +x ${srcdir}/regression.prpt
+[ -w ${srcdir} -a -f ${srcdir}/regression.awk3 ] && \
+  chmod +x ${srcdir}/regression.awk3
+
+if [ -r ${srcdir}/config.status ] && [ x$srcdir != x. ]
+then
+	echo "$progname: \`configure' has been run in \`${srcdir}'" 1>&2
+	exit 1
+fi
+
+host_xmake_file=
+host_truncate_target=
+
+# Complain if an arg is missing
+if [ x$build = x ]
+then
+	# If host was specified, always use it for build also to avoid
+	# confusion.  If someone wants a cross compiler where build != host,
+	# then they must specify build explicitly.  Since this case is
+	# extremely rare, it does not matter that it is slightly inconvenient.
+	if [ x$host != x ]
+	then
+		build=$host
+	
+	# This way of testing the result of a command substitution is
+	# defined by Posix.2 (section 3.9.1) as well as traditional shells.
+	elif build=`${srcdir}/../config.guess`
+	then
+		echo "This appears to be a ${build} system." 1>&2
+
+	elif [ x$target != x ]
+	then
+		echo 'Config.guess failed to determine the host type.  Defaulting to target.'
+		build=$target
+	else
+		echo 'Config.guess failed to determine the host type.  You need to specify one.' 1>&2
+		echo "\
+Usage: `basename $progname` [--host=HOST] [--build=BUILD]
+       [--prefix=DIR] [--gxx-include-dir=DIR] [--local-pref=DIR] [--exec-pref=DIR]
+       [--with-gnu-as] [--with-gnu-ld] [--with-stabs] [--with-elf] [--nfp] TARGET" 1>&2
+	echo "Where HOST, TARGET and BUILD are three-part configuration names " 1>&2
+		if [ -r config.status ]
+		then
+			tail +2 config.status 1>&2
+		fi
+		exit 1
+	fi
+fi
+
+# If $host was not specified, use $build.
+if [ x$host = x ]
+then
+	host=$build
+fi
+
+# If $target was not specified, use $host.
+if [ x$target = x ]
+then
+	target=$host
+fi
+
+# Validate the specs, and canonicalize them.
+canon_build=`/bin/sh $srcdir/../config.sub $build` || exit 1
+canon_host=`/bin/sh $srcdir/../config.sub $host` || exit 1
+canon_target=`/bin/sh $srcdir/../config.sub $target` || exit 1
+
+rm -f config.bak
+if [ -f config.status ]; then mv -f config.status config.bak; fi
+
+#
+# For the current directory and all of the designated SUBDIRS,
+# do the rest of the script...
+#
+if [ ! -d testsuite ] ; then mkdir testsuite; fi
+_SUBDIRS=
+for d in $SUBDIRS; do
+	[ -d $srcdir/$d ] && _SUBDIRS="$_SUBDIRS $d"
+done
+
+savesrcdir=$srcdir
+STARTDIR=`pwd`
+
+for subdir in $_SUBDIRS
+do
+	tmake_file=
+	host_xmake_file=
+	oldsrcdir=$savesrcdir
+
+	# ${invsubdir} is inverse of ${subdir), *with* trailing /, if needed.
+	invsubdir=`echo ${subdir}/ | sed -e 's|\./||g' -e 's|[^/]*/|../|g'`
+
+	# Re-adjust the path
+	# Also create a .gdbinit file which runs the one in srcdir
+	# and tells GDB to look there for source files.
+
+	case $oldsrcdir in
+	".") srcdir=. ;;
+	/*) # absolute path
+               	srcdir=${oldsrcdir}/${subdir}  ;;
+        *) # otherwise relative
+		srcdir=${invsubdir}${oldsrcdir}/${subdir} ;;
+	esac
+
+        if [ -r ${oldsrcdir}/${subdir}/.gdbinit -a ${oldsrcdir} != "." ] ; then
+		cat > ${subdir}/.gdbinit <<EOF
+dir .
+dir ${srcdir}
+source ${srcdir}/.gdbinit
+EOF
+	fi
+
+	case $oldsrcdir in
+	/*)	;;
+	*)	oldsrcdir=${invsubdir}${oldsrcdir} ;;
+	esac
+	mainsrcdir=${oldsrcdir}/..
+	test -d $subdir || mkdir $subdir
+	cd $subdir
+	#
+	# Create Makefile.tem from Makefile.in.
+	# Make it set VPATH if necessary so that the sources are found.
+	# Also change its value of srcdir.
+	rm -f Makefile.tem
+	echo "VPATH = ${srcdir}" \
+	  | cat - ${srcdir}/Makefile.in \
+	  | sed "s@^srcdir = \.@srcdir = ${srcdir}@" > Makefile.tem
+
+	# Conditionalize the makefile for this host machine.
+	if [ -f ${mainsrcdir}/config/${host_xmake_file} ]
+	then
+		rm -f Makefile.xx
+		sed -e "/####host/  r ${mainsrcdir}/config/${host_xmake_file}" Makefile.tem > Makefile.xx
+		echo "Merged ${host_xmake_file}."
+		rm -f Makefile.tem
+		mv Makefile.xx Makefile.tem
+	else
+	# Say in the makefile that there is no host_xmake_file,
+	# by using a name which (when interpreted relative to $srcdir/config)
+	# will duplicate another dependency: $srcdir/Makefile.in.
+		host_xmake_file=../Makefile.in
+	fi
+	
+	# Define variables host_canonical, build_canonical, and target_canonical
+	# because some Cygnus local changes in the Makefile depend on them.
+	echo host_canonical = ${canon_host} > Makefile.xx
+	echo target_canonical = ${canon_target} >> Makefile.xx
+	echo build_canonical = ${canon_build} >> Makefile.xx
+	cat Makefile.tem >> Makefile.xx
+	mv Makefile.xx Makefile.tem
+	
+	# Conditionalize the makefile for this target machine.
+	if [ -f ${mainsrcdir}/config/${tmake_file} ]
+	then
+		rm -f Makefile.xx
+		sed -e "/####target/  r ${mainsrcdir}/config/${tmake_file}" Makefile.tem > Makefile.xx
+		echo "Merged ${tmake_file}."
+		rm -f Makefile.tem
+		mv Makefile.xx Makefile.tem
+	else
+	# Say in the makefile that there is no tmake_file,
+	# by using a name which (when interpreted relative to $srcdir/config)
+	# will duplicate another dependency: $srcdir/Makefile.in.
+		tmake_file=../Makefile.in
+	fi
+	
+	# CYGNUS LOCAL
+	# Conditionalize the makefile for this site.
+	if [ -f ${mainsrcdir}/config/ms-${site} ]
+	then
+		rm -f Makefile.xx
+		sed -e "/####site/  r ${mainsrcdir}/config/ms-${site}" Makefile.tem > Makefile.xx
+		echo "Merged ms-${site}."
+		rm -f Makefile.tem
+		mv Makefile.xx Makefile.tem
+	fi
+	
+	# CYGNUS LOCAL
+	# If this is a cross compilation, and we have newlib in the build
+	# tree, then define inhibit_libc in LIBGCC2_CFLAGS.  This will cause
+	# __eprintf to be left out of libgcc.a, but that's OK because newlib
+	# has its own version of assert.h.
+	if [ x$host != x$target ]; then
+	  sed -e 's/^\(LIBGCC2_CFLAGS[ 	]*=[ 	]*\)/\1-Dinhibit_libc /' Makefile.tem > Makefile.tem2
+	  rm -f Makefile.tem
+	  mv Makefile.tem2 Makefile.tem
+	fi
+	
+	# Remove all formfeeds, since some Makes get confused by them.
+	# Also arrange to give the variables `target', `host_xmake_file',
+	# `tmake_file', `prefix', `local_prefix', `exec_prefix', `FIXINCLUDES'
+	# and `INSTALL_HEADERS_DIR' values in the Makefile from the values
+	# they have in this script.
+	# CYGNUS LOCAL: FLOAT_H, CROSS_FLOAT_H, objdir
+	rm -f Makefile.xx
+	sed -e "s///" -e "s/^target=.*$/target=${target}/" \
+	    -e "s|^xmake_file=.*$|xmake_file=${host_xmake_file}|" \
+	    -e "s|^tmake_file=.*$|tmake_file=${tmake_file}|" \
+	    -e "s|^version=.*$|version=${version}|" \
+	    -e "s|^prefix[ 	]*=.*|prefix = $prefix|" \
+	    -e "s|^local_prefix[ 	]*=.*|local_prefix = $local_prefix|" \
+	    -e "s|^exec_prefix[ 	]*=.*|exec_prefix = $exec_prefix|" \
+	    -e "s|^objdir[ 	]*=.*|objdir=`pwd`|" \
+	    Makefile.tem > Makefile.xx
+	rm -f Makefile.tem
+	mv Makefile.xx Makefile.tem
+	
+	# Install Makefile for real, after making final changes.
+	# Define macro CROSS_COMPILE in compilation if this is a cross-compiler.
+	# Also use all.cross instead of all.internal, and add cross-make to Makefile.
+	if [ x$canon_host = x$canon_target ]
+	then
+		rm -f Makefile
+	  	if [ x$canon_host = x$canon_build ]
+		then
+			mv Makefile.tem Makefile
+		else
+	#		When building gcc with a cross-compiler, we need to fix a
+	#		few things.
+			echo "build= $build" > Makefile
+			sed -e "/####build/  r ${mainsrcdir}/build-make" Makefile.tem >> Makefile
+			rm -f Makefile.tem Makefile.xx
+		fi
+	else
+		rm -f Makefile
+		echo "CROSS=-DCROSS_COMPILE" > Makefile
+		sed -e "/####cross/  r ${mainsrcdir}/cross-make" Makefile.tem >> Makefile
+		rm -f Makefile.tem Makefile.xx
+	fi
+	
+	echo "Created \`$subdir/Makefile'."
+	
+	if [ xx${vint} != xx ]
+	then
+		vintmsg=" (vint)"
+	fi
+	
+	# Describe the chosen configuration in config.status.
+	# Make that file a shellscript which will reestablish the same configuration.
+
+	rm -f config.bak
+	if [ -f config.status ]; then mv -f config.status config.bak; fi
+
+	echo "#!/bin/sh
+	# This directory was configured as follows:
+cd $invsubdir; ${progname}" $arguments > config.new
+	echo echo host=$canon_host target=$canon_target build=$canon_build >> config.new
+	chmod a+x config.new
+
+	# If we aren't executing the configure script in .
+	if [ x$subdir != x. ]
+	then
+		if [ -f $srcdir/configure ]
+		then
+			echo "Running \`${CONFIG_SHELL-sh} $srcdir/configure $arguments\'"
+			${CONFIG_SHELL-sh} $srcdir/configure $arguments
+			echo "${srcdir}/configure" $arguments >> config.new
+			echo echo host=$canon_host target=$canon_target build=$canon_build >> config.new
+		fi
+	fi
+
+	if [ -f config.bak ] && cmp config.bak config.new >/dev/null 2>/dev/null;
+	then
+		mv -f config.bak config.status
+		rm -f config.new
+	else
+		mv -f config.new config.status
+		rm -f config.bak
+	fi
+
+	cd $STARTDIR
+done   # end of current-dir SUBDIRS loop
+	
+srcdir=$savesrcdir
+
+# Describe the chosen configuration in config.status.
+# Make that file a shellscript which will reestablish the same configuration.
+echo "#!/bin/sh
+# This directory was configured as follows:
+${progname}" $arguments > config.new
+echo echo host=$canon_host target=$canon_target build=$canon_build >> config.new
+chmod a+x config.new
+if [ -f config.bak ] && cmp config.bak config.new >/dev/null 2>/dev/null;
+then
+	mv -f config.bak config.status
+	rm -f config.new
+else
+	mv -f config.new config.status
+	rm -f config.bak
+fi
+
+exit 0
diff --git a/gcc/ch/convert.c b/gcc/ch/convert.c
new file mode 100644
index 0000000..d865336
--- /dev/null
+++ b/gcc/ch/convert.c
@@ -0,0 +1,1231 @@
+/* Language-level data type conversion for GNU CHILL.
+   Copyright (C) 1992, 93, 1994 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 file contains the functions for converting CHILL expressions
+   to different data types.  The only entry point is `convert'.
+   Every language front end must have a `convert' function
+   but what kind of conversions it does will depend on the language.  */
+
+#include "config.h"
+#include "tree.h"
+#include "ch-tree.h"
+#include "flags.h"
+#include "convert.h"
+#include "lex.h"
+
+extern void error                              PROTO((char *, ...));
+extern tree initializer_constant_valid_p       PROTO((tree, tree));
+extern tree bit_one_node, bit_zero_node;
+extern tree string_one_type_node;
+extern tree bitstring_one_type_node;
+
+static tree
+convert_to_reference (reftype, expr)
+     tree reftype, expr;
+{
+  while (TREE_CODE (expr) == NOP_EXPR)  /* RETYPE_EXPR */
+    expr = TREE_OPERAND (expr, 0);
+
+  if (! CH_LOCATION_P (expr))
+    error("internal error: trying to make loc-identity with non-location");
+  else
+    {
+      mark_addressable (expr);
+      return fold (build1 (ADDR_EXPR, reftype, expr));
+    }
+
+  return error_mark_node;
+}
+
+tree
+convert_from_reference (expr)
+     tree expr;
+{
+  tree e = build1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (expr)), expr);
+  TREE_READONLY (e) = TREE_READONLY (expr);
+  return e;
+}
+
+/* Convert EXPR to a boolean type.  */
+
+static tree
+convert_to_boolean (type, expr)
+     tree type, expr;
+{
+  register tree intype = TREE_TYPE (expr);
+  
+  if (integer_zerop (expr))
+    return boolean_false_node;
+  if (integer_onep (expr))
+    return boolean_true_node;
+
+  /* Convert a singleton bitstring to a Boolean.
+     Needed if flag_old_strings. */
+  if (CH_BOOLS_ONE_P (intype))
+    {
+      if (TREE_CODE (expr) == CONSTRUCTOR)
+	{
+	  tree valuelist = TREE_OPERAND (expr, 1);
+	  if (valuelist == NULL_TREE)
+	    return boolean_false_node;
+	  if (TREE_CHAIN (valuelist) == NULL_TREE
+	      && TREE_PURPOSE (valuelist) == NULL_TREE
+	      && integer_zerop (TREE_VALUE (valuelist)))
+	    return boolean_true_node;
+	}
+      return build_chill_bitref (expr,
+				 build_tree_list (NULL_TREE,
+						  integer_zero_node));
+    }
+
+  if (INTEGRAL_TYPE_P (intype))
+    return build1 (CONVERT_EXPR, type, expr);
+
+  error ("cannot convert to a boolean mode");
+  return boolean_false_node;
+}
+
+/* Convert EXPR to a char type.  */
+
+static tree
+convert_to_char (type, expr)
+     tree type, expr;
+{
+  register tree intype = TREE_TYPE (expr);
+  register enum chill_tree_code form = TREE_CODE (intype);
+  
+  if (form == CHAR_TYPE)
+    return build1 (NOP_EXPR, type, expr);
+
+  /* Convert a singleton string to a char.
+     Needed if flag_old_strings. */
+  if (CH_CHARS_ONE_P (intype))
+    {
+      if (TREE_CODE (expr) == STRING_CST)
+	{
+	  expr = build_int_2 ((unsigned char)TREE_STRING_POINTER(expr)[0], 0);
+	  TREE_TYPE (expr) = char_type_node;
+	  return expr;
+	}
+      else
+	return build (ARRAY_REF, char_type_node, expr, integer_zero_node);
+
+    }
+
+  /* For now, assume it will always fit */
+  if (form == INTEGER_TYPE)
+    return build1 (CONVERT_EXPR, type, expr);
+
+  error ("cannot convert to a char mode");
+
+  {
+    register tree tem = build_int_2 (0, 0);
+    TREE_TYPE (tem) = type;
+    return tem;
+  }
+}
+
+tree
+base_type_size_in_bytes (type)
+     tree type;
+{
+  if (type == NULL_TREE
+      || TREE_CODE (type) == ERROR_MARK
+      || TREE_CODE (type) != ARRAY_TYPE)
+    return error_mark_node;
+  return size_in_bytes (TREE_TYPE (type));
+}
+
+/*
+ * build a singleton array type, of TYPE objects.
+ */
+tree
+build_array_type_for_scalar (type)
+     tree type;
+{
+  /* KLUDGE */
+  if (type == char_type_node)
+    return build_string_type (type, integer_one_node);
+
+  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+    return error_mark_node;
+
+  return build_chill_array_type
+    (type,
+     tree_cons (NULL_TREE,
+		build_chill_range_type (NULL_TREE,
+					integer_zero_node, integer_zero_node),
+		NULL_TREE),
+     0, NULL_TREE);
+
+}
+
+#if 0
+static tree
+unreferenced_type_of (type)
+     tree type;
+{
+  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+    return error_mark_node;
+  while (TREE_CODE (type) == REFERENCE_TYPE)
+    type = TREE_TYPE (type);
+  return type;
+}
+#endif
+
+
+/* Remove from *LISTP the first TREE_LIST node whose TREE_PURPOSE == KEY.
+   Return the TREE_LIST node, or NULL_TREE on failure. */
+
+static tree
+remove_tree_element (key, listp)
+     tree *listp;
+     tree key;
+{
+  tree node = *listp;
+  for ( ; node; listp = &TREE_CHAIN (node), node = *listp)
+    {
+      if (TREE_PURPOSE (node) == key)
+	{
+	  *listp = TREE_CHAIN (node);
+	  TREE_CHAIN (node) = NULL_TREE;
+	  return node;
+	}
+    }
+  return NULL_TREE;
+}
+
+/* This is quite the same as check_range in actions.c, but with
+   different error message. */
+
+static tree
+check_ps_range (value, lo_limit, hi_limit)
+     tree value;
+     tree lo_limit;
+     tree hi_limit;
+{
+  tree check = test_range (value, lo_limit, hi_limit);
+
+  if (!integer_zerop (check))
+    {
+      if (TREE_CODE (check) == INTEGER_CST)
+	{
+	  error ("powerset tuple element out of range");
+	  return error_mark_node;
+	}
+      else
+	value = check_expression (value, check,
+				  ridpointers[(int) RID_RANGEFAIL]);
+    }
+  return value;
+}
+
+static tree
+digest_powerset_tuple (type, inits)
+     tree type;
+     tree inits;
+{
+  tree list;
+  tree result;
+  tree domain = TYPE_DOMAIN (type);
+  int i = 0;
+  int is_erroneous = 0, is_constant = 1, is_simple = 1;
+  if (domain == NULL_TREE || TREE_CODE (domain) == ERROR_MARK)
+    return error_mark_node;
+  for (list = TREE_OPERAND (inits, 1);  list; list = TREE_CHAIN (list), i++)
+    {
+      tree val = TREE_VALUE (list);
+      if (TREE_CODE (val) == ERROR_MARK)
+	{
+	  is_erroneous = 1;
+	  continue;
+	}
+      if (!TREE_CONSTANT (val))
+	is_constant = 0;
+      else if (!initializer_constant_valid_p (val, TREE_TYPE (val)))
+	is_simple = 0;
+      if (! CH_COMPATIBLE (val, domain))
+	{
+	  error ("incompatible member of powerset tuple (at position #%d)", i);
+	  is_erroneous = 1;
+	  continue;
+	}
+      /* check range of value */
+      val = check_ps_range (val, TYPE_MIN_VALUE (domain),
+			    TYPE_MAX_VALUE (domain));
+      if (TREE_CODE (val) == ERROR_MARK)
+	{
+	  is_erroneous = 1;
+	  continue;
+	}
+
+      /* Updating the list in place is in principle questionable,
+	 but I can't think how it could hurt. */
+      TREE_VALUE (list) = convert (domain, val);
+
+      val = TREE_PURPOSE (list);
+      if (val == NULL_TREE)
+	continue;
+
+      if (TREE_CODE (val) == ERROR_MARK)
+	{
+	  is_erroneous = 1;
+	  continue;
+	}
+      if (! CH_COMPATIBLE (val, domain))
+	{
+	  error ("incompatible member of powerset tuple (at position #%d)", i);
+	  is_erroneous = 1;
+	  continue;
+	}
+      val = check_ps_range (val, TYPE_MIN_VALUE (domain),
+			    TYPE_MAX_VALUE (domain));
+      if (TREE_CODE (val) == ERROR_MARK)
+	{
+	  is_erroneous = 1;
+	  continue;
+	}
+      TREE_PURPOSE (list) = convert (domain, val);
+      if (!TREE_CONSTANT (val))
+	is_constant = 0;
+      else if (!initializer_constant_valid_p (val, TREE_TYPE (val)))
+	is_simple = 0;
+    }
+  result = build (CONSTRUCTOR, type, NULL_TREE, TREE_OPERAND (inits, 1));
+  if (is_erroneous)
+    return error_mark_node;
+  if (is_constant)
+    TREE_CONSTANT (result) = 1;
+  if (is_constant && is_simple)
+    TREE_STATIC (result) = 1;
+  return result;
+}
+
+static tree
+digest_structure_tuple (type, inits)
+     tree type;
+     tree inits;
+{
+  tree elements = CONSTRUCTOR_ELTS (inits);
+  tree values = NULL_TREE;
+  int is_constant = 1;
+  int is_simple = 1;
+  int is_erroneous = 0;
+  tree field;
+  int labelled_elements = 0;
+  int unlabelled_elements = 0;
+  for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (TREE_TYPE (field)) != UNION_TYPE)
+	{ /* Regular fixed field. */
+	  tree value = remove_tree_element (DECL_NAME (field), &elements);
+
+	  if (value)
+	    labelled_elements++;
+	  else if (elements && TREE_PURPOSE (elements) == NULL_TREE)
+	    {
+	      value = elements;
+	      elements = TREE_CHAIN (elements);
+	      unlabelled_elements++;
+	    }
+
+	  if (value)
+	    {
+	      tree val;
+	      char msg[120];
+	      sprintf (msg, "initializer for field `%.80s'",
+		       IDENTIFIER_POINTER (DECL_NAME (field)));
+	      val = chill_convert_for_assignment (TREE_TYPE (field),
+						  TREE_VALUE (value), msg);
+	      if (TREE_CODE (val) == ERROR_MARK)
+		  is_erroneous = 1;
+	      else
+		{
+		  TREE_VALUE (value) = val;
+		  TREE_CHAIN (value) = values;
+		  TREE_PURPOSE (value) = field;
+		  values = value;	
+		  if (TREE_CODE (val) == ERROR_MARK)
+		    is_erroneous = 1;
+		  else if (!TREE_CONSTANT (val))
+		    is_constant = 0;
+		  else if (!initializer_constant_valid_p (val,
+							  TREE_TYPE (val)))
+		    is_simple = 0;
+		}
+	    }
+	  else
+	    {
+	      pedwarn ("no initializer value for fixed field `%s'",
+		       IDENTIFIER_POINTER (DECL_NAME (field)));
+	    }
+	}
+      else
+	{
+	  tree variant;
+	  tree selected_variant = NULL_TREE;
+	  tree variant_values = NULL_TREE;
+
+	  /* In a tagged variant structure mode, try to figure out
+	     (from the fixed fields), which is the selected variant. */
+	  if (TYPE_TAGFIELDS (TREE_TYPE (field)))
+	    {
+	      for (variant = TYPE_FIELDS (TREE_TYPE (field));
+		   variant; variant = TREE_CHAIN (variant))
+		{
+		  tree tag_labels = TYPE_TAG_VALUES (TREE_TYPE (variant));
+		  tree tag_fields = TYPE_TAGFIELDS (TREE_TYPE (field));
+		  if (DECL_NAME (variant) == ELSE_VARIANT_NAME)
+		    {
+		      selected_variant = variant;
+		      break;
+		    }
+		  for (; tag_labels && tag_fields;
+		       tag_labels = TREE_CHAIN (tag_labels),
+		       tag_fields = TREE_CHAIN (tag_fields))
+		    {
+		      tree tag_value = values;
+		      int found = 0;
+		      tree tag_decl = TREE_VALUE (tag_fields);
+		      tree tag_value_set = TREE_VALUE (tag_labels);
+		      for ( ; tag_value; tag_value = TREE_CHAIN (tag_value))
+			{
+			  if (TREE_PURPOSE (tag_value) == tag_decl)
+			    {
+			      tag_value = TREE_VALUE (tag_value);
+			      break;
+			    }
+			}
+		      if (!tag_value || TREE_CODE (tag_value) != INTEGER_CST)
+			{
+			  pedwarn ("non-constant value for tag field `%s'",
+				   IDENTIFIER_POINTER (DECL_NAME (tag_decl)));
+			  goto get_values;
+			}
+
+		      /* Check if the value of the tag (as given in a
+			 previous field) matches the case label list. */
+		      for (; tag_value_set;
+			   tag_value_set = TREE_CHAIN (tag_value_set))
+			{
+			  if (tree_int_cst_equal (TREE_VALUE (tag_value_set),
+						  tag_value))
+			    {
+			      found = 1;
+			      break;
+			    }
+			}
+		      if (!found)
+			break;
+		    }
+		  if (!tag_fields)
+		    {
+		      selected_variant = variant;
+		      break;
+		    }
+		}
+	    }
+	get_values:
+	  for (variant = TYPE_FIELDS (TREE_TYPE (field));
+	       variant; variant = TREE_CHAIN (variant))
+	    {
+	      tree vfield0 = TYPE_FIELDS (TREE_TYPE (variant)); 
+	      tree vfield;
+	      for (vfield = vfield0; vfield;  vfield = TREE_CHAIN (vfield))
+		{
+		  tree value = remove_tree_element (DECL_NAME (vfield),
+						    &elements);
+
+		  if (value)
+		    labelled_elements++;
+		  else if (variant == selected_variant
+			   && elements && TREE_PURPOSE (elements) == NULL_TREE)
+		    {
+		      value = elements;
+		      elements = TREE_CHAIN (elements);
+		      unlabelled_elements++;
+		    }
+
+		  if (value)
+		    {
+		      if (selected_variant && selected_variant != variant)
+			{
+			  error ("field `%s' in wrong variant",
+				 IDENTIFIER_POINTER (DECL_NAME (vfield)));
+			  is_erroneous = 1;
+			}
+		      else
+			{
+			  if (!selected_variant && vfield != vfield0)
+			    pedwarn ("missing variant fields (at least `%s')",
+				     IDENTIFIER_POINTER (DECL_NAME (vfield0)));
+			  selected_variant = variant;
+			  if (CH_COMPATIBLE (TREE_VALUE (value),
+					     TREE_TYPE (vfield)))
+			    {
+			      tree val = convert (TREE_TYPE (vfield),
+						  TREE_VALUE (value));
+			      TREE_PURPOSE (value) = vfield;
+			      TREE_VALUE (value) = val;
+			      TREE_CHAIN (value) = variant_values;
+			      variant_values = value;
+			      if (TREE_CODE (val) == ERROR_MARK)
+				is_erroneous = 1;
+			      else if (!TREE_CONSTANT (val))
+				is_constant = 0;
+			      else if (!initializer_constant_valid_p
+				       (val, TREE_TYPE (val)))
+				is_simple = 0;
+			    }
+			  else
+			    {
+			      is_erroneous = 1;
+			      error ("bad initializer for field `%s'",
+				     IDENTIFIER_POINTER (DECL_NAME (vfield)));
+			    }
+			}
+		    }
+		  else if (variant == selected_variant)
+		    {
+		      pedwarn ("no initializer value for variant field `%s'",
+			       IDENTIFIER_POINTER (DECL_NAME (field)));
+		    }
+		}
+	    }
+	  if (selected_variant == NULL_TREE)
+	    pedwarn ("no selected variant");
+	  else
+	    {
+	      variant_values = build (CONSTRUCTOR,
+				      TREE_TYPE (selected_variant),
+				      NULL_TREE, nreverse (variant_values));
+	      variant_values
+		= build (CONSTRUCTOR, TREE_TYPE (field), NULL_TREE,
+			 build_tree_list (selected_variant, variant_values));
+	      values = tree_cons (field, variant_values, values);
+	    }
+	}
+    }
+
+  if (labelled_elements && unlabelled_elements)
+    pedwarn ("mixture of labelled and unlabelled tuple elements");
+
+  /* Check for unused initializer elements. */
+  unlabelled_elements = 0;
+  for ( ; elements != NULL_TREE; elements = TREE_CHAIN (elements))
+    {
+      if (TREE_PURPOSE (elements) == NULL_TREE)
+	unlabelled_elements++;
+      else
+	{
+	  if (IDENTIFIER_POINTER (TREE_PURPOSE (elements)) == 0)
+	    error ("probably not a structure tuple");
+	  else
+	    error ("excess initializer for field `%s'",
+		   IDENTIFIER_POINTER (TREE_PURPOSE (elements)));
+	  is_erroneous = 1;
+	}
+    }
+  if (unlabelled_elements)
+    {
+      error ("excess unnamed initializers");
+      is_erroneous = 1;
+    }
+
+  CONSTRUCTOR_ELTS (inits) = nreverse (values);
+  TREE_TYPE (inits) = type;
+  if (is_erroneous)
+    return error_mark_node;
+  if (is_constant)
+    TREE_CONSTANT (inits) = 1;
+  if (is_constant && is_simple)
+    TREE_STATIC (inits) = 1;
+  return inits;
+}
+
+/* Return a Chill representation of the INTEGER_CST VAL.
+   The result may be in a static buffer, */
+
+char *
+display_int_cst (val)
+     tree val;
+{
+  static char buffer[50];
+  HOST_WIDE_INT x;
+  tree fields;
+  if (TREE_CODE (val) != INTEGER_CST)
+    return "<not a constant>";
+
+  x = TREE_INT_CST_LOW (val);
+
+  switch (TREE_CODE (TREE_TYPE (val)))
+    {
+    case BOOLEAN_TYPE:
+      if (x == 0)
+	return "FALSE";
+      if (x == 1)
+	return "TRUE";
+      goto int_case;
+    case CHAR_TYPE:
+      if (x == '^')
+	strcpy (buffer, "'^^'");
+      else if (x == '\n')
+	strcpy (buffer, "'^J'");
+      else if (x < ' ' || x > '~')
+	sprintf (buffer, "'^(%u)'", x);
+      else
+	sprintf (buffer, "'%c'", x);
+      return buffer;
+    case ENUMERAL_TYPE:
+      for (fields = TYPE_VALUES (TREE_TYPE (val)); fields != NULL_TREE;
+	   fields = TREE_CHAIN (fields))
+	{
+	  if (tree_int_cst_equal (TREE_VALUE (fields), val))
+	    return IDENTIFIER_POINTER (TREE_PURPOSE (fields));
+	}
+      goto int_case;
+    case POINTER_TYPE:
+      if (x == 0)
+	return "NULL";
+      goto int_case;
+    int_case:
+    default:
+      /* This code is derived from print-tree.c:print_code_brief. */
+      if (TREE_INT_CST_HIGH (val) == 0)
+	sprintf (buffer,
+#if HOST_BITS_PER_WIDE_INT == HOST_BITS_PER_INT
+		 "%1u",
+#else
+		 "%1lu",
+#endif
+		 x);
+      else if (TREE_INT_CST_HIGH (val) == -1 && TREE_INT_CST_LOW (val) != 0)
+	sprintf (buffer,
+#if HOST_BITS_PER_WIDE_INT == HOST_BITS_PER_INT
+		 "-%1u",
+#else
+		 "-%1lu",
+#endif
+		 -x);
+      else
+	sprintf (buffer,
+#if HOST_BITS_PER_WIDE_INT == 64
+#if HOST_BITS_PER_WIDE_INT != HOST_BITS_PER_INT
+		 "H'%lx%016lx",
+#else
+		 "H'%x%016x",
+#endif
+#else
+#if HOST_BITS_PER_WIDE_INT != HOST_BITS_PER_INT
+		 "H'%lx%08lx",
+#else
+		 "H'%x%08x",
+#endif
+#endif
+		 TREE_INT_CST_HIGH (val), TREE_INT_CST_LOW (val));
+      return buffer;
+    }
+}
+
+static tree
+digest_array_tuple (type, init, allow_missing_elements)
+     tree type;
+     tree init;
+     int allow_missing_elements;
+{
+  tree element = CONSTRUCTOR_ELTS (init);
+  int is_constant = 1;
+  int is_simple = 1;
+  tree element_type = TREE_TYPE (type);
+  tree default_value = NULL_TREE;
+  tree element_list = NULL_TREE;
+  tree domain_min;
+  tree domain_max;
+  tree *ptr = &element_list;
+  int errors = 0;
+  int labelled_elements = 0;
+  int unlabelled_elements = 0;
+  tree first, last = NULL_TREE;
+
+  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+    return error_mark_node;
+
+  domain_min = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
+  domain_max = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
+
+  if (domain_min == NULL || TREE_CODE (domain_min) != INTEGER_CST)
+    {
+      error ("non-constant start index for tuple");
+      return error_mark_node;
+    }
+  if (TREE_CODE (domain_max) != INTEGER_CST)
+    is_constant = 0;
+
+  if (TREE_CODE (type) != ARRAY_TYPE)
+    abort ();  
+
+  for ( ; element != NULL_TREE; element = TREE_CHAIN (element))
+    {
+      tree purpose = TREE_PURPOSE (element);
+      tree value   = TREE_VALUE (element);
+
+      if (purpose == NULL_TREE)
+	{
+	  if (last == NULL_TREE)
+	    first = domain_min;
+	  else
+	    {
+	      HOST_WIDE_INT new_lo, new_hi;
+	      add_double (TREE_INT_CST_LOW (last), TREE_INT_CST_HIGH (last),
+			  1, 0,
+			  &new_lo, &new_hi);
+	      first = build_int_2 (new_lo, new_hi);
+	      TREE_TYPE (first) = TYPE_DOMAIN (type);
+	    }
+	  last = first;
+	  unlabelled_elements++;
+	}
+      else
+	{
+	  labelled_elements++;
+	  if (TREE_CODE (purpose) == INTEGER_CST)
+	    first = last = purpose;
+	  else if (TREE_CODE (purpose) == TYPE_DECL
+		   && discrete_type_p (TREE_TYPE (purpose)))
+	    {
+	      first = TYPE_MIN_VALUE (TREE_TYPE (purpose));
+	      last = TYPE_MAX_VALUE (TREE_TYPE (purpose));
+	    }
+	  else if (TREE_CODE (purpose) != RANGE_EXPR)
+	    {
+	      error ("invalid array tuple label");
+	      errors++;
+	      continue;
+	    }
+	  else if (TREE_OPERAND (purpose, 0) == NULL_TREE)
+	    first = last = NULL_TREE;  /* Default value. */
+	  else
+	    {
+	      first = TREE_OPERAND (purpose, 0);
+	      last = TREE_OPERAND (purpose, 1);
+	    }
+	  if ((first != NULL && TREE_CODE (first) != INTEGER_CST)
+	      || (last != NULL && TREE_CODE (last) != INTEGER_CST))
+	    {
+	      error ("non-constant array tuple index range");
+	      errors++;
+	    }
+	}
+
+      if (! CH_COMPATIBLE (value, element_type))
+	{
+	  char *err_val_name = first ? display_int_cst (first) : "(default)";
+	  error ("incompatible array tuple element %s", err_val_name);
+	  value = error_mark_node;
+	}
+      else
+	value = convert (element_type, value);
+      if (TREE_CODE (value) == ERROR_MARK)
+	errors++;
+      else if (!TREE_CONSTANT (value))
+	is_constant = 0;
+      else if (!initializer_constant_valid_p (value, TREE_TYPE (value)))
+	is_simple = 0;
+
+      if (first == NULL_TREE)
+	{
+	  if (default_value != NULL)
+	    {
+	      error ("multiple (*) or (ELSE) array tuple labels");
+	      errors++;
+	    }
+	  default_value = value;
+	  continue;
+	}
+
+      if (first != last && tree_int_cst_lt (last, first))
+	{
+	  error ("empty range in array tuple");
+	  errors++;
+	  continue;
+	}
+
+      ptr = &element_list;
+
+#define MAYBE_RANGE_OP(PURPOSE, OPNO) \
+  (TREE_CODE (PURPOSE) == RANGE_EXPR ? TREE_OPERAND (PURPOSE, OPNO): PURPOSE)
+#define CONSTRUCTOR_ELT_LO(ELT) MAYBE_RANGE_OP (TREE_PURPOSE (ELT), 0)
+#define CONSTRUCTOR_ELT_HI(ELT) MAYBE_RANGE_OP (TREE_PURPOSE (ELT), 1)
+      while (*ptr && tree_int_cst_lt (last,
+				      CONSTRUCTOR_ELT_LO (*ptr)))
+	ptr = &TREE_CHAIN (*ptr);
+      if (*ptr && ! tree_int_cst_lt (CONSTRUCTOR_ELT_HI (*ptr), first))
+	{
+	  char *err_val_name = display_int_cst (first);
+	  error ("array tuple has duplicate index %s", err_val_name);
+	  errors++;
+	  continue;
+	}
+      if ((ptr == &element_list && tree_int_cst_lt (domain_max, last))
+	|| (*ptr == NULL_TREE && tree_int_cst_lt (first, domain_min)))
+	{
+	  if (purpose)
+	    error ("array tuple index out of range");
+	  else if (errors == 0)
+	    error ("too many array tuple values");
+	  errors++;
+	  continue;
+	}
+      if (! tree_int_cst_lt (first, last))
+	purpose = first;
+      else if (purpose == NULL_TREE || TREE_CODE (purpose) != RANGE_EXPR)
+	purpose = build_nt (RANGE_EXPR, first, last);
+      *ptr = tree_cons (purpose, value, *ptr);
+    }
+
+  element_list = nreverse (element_list);
+
+  /* For each missing element, set it to the default value,
+     if there is one.  Otherwise, emit an error.  */
+
+  if (errors == 0
+      && (!allow_missing_elements || default_value != NULL_TREE))
+    {
+      /* Iterate over each *gap* between specified elements/ranges. */
+      tree prev_elt;
+      if (element_list &&
+	  tree_int_cst_equal (CONSTRUCTOR_ELT_LO (element_list), domain_min))
+	{
+	  ptr = &TREE_CHAIN (element_list);
+	  prev_elt = element_list;
+	}
+      else
+	{
+	  prev_elt = NULL_TREE;
+	  ptr = &element_list;
+	}
+      for (;;)
+	{
+	  tree first, last;
+	  /* Calculate the first element of the gap. */
+	  if (prev_elt == NULL_TREE)
+	    first = domain_min;
+	  else
+	    {
+	      first = CONSTRUCTOR_ELT_HI (prev_elt);
+	      if (tree_int_cst_equal (first, domain_max))
+		break; /* We're done.  Avoid overflow below. */
+	      first = copy_node (first);
+	      add_double (TREE_INT_CST_LOW (first), TREE_INT_CST_HIGH (first),
+			  1, 0,
+			  &TREE_INT_CST_LOW (first),
+			  &TREE_INT_CST_HIGH (first));
+	    }
+	  /* Calculate the last element of the gap. */
+	  if (*ptr)
+	    {
+	      /* Actually end up with correct type. */
+	      last = size_binop (MINUS_EXPR,
+				 CONSTRUCTOR_ELT_LO (*ptr),
+				 integer_one_node);
+	    }
+	  else
+	    last = domain_max;
+	  if (TREE_CODE (last) == INTEGER_CST && tree_int_cst_lt (last, first))
+	    ; /* Empty "gap" - no missing elements. */
+	  else if (default_value)
+	    {
+	      tree purpose;
+	      if (tree_int_cst_equal (first, last))
+		purpose = first;
+	      else
+		purpose = build_nt (RANGE_EXPR, first, last);
+	      *ptr = tree_cons (purpose, default_value, *ptr);
+	    }
+	  else
+	    {
+	      char *err_val_name = display_int_cst (first);
+	      if (TREE_CODE (last) != INTEGER_CST)
+		error ("dynamic array tuple without (*) or (ELSE)");
+	      else if (tree_int_cst_equal (first, last))
+		error ("missing array tuple element %s", err_val_name);
+	      else
+		{
+		  char *first_name = (char *)
+		    xmalloc (strlen (err_val_name) + 1);
+		  strcpy (first_name, err_val_name);
+		  err_val_name = display_int_cst (last);
+		  error ("missing array tuple elements %s : %s",
+			 first_name, err_val_name);
+		  free (first_name);
+		}
+	      errors++;
+	    }
+	  if (*ptr == NULL_TREE)
+	    break;
+	  prev_elt = *ptr;
+	  ptr = &TREE_CHAIN (*ptr);
+	}
+    }
+  if (errors)
+    return error_mark_node;
+
+  element = build (CONSTRUCTOR, type, NULL_TREE, element_list);
+  TREE_CONSTANT (element) = is_constant;
+  if (is_constant && is_simple)
+    TREE_STATIC (element) = 1;
+  if (labelled_elements && unlabelled_elements)
+    pedwarn ("mixture of labelled and unlabelled tuple elements");
+  return element;
+}
+
+/* This function is needed because no-op CHILL conversions are not fully
+   understood by the initialization machinery.  This function should only
+   be called when a conversion truly is a no-op.  */
+
+static tree
+convert1 (type, expr)
+     tree type, expr;
+{
+  int was_constant = TREE_CONSTANT (expr);
+  STRIP_NOPS (expr);
+  was_constant |= TREE_CONSTANT (expr);
+  expr = copy_node (expr);
+  TREE_TYPE (expr) = type;
+  if (TREE_CONSTANT (expr) != was_constant) abort ();
+  TREE_CONSTANT (expr) = was_constant;
+  return expr;
+}
+
+/* Create an expression whose value is that of EXPR,
+   converted to type TYPE.  The TREE_TYPE of the value
+   is always TYPE.  This function implements all reasonable
+   conversions; callers should filter out those that are
+   not permitted by the language being compiled.
+
+   In CHILL, we assume that the type is Compatible with the
+   Class of expr, and generally complain otherwise.
+   However, convert is more general (e.g. allows enum<->int
+   conversion), so there should probably be at least two routines.
+   Maybe add something like convert_for_assignment.  FIXME. */
+
+tree
+convert (type, expr)
+     tree type, expr;
+{
+  register tree e = expr;
+  register enum chill_tree_code code;
+  char *errstr;
+  int type_varying;
+
+  if (e == NULL_TREE || TREE_CODE (e) == ERROR_MARK)
+    return error_mark_node;
+
+  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+    return error_mark_node;
+
+  code = TREE_CODE (type);
+
+  if (type == TREE_TYPE (e))
+    return e;
+
+  if (TREE_TYPE (e) != NULL_TREE
+      && TREE_CODE (TREE_TYPE (e)) == REFERENCE_TYPE)
+    e = convert_from_reference (e);
+
+  /* Support for converting *to* a reference type is limited;
+     it is only here as a convenience for loc-identity declarations,
+     and loc parameters. */
+  if (code == REFERENCE_TYPE)
+    return convert_to_reference (type, e);
+
+  /* if expression was untyped because of its context (an if_expr or case_expr
+     in a tuple, perhaps) just apply the type */
+  if (TREE_TYPE (e) && TREE_CODE (TREE_TYPE (e)) == ERROR_MARK)
+    {
+      TREE_TYPE (e) = type;
+      return e;
+    }
+
+  /* Turn a NULL keyword into [0, 0] for an instance */
+  if (CH_IS_INSTANCE_MODE (type) && expr == null_pointer_node)
+    {
+      tree field0 = TYPE_FIELDS (type);
+      tree field1 = TREE_CHAIN (field0);
+      e = build (CONSTRUCTOR, type, NULL_TREE,
+		 tree_cons (field0, integer_zero_node,
+			    tree_cons (field1, integer_zero_node,
+				       NULL_TREE)));
+      TREE_CONSTANT (e) = 1;
+      TREE_STATIC (e) = 1;
+      return e;
+    }
+
+  /* Turn a pointer into a function pointer for a procmode */
+  if (TREE_CODE (type) == POINTER_TYPE
+      && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE
+      && expr == null_pointer_node)
+    return convert1 (type, expr);
+
+  /* turn function_decl expression into a pointer to 
+     that function */
+  if (TREE_CODE (expr) == FUNCTION_DECL
+      && TREE_CODE (type) == POINTER_TYPE
+      && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE)
+    {
+      e = build1 (ADDR_EXPR, type, expr);
+      TREE_CONSTANT (e) = 1;
+      return e;
+    }
+
+  if (TREE_TYPE (e) && TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE)
+    e = varying_to_slice (e);
+  type_varying   = chill_varying_type_p (type);
+
+  /* Convert a char to a singleton string.
+     Needed for compatibility with 1984 version of Z.200. */
+  if (TREE_TYPE (e) && TREE_CODE (TREE_TYPE (e)) == CHAR_TYPE
+      && (CH_CHARS_ONE_P (type) || type_varying))
+    {
+      if (TREE_CODE (e) == INTEGER_CST)
+	{
+	  char ch = TREE_INT_CST_LOW (e);
+	  e = build_chill_string (1, &ch);
+	}
+      else
+	e = build (CONSTRUCTOR, string_one_type_node, NULL_TREE,
+		   tree_cons (NULL_TREE, e, NULL_TREE));
+    }
+
+  /* Convert a Boolean to a singleton bitstring.
+     Needed for compatibility with 1984 version of Z.200. */
+  if (TREE_TYPE (e) && TREE_CODE (TREE_TYPE (e)) == BOOLEAN_TYPE
+      && (CH_BOOLS_ONE_P (type) || type_varying))
+    {
+      if (TREE_CODE (e) == INTEGER_CST)
+	e = integer_zerop (e) ? bit_zero_node : bit_one_node;
+      else
+	e = build (COND_EXPR, bitstring_one_type_node,
+		   e, bit_one_node, bit_zero_node);
+    }
+
+  if (type_varying)
+    {
+      tree nentries;
+      tree field0 = TYPE_FIELDS (type);
+      tree field1 = TREE_CHAIN (field0);
+      tree orig_e = e;
+      tree target_array_type = TREE_TYPE (field1);
+      tree needed_padding;
+      tree padding_max_size = 0;
+      int orig_e_constant = TREE_CONSTANT (orig_e);
+      if (TREE_TYPE (e) != NULL_TREE
+	  && TREE_CODE (TREE_TYPE (e)) == ARRAY_TYPE)
+	{
+	  /* Note that array_type_nelts returns 1 less than the size. */
+	  nentries = array_type_nelts (TREE_TYPE (e));
+	  needed_padding = size_binop (MINUS_EXPR,
+				       array_type_nelts (target_array_type),
+				       nentries);
+	  if (TREE_CODE (needed_padding) != INTEGER_CST)
+	    {
+	      padding_max_size = size_in_bytes (TREE_TYPE (e));
+	      if (TREE_CODE (padding_max_size) != INTEGER_CST)
+		padding_max_size = TYPE_ARRAY_MAX_SIZE (TREE_TYPE (e));
+	    }
+	  nentries = size_binop (PLUS_EXPR, nentries, integer_one_node);
+	}
+      else if (TREE_CODE (e) == CONSTRUCTOR)
+	{
+	  HOST_WIDE_INT init_cnt = 0;
+	  tree chaser = CONSTRUCTOR_ELTS (e);
+	  for ( ; chaser; chaser = TREE_CHAIN (chaser))
+	    init_cnt++;               /* count initializer elements */
+	  nentries = build_int_2 (init_cnt, 0);
+	  needed_padding = integer_zero_node;
+	  if (TREE_TYPE (e) == NULL_TREE)
+	    e = digest_array_tuple (TREE_TYPE (field1), e, 1);
+	  orig_e_constant = TREE_CONSTANT (e);
+	}
+      else
+	{
+	  error ("initializer is not an array or string mode");
+	  return error_mark_node;
+	}
+#if 0
+      FIXME check that nentries will fit in type;
+#endif
+      if (!integer_zerop (needed_padding))
+	{
+	  tree padding, padding_type, padding_range;
+	  if (TREE_CODE (needed_padding) == INTEGER_CST
+	      && (long)TREE_INT_CST_LOW (needed_padding) < 0)
+	    {
+	      error ("destination is too small");
+	      return error_mark_node;
+	    }
+	  padding_range = build_chill_range_type (NULL_TREE, integer_one_node,
+						  needed_padding);
+	  padding_type
+	    = build_simple_array_type (TREE_TYPE (target_array_type),
+				       padding_range, NULL_TREE);
+	  TYPE_ARRAY_MAX_SIZE (padding_type) = padding_max_size;
+	  if (CH_CHARS_TYPE_P (target_array_type))
+	    MARK_AS_STRING_TYPE (padding_type);
+	  padding = build (UNDEFINED_EXPR, padding_type);
+	  if (TREE_CONSTANT (e))
+	    e = build_chill_binary_op (CONCAT_EXPR, e, padding);
+	  else
+	    e = build (CONCAT_EXPR, target_array_type, e, padding);
+	}
+      e = convert (TREE_TYPE (field1), e);
+      /* We build this constructor by hand (rather than going through
+	 digest_structure_tuple), to avoid some type-checking problem.
+	 E.g. type may have non-null novelty, but its field1 will
+	 have non-novelty. */
+      e = build (CONSTRUCTOR, type, NULL_TREE,
+		    tree_cons (field0, nentries,
+			       build_tree_list (field1, e)));
+      /* following was wrong, cause orig_e never will be TREE_CONSTANT. e
+	 may become constant after digest_array_tuple. */
+      if (TREE_CONSTANT (nentries) && orig_e_constant) /* TREE_CONSTANT (orig_e)) */
+	{
+	  TREE_CONSTANT (e) = 1;
+	  if (TREE_STATIC (nentries) && TREE_STATIC (orig_e))
+	    TREE_STATIC (e) = 1;
+	}
+    }
+  if (TREE_TYPE (e) == NULL_TREE)
+    {
+      if (TREE_CODE (e) == CONSTRUCTOR)
+	{
+	  if (TREE_CODE (type) == SET_TYPE)
+	    return digest_powerset_tuple (type, e);
+	  if (TREE_CODE (type) == RECORD_TYPE)
+	    return digest_structure_tuple (type, e);
+	  if (TREE_CODE (type) == ARRAY_TYPE)
+	    return digest_array_tuple (type, e, 0);
+	  fatal ("internal error - bad CONSTRUCTOR passed to convert");
+	}
+      else if (TREE_CODE (e) == COND_EXPR)
+	e = build (COND_EXPR, type,
+		   TREE_OPERAND (e, 0),
+		   convert (type, TREE_OPERAND (e, 1)),
+		   convert (type, TREE_OPERAND (e, 2)));
+      else if (TREE_CODE (e) == CASE_EXPR)
+	TREE_TYPE (e) = type;
+      else
+	{
+	  error ("internal error:  unknown type of expression");
+	  return error_mark_node;
+	}
+    }
+
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e))
+      || (CH_NOVELTY (type) != NULL_TREE
+	  && CH_NOVELTY (type) == CH_NOVELTY (TREE_TYPE (e))))
+    return convert1 (type, e);
+
+  if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE)
+    {
+      error ("void value not ignored as it ought to be");
+      return error_mark_node;
+    }
+  if (code == VOID_TYPE)
+    return build1 (CONVERT_EXPR, type, e);
+
+  if (code == SET_TYPE)
+    return convert1 (type, e);
+
+  if (code == INTEGER_TYPE || code == ENUMERAL_TYPE)
+    {
+      if (flag_old_strings)
+	{
+	  if (CH_CHARS_ONE_P (TREE_TYPE (e)))
+	    e = convert_to_char (char_type_node, e);
+	  else if (CH_BOOLS_ONE_P (TREE_TYPE (e)))
+	    e = convert_to_boolean (boolean_type_node, e);
+	}
+      return fold (convert_to_integer (type, e));
+    }
+  if (code == POINTER_TYPE)
+    return fold (convert_to_pointer (type, e));
+  if (code == REAL_TYPE)
+    return fold (convert_to_real (type, e));
+  if (code == BOOLEAN_TYPE)
+    return fold (convert_to_boolean (type, e));
+  if (code == CHAR_TYPE)
+    return fold (convert_to_char (type, e));
+
+  if (code == ARRAY_TYPE && TYPE_MODE (type) != TYPE_MODE (TREE_TYPE (e)))
+    {
+      /* The mode of the expression is different from that of the type.
+	 Earlier checks should have tested against different lengths.
+	 But even if the lengths are the same, it is possible that one
+	 type is a static type (and hence could be say SImode), while the
+	 other type is dynamic type (and hence is BLKmode).
+	 This causes problems when emitting instructions.  */
+      tree ee = build1 (INDIRECT_REF, type,
+			build1 (NOP_EXPR, build_pointer_type (type),
+				build1 (ADDR_EXPR,
+					build_pointer_type (TREE_TYPE (e)),
+					e)));
+      TREE_READONLY (ee) = TYPE_READONLY (type);
+      return ee;
+    }
+
+  /* The default! */
+  return convert1 (type, e);
+}
+
+/* Return an expression whose value is EXPR, but whose class is CLASS. */
+
+tree
+convert_to_class (class, expr)
+     struct ch_class class;
+     tree expr;
+{
+  switch (class.kind)
+    {
+    case CH_NULL_CLASS:
+    case CH_ALL_CLASS:
+      return expr;
+    case CH_DERIVED_CLASS:
+      if (TREE_TYPE (expr) != class.mode)
+	expr = convert (class.mode, expr);
+      if (!CH_DERIVED_FLAG (expr))
+	{
+	  expr = copy_node (expr);
+	  CH_DERIVED_FLAG (expr) = 1;
+	}
+      return expr;
+    case CH_VALUE_CLASS:
+    case CH_REFERENCE_CLASS:
+      if (TREE_TYPE (expr) != class.mode)
+	expr = convert (class.mode, expr);
+      if (CH_DERIVED_FLAG (expr))
+	{
+	  expr = copy_node (expr);
+	  CH_DERIVED_FLAG (expr) = 0;
+	}
+      return expr;
+    }
+  return expr;
+}
diff --git a/gcc/ch/decl.c b/gcc/ch/decl.c
new file mode 100644
index 0000000..57842b0
--- /dev/null
+++ b/gcc/ch/decl.c
@@ -0,0 +1,5176 @@
+/* Process declarations and variables for GNU CHILL compiler.
+   Copyright (C) 1992, 93, 1994 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.  */
+
+
+/* Process declarations and symbol lookup for CHILL front end.
+   Also constructs types; the standard scalar types at initialization,
+   and structure, union, array and enum types when they are declared.  */
+
+/* NOTES on Chill name resolution
+   
+   Chill allows one to refer to an identifier that is declared later in
+   the same Group.  Hence, a single pass over the code (as in C) is
+   insufficient.
+   
+   This implementation uses two complete passes over the source code,
+   plus some extra passes over internal data structures.
+   
+   Loosely, during pass 1, a 'scope' object is created for each Chill
+   reach.  Each scope object contains a list of 'decl' objects,
+   one for each 'defining occurrence' in the reach.  (This list
+   is in the 'remembered_decls' field of each scope.)
+   The scopes and their decls are replayed in pass 2:  As each reach
+   is entered, the decls saved from pass 1 are made visible.
+   
+   There are some exceptions.  Declarations that cannot be referenced
+   before their declaration (i.e. whose defining occurrence precede
+   their reach), can be deferred to pass 2.  These include formal
+   parameter declarations, and names defined in a DO action.
+   
+   During pass 2, as each scope is entered, we must make visible all
+   the declarations defined in the scope, before we generate any code.
+   We must also simplify the declarations from pass 1:  For example
+   a VAR_DECL may have a array type whose bounds are expressions;
+   these need to be folded.  But of course the expressions may contain
+   identifiers that may be defined later in the scope - or even in
+   a different module.
+   
+   The "satisfy" process has two main phases:
+   
+   1: Binding. Each identifier *referenced* in a declaration (i.e. in
+   a mode or the RHS of a synonum declaration) must be bound to its
+   defining occurrence.  This may need to be linking via
+   grants and/or seizes (which are represented by ALIAS_DECLs).
+   A further complication is handling implied name strings.
+   
+   2: Layout. Each CONST_DECL or TYPE_DECL *referenced* in a declaration
+   must than be replaced by its value (or type).  Constants must be
+   folded.  Types and declarstions must be laid out.  DECL_RTL must be set.
+   While doing this, we must watch out for circular dependencies.
+   
+   If a scope contains nested modulions, then the Binding phase must be
+   done for each nested module (recursively) before the Layout phase
+   can start for that scope.  As an example of why this is needed, consider:
+   
+   M1: MODULE
+     DCL a ARRAY [1:y] int; -- This should have 7 elements.
+     SYN x = 5;
+     SEIZE y;
+   END M1;
+   M2: MODULE
+     SYN x = 2;
+     SYN y = x + 5;
+     GRANT y;
+   END M2;
+
+   Here, the 'x' in "x + 5" must be Bound to the 'x' in module M2.
+   This must be done before we can Layout a.
+   The reason this is an issue is that we do *not* have a lookup
+   (or hash) table per scope (or module).  Instead we have a single
+   global table we we keep adding and removing bindings from.
+   (This is both for speed, and because of gcc history.)
+
+   Note that a SEIZE generates a declaration in the current scope,
+   linked to something in the surrounding scope.  Determining (binding)
+   the link must be done in pass 2.  On the other hand, a GRANT
+   generates a declaration in the surrounding scope, linked to
+   something in the current scope.  This linkage is Bound in pass 1.
+
+   The sequence for the above example is:
+   - Enter the declarations of M1 (i.e. {a, x, y}) into the hash table.
+   - For each of {a, x, y}, examine dependent expression (the
+     rhs of x, the bounds of a), and Bind any identifiers to
+     the current declarations (as found in the hash table).  Specifically,
+     the 'y' in the array bounds of 'a' is bound to the 'y' declared by
+     the SEIZE declaration.  Also, 'y' is Bound to the implicit
+     declaration in the global scope (generated from the GRANT in M2).
+   - Remove the bindings for M1 (i.e. {a, x, y}) from the hash table.
+   - Enter the declarations of M2 (i.e. {x, y}) into the hash table.
+   - For each of {x, y} examine the dependent expressions (the rhs of
+     x and y), and Bind any identifiers to their current declarartions
+     (in this case the 'x' in "x + 5" is bound to the 'x' that is 2.
+   - Remove the bindings for M2 (i.e. {x, y}) from the hash table.
+   - Perform Layout for M1:  This requires the size of a, which
+     requires the value of y.  The 'y'  is Bound to the implicit
+     declaration in the global scope, which is Bound to the declaration
+     of y in M2.  We now require the value of this 'y', which is "x + 5"
+     where x is bound to the x in M2 (thanks to our previous Binding
+     phase).  So we get that the value of y is 7.
+   - Perform layout of M2.  This implies calculating (constant folding)
+   the value of y - but we already did that, so we're done.   
+
+   An example illustating the problem with implied names:
+
+   M1: MODULE
+     SEIZE y;
+     use(e);  -- e is implied by y.
+   END M1;
+   M2: MODULE
+     GRANT y;
+     SYNMODE y = x;
+     SEIZE x;
+   END M2;
+   M3: MODULE
+     GRANT x;
+     SYNMODE x = SET (e);
+   END M3;
+
+   This implies that determining the implied name e in M1
+   must be done after Binding of y to x in M2.
+
+   Yet another nasty:
+   M1: MODULE
+     SEIZE v;
+     DCL a ARRAY(v:v) int;
+   END M1;
+   M2: MODULE
+     GRANT v;
+     SEIZE x;
+     SYN v x = e;
+   END M2;
+   M3: MODULE
+     GRANT x;
+     SYNMODE x = SET(e);
+   END M3;
+
+   This one implies that determining the implied name e in M2,
+   must be done before Layout of a in M1.
+
+   These two examples togother indicate the determining implieed
+   names requries yet another phase.
+   - Bind strong names in M1.
+   - Bind strong names in M2.
+   - Bind strong names in M3.
+   - Determine weak names implied by SEIZEs in M1.
+   - Bind the weak names in M1.
+   - Determine weak names implied by SEIZEs in M2.
+   - Bind the weak names in M2.
+   - Determine weak names implied by SEIZEs in M3.
+   - Bind the weak names in M3.
+   - Layout M1.
+   - Layout M2.
+   - Layout M3.
+
+   We must bind the strong names in every module before we can determine
+   weak names in any module (because of seized/granted synmode/newmodes).
+   We must bind the weak names in every module before we can do Layout
+   in any module.
+
+   Sigh.
+
+   */
+
+/* ??? not all decl nodes are given the most useful possible
+   line numbers.  For example, the CONST_DECLs for enum values.  */
+
+#include <stdio.h>
+#include "config.h"
+#include "tree.h"
+#include "flags.h"
+#include "ch-tree.h"
+#include "lex.h"
+#include "obstack.h"
+#include "input.h"
+#include "rtl.h"
+
+#define IS_UNKNOWN_TYPE(type) (TYPE_SIZE(type)==0)
+#define BUILTIN_NESTING_LEVEL (-1)
+
+/* For backward compatibility, we define Chill INT to be the same
+   as SHORT (i.e. 16 bits), at least if C INT is the same as LONG.
+   This is a lose. */
+#define CHILL_INT_IS_SHORT (INT_TYPE_SIZE==LONG_TYPE_SIZE)
+
+extern int  ignore_case;
+extern tree process_type;
+extern struct obstack *saveable_obstack;
+extern tree signal_code;
+extern int special_UC;
+
+extern void tasking_init              PROTO((void));
+extern void error                     PROTO((char *, ...));
+extern void error_with_decl           PROTO((tree, char *, ...));
+extern void expand_decl               PROTO((tree));
+static tree get_next_decl             PROTO((void));
+extern tree get_parm_decls            PROTO((void));
+extern void end_temporary_allocation  PROTO((void));
+extern void indent_to                 PROTO((FILE *, int));
+#ifdef RTX_CODE
+extern rtx  label_rtx                 PROTO((tree));
+#endif
+extern tree lookup_name_for_seizing   PROTO((tree));
+extern tree lookup_name_current_level PROTO((tree));
+extern int  operand_equal_p           PROTO((tree, tree, int));
+extern void pedwarn_with_decl         PROTO((tree, char *, ...));
+extern void print_node                PROTO((FILE *, char *, tree, int));
+extern void push_granted              PROTO((tree, tree));
+extern void push_obstacks             PROTO((struct obstack *, struct obstack *));
+extern void rest_of_decl_compilation  PROTO((tree, char *, int, int));
+extern void sorry                     PROTO((char *, ...));
+static void save_decl                 PROTO((tree));
+extern void start_identifier_warnings PROTO((void));
+extern void temporary_allocation      PROTO((void));
+extern void warning                   PROTO((char *, ...));
+
+extern struct obstack permanent_obstack;
+extern int in_pseudo_module;
+
+struct module *current_module = NULL;
+struct module *first_module = NULL;
+struct module **next_module = &first_module;
+
+extern int  in_pseudo_module;
+
+int module_number = 0;
+
+/* This is only used internally (by signed_type). */
+
+tree signed_boolean_type_node;
+
+tree global_function_decl = NULL_TREE;
+
+/* This is a temportary used by RESULT to store its value.
+   Note we cannot directly use DECL_RESULT for two reasons:
+   a) If DECL_RESULT is a register, it may get clobbered by a
+   subsequent function call; and
+   b) if the function returns a struct, we might (visibly) modify the
+   destination before we're supposed to. */
+tree chill_result_decl;
+
+int result_never_set;
+
+/* forward declarations */
+static void pushdecllist                     PROTO((tree, int));
+static int  init_nonvalue_struct             PROTO((tree));
+static int  init_nonvalue_array              PROTO((tree));
+
+int current_nesting_level = BUILTIN_NESTING_LEVEL;
+int current_module_nesting_level = 0;
+
+/* Lots of declarations copied from c-decl.c. */
+/* ??? not all decl nodes are given the most useful possible
+   line numbers.  For example, the CONST_DECLs for enum values.  */
+
+#if 0
+/* In grokdeclarator, distinguish syntactic contexts of declarators.  */
+enum decl_context
+{ NORMAL,			/* Ordinary declaration */
+    FUNCDEF,			/* Function definition */
+    PARM,			/* Declaration of parm before function body */
+    FIELD,			/* Declaration inside struct or union */
+    BITFIELD,			/* Likewise but with specified width */
+    TYPENAME};			/* Typename (inside cast or sizeof)  */
+#endif
+
+#ifndef CHAR_TYPE_SIZE
+#define CHAR_TYPE_SIZE BITS_PER_UNIT
+#endif
+
+#ifndef SHORT_TYPE_SIZE
+#define SHORT_TYPE_SIZE (BITS_PER_UNIT * MIN ((UNITS_PER_WORD + 1) / 2, 2))
+#endif
+
+#ifndef INT_TYPE_SIZE
+#define INT_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#ifndef LONG_TYPE_SIZE
+#define LONG_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#ifndef LONG_LONG_TYPE_SIZE
+#define LONG_LONG_TYPE_SIZE (BITS_PER_WORD * 2)
+#endif
+
+#ifndef WCHAR_UNSIGNED
+#define WCHAR_UNSIGNED 0
+#endif
+
+#ifndef FLOAT_TYPE_SIZE
+#define FLOAT_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#ifndef DOUBLE_TYPE_SIZE
+#define DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
+#endif
+
+#ifndef LONG_DOUBLE_TYPE_SIZE
+#define LONG_DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
+#endif
+
+/* We let tm.h override the types used here, to handle trivial differences
+   such as the choice of unsigned int or long unsigned int for size_t.
+   When machines start needing nontrivial differences in the size type,
+   it would be best to do something here to figure out automatically
+   from other information what type to use.  */
+
+#ifndef PTRDIFF_TYPE
+#define PTRDIFF_TYPE "long int"
+#endif
+
+#ifndef WCHAR_TYPE
+#define WCHAR_TYPE "int"
+#endif
+
+/* a node which has tree code ERROR_MARK, and whose type is itself.
+   All erroneous expressions are replaced with this node.  All functions
+   that accept nodes as arguments should avoid generating error messages
+   if this node is one of the arguments, since it is undesirable to get
+   multiple error messages from one error in the input.  */
+
+tree error_mark_node;
+
+/* INTEGER_TYPE and REAL_TYPE nodes for the standard data types */
+
+tree short_integer_type_node;
+tree integer_type_node;
+tree long_integer_type_node;
+tree long_long_integer_type_node;
+
+tree short_unsigned_type_node;
+tree unsigned_type_node;
+tree long_unsigned_type_node;
+tree long_long_unsigned_type_node;
+
+tree ptrdiff_type_node;
+
+tree unsigned_char_type_node;
+tree signed_char_type_node;
+tree char_type_node;
+tree wchar_type_node;
+tree signed_wchar_type_node;
+tree unsigned_wchar_type_node;
+
+tree float_type_node;
+tree double_type_node;
+tree long_double_type_node;
+
+tree complex_integer_type_node;
+tree complex_float_type_node;
+tree complex_double_type_node;
+tree complex_long_double_type_node;
+
+tree intQI_type_node;
+tree intHI_type_node;
+tree intSI_type_node;
+tree intDI_type_node;
+tree intTI_type_node;
+
+tree unsigned_intQI_type_node;
+tree unsigned_intHI_type_node;
+tree unsigned_intSI_type_node;
+tree unsigned_intDI_type_node;
+tree unsigned_intTI_type_node;
+
+/* a VOID_TYPE node.  */
+
+tree void_type_node;
+tree void_list_node;
+
+/* Nodes for types `void *' and `const void *'.  */
+tree ptr_type_node, const_ptr_type_node;
+
+/* type of initializer structure, which points to
+   a module's module-level code, and to the next
+   such structure. */
+tree initializer_type;
+
+/* type of a CHILL predefined value builtin routine */
+tree chill_predefined_function_type;
+
+/* type `int ()' -- used for implicit declaration of functions.  */
+
+tree default_function_type;
+
+#if 0
+/* function types `double (double)' and `double (double, double)', etc.  */
+
+tree double_ftype_double, double_ftype_double_double;
+tree int_ftype_int, long_ftype_long;
+
+/* Function type `void (void *, void *, int)' and similar ones */
+
+tree void_ftype_ptr_ptr_int, int_ftype_ptr_ptr_int, void_ftype_ptr_int_int;
+
+/* Function type `char *(char *, char *)' and similar ones */
+tree string_ftype_ptr_ptr, int_ftype_string_string;
+
+/* Function type `int (const void *, const void *, size_t)' */
+tree int_ftype_cptr_cptr_sizet;
+#endif
+
+char **boolean_code_name;
+
+/* Two expressions that are constants with value zero.
+   The first is of type `int', the second of type `void *'.  */
+
+tree integer_zero_node;
+tree null_pointer_node;
+
+/* A node for the integer constant 1.  */
+tree integer_one_node;
+
+/* A node for the integer constant -1.  */
+tree integer_minus_one_node;
+
+/* Nodes for boolean constants TRUE and FALSE. */
+tree boolean_true_node, boolean_false_node;
+
+tree string_one_type_node;  /* The type of CHARS(1). */
+tree bitstring_one_type_node;  /* The type of BOOLS(1). */
+tree bit_zero_node; /* B'0' */
+tree bit_one_node; /* B'1' */
+
+/* Nonzero if we have seen an invalid cross reference
+   to a struct, union, or enum, but not yet printed the message.  */
+
+tree pending_invalid_xref;
+/* File and line to appear in the eventual error message.  */
+char *pending_invalid_xref_file;
+int pending_invalid_xref_line;
+
+/* After parsing the declarator that starts a function definition,
+   `start_function' puts here the list of parameter names or chain of decls.
+   `store_parm_decls' finds it here.  */
+
+static tree current_function_parms;
+
+/* Nonzero when store_parm_decls is called indicates a varargs function.
+   Value not meaningful after store_parm_decls.  */
+
+static int c_function_varargs;
+
+/* The FUNCTION_DECL for the function currently being compiled,
+   or 0 if between functions.  */
+tree current_function_decl;
+
+/* These are irrelevant for Chill, but are referenced from from c-typeck.c. */
+int warn_format;
+int warn_traditional;
+int warn_bad_function_cast;
+
+/* Identifiers that hold VAR_LENGTH and VAR_DATA.  */
+tree var_length_id, var_data_id;
+
+tree case_else_node;
+
+/* For each binding contour we allocate a scope structure
+ * which records the names defined in that contour.
+ * Contours include:
+ *  0) the global one
+ *  1) one for each function definition,
+ *     where internal declarations of the parameters appear.
+ *  2) one for each compound statement,
+ *     to record its declarations.
+ *
+ * The current meaning of a name can be found by searching the levels from
+ * the current one out to the global one.
+ */
+
+/* To communicate between pass 1 and 2, we maintain a list of "scopes".
+   Each scope corrresponds to a nested source scope/block that contain 
+   that can contain declarations.  The TREE_VALUE of the scope points
+   to the list of declarations declared in that scope.
+   The TREE_PURPOSE of the scope points to the surrounding scope.
+   (We may need to handle nested modules later.  FIXME)
+   The TREE_CHAIN field contains a list of scope as they are seen
+   in chronological order.  (Reverse order during first pass,
+   but it is reverse before pass 2.) */
+
+struct scope
+{
+  /* The enclosing scope. */
+  struct scope *enclosing;
+  
+  /* The next scope, in chronlogical order. */
+  struct scope *next;
+  
+  /* A chain of DECLs constructed using save_decl during pass 1. */
+  tree remembered_decls;
+  
+  /* A chain of _DECL nodes for all variables, constants, functions,
+     and typedef types belong to this scope. */
+  tree decls;
+  
+  /* List of declarations that have been granted into this scope. */
+  tree granted_decls;
+
+  /* List of implied (weak) names. */
+  tree weak_decls;
+  
+  /* For each level, a list of shadowed outer-level local definitions
+     to be restored when this level is popped.
+     Each link is a TREE_LIST whose TREE_PURPOSE is an identifier and
+     whose TREE_VALUE is its old definition (a kind of ..._DECL node).  */
+  tree shadowed;
+  
+  /* For each level (except not the global one),
+     a chain of BLOCK nodes for all the levels
+     that were entered and exited one level down.  */
+  tree blocks;
+  
+  /* The BLOCK node for this level, if one has been preallocated.
+     If 0, the BLOCK is allocated (if needed) when the level is popped.  */
+  tree this_block;
+  
+  /* The binding level which this one is contained in (inherits from).  */
+  struct scope *level_chain;
+  
+  /* Nonzero for a level that corresponds to a module. */
+  char module_flag;
+  
+  /* Zero means called from backend code. */
+  char two_pass;
+  
+  /* The modules that are directly enclosed by this scope
+     are chained together. */
+  struct scope* first_child_module;
+  struct scope** tail_child_module;
+  struct scope* next_sibling_module;
+};
+
+/* The outermost binding level, for pre-defined (builtin) names. */
+
+static struct scope builtin_scope = { NULL, NULL, NULL_TREE};
+
+struct scope *global_scope;
+
+/* The binding level currently in effect.  */
+
+static struct scope *current_scope = &builtin_scope;
+
+/* The most recently seen scope. */
+struct scope *last_scope = &builtin_scope;
+
+/* Binding level structures are initialized by copying this one.  */
+
+static struct scope clear_scope
+  = {NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, 0, 0, 0};
+
+/* Chain of decls accessible through IDENTIFIER_OUTER_VALUE.
+   Decls with the same DECL_NAME are adjacent in the chain. */
+
+static tree outer_decls = NULL_TREE;
+
+/* Forward declarations.  */
+
+tree pushdecl ();
+tree builtin_function ();
+
+tree lookup_name_current_level ();
+static void layout_array_type ();
+
+/* C-specific option variables.  */
+
+/* Nonzero means allow type mismatches in conditional expressions;
+   just make their values `void'.   */
+
+int flag_cond_mismatch;
+
+/* Nonzero means give `double' the same size as `float'.  */
+
+int flag_short_double;
+
+/* Nonzero means don't recognize the keyword `asm'.  */
+
+int flag_no_asm;
+
+/* Nonzero means don't recognize any builtin functions.  */
+
+int flag_no_builtin;
+
+/* Nonzero means don't recognize the non-ANSI builtin functions.
+   -ansi sets this.  */
+
+int flag_no_nonansi_builtin;
+
+/* Nonzero means do some things the same way PCC does.  */
+
+int flag_traditional;
+
+/* Nonzero means to allow single precision math even if we're generally
+   being traditional. */
+int flag_allow_single_precision = 0;
+
+/* Nonzero means to treat bitfields as signed unless they say `unsigned'.  */
+
+int flag_signed_bitfields = 1;
+int explicit_flag_signed_bitfields = 0;
+
+/* Nonzero means handle `#ident' directives.  0 means ignore them.  */
+
+int flag_no_ident = 0;
+
+/* Nonzero means warn about implicit declarations.  */
+
+int warn_implicit;
+
+/* Nonzero means give string constants the type `const char *'
+   to get extra warnings from them.  These warnings will be too numerous
+   to be useful, except in thoroughly ANSIfied programs.  */
+
+int warn_write_strings;
+
+/* Nonzero means warn about pointer casts that can drop a type qualifier
+   from the pointer target type.  */
+
+int warn_cast_qual;
+
+/* Nonzero means warn about sizeof(function) or addition/subtraction
+   of function pointers.  */
+
+int warn_pointer_arith;
+
+/* Nonzero means warn for non-prototype function decls
+   or non-prototyped defs without previous prototype.  */
+
+int warn_strict_prototypes;
+
+/* Nonzero means warn for any global function def
+   without separate previous prototype decl.  */
+
+int warn_missing_prototypes;
+
+/* Nonzero means warn about multiple (redundant) decls for the same single
+   variable or function.  */
+
+int warn_redundant_decls = 0;
+
+/* Nonzero means warn about extern declarations of objects not at
+   file-scope level and about *all* declarations of functions (whether
+   extern or static) not at file-scope level.  Note that we exclude
+   implicit function declarations.  To get warnings about those, use
+   -Wimplicit.  */
+
+int warn_nested_externs = 0;
+
+/* Warn about a subscript that has type char.  */
+
+int warn_char_subscripts = 0;
+
+/* Warn if a type conversion is done that might have confusing results.  */
+
+int warn_conversion;
+
+/* Warn if adding () is suggested.  */
+
+int warn_parentheses;
+
+/* Warn if initializer is not completely bracketed.  */
+
+int warn_missing_braces;
+
+/* Define the special tree codes that we use.  */
+
+/* Table indexed by tree code giving a string containing a character
+   classifying the tree code.  Possibilities are
+   t, d, s, c, r, <, 1 and 2.  See ch-tree.def for details.  */
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
+  
+  char chill_tree_code_type[] = {
+    'x',
+#include "ch-tree.def"
+  };
+#undef DEFTREECODE
+
+/* Table indexed by tree code giving number of expression
+   operands beyond the fixed part of the node structure.
+   Not used for types or decls.  */
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
+  
+int chill_tree_code_length[] = {
+    0,
+#include "ch-tree.def"
+  };
+#undef DEFTREECODE
+
+
+/* Names of tree components.
+   Used for printing out the tree and error messages.  */
+#define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
+  
+char *chill_tree_code_name[] = {
+    "@@dummy",
+#include "ch-tree.def"
+  };
+#undef DEFTREECODE
+
+/* Nonzero means `$' can be in an identifier.
+   See cccp.c for reasons why this breaks some obscure ANSI C programs.  */
+
+#ifndef DOLLARS_IN_IDENTIFIERS
+#define DOLLARS_IN_IDENTIFIERS 0
+#endif
+int dollars_in_ident = DOLLARS_IN_IDENTIFIERS > 1;
+
+/* An identifier that is used internally to indicate
+   an "ALL" prefix for granting or seizing.
+   We use "*" rather than the external name "ALL", partly for convenience,
+   and partly to avoid case senstivity problems. */
+
+tree ALL_POSTFIX;
+
+void
+allocate_lang_decl (t)
+     tree t;
+{
+  /* Nothing needed */
+}
+
+void
+copy_lang_decl (node)
+     tree node;
+{
+  /* Nothing needed */
+}
+
+tree
+build_lang_decl (code, name, type)
+     enum chill_tree_code code;
+     tree name;
+     tree type;
+{
+  return build_decl (code, name, type);
+}
+
+/* Decode the string P as a language-specific option for C.
+   Return the number of strings consumed for a valid option.
+   Return 0 for an invalid option.  */
+
+int
+c_decode_option (argc, argv)
+     int argc;
+     char **argv;
+{
+  char *p = argv[0];
+  if (!strcmp (p, "-ftraditional") || !strcmp (p, "-traditional"))
+    {
+      flag_traditional = 1;
+      flag_writable_strings = 1;
+#if DOLLARS_IN_IDENTIFIERS > 0
+      dollars_in_ident = 1;
+#endif
+    }
+  else if (!strcmp (p, "-fnotraditional") || !strcmp (p, "-fno-traditional"))
+    {
+      flag_traditional = 0;
+      flag_writable_strings = 0;
+      dollars_in_ident = DOLLARS_IN_IDENTIFIERS > 1;
+    }
+  else if (!strcmp (p, "-fsigned-char"))
+    flag_signed_char = 1;
+  else if (!strcmp (p, "-funsigned-char"))
+    flag_signed_char = 0;
+  else if (!strcmp (p, "-fno-signed-char"))
+    flag_signed_char = 0;
+  else if (!strcmp (p, "-fno-unsigned-char"))
+    flag_signed_char = 1;
+  else if (!strcmp (p, "-fsigned-bitfields")
+	   || !strcmp (p, "-fno-unsigned-bitfields"))
+    {
+      flag_signed_bitfields = 1;
+      explicit_flag_signed_bitfields = 1;
+    }
+  else if (!strcmp (p, "-funsigned-bitfields")
+	   || !strcmp (p, "-fno-signed-bitfields"))
+    {
+      flag_signed_bitfields = 0;
+      explicit_flag_signed_bitfields = 1;
+    }
+  else if (!strcmp (p, "-fshort-enums"))
+    flag_short_enums = 1;
+  else if (!strcmp (p, "-fno-short-enums"))
+    flag_short_enums = 0;
+  else if (!strcmp (p, "-fcond-mismatch"))
+    flag_cond_mismatch = 1;
+  else if (!strcmp (p, "-fno-cond-mismatch"))
+    flag_cond_mismatch = 0;
+  else if (!strcmp (p, "-fshort-double"))
+    flag_short_double = 1;
+  else if (!strcmp (p, "-fno-short-double"))
+    flag_short_double = 0;
+  else if (!strcmp (p, "-fasm"))
+    flag_no_asm = 0;
+  else if (!strcmp (p, "-fno-asm"))
+    flag_no_asm = 1;
+  else if (!strcmp (p, "-fbuiltin"))
+    flag_no_builtin = 0;
+  else if (!strcmp (p, "-fno-builtin"))
+    flag_no_builtin = 1;
+  else if (!strcmp (p, "-fno-ident"))
+    flag_no_ident = 1;
+  else if (!strcmp (p, "-fident"))
+    flag_no_ident = 0;
+  else if (!strcmp (p, "-ansi"))
+    flag_no_asm = 1, flag_no_nonansi_builtin = 1, dollars_in_ident = 0;
+  else if (!strcmp (p, "-Wimplicit"))
+    warn_implicit = 1;
+  else if (!strcmp (p, "-Wno-implicit"))
+    warn_implicit = 0;
+  else if (!strcmp (p, "-Wwrite-strings"))
+    warn_write_strings = 1;
+  else if (!strcmp (p, "-Wno-write-strings"))
+    warn_write_strings = 0;
+  else if (!strcmp (p, "-Wcast-qual"))
+    warn_cast_qual = 1;
+  else if (!strcmp (p, "-Wno-cast-qual"))
+    warn_cast_qual = 0;
+  else if (!strcmp (p, "-Wpointer-arith"))
+    warn_pointer_arith = 1;
+  else if (!strcmp (p, "-Wno-pointer-arith"))
+    warn_pointer_arith = 0;
+  else if (!strcmp (p, "-Wstrict-prototypes"))
+    warn_strict_prototypes = 1;
+  else if (!strcmp (p, "-Wno-strict-prototypes"))
+    warn_strict_prototypes = 0;
+  else if (!strcmp (p, "-Wmissing-prototypes"))
+    warn_missing_prototypes = 1;
+  else if (!strcmp (p, "-Wno-missing-prototypes"))
+    warn_missing_prototypes = 0;
+  else if (!strcmp (p, "-Wredundant-decls"))
+    warn_redundant_decls = 1;
+  else if (!strcmp (p, "-Wno-redundant-decls"))
+    warn_redundant_decls = 0;
+  else if (!strcmp (p, "-Wnested-externs"))
+    warn_nested_externs = 1;
+  else if (!strcmp (p, "-Wno-nested-externs"))
+    warn_nested_externs = 0;
+  else if (!strcmp (p, "-Wchar-subscripts"))
+    warn_char_subscripts = 1;
+  else if (!strcmp (p, "-Wno-char-subscripts"))
+    warn_char_subscripts = 0;
+  else if (!strcmp (p, "-Wconversion"))
+    warn_conversion = 1;
+  else if (!strcmp (p, "-Wno-conversion"))
+    warn_conversion = 0;
+  else if (!strcmp (p, "-Wparentheses"))
+    warn_parentheses = 1;
+  else if (!strcmp (p, "-Wno-parentheses"))
+    warn_parentheses = 0;
+  else if (!strcmp (p, "-Wreturn-type"))
+    warn_return_type = 1;
+  else if (!strcmp (p, "-Wno-return-type"))
+    warn_return_type = 0;
+  else if (!strcmp (p, "-Wcomment"))
+    ; /* cpp handles this one.  */
+  else if (!strcmp (p, "-Wno-comment"))
+    ; /* cpp handles this one.  */
+  else if (!strcmp (p, "-Wcomments"))
+    ; /* cpp handles this one.  */
+  else if (!strcmp (p, "-Wno-comments"))
+    ; /* cpp handles this one.  */
+  else if (!strcmp (p, "-Wtrigraphs"))
+    ; /* cpp handles this one.  */
+  else if (!strcmp (p, "-Wno-trigraphs"))
+    ; /* cpp handles this one.  */
+  else if (!strcmp (p, "-Wimport"))
+    ; /* cpp handles this one.  */
+  else if (!strcmp (p, "-Wno-import"))
+    ; /* cpp handles this one.  */
+  else if (!strcmp (p, "-Wmissing-braces"))
+    warn_missing_braces = 1;
+  else if (!strcmp (p, "-Wno-missing-braces"))
+    warn_missing_braces = 0;
+  else if (!strcmp (p, "-Wall"))
+    {
+      extra_warnings = 1;
+      /* We save the value of warn_uninitialized, since if they put
+	 -Wuninitialized on the command line, we need to generate a
+	 warning about not using it without also specifying -O.  */
+      if (warn_uninitialized != 1)
+	warn_uninitialized = 2;
+      warn_implicit = 1;
+      warn_return_type = 1;
+      warn_unused = 1;
+      warn_char_subscripts = 1;
+      warn_parentheses = 1;
+      warn_missing_braces = 1;
+    }
+  else
+    return 0;
+  
+  return 1;
+}
+
+/* Hooks for print_node.  */
+
+void
+print_lang_decl (file, node, indent)
+     FILE *file;
+     tree node;
+     int  indent;
+{
+  indent_to (file, indent + 3);
+  fprintf (file, "nesting_level %d ", DECL_NESTING_LEVEL (node));
+  if (DECL_WEAK_NAME (node))
+    fprintf (file, "weak_name ");
+  if (CH_DECL_SIGNAL (node))
+    fprintf (file, "decl_signal ");
+  print_node (file, "tasking_code",
+	      (tree)DECL_TASKING_CODE_DECL (node), indent + 4);
+}
+
+
+void
+print_lang_type (file, node, indent)
+     FILE *file;
+     tree node;
+     int  indent;
+{
+  tree temp;
+
+  indent_to (file, indent + 3);
+  if (CH_IS_BUFFER_MODE (node))
+    fprintf (file, "buffer_mode ");
+  if (CH_IS_EVENT_MODE (node))
+    fprintf (file, "event_mode ");
+
+  if (CH_IS_EVENT_MODE (node) || CH_IS_BUFFER_MODE (node))
+    {
+      temp = max_queue_size (node);
+      if (temp)
+	print_node_brief (file, "qsize", temp, indent + 4);
+    }
+}
+
+void
+print_lang_identifier (file, node, indent)
+     FILE *file;
+     tree node;
+     int  indent;
+{
+  print_node (file, "local",       IDENTIFIER_LOCAL_VALUE (node),   indent +  4);
+  print_node (file, "outer",       IDENTIFIER_OUTER_VALUE (node),   indent +  4);
+  print_node (file, "implicit",    IDENTIFIER_IMPLICIT_DECL (node), indent + 4);
+  print_node (file, "error locus", IDENTIFIER_ERROR_LOCUS (node),   indent + 4);
+  print_node (file, "signal_dest", IDENTIFIER_SIGNAL_DEST (node),   indent + 4);
+  indent_to  (file, indent + 3);
+  if (IDENTIFIER_SIGNAL_DATA(node))
+    fprintf (file, "signal_data ");
+}
+
+/* initialise non-value struct */
+
+static int
+init_nonvalue_struct (expr)
+     tree expr;
+{
+  tree type = TREE_TYPE (expr);
+  tree field;
+  int res = 0;
+
+  if (CH_IS_BUFFER_MODE (type))
+    {
+      expand_expr_stmt (
+        build_chill_modify_expr (
+          build_component_ref (expr, get_identifier ("__buffer_data")),
+            null_pointer_node));
+      return 1;
+    }
+  else if (CH_IS_EVENT_MODE (type))
+    {
+      expand_expr_stmt (
+        build_chill_modify_expr (
+          build_component_ref (expr, get_identifier ("__event_data")),
+            null_pointer_node));
+      return 1;
+    }
+  else if (CH_IS_ASSOCIATION_MODE (type))
+    {
+      expand_expr_stmt (
+        build_chill_modify_expr (expr,
+          chill_convert_for_assignment (type, association_init_value,
+					"association")));
+      return 1;
+    }
+  else if (CH_IS_ACCESS_MODE (type))
+    {
+      init_access_location (expr, type);
+      return 1;
+    }
+  else if (CH_IS_TEXT_MODE (type))
+    {
+      init_text_location (expr, type);
+      return 1;
+    }
+
+  for (field = TYPE_FIELDS (type); field != NULL_TREE; field = TREE_CHAIN (field))
+    {
+      type = TREE_TYPE (field);
+      if (CH_TYPE_NONVALUE_P (type))
+	{
+	  tree exp = build_component_ref (expr, DECL_NAME (field));
+	  if (TREE_CODE (type) == RECORD_TYPE)
+	    res |= init_nonvalue_struct (exp);
+	  else if (TREE_CODE (type) == ARRAY_TYPE)
+	    res |= init_nonvalue_array (exp);
+	}
+    }
+  return res;
+}
+
+/* initialize non-value array */
+/* do it with DO FOR unique-id IN expr; ... OD; */
+static int
+init_nonvalue_array (expr)
+     tree expr;
+{
+  tree tmpvar = get_unique_identifier ("NONVALINIT");
+  tree type;
+  int res = 0;
+
+  push_loop_block ();
+  build_loop_iterator (tmpvar, expr, NULL_TREE, NULL_TREE, 0, 1, 0);
+  nonvalue_begin_loop_scope ();
+  build_loop_start (NULL_TREE);
+  tmpvar = lookup_name (tmpvar);
+  type = TREE_TYPE (tmpvar);
+  if (CH_TYPE_NONVALUE_P (type))
+    {
+      if (TREE_CODE (type) == RECORD_TYPE)
+	res |= init_nonvalue_struct (tmpvar);
+      else if (TREE_CODE (type) == ARRAY_TYPE)
+	res |= init_nonvalue_array (tmpvar);
+    }
+  build_loop_end ();
+  nonvalue_end_loop_scope ();
+  pop_loop_block ();
+  return res;
+}
+
+/* This excessive piece of code sets DECL_NESTING_LEVEL (DECL) to LEVEL. */
+
+void
+set_nesting_level (decl, level)
+     tree decl;
+     int level;
+{
+  static tree *small_ints = NULL;
+  static int max_small_ints = 0;
+  
+  if (level < 0)
+    decl->decl.vindex = NULL_TREE;
+  else
+    {
+      if (level >= max_small_ints)
+	{
+	  int new_max = level + 20;
+	  if (small_ints == NULL)
+	    small_ints = (tree*)xmalloc (new_max * sizeof(tree));
+	  else
+	    small_ints = (tree*)xrealloc (small_ints, new_max * sizeof(tree));
+	  while (max_small_ints < new_max)
+	    small_ints[max_small_ints++] = NULL_TREE;
+	}
+      if (small_ints[level] == NULL_TREE)
+	{
+	  push_obstacks (&permanent_obstack, &permanent_obstack);
+	  small_ints[level] = build_int_2 (level, 0);
+	  pop_obstacks ();
+	}
+      /* set DECL_NESTING_LEVEL */
+      decl->decl.vindex = small_ints[level];
+    }
+}
+
+/* OPT_EXTERNAL is non-zero when the declaration is at module level.
+ * OPT_EXTERNAL == 2 means implicitly grant it.
+ */
+void
+do_decls (names, type, opt_static, lifetime_bound, opt_init, opt_external)
+     tree names;
+     tree type;
+     int  opt_static;
+     int  lifetime_bound;
+     tree opt_init;
+     int  opt_external;
+{
+  if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
+    {
+      for (; names != NULL_TREE; names = TREE_CHAIN (names))
+	do_decl (TREE_VALUE (names), type, opt_static, lifetime_bound,
+		 opt_init, opt_external);
+    }
+  else if (TREE_CODE (names) != ERROR_MARK)
+    do_decl (names, type, opt_static, lifetime_bound, opt_init, opt_external);
+}
+
+tree
+do_decl (name, type, is_static, lifetime_bound, opt_init, opt_external)
+     tree name, type;
+     int  is_static;
+     int  lifetime_bound;
+     tree opt_init;
+     int  opt_external;
+{
+  tree decl;
+
+  if (current_function_decl == global_function_decl
+      && ! lifetime_bound /*&& opt_init != NULL_TREE*/)
+    seen_action = 1;
+
+  if (pass < 2)
+    {
+      push_obstacks (&permanent_obstack, &permanent_obstack);
+      decl = make_node (VAR_DECL);
+      DECL_NAME (decl) = name;
+      TREE_TYPE (decl) = type;
+      DECL_ASSEMBLER_NAME (decl) = name;
+
+      /* Try to put things in common when possible.
+         Tasking variables must go into common.  */
+      DECL_COMMON (decl) = 1;
+      DECL_EXTERNAL (decl) = opt_external > 0;
+      TREE_PUBLIC (decl)   = opt_external > 0;
+      TREE_STATIC (decl)   = is_static;
+
+      if (pass == 0)
+	{
+	  /* We have to set this here, since we build the decl w/o
+	     calling `build_decl'.  */
+	  DECL_INITIAL (decl) = opt_init;
+	  pushdecl (decl);
+	  finish_decl (decl);
+	}
+      else
+	{
+	  save_decl (decl);
+	  pop_obstacks ();
+	}
+      DECL_INITIAL (decl) = opt_init;
+      if (opt_external > 1 || in_pseudo_module)
+	push_granted (DECL_NAME (decl), decl);
+    }
+  else /* pass == 2 */
+    {
+      tree temp = NULL_TREE;
+      int init_it = 0;
+
+      decl = get_next_decl ();
+      
+      if (name != DECL_NAME (decl))
+	abort ();
+      
+      type = TREE_TYPE (decl);
+      
+      push_obstacks_nochange ();
+      if (TYPE_READONLY_PROPERTY (type))
+	{
+	  if (CH_TYPE_NONVALUE_P (type))
+	    {
+	      error_with_decl (decl, "`%s' must not be declared readonly");
+	      opt_init = NULL_TREE; /* prevent subsequent errors */
+	    }
+	  else if (opt_init == NULL_TREE && !opt_external)
+	    error("declaration of readonly variable without initialization");
+	}
+      TREE_READONLY (decl) = TYPE_READONLY (type);
+      
+      if (!opt_init && chill_varying_type_p (type))
+	{
+	  tree fixed_part_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)));
+	  if (fixed_part_type != NULL_TREE && TREE_CODE (fixed_part_type) != ERROR_MARK)
+	    {
+	      if (CH_CHARS_TYPE_P (fixed_part_type))
+		opt_init = build_chill_string (0, "");
+	      else
+		opt_init = build_nt (CONSTRUCTOR, NULL_TREE, NULL_TREE);
+	      lifetime_bound = 1;
+	    }
+	}
+
+      if (opt_init)
+	{
+	  if (CH_TYPE_NONVALUE_P (type))
+	    {
+	      error_with_decl (decl,
+			       "no initialisation allowed for `%s'");
+	      temp = NULL_TREE;
+	    }
+	  else if (TREE_CODE (type) == REFERENCE_TYPE)
+	    { /* A loc-identity declaration */
+	      if (! CH_LOCATION_P (opt_init))
+		{
+		  error_with_decl (decl,
+			"value for loc-identity `%s' is not a location");
+		  temp = NULL_TREE;
+		}
+	      else if (! CH_READ_COMPATIBLE (TREE_TYPE (type),
+					     TREE_TYPE (opt_init)))
+		{
+		  error_with_decl (decl,
+				   "location for `%s' not read-compatible");
+		  temp = NULL_TREE;
+		}
+	      else
+		temp = convert (type, opt_init);
+	    }
+	  else
+	    { /* Normal location declaration */
+	      char place[80];
+	      sprintf (place, "`%.60s' initializer",
+		       IDENTIFIER_POINTER (DECL_NAME (decl)));
+	      temp = chill_convert_for_assignment (type, opt_init, place);
+	    }
+	}
+      else if (CH_TYPE_NONVALUE_P (type))
+	{
+	  temp = NULL_TREE;
+	  init_it = 1;
+	}
+      DECL_INITIAL (decl) = NULL_TREE;
+
+      if (temp != NULL_TREE && TREE_CODE (temp) != ERROR_MARK)
+        {
+	  /* The same for stack variables (assuming no nested modules). */
+	  if (lifetime_bound || !is_static)
+	    {
+	      if (is_static && ! TREE_CONSTANT (temp))
+		error_with_decl (decl, "nonconstant initializer for `%s'");
+	      else
+		DECL_INITIAL (decl) = temp;
+	    }
+        }
+      finish_decl (decl);
+      /* Initialize the variable unless initialized statically. */
+      if ((!is_static || ! lifetime_bound) &&
+	  temp != NULL_TREE && TREE_CODE (temp) != ERROR_MARK)
+	{
+	  int was_used = TREE_USED (decl);
+	  emit_line_note (input_filename, lineno);
+	  expand_expr_stmt (build_chill_modify_expr (decl, temp));
+	  /* Don't let the initialization count as "using" the variable.  */
+	  TREE_USED (decl) = was_used;
+	  if (current_function_decl == global_function_decl)
+	    build_constructor = 1;
+	}
+      else if (init_it && TREE_CODE (type) != ERROR_MARK)
+	{
+	  /* Initialize variables with non-value type */
+	  int was_used = TREE_USED (decl);
+	  int something_initialised = 0;
+
+	  emit_line_note (input_filename, lineno);
+	  if (TREE_CODE (type) == RECORD_TYPE)
+	    something_initialised = init_nonvalue_struct (decl);
+	  else if (TREE_CODE (type) == ARRAY_TYPE)
+	    something_initialised = init_nonvalue_array (decl);
+	  if (! something_initialised)
+	    {
+	      error ("do_decl: internal error: don't know what to initialize");
+	      abort ();
+	    }
+	  /* Don't let the initialization count as "using" the variable.  */
+	  TREE_USED (decl) = was_used;
+	  if (current_function_decl == global_function_decl)
+	    build_constructor = 1;
+	}
+    }
+  return decl;
+}
+
+/*
+ * ARGTYPES is a tree_list of formal argument types.  TREE_VALUE
+ * is the type tree for each argument, while the attribute is in
+ * TREE_PURPOSE.
+ */
+tree
+build_chill_function_type (return_type, argtypes, exceptions, recurse_p)
+     tree return_type, argtypes, exceptions, recurse_p;
+{
+  tree ftype, arg;
+
+  if (exceptions != NULL_TREE)
+    {
+      /* if we have exceptions we add 2 arguments, callers filename
+	 and linenumber. These arguments will be added automatically
+	 when calling a function which may raise exceptions. */
+      argtypes = chainon (argtypes,
+			  build_tree_list (NULL_TREE, ridpointers[(int) RID_PTR]));
+      argtypes = chainon (argtypes,
+			  build_tree_list (NULL_TREE, ridpointers[(int) RID_LONG]));
+}
+
+  /* Indicate the argument list is complete. */
+  argtypes = chainon (argtypes,
+		      build_tree_list (NULL_TREE, void_type_node));
+  
+  /* INOUT and OUT parameters must be a REFERENCE_TYPE since
+     we'll be passing a temporary's address at call time. */
+  for (arg = argtypes; arg; arg = TREE_CHAIN (arg))
+    if (TREE_PURPOSE (arg) == ridpointers[(int) RID_LOC]
+	|| TREE_PURPOSE (arg) == ridpointers[(int) RID_OUT]
+	|| TREE_PURPOSE (arg) == ridpointers[(int) RID_INOUT]
+	)
+      TREE_VALUE (arg) = 
+	build_chill_reference_type (TREE_VALUE (arg));
+  
+  /* Cannot use build_function_type, because if does hash-canonlicalization. */
+  ftype = make_node (FUNCTION_TYPE);
+  TREE_TYPE (ftype) = return_type ? return_type : void_type_node ;
+  TYPE_ARG_TYPES (ftype) = argtypes;
+  
+  if (exceptions)
+    ftype = build_exception_variant (ftype, exceptions);
+  
+  if (recurse_p)
+    sorry ("RECURSIVE PROCs");
+  
+  return ftype;
+}
+
+/*
+ * ARGTYPES is a tree_list of formal argument types.
+ */
+tree
+push_extern_function (name, typespec, argtypes, exceptions, granting)
+     tree name, typespec, argtypes, exceptions;
+     int granting; /* If 0 do pushdecl(); if 1 do push_granted(). */
+{
+  tree ftype, fndecl;
+  
+  push_obstacks_nochange ();
+  end_temporary_allocation ();
+  
+  if (pass < 2)
+    {
+      ftype = build_chill_function_type (typespec, argtypes,
+					 exceptions, NULL_TREE);
+      
+      fndecl = build_decl (FUNCTION_DECL, name, ftype);
+      
+      DECL_EXTERNAL(fndecl) = 1;
+      TREE_STATIC (fndecl) = 1;
+      TREE_PUBLIC (fndecl) = 1;
+      if (pass == 0)
+	{
+	  pushdecl (fndecl);
+	  finish_decl (fndecl);
+	}
+      else
+	{
+	  save_decl (fndecl);
+	  pop_obstacks ();
+	}
+      make_function_rtl (fndecl);
+    }
+  else
+    {
+      fndecl = get_next_decl (); 
+      finish_decl (fndecl);
+    }
+#if 0
+  
+  if (granting)
+    push_granted (name, decl);
+  else
+    pushdecl(decl);
+#endif
+  return fndecl;
+}
+
+
+
+void
+push_extern_process (name, argtypes, exceptions, granting)
+     tree name, argtypes, exceptions;
+     int  granting;
+{
+  tree decl, func, arglist;
+  
+  push_obstacks_nochange ();
+  end_temporary_allocation ();
+  
+  if (pass < 2)
+    {
+      tree proc_struct = make_process_struct (name, argtypes);
+      arglist = (argtypes == NULL_TREE) ? NULL_TREE :
+	tree_cons (NULL_TREE,
+		   build_chill_pointer_type (proc_struct), NULL_TREE);
+    }
+  else
+    arglist = NULL_TREE;
+
+  func = push_extern_function (name, NULL_TREE, arglist,
+			       exceptions, granting);
+
+  /* declare the code variable */
+  decl = generate_tasking_code_variable (name, &process_type, 1);
+  CH_DECL_PROCESS (func) = 1;
+  /* remember the code variable in the function decl */
+  DECL_TASKING_CODE_DECL (func) = (struct lang_decl *)decl;
+
+  add_taskstuff_to_list (decl, "_TT_Process", NULL_TREE, func, NULL_TREE);
+}
+
+void
+push_extern_signal (signame, sigmodelist, optsigdest)
+     tree signame, sigmodelist, optsigdest;
+{
+  tree decl, sigtype;
+
+  push_obstacks_nochange ();
+  end_temporary_allocation ();
+  
+  sigtype = 
+    build_signal_struct_type (signame, sigmodelist, optsigdest);
+  
+  /* declare the code variable outside the process */
+  decl = generate_tasking_code_variable (signame, &signal_code, 1);
+  add_taskstuff_to_list (decl, "_TT_Signal", NULL_TREE, sigtype, NULL_TREE);
+}
+
+void
+print_mode (mode)
+     tree mode;
+{
+  while (mode != NULL_TREE)
+    {
+      switch (TREE_CODE (mode))
+	{
+	case POINTER_TYPE:
+	  printf (" REF ");
+	  mode = TREE_TYPE (mode);
+	  break;
+	case INTEGER_TYPE:
+	case REAL_TYPE:
+	  printf (" %s ", IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (mode))));
+	  mode = NULL_TREE;
+	  break;
+	case ARRAY_TYPE:
+	  {
+	    tree itype = TYPE_DOMAIN (mode);
+	    if (CH_STRING_TYPE_P (mode))
+	      printf (" STRING (%d) OF ",
+		      TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype)));
+	    else
+	      printf (" ARRAY (%d:%d) OF ",
+		      TREE_INT_CST_LOW (TYPE_MIN_VALUE (itype)),
+		      TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype)));
+	    mode = TREE_TYPE (mode);
+	    break;
+	  }
+	case RECORD_TYPE:
+	  {
+	    tree fields = TYPE_FIELDS (mode);
+	    printf (" RECORD (");
+	    while (fields != NULL_TREE)
+	      {
+		printf (" %s:", IDENTIFIER_POINTER (DECL_NAME (fields)));
+		print_mode (TREE_TYPE (fields));
+		if (TREE_CHAIN (fields))
+		  printf (",");
+		fields = TREE_CHAIN (fields);
+	      }
+	    printf (")");
+	    mode = NULL_TREE;
+	    break;
+	  }
+	default:
+	  abort ();
+	}
+    }
+}
+
+tree
+chill_munge_params (nodes, type, attr)
+     tree nodes, type, attr;
+{
+  tree node;
+  if (pass == 1)
+    {
+      /* Convert the list of identifiers to a list of types. */
+      for (node = nodes; node != NULL_TREE; node = TREE_CHAIN (node))
+	{
+	  TREE_VALUE (node) = type;  /* this was the identifier node */
+	  TREE_PURPOSE (node) = attr;
+	}
+    }
+  return nodes;
+}
+
+/* Push the declarations described by SYN_DEFS into the current scope.  */
+void
+push_syndecl (name, mode, value)
+     tree name, mode, value;
+{
+  if (pass == 1)
+    {
+      tree decl = make_node (CONST_DECL);
+      DECL_NAME (decl) = name;
+      DECL_ASSEMBLER_NAME (decl) = name;
+      TREE_TYPE (decl) = mode;
+      DECL_INITIAL (decl) = value;
+      TREE_READONLY (decl) = 1;
+      save_decl (decl);
+      if (in_pseudo_module)
+	push_granted (DECL_NAME (decl), decl);
+    }
+  else /* pass == 2 */
+    get_next_decl ();
+}
+
+
+
+/* Push the declarations described by (MODENAME,MODE) into the current scope.
+   MAKE_NEWMODE is 1 for NEWMODE, 0 for SYNMODE, and
+   -1 for internal use (in which case the mode does not need to be copied). */
+
+tree
+push_modedef (modename, mode, make_newmode)
+     tree modename;
+     tree mode;  /* ignored if pass==2. */
+     int make_newmode;
+{
+  tree newdecl, newmode;
+  
+  if (pass == 1)
+    {
+      /* FIXME: need to check here for SYNMODE fred fred; */
+      push_obstacks (&permanent_obstack, &permanent_obstack);
+
+      newdecl = build_lang_decl (TYPE_DECL, modename, mode);
+
+      if (make_newmode >= 0)
+	{
+	  newmode = make_node (LANG_TYPE);
+	  TREE_TYPE (newmode) = mode;
+	  TREE_TYPE (newdecl) = newmode;
+	  TYPE_NAME (newmode) = newdecl;
+	  if (make_newmode > 0)
+	    CH_NOVELTY (newmode) = newdecl;
+	}
+
+      save_decl (newdecl);
+      pop_obstacks ();
+	  
+    }
+  else /* pass == 2 */
+    {
+      /* FIXME: need to check here for SYNMODE fred fred; */
+      newdecl = get_next_decl ();
+      if (DECL_NAME (newdecl) != modename)
+	abort ();
+      if (TREE_CODE (TREE_TYPE (newdecl)) != ERROR_MARK)
+	{
+	  /* ASSOCIATION, ACCESS, TEXT, BUFFER, and EVENT must not be READOnly */
+	  if (TREE_READONLY (TREE_TYPE (newdecl)) &&
+	      (CH_IS_ASSOCIATION_MODE (TREE_TYPE (newdecl)) ||
+	       CH_IS_ACCESS_MODE (TREE_TYPE (newdecl)) ||
+	       CH_IS_TEXT_MODE (TREE_TYPE (newdecl)) ||
+	       CH_IS_BUFFER_MODE (TREE_TYPE (newdecl)) ||
+	       CH_IS_EVENT_MODE (TREE_TYPE (newdecl))))
+	    error_with_decl (newdecl, "`%s' must not be READonly");
+	  rest_of_decl_compilation (newdecl, NULL_PTR,
+				    global_bindings_p (), 0);
+	}
+    }
+  return newdecl;
+}
+
+/* Return a chain of FIELD_DECLs for the names in NAMELIST.  All of
+   of type TYPE.  When NAMELIST is passed in from the parser, it is
+   in reverse order.
+   LAYOUT is (NULL_TREE, integer_one_node, integer_zero_node, tree_list),
+   meaning (default, pack, nopack, POS (...) ).  */
+
+tree
+grok_chill_fixedfields (namelist, type, layout)
+     tree namelist, type;
+     tree layout;
+{
+  tree decls = NULL_TREE;
+  
+  if (layout != NULL_TREE && TREE_CHAIN (namelist) != NULL_TREE)
+    {
+      if (layout != integer_one_node && layout != integer_zero_node)
+	{
+	  layout = NULL_TREE;
+	  error ("POS may not be specified for a list of field declarations");
+	}
+    }
+
+  /* we build the chain of FIELD_DECLs backwards, effectively
+     unreversing the reversed names in NAMELIST.  */
+  for (; namelist; namelist = TREE_CHAIN (namelist))
+    {
+      tree decl = build_decl (FIELD_DECL, 
+			      TREE_VALUE (namelist), type);
+      DECL_INITIAL (decl) = layout;
+      TREE_CHAIN (decl) = decls;
+      decls = decl;
+    }
+  
+  return decls;
+}
+
+struct tree_pair
+{
+  tree value;
+  tree decl;
+};
+
+
+/* Function to help qsort sort variant labels by value order.  */
+static int
+label_value_cmp (x, y)
+     struct tree_pair *x, *y;
+{
+  return TREE_INT_CST_LOW (x->value) - TREE_INT_CST_LOW (y->value);
+}
+
+tree
+make_chill_variants (tagfields, body, variantelse)
+     tree tagfields;
+     tree body;
+     tree variantelse;
+{
+  tree utype;
+  tree first = NULL_TREE;
+  for (; body; body = TREE_CHAIN (body))
+    {
+      tree decls = TREE_VALUE (body);
+      tree labellist = TREE_PURPOSE (body);
+
+      if (labellist != NULL_TREE
+	  && TREE_CODE (TREE_VALUE (labellist)) == TREE_LIST
+	  && TREE_VALUE (TREE_VALUE (labellist)) == case_else_node
+	  && TREE_CHAIN (labellist) == NULL_TREE)
+	{
+	  if (variantelse)
+	    error ("(ELSE) case label as well as ELSE variant");
+	  variantelse = decls;
+	}
+      else
+	{
+	  tree rtype = start_struct (RECORD_TYPE, NULL_TREE);
+	  rtype = finish_struct (rtype, decls);
+
+	  first = chainon (first, build_decl (FIELD_DECL, NULL_TREE, rtype));
+      
+	  TYPE_TAG_VALUES (rtype) = labellist;
+	}
+    }
+  
+  if (variantelse != NULL_TREE)
+    {
+      tree rtype = start_struct (RECORD_TYPE, NULL_TREE);
+      rtype = finish_struct (rtype, variantelse);
+      first = chainon (first,
+		       build_decl (FIELD_DECL,
+				   ELSE_VARIANT_NAME, rtype));
+    }
+  
+  utype = start_struct (UNION_TYPE, NULL_TREE);
+  utype = finish_struct (utype, first);
+  TYPE_TAGFIELDS (utype) = tagfields;
+  return utype;
+}
+
+tree
+layout_chill_variants (utype)
+     tree utype;
+{
+  tree first = TYPE_FIELDS (utype);
+  int nlabels = 0, label_index = 0;
+  struct tree_pair *label_value_array;
+  tree decl;
+  extern int errorcount;
+  
+  if (TYPE_SIZE (utype))
+    return utype;
+  
+  for (decl = first; decl; decl = TREE_CHAIN (decl))
+    {
+      tree tagfields = TYPE_TAGFIELDS (utype);
+      tree t = TREE_TYPE (decl);
+      tree taglist = TYPE_TAG_VALUES (t);
+      if (DECL_NAME (decl) == ELSE_VARIANT_NAME)
+	continue;
+      if (tagfields == NULL_TREE)
+	continue;
+      for ( ; tagfields != NULL_TREE && taglist != NULL_TREE;
+	   tagfields = TREE_CHAIN (tagfields), taglist = TREE_CHAIN (taglist))
+	{
+	  tree labellist = TREE_VALUE (taglist);
+	  for (; labellist; labellist = TREE_CHAIN (labellist))
+	    {
+	      int compat_error = 0;
+	      tree label_value = TREE_VALUE (labellist);
+	      if (TREE_CODE (label_value) == RANGE_EXPR)
+		{
+		  if (TREE_OPERAND (label_value, 0) != NULL_TREE)
+		    {
+		      if (!CH_COMPATIBLE (TREE_OPERAND (label_value, 0),
+					  TREE_TYPE (TREE_VALUE (tagfields)))
+			  || !CH_COMPATIBLE (TREE_OPERAND (label_value, 1),
+					     TREE_TYPE (TREE_VALUE (tagfields))))
+			compat_error = 1;
+		    }
+		}
+	      else if (TREE_CODE (label_value) == TYPE_DECL)
+		{
+		  if (!CH_COMPATIBLE (label_value,
+				      TREE_TYPE (TREE_VALUE (tagfields))))
+		    compat_error = 1;
+		}
+	      else if (TREE_CODE (label_value) == INTEGER_CST)
+		{
+		  if (!CH_COMPATIBLE (label_value,
+				      TREE_TYPE (TREE_VALUE (tagfields))))
+		    compat_error = 1;
+		}
+	      if (compat_error)
+		{
+		  if (TYPE_FIELDS (t) == NULL_TREE)
+		    error ("inconsistent modes between labels and tag field");
+		  else 
+		    error_with_decl (TYPE_FIELDS (t),
+				     "inconsistent modes between labels and tag field");
+		}
+	      nlabels++;
+	    }
+	}
+      if (tagfields != NULL_TREE)
+	error ("too few tag labels");
+      if (taglist != NULL_TREE)
+	error ("too many tag labels");
+    }
+
+  /* Check for duplicate label values.  */
+  label_value_array = (struct tree_pair *)alloca (nlabels * sizeof (struct tree_pair));
+  for (decl = first; decl; decl = TREE_CHAIN (decl))
+    {
+      tree t = TREE_TYPE (decl);
+       /* Only one tag (first case_label_list) supported, for now. */
+      tree labellist = TYPE_TAG_VALUES (t);
+      if (labellist)
+	labellist = TREE_VALUE (labellist);
+      
+      for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist))
+	{
+	  struct tree_pair p;
+	  
+	  tree x = TREE_VALUE (labellist);
+	  if (TREE_CODE (x) == RANGE_EXPR)
+	    {
+	      if (TREE_OPERAND (x, 0) != NULL_TREE)
+		{
+		  if (TREE_CODE (TREE_OPERAND (x, 0)) != INTEGER_CST)
+		    error ("case label lower limit is not a discrete constant expression");
+		  if (TREE_CODE (TREE_OPERAND (x, 1)) != INTEGER_CST)
+		    error ("case label upper limit is not a discrete constant expression");
+		}
+	      continue;
+	    }
+	  else if (TREE_CODE (x) == TYPE_DECL)
+	    continue;
+	  else if (TREE_CODE (x) == ERROR_MARK)
+	    continue;
+	  else if (TREE_CODE (x) != INTEGER_CST) /* <-- FIXME: what about CONST_DECLs? */
+	    {
+	      error ("case label must be a discrete constant expression");
+	      continue;
+	    }
+	  
+	  if (TREE_CODE (x) == CONST_DECL)
+	    x = DECL_INITIAL (x);
+	  if (TREE_CODE (x) != INTEGER_CST) abort ();
+	  p.value = x;
+	  p.decl = decl;
+	  if (p.decl == NULL_TREE)
+	    p.decl = TREE_VALUE (labellist);
+	  label_value_array[label_index++] = p;
+	}
+    }
+  if (errorcount == 0)
+    {
+      int limit;
+      qsort (label_value_array,
+	     label_index, sizeof (struct tree_pair), label_value_cmp);
+      limit = label_index - 1;
+      for (label_index = 0; label_index < limit; label_index++)
+	{
+	  if (tree_int_cst_equal (label_value_array[label_index].value, 
+				  label_value_array[label_index+1].value))
+	    {
+	      error_with_decl (label_value_array[label_index].decl,
+			       "variant label declared here...");
+	      error_with_decl (label_value_array[label_index+1].decl,
+			       "...is duplicated here");
+	    }
+	}
+    }
+  layout_type (utype);
+  return utype;
+}
+
+/* Convert a TREE_LIST of tag field names into a list of
+   field decls, found from FIXED_FIELDS, re-using the input list. */
+
+tree
+lookup_tag_fields (tag_field_names, fixed_fields)
+     tree tag_field_names;
+     tree fixed_fields;
+{
+  tree list;
+  for (list = tag_field_names; list != NULL_TREE; list = TREE_CHAIN (list))
+    {
+      tree decl = fixed_fields;
+      for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl))
+	{
+	  if (DECL_NAME (decl) == TREE_VALUE (list))
+	    {
+	      TREE_VALUE (list) = decl;
+	      break;
+	    }
+	}
+      if (decl == NULL_TREE)
+	{
+	  error ("no field (yet) for tag %s",
+		 IDENTIFIER_POINTER (TREE_VALUE (list)));
+	  TREE_VALUE (list) = error_mark_node;
+	}
+    }
+  return tag_field_names;
+}
+
+/* If non-NULL, TAGFIELDS is the tag fields for this variant record.
+   BODY is a TREE_LIST of (optlabels, fixed fields).
+   If non-null, VARIANTELSE is a fixed field for the else part of the
+   variant record.  */
+
+tree
+grok_chill_variantdefs (tagfields, body, variantelse)
+     tree tagfields, body, variantelse;
+{
+  tree t;
+  
+  t = make_chill_variants (tagfields, body, variantelse);
+  if (pass != 1)
+    t = layout_chill_variants (t);
+  return build_decl (FIELD_DECL, NULL_TREE, t);
+}
+
+/*
+  In pass 1, PARMS is a list of types (with attributes).
+  In pass 2, PARMS is a chain of PARM_DECLs.
+  */
+
+int
+start_chill_function (label, rtype, parms, exceptlist, attrs)
+     tree label, rtype, parms, exceptlist, attrs;
+{
+  tree decl, fndecl, type, result_type, func_type;
+  int nested = current_function_decl != 0;
+  if (pass == 1)
+    {
+      func_type
+	= build_chill_function_type (rtype, parms, exceptlist, 0);
+      fndecl = build_decl (FUNCTION_DECL, label, func_type);
+
+      save_decl (fndecl);
+      
+      /* Make the init_value nonzero so pushdecl knows this is not tentative.
+	 error_mark_node is replaced below (in poplevel) with the BLOCK.  */
+      DECL_INITIAL (fndecl) = error_mark_node;
+      
+      DECL_EXTERNAL (fndecl) = 0;
+      
+      /* This function exists in static storage.
+	 (This does not mean `static' in the C sense!)  */
+      TREE_STATIC (fndecl) = 1;
+
+      for (; attrs != NULL_TREE; attrs = TREE_CHAIN (attrs))
+	{
+	  if (TREE_VALUE (attrs) == ridpointers[RID_GENERAL])
+	    CH_DECL_GENERAL (fndecl) = 1;
+	  else if (TREE_VALUE (attrs) == ridpointers[RID_SIMPLE])
+	    CH_DECL_SIMPLE (fndecl) = 1;
+	  else if (TREE_VALUE (attrs) == ridpointers[RID_RECURSIVE])
+	    CH_DECL_RECURSIVE (fndecl) = 1;
+	  else if (TREE_VALUE (attrs) == ridpointers[RID_INLINE])
+	    DECL_INLINE (fndecl) = 1;
+	  else
+	    abort ();
+	}
+    }
+  else /* pass == 2 */
+    {
+      fndecl = get_next_decl (); 
+      if (DECL_NAME (fndecl) != label)
+	abort ();           /* outta sync - got wrong decl */
+      func_type = TREE_TYPE (fndecl);
+      if (TYPE_RAISES_EXCEPTIONS (func_type) != NULL_TREE)
+	{
+	  /* In this case we have to add 2 parameters. 
+	     See build_chill_function_type (pass == 1). */
+	  tree arg;
+        
+	  arg = make_node (PARM_DECL);
+	  DECL_ASSEMBLER_NAME (arg) = DECL_NAME (arg) = get_identifier (CALLER_FILE);
+	  DECL_IGNORED_P (arg) = 1;
+	  parms = chainon (parms, arg);
+        
+	  arg = make_node (PARM_DECL);
+	  DECL_ASSEMBLER_NAME (arg) = DECL_NAME (arg) = get_identifier (CALLER_LINE);
+	  DECL_IGNORED_P (arg) = 1;
+	  parms = chainon (parms, arg);
+	}
+    }
+
+  current_function_decl = fndecl;
+  result_type = TREE_TYPE (func_type);
+  if (CH_TYPE_NONVALUE_P (result_type))
+    error ("non-value mode may only returned by LOC");
+
+  pushlevel (1); /* Push parameters. */
+
+  if (pass == 2)
+    {
+      DECL_ARGUMENTS (fndecl) = parms;
+      for (decl = DECL_ARGUMENTS (fndecl), type = TYPE_ARG_TYPES (func_type);
+	   decl != NULL_TREE;
+	   decl = TREE_CHAIN (decl), type = TREE_CHAIN (type))
+	{
+	  /* check here that modes with the non-value property (like
+	     BUFFER's, EVENT's, ASSOCIATION's, ACCESS's, or TEXT's) only
+	     gets passed by LOC */
+	  tree argtype = TREE_VALUE (type);
+	  tree argattr = TREE_PURPOSE (type);
+
+	  if (TREE_CODE (argtype) == REFERENCE_TYPE)
+	    argtype = TREE_TYPE (argtype);
+
+	  if (TREE_CODE (argtype) != ERROR_MARK &&
+	      TREE_CODE_CLASS (TREE_CODE (argtype)) != 't')
+	    {
+	      error_with_decl (decl, "mode of `%s' is not a mode");
+	      TREE_VALUE (type) = error_mark_node;
+	    }
+
+	  if (CH_TYPE_NONVALUE_P (argtype) &&
+	      argattr != ridpointers[(int) RID_LOC])
+	    error_with_decl (decl, "`%s' may only be passed by LOC");
+	  TREE_TYPE (decl) = TREE_VALUE (type);
+	  DECL_ARG_TYPE (decl) = TREE_TYPE (decl);
+	  DECL_CONTEXT (decl) = fndecl;
+	  TREE_READONLY (decl) = TYPE_READONLY (argtype);
+	  layout_decl (decl, 0);
+	}
+
+      pushdecllist (DECL_ARGUMENTS (fndecl), 0);
+
+      DECL_RESULT (current_function_decl)
+	= build_decl (RESULT_DECL, NULL_TREE, result_type);
+
+#if 0
+      /* Write a record describing this function definition to the prototypes
+	 file (if requested).  */
+      gen_aux_info_record (fndecl, 1, 0, prototype);
+#endif
+
+      if (fndecl != global_function_decl || seen_action)
+	{
+	  /* Initialize the RTL code for the function.  */
+	  init_function_start (fndecl, input_filename, lineno);
+
+	  /* Set up parameters and prepare for return, for the function.  */
+	  expand_function_start (fndecl, 0);
+	}
+
+      if (!nested)
+	/* Allocate further tree nodes temporarily during compilation
+	   of this function only.  */
+	temporary_allocation ();
+
+      /* If this fcn was already referenced via a block-scope `extern' decl (or
+	 an implicit decl), propagate certain information about the usage. */
+      if (TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (current_function_decl)))
+	TREE_ADDRESSABLE (current_function_decl) = 1;
+    }
+      
+  /* Z.200 requires that formal parameter names be defined in
+     the same block as the procedure body.
+     We could do this by keeping boths sets of DECLs in the same
+     scope, but we would have to be careful to not merge the
+     two chains (e.g. DECL_ARGUEMENTS musr not contains locals).
+     Instead, we just make sure they have the same nesting_level. */
+  current_nesting_level--;
+  pushlevel (1); /* Push local variables. */
+
+  if (pass == 2 && (fndecl != global_function_decl || seen_action))
+    {
+      /* generate label for possible 'exit' */
+      expand_start_bindings (1);
+
+      result_never_set = 1;
+    }
+
+  if (TREE_CODE (result_type) == VOID_TYPE)
+    chill_result_decl = NULL_TREE;
+  else
+    {
+      /* We use the same name as the keyword.
+	 This makes it easy to print and change the RESULT from gdb. */
+      char *result_str = (ignore_case || ! special_UC) ? "result" : "RESULT";
+      if (pass == 2 && TREE_CODE (result_type) == ERROR_MARK)
+	TREE_TYPE (current_scope->remembered_decls) = result_type;
+      chill_result_decl = do_decl (get_identifier (result_str),
+				   result_type, 0, 0, 0, 0);
+      DECL_CONTEXT (chill_result_decl) = fndecl;
+    }
+
+  return 1;
+}
+
+/* For checking purpose added pname as new argument
+   MW Wed Oct 14 14:22:10 1992 */
+void
+finish_chill_function ()
+{
+  register tree fndecl = current_function_decl;
+  tree outer_function = decl_function_context (fndecl);
+  int nested;
+  if (outer_function == NULL_TREE && fndecl != global_function_decl)
+    outer_function = global_function_decl;
+  nested = current_function_decl != global_function_decl;
+  if (pass == 2 && (fndecl != global_function_decl || seen_action))
+    expand_end_bindings (getdecls (), 1, 0);
+    
+  /* pop out of function */
+  poplevel (1, 1, 0);
+  current_nesting_level++;
+  /* pop out of its parameters */
+  poplevel (1, 0, 1);
+
+  if (pass == 2)
+    {
+      /*  TREE_READONLY (fndecl) = 1;
+	  This caused &foo to be of type ptr-to-const-function which
+	  then got a warning when stored in a ptr-to-function variable. */
+
+      BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
+
+      /* Must mark the RESULT_DECL as being in this function.  */
+
+      DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
+
+      if (fndecl != global_function_decl || seen_action)
+	{
+	  /* Generate rtl for function exit.  */
+	  expand_function_end (input_filename, lineno, 0);
+
+	  /* So we can tell if jump_optimize sets it to 1.  */
+	  can_reach_end = 0;
+
+	  /* Run the optimizers and output assembler code for this function. */
+	  rest_of_compilation (fndecl);
+	}
+
+      if (DECL_SAVED_INSNS (fndecl) == 0 && ! nested)
+	{
+	  /* Stop pointing to the local nodes about to be freed.  */
+	  /* But DECL_INITIAL must remain nonzero so we know this
+	     was an actual function definition.  */
+	  /* For a nested function, this is done in pop_chill_function_context.  */
+	  DECL_INITIAL (fndecl) = error_mark_node;
+	  DECL_ARGUMENTS (fndecl) = 0;
+	}
+    }
+  current_function_decl = outer_function;
+}
+
+/* process SEIZE */
+
+/* Points to the head of the _DECLs read from seize files.  */
+#if 0
+static tree seized_decls;
+
+static tree processed_seize_files = 0;
+#endif
+
+void
+chill_seize (old_prefix, new_prefix, postfix)
+     tree old_prefix, new_prefix, postfix;
+{
+  if (pass == 1)
+    {
+      tree decl = build_alias_decl (old_prefix, new_prefix, postfix);
+      DECL_SEIZEFILE(decl) = use_seizefile_name;
+      save_decl (decl);
+    }
+  else /* pass == 2 */
+    {
+      /* Do nothing - get_next_decl automatically ignores ALIAS_DECLs */
+    }
+}
+#if 0
+
+/*
+ * output a debug dump of a scope structure
+ */
+void
+debug_scope (sp)
+     struct scope *sp;
+{
+  if (sp == (struct scope *)NULL)
+    {
+      fprintf (stderr, "null scope ptr\n");
+      return;
+    }
+  fprintf (stderr, "enclosing 0x%x ",           sp->enclosing);
+  fprintf (stderr, "next 0x%x ",                sp->next); 
+  fprintf (stderr, "remembered_decls 0x%x ",    sp->remembered_decls);
+  fprintf (stderr, "decls 0x%x\n",              sp->decls); 
+  fprintf (stderr, "shadowed 0x%x ",            sp->shadowed); 
+  fprintf (stderr, "blocks 0x%x ",              sp->blocks); 
+  fprintf (stderr, "this_block 0x%x ",          sp->this_block); 
+  fprintf (stderr, "level_chain 0x%x\n",        sp->level_chain);
+  fprintf (stderr, "module_flag %c ",           sp->module_flag ? 'T' : 'F');
+  fprintf (stderr, "first_child_module 0x%x ",  sp->first_child_module);
+  fprintf (stderr, "next_sibling_module 0x%x\n", sp->next_sibling_module);
+  if (sp->remembered_decls != NULL_TREE)
+    {
+      tree temp;
+      fprintf (stderr, "remembered_decl chain:\n");
+      for (temp = sp->remembered_decls; temp; temp = TREE_CHAIN (temp))
+	debug_tree (temp);
+    }
+}
+#endif
+
+static void
+save_decl (decl)
+     tree decl;
+{
+  if (current_function_decl != global_function_decl)
+    DECL_CONTEXT (decl) = current_function_decl;
+
+  TREE_CHAIN (decl) = current_scope->remembered_decls;
+  current_scope->remembered_decls = decl;
+#if 0
+  fprintf (stderr, "\n\nsave_decl 0x%x\n", decl);
+  debug_scope (current_scope);  /* ************* */
+#endif
+  set_nesting_level (decl, current_nesting_level);
+}
+
+static tree
+get_next_decl ()
+{
+  tree decl;
+  do
+    {
+      decl = current_scope->remembered_decls;
+      current_scope->remembered_decls = TREE_CHAIN (decl);
+      /* We ignore ALIAS_DECLs, because push_scope_decls
+	 can convert a single ALIAS_DECL representing 'SEIZE ALL'
+	 into one ALIAS_DECL for each seizeable name.
+	 This means we lose the nice one-to-one mapping
+         between pass 1 decls and pass 2 decls.
+	 (Perhaps ALIAS_DECLs should not be on the remembered_decls list.) */
+    } while (decl && TREE_CODE (decl) == ALIAS_DECL);
+  return decl;
+}
+
+/* At the end of pass 1, we reverse the chronological chain of scopes. */
+
+void
+switch_to_pass_2 ()
+{
+  extern int errorcount, sorrycount;
+  if (current_scope != &builtin_scope)
+    abort ();
+  last_scope = &builtin_scope;
+  builtin_scope.remembered_decls = nreverse (builtin_scope.remembered_decls);
+  write_grant_file ();
+
+#if 0
+  if (errorcount || sorrycount)
+    exit (FATAL_EXIT_CODE);
+  else
+#endif
+  if (grant_only_flag)
+    exit (SUCCESS_EXIT_CODE);
+
+  pass = 2;
+  module_number = 0;
+  next_module = &first_module;
+}
+
+/*
+ * Called during pass 2, when we're processing actions, to
+ * generate a temporary variable.  These don't need satisfying
+ * because they're compiler-generated and always declared
+ * before they're used.
+ */
+tree
+decl_temp1 (name, type, opt_static, opt_init, 
+	    opt_external, opt_public)
+     tree name, type;
+     int  opt_static;
+     tree opt_init;
+     int  opt_external, opt_public;
+{
+  int orig_pass = pass;           /* be cautious */
+  tree mydecl;
+
+  pass = 1;
+  mydecl = do_decl (name, type, opt_static, opt_static,
+		    opt_init, opt_external);
+
+  if (opt_public)
+    TREE_PUBLIC (mydecl) = 1;
+  pass = 2;
+  do_decl (name, type, opt_static, opt_static, opt_init, opt_external);
+
+  pass = orig_pass;
+  return mydecl;
+}
+
+/* True if we're reading a seizefile, but we haven't seen a SPEC MODULE yet.
+   For backwards compatibility, we treat declarations in such a context
+   as implicity granted. */
+
+tree
+set_module_name (name)
+     tree name;
+{
+  module_number++;
+  if (name == NULL_TREE)
+    {
+      /* NOTE: build_prefix_clause assumes a generated
+	 module starts with a '_'. */
+      char buf[20];
+      sprintf (buf, "_MODULE_%d", module_number);
+      name = get_identifier (buf);
+    }
+  return name;
+}
+
+tree
+push_module (name, is_spec_module)
+     tree name;
+     int is_spec_module;
+{ 
+  struct module *new_module;
+  if (pass == 1)
+    {
+      new_module = (struct module*) permalloc (sizeof (struct module));
+      new_module->prev_module = current_module;
+
+      *next_module = new_module;
+    }
+  else
+    {
+      new_module = *next_module;
+    }
+  next_module = &new_module->next_module;
+
+  new_module->procedure_seen = 0;
+  new_module->is_spec_module = is_spec_module;
+  new_module->name = name;
+  if (current_module)
+    new_module->prefix_name
+      = get_identifier3 (IDENTIFIER_POINTER (current_module->prefix_name),
+			 "__", IDENTIFIER_POINTER (name));
+  else
+    new_module->prefix_name = name;
+
+  new_module->granted_decls = NULL_TREE;
+  new_module->nesting_level = current_nesting_level + 1;
+
+  current_module = new_module;
+  current_module_nesting_level = new_module->nesting_level;
+  in_pseudo_module = name ? 0 : 1;
+
+  pushlevel (1);
+
+  current_scope->module_flag = 1;
+
+  *current_scope->enclosing->tail_child_module = current_scope;
+  current_scope->enclosing->tail_child_module
+    = &current_scope->next_sibling_module;
+
+  /* Rename the global function to have the same name as
+     the first named non-spec module. */
+  if (!is_spec_module
+      && IDENTIFIER_POINTER (name)[0] != '_'
+      && IDENTIFIER_POINTER (DECL_NAME (global_function_decl))[0] == '_')
+    {
+      tree fname = get_identifier3 ("", IDENTIFIER_POINTER (name), "_");
+      DECL_NAME (global_function_decl) = fname;
+      DECL_ASSEMBLER_NAME (global_function_decl) = fname;
+    }
+
+  return name;   /* may have generated a name */
+}
+/* Make a copy of the identifier NAME, replacing each '!' by '__'. */
+tree
+fix_identifier (name)
+     tree name;
+{
+  char *buf = (char*)alloca (2 * IDENTIFIER_LENGTH (name) + 1);
+  int fixed = 0;
+  register char *dptr = buf;
+  register char *sptr = IDENTIFIER_POINTER (name);
+  for (; *sptr; sptr++)
+    {
+      if (*sptr == '!')
+	{
+	  *dptr++ = '_';
+	  *dptr++ = '_';
+	  fixed++;
+	}
+      else
+	*dptr++ = *sptr;
+    }
+  *dptr = '\0';
+  return fixed ? get_identifier (buf) : name;
+}
+
+void
+find_granted_decls ()
+{
+  if (pass == 1)
+    {
+      /* Match each granted name to a granted decl. */
+
+      tree alias = current_module->granted_decls;
+      tree next_alias, decl;
+      /* This is an O(M*N) algorithm.  FIXME! */
+      for (; alias; alias = next_alias)
+	{
+	  int found = 0;
+	  next_alias = TREE_CHAIN (alias);
+	  for (decl = current_scope->remembered_decls;
+	       decl; decl = TREE_CHAIN (decl))
+	    {
+	      tree new_name = (! DECL_NAME (decl)) ? NULL_TREE :
+		              decl_check_rename (alias, 
+						 DECL_NAME (decl));
+
+	      if (!new_name)
+		continue;
+	      /* A Seized declaration is not grantable. */
+	      if (TREE_CODE (decl) == ALIAS_DECL && !CH_DECL_GRANTED (decl))
+		continue;
+	      found = 1;
+	      if (global_bindings_p ())
+		TREE_PUBLIC (decl) = 1;
+	      if (DECL_ASSEMBLER_NAME (decl) == NULL_TREE)
+		DECL_ASSEMBLER_NAME (decl) = fix_identifier (new_name);
+	      if (DECL_POSTFIX_ALL (alias))
+		{
+		  tree new_alias
+		    = build_alias_decl (NULL_TREE, NULL_TREE, new_name);
+		  TREE_CHAIN (new_alias) = TREE_CHAIN (alias);
+		  TREE_CHAIN (alias) = new_alias;
+		  DECL_ABSTRACT_ORIGIN (new_alias) = decl;
+		  DECL_SOURCE_LINE (new_alias) = 0;
+		  DECL_SEIZEFILE (new_alias) = DECL_SEIZEFILE (alias);
+		}
+	      else
+		{
+		  DECL_ABSTRACT_ORIGIN (alias) = decl;
+		  break;
+		}
+	    }
+	  if (!found)
+	    {
+	      error_with_decl (alias, "Nothing named `%s' to grant.");
+	      DECL_ABSTRACT_ORIGIN (alias) = error_mark_node;
+	    }
+	}
+    }
+}
+
+void
+pop_module ()
+{
+  tree decl;
+  struct scope *module_scope = current_scope;
+
+  poplevel (0, 0, 0);
+
+  if (pass == 1)
+    {
+      /* Write out the grant file. */
+      if (!current_module->is_spec_module)
+	{
+	  /* After reversal, TREE_CHAIN (last_old_decl) is the oldest
+	     decl of the current module. */
+	  write_spec_module (module_scope->remembered_decls,
+			     current_module->granted_decls);
+	}
+
+      /* Move the granted decls into the enclosing scope. */
+      if (current_scope == global_scope)
+	{
+	  tree next_decl;
+	  for (decl = current_module->granted_decls; decl; decl = next_decl)
+	    {
+	      tree name = DECL_NAME (decl);
+	      next_decl = TREE_CHAIN (decl);
+	      if (name != NULL_TREE)
+		{
+		  tree old_decl = IDENTIFIER_OUTER_VALUE (name);
+		  set_nesting_level (decl, current_nesting_level);
+		  if (old_decl != NULL_TREE)
+		    {
+		      pedwarn_with_decl (decl, "duplicate grant for `%s'");
+		      pedwarn_with_decl (old_decl, "previous grant for `%s'");
+		      TREE_CHAIN (decl) = TREE_CHAIN (old_decl);
+		      TREE_CHAIN (old_decl) = decl;
+		    }
+		  else
+		    {
+		      TREE_CHAIN (decl) = outer_decls;
+		      outer_decls = decl;
+		      IDENTIFIER_OUTER_VALUE (name) = decl;
+		    }
+		}
+	    }
+	}
+      else
+	current_scope->granted_decls = chainon (current_module->granted_decls,
+						current_scope->granted_decls);
+    }
+
+  chill_check_no_handlers (); /* Sanity test */
+  current_module = current_module->prev_module;
+  current_module_nesting_level = current_module ?
+    current_module->nesting_level : 0;
+  in_pseudo_module = 0;
+}
+
+/* Nonzero if we are currently in the global binding level.  */
+
+int
+global_bindings_p ()
+{
+  /* We return -1 here for the sake of variable_size() in ../stor-layout.c. */
+  return (current_function_decl == NULL_TREE 
+	  || current_function_decl == global_function_decl) ? -1 : 0;
+}
+
+/* Nonzero if the current level needs to have a BLOCK made.  */
+
+int
+kept_level_p ()
+{
+  return current_scope->decls != 0;
+}
+
+/* Make DECL visible.
+   Save any existing definition.
+   Check redefinitions at the same level.
+   Suppress error messages if QUIET is true. */
+
+void
+proclaim_decl (decl, quiet)
+     tree decl;
+     int quiet;
+{
+  tree name = DECL_NAME (decl);
+  if (name)
+    {
+      tree old_decl = IDENTIFIER_LOCAL_VALUE (name);
+      if (old_decl == NULL) ; /* No duplication */
+      else if (DECL_NESTING_LEVEL (old_decl) != current_nesting_level)
+	{
+	  /* Record for restoration when this binding level ends.  */
+	  current_scope->shadowed
+	    = tree_cons (name, old_decl, current_scope->shadowed);
+	}
+      else if (DECL_WEAK_NAME (decl))
+	return;
+      else if (!DECL_WEAK_NAME (old_decl))
+	{
+	  tree base_decl = decl, base_old_decl = old_decl;
+	  while (TREE_CODE (base_decl) == ALIAS_DECL)
+	    base_decl = DECL_ABSTRACT_ORIGIN (base_decl);
+	  while (TREE_CODE (base_old_decl) == ALIAS_DECL)
+	    base_old_decl = DECL_ABSTRACT_ORIGIN (base_old_decl);
+	  /* Note that duplicate definitions are allowed for set elements
+	     of similar set modes.  See Z200 (1988) 12.2.2.
+	     However, if the types are identical, we are defining the
+	     same name multiple times in the same SET, which is naughty. */
+	  if (!quiet && base_decl != base_old_decl)
+	    {
+	      if (TREE_CODE (base_decl) != CONST_DECL
+		  || TREE_CODE (base_old_decl) != CONST_DECL
+		  || !CH_DECL_ENUM (base_decl)
+		  || !CH_DECL_ENUM (base_old_decl)
+		  || TREE_TYPE (base_decl) == TREE_TYPE (base_old_decl)
+		  || !CH_SIMILAR (TREE_TYPE (base_decl),
+				  TREE_TYPE(base_old_decl)))
+		{
+		  error_with_decl (decl, "duplicate definition `%s'");
+		  error_with_decl (old_decl, "previous definition of `%s'");
+		}
+	    }
+	}
+      IDENTIFIER_LOCAL_VALUE (name) = decl;
+    }
+  /* Should be redundant most of the time ... */
+  set_nesting_level (decl, current_nesting_level);
+}
+
+/* Return tree_cons (NULL_TREE, ELEMENT, LIST) unless ELEMENT
+   is already in LIST, in which case return LIST. */
+
+static tree
+maybe_acons (element, list)
+     tree element, list;
+{
+  tree pair;
+  for (pair = list; pair; pair = TREE_CHAIN (pair))
+    if (element == TREE_VALUE (pair))
+      return list;
+  return tree_cons (NULL_TREE, element, list);
+}
+
+struct path
+{
+  struct path *prev;
+  tree node;
+};
+
+/* Look for implied types (enumeral types) implied by TYPE (a decl or type).
+   Add these to list.
+   Use old_path to guard against cycles. */
+
+tree
+find_implied_types (type, old_path, list)
+     tree type;
+     struct path *old_path;
+     tree list;
+{
+  struct path path[1], *link;
+  if (type == NULL_TREE)
+    return list;
+  path[0].prev = old_path;
+  path[0].node = type;
+
+  /* Check for a cycle.  Something more clever might be appropriate.  FIXME? */
+  for (link = old_path; link; link = link->prev)
+    if (link->node == type)
+      return list;
+
+  switch (TREE_CODE (type))
+    {
+    case ENUMERAL_TYPE:
+      return maybe_acons (type, list);
+    case LANG_TYPE:
+    case POINTER_TYPE:
+    case REFERENCE_TYPE:
+    case INTEGER_TYPE:
+      return find_implied_types (TREE_TYPE (type), path, list);
+    case SET_TYPE:
+      return find_implied_types (TYPE_DOMAIN (type), path, list);
+    case FUNCTION_TYPE:
+#if 0
+    case PROCESS_TYPE:
+#endif
+      { tree t;
+	list = find_implied_types (TREE_TYPE (type), path, list);
+	for (t = TYPE_ARG_TYPES (type); t != NULL_TREE; t = TREE_CHAIN (t))
+	  list = find_implied_types (TREE_VALUE (t), path, list);
+	return list;
+      }
+    case ARRAY_TYPE:
+      list = find_implied_types (TYPE_DOMAIN (type), path, list);
+      return find_implied_types (TREE_TYPE (type), path, list);
+    case RECORD_TYPE:
+    case UNION_TYPE:
+      { tree fields;
+	for (fields = TYPE_FIELDS (type); fields != NULL_TREE;
+	     fields = TREE_CHAIN (fields))
+	  list = find_implied_types (TREE_TYPE (fields), path, list);
+	return list;
+      }
+
+    case IDENTIFIER_NODE:
+      return find_implied_types (lookup_name (type), path, list);
+      break;
+    case ALIAS_DECL:
+      return find_implied_types (DECL_ABSTRACT_ORIGIN (type), path, list);
+    case VAR_DECL:
+    case FUNCTION_DECL:
+    case TYPE_DECL:
+      return find_implied_types (TREE_TYPE (type), path, list);
+    default:
+      return list;
+    }
+}
+
+/* Make declarations in current scope visible.
+   Also, expand SEIZEs, and make correspondong ALIAS_DECLs visible. */
+
+static void
+push_scope_decls (quiet)
+     int quiet;  /* If 1, we're pre-scanning, so suppress errors. */
+{
+  tree decl;
+
+  /* First make everything except 'SEIZE ALL' names visible, before
+     handling 'SEIZE ALL'.  (This makes it easier to check 'seizable'). */
+  for (decl = current_scope->remembered_decls; decl; decl = TREE_CHAIN (decl))
+    {
+      if (TREE_CODE (decl) == ALIAS_DECL)
+	{
+	  if (DECL_POSTFIX_ALL (decl))
+	    continue;
+	  if (DECL_ABSTRACT_ORIGIN (decl) == NULL_TREE)
+	    {
+	      tree val = lookup_name_for_seizing (decl);
+	      if (val == NULL_TREE)
+		{
+		  error_with_file_and_line
+		    (DECL_SOURCE_FILE (decl), DECL_SOURCE_LINE (decl),
+		     "cannot SEIZE `%s'",
+		     IDENTIFIER_POINTER (DECL_OLD_NAME (decl)));
+		  val = error_mark_node;
+		}
+	      DECL_ABSTRACT_ORIGIN (decl) = val;
+	    }
+	}
+      proclaim_decl (decl, quiet);
+    }
+
+  pushdecllist (current_scope->granted_decls, quiet);
+
+  /* Now handle SEIZE ALLs. */
+  for (decl = current_scope->remembered_decls; decl; )
+    {
+      tree next_decl = TREE_CHAIN (decl);
+      if (TREE_CODE (decl) == ALIAS_DECL
+	  && DECL_ABSTRACT_ORIGIN (decl) == NULL_TREE
+	  && DECL_POSTFIX_ALL (decl))
+	{
+	  /* We saw a "SEIZE ALL".  Replace it be a SEIZE for each
+	     declaration visible in the surrounding scope.
+	     Note that this complicates get_next_decl(). */
+	  tree candidate;
+	  tree last_new_alias = decl;
+	  DECL_ABSTRACT_ORIGIN (decl) = error_mark_node;
+	  if (current_scope->enclosing == global_scope)
+	    candidate = outer_decls;
+	  else
+	    candidate = current_scope->enclosing->decls;
+	  for ( ; candidate; candidate = TREE_CHAIN (candidate))
+	    {
+	      tree seizename = DECL_NAME (candidate);
+	      tree new_name;
+	      tree new_alias;
+	      if (!seizename)
+		continue;
+	      new_name = decl_check_rename (decl, seizename);
+	      if (!new_name)
+		continue;
+
+	      /* Check if candidate is seizable. */
+	      if (lookup_name (new_name) != NULL_TREE)
+		continue;
+
+	      new_alias = build_alias_decl (NULL_TREE,NULL_TREE, new_name);
+	      TREE_CHAIN (new_alias) = TREE_CHAIN (last_new_alias);
+	      TREE_CHAIN (last_new_alias) = new_alias;
+	      last_new_alias = new_alias;
+	      DECL_ABSTRACT_ORIGIN (new_alias) = candidate;
+	      DECL_SOURCE_LINE (new_alias) = 0;
+
+	      proclaim_decl (new_alias, quiet);
+	    }
+	}
+      decl = next_decl;
+    }
+
+  /* Link current_scope->remembered_decls at the head of the
+     current_scope->decls list (just like pushdecllist, but
+     without calling proclaim_decl, since we've already done that). */
+  if ((decl = current_scope->remembered_decls) != NULL_TREE)
+    {
+      while (TREE_CHAIN (decl) != NULL_TREE)
+	decl = TREE_CHAIN (decl);
+      TREE_CHAIN (decl) = current_scope->decls;
+      current_scope->decls = current_scope->remembered_decls;
+    }
+}
+
+static void
+pop_scope_decls (decls_limit, shadowed_limit)
+     tree decls_limit, shadowed_limit;
+{
+  /* Remove the temporary bindings we made. */
+  tree link = current_scope->shadowed;
+  tree decl = current_scope->decls;
+  if (decl != decls_limit)
+    {
+      while (decl != decls_limit)
+	{
+	  tree next = TREE_CHAIN (decl);
+	  if (DECL_NAME (decl))
+	    {
+	      /* If the ident. was used or addressed via a local extern decl,
+		 don't forget that fact.  */
+	      if (DECL_EXTERNAL (decl))
+		{
+		  if (TREE_USED (decl))
+		    TREE_USED (DECL_NAME (decl)) = 1;
+		  if (TREE_ADDRESSABLE (decl))
+		    TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (decl)) = 1;
+		}
+	      IDENTIFIER_LOCAL_VALUE (DECL_NAME (decl)) = 0;
+	    }
+	  if (next == decls_limit)
+	    {
+	      TREE_CHAIN (decl) = NULL_TREE;
+	      break;
+	    }
+	  decl = next;
+	}
+      current_scope->decls = decls_limit;
+    }
+  
+  /* Restore all name-meanings of the outer levels
+     that were shadowed by this level.  */
+  for ( ; link != shadowed_limit; link = TREE_CHAIN (link))
+    IDENTIFIER_LOCAL_VALUE (TREE_PURPOSE (link)) = TREE_VALUE (link);
+  current_scope->shadowed = shadowed_limit;
+}
+
+/* Return list of weak names (as ALIAS_DECLs) implied by IMPLIED_TYPES. */
+
+static tree
+build_implied_names (implied_types)
+     tree implied_types;
+{
+  tree aliases = NULL_TREE;
+
+  for ( ; implied_types; implied_types = TREE_CHAIN (implied_types))
+    {
+      tree enum_type = TREE_VALUE (implied_types);
+      tree link = TYPE_VALUES (enum_type);
+      if (TREE_CODE (enum_type) != ENUMERAL_TYPE)
+	abort ();
+      
+      for ( ; link; link = TREE_CHAIN (link))
+	{
+	  /* We don't handle renaming/prefixes (Blue Book p 163) FIXME */
+	  /* Note that before enum_type is laid out, TREE_VALUE (link)
+	     is a CONST_DECL, while after it is laid out,
+	     TREE_VALUE (link) is an INTEGER_CST.  Either works. */
+	  tree alias
+	    = build_alias_decl (NULL_TREE, NULL_TREE, TREE_PURPOSE (link));
+	  DECL_ABSTRACT_ORIGIN (alias) = TREE_VALUE (link);
+	  DECL_WEAK_NAME (alias) = 1;
+	  TREE_CHAIN (alias) = aliases;
+	  aliases = alias;
+	  /* Strictlt speaking, we should have a pointer from the alias
+	     to the decl, so we can make sure that the alias is only
+	     visible when the decl is.  FIXME */
+	}
+    }
+  return aliases;
+}
+
+static void
+bind_sub_modules (do_weak)
+     int do_weak;
+{
+  tree decl;
+  int save_module_nesting_level = current_module_nesting_level;
+  struct scope *saved_scope = current_scope;
+  struct scope *nested_module = current_scope->first_child_module;
+
+  while (nested_module != NULL)
+    {
+      tree saved_shadowed = nested_module->shadowed;
+      tree saved_decls = nested_module->decls;
+      current_nesting_level++;
+      current_scope = nested_module;
+      current_module_nesting_level = current_nesting_level;
+      if (do_weak == 0)
+	push_scope_decls (1);
+      else
+	{
+	  tree implied_types = NULL_TREE;
+	  /* Push weak names implied by decls in current_scope. */
+	  for (decl = current_scope->remembered_decls;
+	       decl; decl = TREE_CHAIN (decl))
+	    if (TREE_CODE (decl) == ALIAS_DECL)
+	      implied_types = find_implied_types (decl, NULL, implied_types);
+	  for (decl = current_scope->granted_decls;
+	       decl; decl = TREE_CHAIN (decl))
+	    implied_types = find_implied_types (decl, NULL, implied_types);
+	  current_scope->weak_decls = build_implied_names (implied_types);
+	  pushdecllist (current_scope->weak_decls, 1);
+	}
+
+      bind_sub_modules (do_weak);
+      for (decl = current_scope->remembered_decls;
+	   decl; decl = TREE_CHAIN (decl))
+	satisfy_decl (decl, 1);
+      pop_scope_decls (saved_decls, saved_shadowed);
+      current_nesting_level--;
+      nested_module = nested_module->next_sibling_module;
+    }
+
+  current_scope = saved_scope;
+  current_module_nesting_level = save_module_nesting_level;
+}
+
+/* Enter a new binding level.
+   If two_pass==0, assume we are called from non-Chill-specific parts
+   of the compiler.  These parts assume a single pass.
+   If two_pass==1,  we're called from Chill parts of the compiler.
+*/
+
+void
+pushlevel (two_pass)
+     int two_pass;
+{
+  register struct scope *newlevel;
+
+  current_nesting_level++;
+  if (!two_pass)
+    {
+      newlevel = (struct scope *)xmalloc (sizeof(struct scope));
+      *newlevel = clear_scope;
+      newlevel->enclosing = current_scope;
+      current_scope = newlevel;
+    }
+  else if (pass < 2)
+    {
+      newlevel = (struct scope *)permalloc (sizeof(struct scope));
+      *newlevel = clear_scope;
+      newlevel->tail_child_module = &newlevel->first_child_module;
+      newlevel->enclosing = current_scope;
+      current_scope = newlevel;
+      last_scope->next = newlevel;
+      last_scope = newlevel;
+    }
+  else /* pass == 2 */
+    {
+      tree decl;
+      newlevel = current_scope = last_scope = last_scope->next;
+
+      push_scope_decls (0);
+      pushdecllist (current_scope->weak_decls, 0);
+
+      /* If this is not a module scope, scan ahead for locally nested
+	 modules.  (If this is a module, that's already done.) */
+      if (!current_scope->module_flag)
+	{
+	  bind_sub_modules (0);
+	  bind_sub_modules (1);
+	}
+
+      for (decl = current_scope->remembered_decls;
+	   decl; decl = TREE_CHAIN (decl))
+	satisfy_decl (decl, 0);
+    }
+
+  /* Add this level to the front of the chain (stack) of levels that
+     are active.  */
+
+  newlevel->level_chain = current_scope;
+  current_scope = newlevel;
+
+  newlevel->two_pass = two_pass;
+}
+
+/* Exit a binding level.
+   Pop the level off, and restore the state of the identifier-decl mappings
+   that were in effect when this level was entered.
+
+   If KEEP is nonzero, this level had explicit declarations, so
+   and create a "block" (a BLOCK node) for the level
+   to record its declarations and subblocks for symbol table output.
+
+   If FUNCTIONBODY is nonzero, this level is the body of a function,
+   so create a block as if KEEP were set and also clear out all
+   label names.
+
+   If REVERSE is nonzero, reverse the order of decls before putting
+   them into the BLOCK.  */
+
+tree
+poplevel (keep, reverse, functionbody)
+     int keep;
+     int reverse;
+     int functionbody;
+{
+  register tree link;
+  /* The chain of decls was accumulated in reverse order.
+     Put it into forward order, just for cleanliness.  */
+  tree decls;
+  tree subblocks;
+  tree block = 0;
+  tree decl;
+  int block_previously_created;
+
+  if (current_scope == NULL)
+    return error_mark_node;
+
+  subblocks = current_scope->blocks;
+
+  /* Get the decls in the order they were written.
+     Usually current_scope->decls is in reverse order.
+     But parameter decls were previously put in forward order.  */
+
+  if (reverse)
+    current_scope->decls
+      = decls = nreverse (current_scope->decls);
+  else
+    decls = current_scope->decls;
+
+  if (pass == 2)
+    {
+      /* Output any nested inline functions within this block
+	 if they weren't already output.  */
+
+      for (decl = decls; decl; decl = TREE_CHAIN (decl))
+	if (TREE_CODE (decl) == FUNCTION_DECL
+	    && ! TREE_ASM_WRITTEN (decl)
+	    && DECL_INITIAL (decl) != 0
+	    && TREE_ADDRESSABLE (decl))
+	  {
+	    /* If this decl was copied from a file-scope decl
+	       on account of a block-scope extern decl,
+	       propagate TREE_ADDRESSABLE to the file-scope decl.  */
+	    if (DECL_ABSTRACT_ORIGIN (decl) != 0)
+	      TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1;
+	    else
+	      {
+		push_function_context ();
+		output_inline_function (decl);
+		pop_function_context ();
+	      }
+	  }
+
+      /* Clear out the meanings of the local variables of this level.  */
+      pop_scope_decls (NULL_TREE, NULL_TREE);
+
+      /* If there were any declarations or structure tags in that level,
+	 or if this level is a function body,
+	 create a BLOCK to record them for the life of this function.  */
+
+      block = 0;
+      block_previously_created = (current_scope->this_block != 0);
+      if (block_previously_created)
+	block = current_scope->this_block;
+      else if (keep || functionbody)
+	block = make_node (BLOCK);
+      if (block != 0)
+	{
+	  tree *ptr;
+	  BLOCK_VARS (block) = decls;
+
+	  /* Splice out ALIAS_DECL and LABEL_DECLs,
+	     since instantiate_decls can't handle them. */
+	  for (ptr = &BLOCK_VARS (block); *ptr; )
+	    {
+	      decl = *ptr;
+	      if (TREE_CODE (decl) == ALIAS_DECL
+		  || TREE_CODE (decl) == LABEL_DECL)
+		*ptr = TREE_CHAIN (decl);
+	      else
+		ptr = &TREE_CHAIN(*ptr);
+	    }
+
+	  BLOCK_SUBBLOCKS (block) = subblocks;
+	  remember_end_note (block);
+	}
+
+      /* In each subblock, record that this is its superior.  */
+
+      for (link = subblocks; link; link = TREE_CHAIN (link))
+	BLOCK_SUPERCONTEXT (link) = block;
+
+    }
+
+  /* If the level being exited is the top level of a function,
+     check over all the labels, and clear out the current
+     (function local) meanings of their names.  */
+
+  if (pass == 2 && functionbody)
+    {
+      /* If this is the top level block of a function,
+	 the vars are the function's parameters.
+	 Don't leave them in the BLOCK because they are
+	 found in the FUNCTION_DECL instead.  */
+
+      BLOCK_VARS (block) = 0;
+
+#if 0
+      /* Clear out the definitions of all label names,
+	 since their scopes end here,
+	 and add them to BLOCK_VARS.  */
+
+      for (link = named_labels; link; link = TREE_CHAIN (link))
+	{
+	  register tree label = TREE_VALUE (link);
+
+	  if (DECL_INITIAL (label) == 0)
+	    {
+	      error_with_decl (label, "label `%s' used but not defined");
+	      /* Avoid crashing later.  */
+	      define_label (input_filename, lineno,
+			    DECL_NAME (label));
+	    }
+	  else if (warn_unused && !TREE_USED (label))
+	    warning_with_decl (label, "label `%s' defined but not used");
+	  IDENTIFIER_LABEL_VALUE (DECL_NAME (label)) = 0;
+
+	  /* Put the labels into the "variables" of the
+	     top-level block, so debugger can see them.  */
+	  TREE_CHAIN (label) = BLOCK_VARS (block);
+	  BLOCK_VARS (block) = label;
+	}
+#endif
+    }
+
+  if (pass < 2)
+    {
+      current_scope->remembered_decls
+	= nreverse (current_scope->remembered_decls);
+      current_scope->granted_decls = nreverse (current_scope->granted_decls);
+    }
+
+  current_scope = current_scope->enclosing;
+  current_nesting_level--;
+
+  if (pass < 2)
+    {
+      return NULL_TREE;
+    }
+
+  /* Dispose of the block that we just made inside some higher level.  */
+  if (functionbody)
+    DECL_INITIAL (current_function_decl) = block;
+  else if (block)
+    {
+      if (!block_previously_created)
+        current_scope->blocks
+          = chainon (current_scope->blocks, block);
+    }
+  /* If we did not make a block for the level just exited,
+     any blocks made for inner levels
+     (since they cannot be recorded as subblocks in that level)
+     must be carried forward so they will later become subblocks
+     of something else.  */
+  else if (subblocks)
+    current_scope->blocks
+      = chainon (current_scope->blocks, subblocks);
+
+  if (block)
+    TREE_USED (block) = 1;
+  return block;
+}
+
+/* Delete the node BLOCK from the current binding level.
+   This is used for the block inside a stmt expr ({...})
+   so that the block can be reinserted where appropriate.  */
+
+void
+delete_block (block)
+     tree block;
+{
+  tree t;
+  if (current_scope->blocks == block)
+    current_scope->blocks = TREE_CHAIN (block);
+  for (t = current_scope->blocks; t;)
+    {
+      if (TREE_CHAIN (t) == block)
+	TREE_CHAIN (t) = TREE_CHAIN (block);
+      else
+	t = TREE_CHAIN (t);
+    }
+  TREE_CHAIN (block) = NULL;
+  /* Clear TREE_USED which is always set by poplevel.
+     The flag is set again if insert_block is called.  */
+  TREE_USED (block) = 0;
+}
+
+/* Insert BLOCK at the end of the list of subblocks of the
+   current binding level.  This is used when a BIND_EXPR is expanded,
+   to handle the BLOCK node inside teh BIND_EXPR.  */
+
+void
+insert_block (block)
+     tree block;
+{
+  TREE_USED (block) = 1;
+  current_scope->blocks
+    = chainon (current_scope->blocks, block);
+}
+
+/* Set the BLOCK node for the innermost scope
+   (the one we are currently in).  */
+
+void
+set_block (block)
+     register tree block;
+{
+  current_scope->this_block = block;
+}
+
+/* Record a decl-node X as belonging to the current lexical scope.
+   Check for errors (such as an incompatible declaration for the same
+   name already seen in the same scope).
+
+   Returns either X or an old decl for the same name.
+   If an old decl is returned, it may have been smashed
+   to agree with what X says. */
+
+tree
+pushdecl (x)
+     tree x;
+{
+  register tree t;
+  register tree name = DECL_NAME (x);
+  register struct scope *b = current_scope;
+
+  DECL_CONTEXT (x) = current_function_decl;
+  /* A local extern declaration for a function doesn't constitute nesting.
+     A local auto declaration does, since it's a forward decl
+     for a nested function coming later.  */
+  if (TREE_CODE (x) == FUNCTION_DECL && DECL_INITIAL (x) == 0
+      && DECL_EXTERNAL (x))
+    DECL_CONTEXT (x) = 0;
+
+  if (name)
+    proclaim_decl (x, 0);
+
+  if (TREE_CODE (x) == TYPE_DECL && DECL_SOURCE_LINE (x) == 0
+      && TYPE_NAME (TREE_TYPE (x)) == 0)
+    TYPE_NAME (TREE_TYPE (x)) = x;
+
+  /* Put decls on list in reverse order.
+     We will reverse them later if necessary.  */
+  TREE_CHAIN (x) = b->decls;
+  b->decls = x;
+
+  return x;
+}
+
+/* Make DECLS (a chain of decls) visible in the current_scope. */
+
+static void
+pushdecllist (decls, quiet)
+     tree decls;
+     int quiet;
+{
+  tree last = NULL_TREE, decl;
+
+  for (decl = decls; decl != NULL_TREE; 
+       last = decl, decl = TREE_CHAIN (decl))
+    {
+      proclaim_decl (decl, quiet);
+    }
+
+  if (last)
+    {
+      TREE_CHAIN (last) = current_scope->decls;
+      current_scope->decls = decls;
+    }
+}
+
+/* Like pushdecl, only it places X in GLOBAL_SCOPE, if appropriate.  */
+
+tree
+pushdecl_top_level (x)
+     tree x;
+{
+  register tree t;
+  register struct scope *b = current_scope;
+
+  current_scope = global_scope;
+  t = pushdecl (x);
+  current_scope = b;
+  return t;
+}
+
+/* Define a label, specifying the location in the source file.
+   Return the LABEL_DECL node for the label, if the definition is valid.
+   Otherwise return 0.  */
+
+tree
+define_label (filename, line, name)
+     char *filename;
+     int line;
+     tree name;
+{
+  tree decl;
+
+  if (pass == 1)
+    {
+      decl = build_decl (LABEL_DECL, name, void_type_node);
+
+      /* A label not explicitly declared must be local to where it's ref'd.  */
+      DECL_CONTEXT (decl) = current_function_decl;
+
+      DECL_MODE (decl) = VOIDmode;
+
+      /* Say where one reference is to the label,
+	 for the sake of the error if it is not defined.  */
+      DECL_SOURCE_LINE (decl) = line;
+      DECL_SOURCE_FILE (decl) = filename;
+
+      /* Mark label as having been defined.  */
+      DECL_INITIAL (decl) = error_mark_node;
+
+      DECL_ACTION_NESTING_LEVEL (decl) = action_nesting_level;
+
+      save_decl (decl);
+    }
+  else
+    {
+      decl = get_next_decl ();
+      /* Make sure every label has an rtx.  */
+
+      label_rtx (decl);
+      expand_label (decl);
+    }
+  return decl;
+}
+
+/* Return the list of declarations of the current level.
+   Note that this list is in reverse order unless/until
+   you nreverse it; and when you do nreverse it, you must
+   store the result back using `storedecls' or you will lose.  */
+
+tree
+getdecls ()
+{
+  /* This is a kludge, so that dbxout_init can get the predefined types,
+     which are in the builtin_scope, though when it is called,
+     the current_scope is the global_scope.. */
+  if (current_scope == global_scope)
+    return builtin_scope.decls;
+  return current_scope->decls;
+}
+
+#if 0
+/* Store the list of declarations of the current level.
+   This is done for the parameter declarations of a function being defined,
+   after they are modified in the light of any missing parameters.  */
+
+static void
+storedecls (decls)
+     tree decls;
+{
+  current_scope->decls = decls;
+}
+#endif
+
+/* Look up NAME in the current binding level and its superiors
+   in the namespace of variables, functions and typedefs.
+   Return a ..._DECL node of some kind representing its definition,
+   or return 0 if it is undefined.  */
+
+tree
+lookup_name (name)
+     tree name;
+{
+  register tree val = IDENTIFIER_LOCAL_VALUE (name);
+
+  if (val == NULL_TREE)
+    return NULL_TREE;
+  if (TREE_CODE_CLASS (TREE_CODE (val)) == 'c')
+    return val;
+  if (DECL_NESTING_LEVEL (val) > BUILTIN_NESTING_LEVEL
+      && DECL_NESTING_LEVEL (val) < current_module_nesting_level)
+    {
+      return NULL_TREE;
+    }
+  while (TREE_CODE (val) == ALIAS_DECL)
+    {
+      val = DECL_ABSTRACT_ORIGIN (val);
+      if (TREE_CODE (val) == ERROR_MARK)
+	return NULL_TREE;
+    }
+  if (TREE_CODE (val) == BASED_DECL)
+    {
+      return build_chill_indirect_ref (DECL_ABSTRACT_ORIGIN (val),
+				       TREE_TYPE (val), 1);
+    }
+  if (TREE_CODE (val) == WITH_DECL)
+    return build_component_ref (DECL_ABSTRACT_ORIGIN (val), DECL_NAME (val));
+  return val;
+}
+
+/* Similar to `lookup_name' but look only at current binding level.  */
+
+tree
+lookup_name_current_level (name)
+     tree name;
+{
+  register tree val = IDENTIFIER_LOCAL_VALUE (name);
+  if (val && DECL_NESTING_LEVEL (val) == current_nesting_level)
+    return val;
+  return NULL_TREE;
+}
+
+tree
+lookup_name_for_seizing (seize_decl)
+     tree seize_decl;
+{
+  tree name = DECL_OLD_NAME (seize_decl);
+  register tree val;
+  val = IDENTIFIER_LOCAL_VALUE (name);
+  if (val == NULL_TREE || DECL_NESTING_LEVEL (val) == BUILTIN_NESTING_LEVEL)
+    {
+      val = IDENTIFIER_OUTER_VALUE (name);
+      if (val == NULL_TREE)
+	return NULL_TREE;
+      if (TREE_CHAIN (val) && DECL_NAME (TREE_CHAIN (val)) == name)
+	{ /* More than one decl with the same name has been granted
+	     into the same global scope.  Pick the one (we hope) that
+	     came from a seizefile the matches the most recent
+	     seizefile (as given by DECL_SEIZEFILE (seize_decl).) */
+	  tree d, best = NULL_TREE;
+	  for (d = val; d != NULL_TREE && DECL_NAME (d) == name;
+	       d = TREE_CHAIN (d))
+	    if (DECL_SEIZEFILE (d) == DECL_SEIZEFILE (seize_decl))
+	      {
+		if (best)
+		  {
+		    error_with_decl (seize_decl,
+				     "ambiguous choice for seize `%s' -");
+		    error_with_decl (best, " - can seize this `%s' -");
+		    error_with_decl (d, " - or this granted decl `%s'");
+		    return NULL_TREE;
+		  }
+		best = d;
+	      }
+	  if (best == NULL_TREE)
+	    {
+	      error_with_decl (seize_decl,
+			       "ambiguous choice for seize `%s' -");
+	      error_with_decl (val, " - can seize this `%s' -");
+	      error_with_decl (TREE_CHAIN (val),
+			       " - or this granted decl `%s'");
+	      return NULL_TREE;
+	    }
+	  val = best;
+	}
+    }
+#if 0
+  /* We don't need to handle this, as long as we
+     resolve the seize targets before pushing them. */
+  if (DECL_NESTING_LEVEL (val) >= current_module_nesting_level)
+    {
+      /* VAL was declared inside current module.  We need something
+	 from the scope *enclosing* the current module, so search
+	 through the shadowed declarations. */
+      /* TODO - FIXME */
+    }
+#endif
+  if (current_module && current_module->prev_module
+      && DECL_NESTING_LEVEL (val)
+      < current_module->prev_module->nesting_level)
+    {
+
+      /* It's declared in a scope enclosing the module enclosing
+	 the current module.  Hence it's not visible. */
+      return NULL_TREE;
+    }
+  while (TREE_CODE (val) == ALIAS_DECL)
+    {
+      val = DECL_ABSTRACT_ORIGIN (val);
+      if (TREE_CODE (val) == ERROR_MARK)
+	return NULL_TREE;
+    }
+  return val;
+}
+
+/* Create the predefined scalar types of C,
+   and some nodes representing standard constants (0, 1, (void *)0).
+   Initialize the global binding level.
+   Make definitions for built-in primitive functions.  */
+
+void
+init_decl_processing ()
+{
+  int  wchar_type_size;
+  tree bool_ftype_int_ptr_int;
+  tree bool_ftype_int_ptr_int_int;
+  tree bool_ftype_luns_ptr_luns_long;
+  tree bool_ftype_luns_ptr_luns_long_ptr_int;
+  tree bool_ftype_ptr_int_ptr_int;
+  tree bool_ftype_ptr_int_ptr_int_int;
+  tree find_bit_ftype;
+  tree bool_ftype_ptr_ptr_int;
+  tree bool_ftype_ptr_ptr_luns;
+  tree bool_ftype_ptr_ptr_ptr_luns;
+  tree endlink;
+  tree int_ftype_int;
+  tree int_ftype_int_int;
+  tree int_ftype_int_ptr_int;
+  tree int_ftype_ptr;
+  tree int_ftype_ptr_int;
+  tree int_ftype_ptr_int_int_ptr_int;
+  tree int_ftype_ptr_luns_long_ptr_int;
+  tree int_ftype_ptr_ptr_int;
+  tree int_ftype_ptr_ptr_luns;
+  tree long_ftype_ptr_luns;
+  tree memcpy_ftype;
+  tree memcmp_ftype;
+  tree ptr_ftype_ptr_int_int;
+  tree ptr_ftype_ptr_ptr_int;
+  tree ptr_ftype_ptr_ptr_int_ptr_int;
+  tree real_ftype_real;
+  tree temp;
+  tree void_ftype_cptr_cptr_int;
+  tree void_ftype_long_int_ptr_int_ptr_int;
+  tree void_ftype_ptr;
+  tree void_ftype_ptr_int_int_int_int;
+  tree void_ftype_ptr_int_ptr_int_int_int;
+  tree void_ftype_ptr_int_ptr_int_ptr_int;
+  tree void_ftype_ptr_luns_long_long_bool_ptr_int;
+  tree void_ftype_ptr_luns_ptr_luns_luns_luns;
+  tree void_ftype_ptr_ptr_ptr_int;
+  tree void_ftype_ptr_ptr_ptr_luns;
+  tree void_ftype_refptr_int_ptr_int;
+  tree void_ftype_void;
+  tree void_ftype_ptr_ptr_int;
+  tree void_ftype_ptr_luns_luns_cptr_luns_luns_luns;
+  tree ptr_ftype_luns_ptr_int;
+  tree double_ftype_double;
+
+  extern int set_alignment;
+
+  /* allow 0-255 enums to occupy only a byte */
+  flag_short_enums = 1;
+
+  current_function_decl = NULL;
+
+  set_alignment = BITS_PER_UNIT;
+
+  ALL_POSTFIX = get_identifier ("*");
+  string_index_type_dummy = get_identifier("%string-index%");
+
+  var_length_id = get_identifier (VAR_LENGTH);
+  var_data_id = get_identifier (VAR_DATA);
+
+  /* This is the *C* int type. */
+  integer_type_node = make_signed_type (INT_TYPE_SIZE);
+
+  if (CHILL_INT_IS_SHORT)
+    long_integer_type_node = integer_type_node;
+  else
+    long_integer_type_node = make_signed_type (LONG_TYPE_SIZE);
+
+  unsigned_type_node = make_unsigned_type (INT_TYPE_SIZE);
+  long_unsigned_type_node = make_unsigned_type (LONG_TYPE_SIZE);
+  long_long_integer_type_node = make_signed_type (LONG_LONG_TYPE_SIZE);
+  long_long_unsigned_type_node = make_unsigned_type (LONG_LONG_TYPE_SIZE);
+
+  /* `unsigned long' is the standard type for sizeof.
+     Note that stddef.h uses `unsigned long',
+     and this must agree, even of long and int are the same size.  */
+#ifndef SIZE_TYPE
+    sizetype = long_unsigned_type_node;
+#else
+  {
+    char *size_type_c_name = SIZE_TYPE;
+    if (strncmp (size_type_c_name, "long long ", 10) == 0)
+      sizetype = long_long_unsigned_type_node;
+    else if (strncmp (size_type_c_name, "long ", 5) == 0)
+      sizetype = long_unsigned_type_node;
+    else
+      sizetype = unsigned_type_node;
+  }
+#endif
+
+  TREE_TYPE (TYPE_SIZE (integer_type_node)) = sizetype;
+  TREE_TYPE (TYPE_SIZE (unsigned_type_node)) = sizetype;
+  TREE_TYPE (TYPE_SIZE (long_unsigned_type_node)) = sizetype;
+  TREE_TYPE (TYPE_SIZE (long_integer_type_node)) = sizetype;
+  TREE_TYPE (TYPE_SIZE (long_long_integer_type_node)) = sizetype;
+  TREE_TYPE (TYPE_SIZE (long_long_unsigned_type_node)) = sizetype;
+
+  error_mark_node = make_node (ERROR_MARK);
+  TREE_TYPE (error_mark_node) = error_mark_node;
+
+  short_integer_type_node = make_signed_type (SHORT_TYPE_SIZE);
+  short_unsigned_type_node = make_unsigned_type (SHORT_TYPE_SIZE);
+  signed_char_type_node = make_signed_type (CHAR_TYPE_SIZE);
+  unsigned_char_type_node = make_unsigned_type (CHAR_TYPE_SIZE);
+  intQI_type_node = make_signed_type (GET_MODE_BITSIZE (QImode));
+  intHI_type_node = make_signed_type (GET_MODE_BITSIZE (HImode));
+  intSI_type_node = make_signed_type (GET_MODE_BITSIZE (SImode));
+  intDI_type_node = make_signed_type (GET_MODE_BITSIZE (DImode));
+  intTI_type_node = make_signed_type (GET_MODE_BITSIZE (TImode));
+  unsigned_intQI_type_node = make_unsigned_type (GET_MODE_BITSIZE (QImode));
+  unsigned_intHI_type_node = make_unsigned_type (GET_MODE_BITSIZE (HImode));
+  unsigned_intSI_type_node = make_unsigned_type (GET_MODE_BITSIZE (SImode));
+  unsigned_intDI_type_node = make_unsigned_type (GET_MODE_BITSIZE (DImode));
+  unsigned_intTI_type_node = make_unsigned_type (GET_MODE_BITSIZE (TImode));
+
+  float_type_node = make_node (REAL_TYPE);
+  TYPE_PRECISION (float_type_node) = FLOAT_TYPE_SIZE;
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int) RID_FLOAT],
+			float_type_node));
+  layout_type (float_type_node);
+
+  double_type_node = make_node (REAL_TYPE);
+  if (flag_short_double)
+    TYPE_PRECISION (double_type_node) = FLOAT_TYPE_SIZE;
+  else
+    TYPE_PRECISION (double_type_node) = DOUBLE_TYPE_SIZE;
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int) RID_DOUBLE],
+			double_type_node));
+  layout_type (double_type_node);
+
+  long_double_type_node = make_node (REAL_TYPE);
+  TYPE_PRECISION (long_double_type_node) = LONG_DOUBLE_TYPE_SIZE;
+  layout_type (long_double_type_node);
+
+  complex_integer_type_node = make_node (COMPLEX_TYPE);
+  TREE_TYPE (complex_integer_type_node) = integer_type_node;
+  layout_type (complex_integer_type_node);
+
+  complex_float_type_node = make_node (COMPLEX_TYPE);
+  TREE_TYPE (complex_float_type_node) = float_type_node;
+  layout_type (complex_float_type_node);
+
+  complex_double_type_node = make_node (COMPLEX_TYPE);
+  TREE_TYPE (complex_double_type_node) = double_type_node;
+  layout_type (complex_double_type_node);
+
+  complex_long_double_type_node = make_node (COMPLEX_TYPE);
+  TREE_TYPE (complex_long_double_type_node) = long_double_type_node;
+  layout_type (complex_long_double_type_node);
+
+  integer_zero_node = build_int_2 (0, 0);
+  TREE_TYPE (integer_zero_node) = integer_type_node;
+  integer_one_node = build_int_2 (1, 0);
+  TREE_TYPE (integer_one_node) = integer_type_node;
+  integer_minus_one_node = build_int_2 (-1, -1);
+  TREE_TYPE (integer_minus_one_node) = integer_type_node;
+
+  size_zero_node = build_int_2 (0, 0);
+  TREE_TYPE (size_zero_node) = sizetype;
+  size_one_node = build_int_2 (1, 0);
+  TREE_TYPE (size_one_node) = sizetype;
+
+  void_type_node = make_node (VOID_TYPE);
+  pushdecl (build_decl (TYPE_DECL,
+			ridpointers[(int) RID_VOID], void_type_node));
+  layout_type (void_type_node);	/* Uses integer_zero_node */
+  /* We are not going to have real types in C with less than byte alignment,
+     so we might as well not have any types that claim to have it.  */
+  TYPE_ALIGN (void_type_node) = BITS_PER_UNIT;
+
+  null_pointer_node = build_int_2 (0, 0);
+  TREE_TYPE (null_pointer_node) = build_pointer_type (void_type_node);
+  layout_type (TREE_TYPE (null_pointer_node));
+
+  /* This is for wide string constants.  */
+  wchar_type_node = short_unsigned_type_node;
+  wchar_type_size = TYPE_PRECISION (wchar_type_node);
+  signed_wchar_type_node = type_for_size (wchar_type_size, 0);
+  unsigned_wchar_type_node = type_for_size (wchar_type_size, 1);
+
+  default_function_type
+    = build_function_type (integer_type_node, NULL_TREE);
+
+  ptr_type_node = build_pointer_type (void_type_node);
+  const_ptr_type_node
+    = build_pointer_type (build_type_variant (void_type_node, 1, 0));
+
+  void_list_node = build_tree_list (NULL_TREE, void_type_node);
+
+  boolean_type_node = make_node (BOOLEAN_TYPE);
+  TYPE_PRECISION (boolean_type_node) = 1;
+  fixup_unsigned_type (boolean_type_node);
+  boolean_false_node = TYPE_MIN_VALUE (boolean_type_node);
+  boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_BOOL],
+                        boolean_type_node));
+
+  /* TRUE and FALSE have the BOOL derived class */
+  CH_DERIVED_FLAG (boolean_true_node) = 1;
+  CH_DERIVED_FLAG (boolean_false_node) = 1;
+
+  signed_boolean_type_node = make_node (BOOLEAN_TYPE);
+  temp = build_int_2 (-1, -1);
+  TREE_TYPE (temp) = signed_boolean_type_node;
+  TYPE_MIN_VALUE (signed_boolean_type_node) = temp;
+  temp = build_int_2 (0, 0);
+  TREE_TYPE (temp) = signed_boolean_type_node;
+  TYPE_MAX_VALUE (signed_boolean_type_node) = temp;
+  layout_type (signed_boolean_type_node);
+
+ 
+  bitstring_one_type_node = build_bitstring_type (integer_one_node);
+  bit_zero_node = build (CONSTRUCTOR, bitstring_one_type_node, NULL_TREE,
+			 NULL_TREE);
+  bit_one_node = build (CONSTRUCTOR, bitstring_one_type_node, NULL_TREE,
+			build_tree_list (NULL_TREE, integer_zero_node));
+
+  char_type_node = make_node (CHAR_TYPE);
+  TYPE_PRECISION (char_type_node) = CHAR_TYPE_SIZE;
+  fixup_unsigned_type (char_type_node);
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_CHAR],
+			char_type_node));
+
+  if (CHILL_INT_IS_SHORT)
+    {
+      chill_integer_type_node = short_integer_type_node;
+      chill_unsigned_type_node = short_unsigned_type_node;
+    }
+  else
+    {
+      chill_integer_type_node = integer_type_node;
+      chill_unsigned_type_node = unsigned_type_node;
+    }
+
+  string_one_type_node = build_string_type (char_type_node, integer_one_node);
+
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_BYTE],
+                        signed_char_type_node));
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_UBYTE],
+                        unsigned_char_type_node));
+
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_INT],
+                        chill_integer_type_node));
+
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_UINT],
+                        chill_unsigned_type_node));
+
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_LONG],
+                        long_integer_type_node));
+
+  sizetype = long_integer_type_node;
+#if 0
+  ptrdiff_type_node
+    = TREE_TYPE (IDENTIFIER_LOCAL_VALUE (get_identifier (PTRDIFF_TYPE)));
+#endif
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_ULONG],
+                        long_unsigned_type_node));
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_REAL],
+                        float_type_node));
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_LONG_REAL],
+                        double_type_node));
+  pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_PTR],
+                        ptr_type_node));
+
+  IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_TRUE]) =
+    boolean_true_node;    
+  IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_FALSE]) =
+    boolean_false_node;    
+  IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_NULL]) =
+    null_pointer_node;    
+
+  /* The second operand is set to non-NULL to distinguish
+     (ELSE) from (*).  Used when writing grant files.  */
+  case_else_node = build (RANGE_EXPR,
+			  NULL_TREE, NULL_TREE, boolean_false_node);
+
+  pushdecl (temp = build_decl (TYPE_DECL,
+		     get_identifier ("__tmp_initializer"),
+		       build_init_struct ()));
+  DECL_SOURCE_LINE (temp) = 0;
+  initializer_type = TREE_TYPE (temp);
+
+  bcopy (chill_tree_code_type,
+         tree_code_type + (int) LAST_AND_UNUSED_TREE_CODE,
+         (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE)
+          * sizeof (char)));
+  bcopy (chill_tree_code_length,
+         tree_code_length + (int) LAST_AND_UNUSED_TREE_CODE,
+         (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE)
+          * sizeof (int)));
+  bcopy (chill_tree_code_name,
+         tree_code_name + (int) LAST_AND_UNUSED_TREE_CODE,
+         (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE)
+          * sizeof (char *)));
+  boolean_code_name = (char **) xmalloc (sizeof (char *) * (int) LAST_CHILL_TREE_CODE);
+  bzero (boolean_code_name, sizeof (char *) * (int) LAST_CHILL_TREE_CODE);
+
+  boolean_code_name[EQ_EXPR] = "=";
+  boolean_code_name[NE_EXPR] = "/=";
+  boolean_code_name[LT_EXPR] = "<";
+  boolean_code_name[GT_EXPR] = ">";
+  boolean_code_name[LE_EXPR] = "<=";
+  boolean_code_name[GE_EXPR] = ">=";
+  boolean_code_name[SET_IN_EXPR] = "in";
+  boolean_code_name[TRUTH_ANDIF_EXPR] = "andif";
+  boolean_code_name[TRUTH_ORIF_EXPR] = "orif";
+  boolean_code_name[TRUTH_AND_EXPR] = "and";
+  boolean_code_name[TRUTH_OR_EXPR] = "or";
+  boolean_code_name[BIT_AND_EXPR] = "and";
+  boolean_code_name[BIT_IOR_EXPR] = "or";
+  boolean_code_name[BIT_XOR_EXPR] = "xor";
+
+  endlink = void_list_node;
+
+  chill_predefined_function_type
+    = build_function_type (integer_type_node,
+       tree_cons (NULL_TREE, integer_type_node,
+         endlink));
+
+  bool_ftype_int_ptr_int
+    = build_function_type (boolean_type_node,
+          tree_cons (NULL_TREE, integer_type_node,
+	      tree_cons (NULL_TREE, ptr_type_node,
+ 	          tree_cons (NULL_TREE, integer_type_node,
+		      endlink))));
+  bool_ftype_int_ptr_int
+    = build_function_type (boolean_type_node,
+          tree_cons (NULL_TREE, integer_type_node,
+	      tree_cons (NULL_TREE, ptr_type_node,
+ 	          tree_cons (NULL_TREE, integer_type_node,
+ 	              tree_cons (NULL_TREE, integer_type_node,
+			  endlink)))));
+  bool_ftype_int_ptr_int_int
+    = build_function_type (boolean_type_node,
+          tree_cons (NULL_TREE, integer_type_node,
+	      tree_cons (NULL_TREE, ptr_type_node,
+ 	              tree_cons (NULL_TREE, integer_type_node,
+ 	                  tree_cons (NULL_TREE, integer_type_node,
+			      endlink)))));
+  bool_ftype_luns_ptr_luns_long
+    = build_function_type (boolean_type_node,
+          tree_cons (NULL_TREE, long_unsigned_type_node,
+	      tree_cons (NULL_TREE, ptr_type_node,
+ 	              tree_cons (NULL_TREE, long_unsigned_type_node,
+ 	                  tree_cons (NULL_TREE, long_integer_type_node,
+			      endlink)))));
+  bool_ftype_luns_ptr_luns_long_ptr_int
+    = build_function_type (boolean_type_node,
+          tree_cons (NULL_TREE, long_unsigned_type_node,
+	      tree_cons (NULL_TREE, ptr_type_node,
+ 	              tree_cons (NULL_TREE, long_unsigned_type_node,
+ 	                  tree_cons (NULL_TREE, long_integer_type_node,
+                              tree_cons (NULL_TREE, ptr_type_node,
+                                  tree_cons (NULL_TREE, integer_type_node,
+			              endlink)))))));
+  bool_ftype_ptr_ptr_int
+    = build_function_type (boolean_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, ptr_type_node,
+	          tree_cons (NULL_TREE, integer_type_node, 
+		      endlink))));
+  bool_ftype_ptr_ptr_luns
+    = build_function_type (boolean_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, ptr_type_node,
+		  tree_cons (NULL_TREE, long_unsigned_type_node, 
+		      endlink))));
+  bool_ftype_ptr_ptr_ptr_luns
+    = build_function_type (boolean_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, ptr_type_node,
+		  tree_cons (NULL_TREE, ptr_type_node,
+	              tree_cons (NULL_TREE, long_unsigned_type_node, 
+		          endlink)))));
+  bool_ftype_ptr_int_ptr_int
+    = build_function_type (boolean_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, integer_type_node,
+	          tree_cons (NULL_TREE, ptr_type_node, 
+		      tree_cons (NULL_TREE, integer_type_node, 
+			  endlink)))));
+  bool_ftype_ptr_int_ptr_int_int
+    = build_function_type (boolean_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, integer_type_node,
+	          tree_cons (NULL_TREE, ptr_type_node, 
+		      tree_cons (NULL_TREE, integer_type_node, 
+		          tree_cons (NULL_TREE, integer_type_node, 
+			             endlink))))));
+  find_bit_ftype
+    = build_function_type (integer_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, long_unsigned_type_node,
+		  tree_cons (NULL_TREE, integer_type_node,
+			             endlink))));
+  int_ftype_int
+    = build_function_type (integer_type_node,
+         tree_cons (NULL_TREE, integer_type_node, 
+	     endlink));
+  int_ftype_int_int
+    = build_function_type (integer_type_node,
+          tree_cons (NULL_TREE, integer_type_node,
+	      tree_cons (NULL_TREE, integer_type_node, 
+                  endlink)));
+  int_ftype_int_ptr_int
+    = build_function_type (integer_type_node,
+	   tree_cons (NULL_TREE, integer_type_node,
+ 	       tree_cons (NULL_TREE, ptr_type_node,
+ 		   tree_cons (NULL_TREE, integer_type_node,
+		       endlink))));
+  int_ftype_ptr
+    = build_function_type (integer_type_node,
+          tree_cons (NULL_TREE, ptr_type_node, 
+              endlink));
+  int_ftype_ptr_int
+    = build_function_type (integer_type_node,
+          tree_cons (NULL_TREE, ptr_type_node, 
+	      tree_cons (NULL_TREE, integer_type_node,
+		  endlink)));
+
+  long_ftype_ptr_luns
+    = build_function_type (long_integer_type_node,
+          tree_cons (NULL_TREE, ptr_type_node, 
+	      tree_cons (NULL_TREE, long_unsigned_type_node,
+		  endlink)));
+
+  int_ftype_ptr_int_int_ptr_int
+    = build_function_type (integer_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+ 	      tree_cons (NULL_TREE, integer_type_node,
+ 		  tree_cons (NULL_TREE, integer_type_node,
+		      tree_cons (NULL_TREE, ptr_type_node,
+			  tree_cons (NULL_TREE, integer_type_node,
+			      endlink))))));
+
+  int_ftype_ptr_luns_long_ptr_int
+    = build_function_type (integer_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+ 	      tree_cons (NULL_TREE, long_unsigned_type_node,
+ 		  tree_cons (NULL_TREE, long_integer_type_node,
+		      tree_cons (NULL_TREE, ptr_type_node,
+			  tree_cons (NULL_TREE, integer_type_node,
+			      endlink))))));
+
+  int_ftype_ptr_ptr_int
+    = build_function_type (integer_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+ 	      tree_cons (NULL_TREE, ptr_type_node,
+ 		  tree_cons (NULL_TREE, integer_type_node,
+		      endlink))));
+  int_ftype_ptr_ptr_luns
+    = build_function_type (integer_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+ 	      tree_cons (NULL_TREE, ptr_type_node,
+ 		  tree_cons (NULL_TREE, long_unsigned_type_node,
+		      endlink))));
+  memcpy_ftype	/* memcpy/memmove prototype */
+    = build_function_type (ptr_type_node,
+	tree_cons (NULL_TREE, ptr_type_node,
+	  tree_cons (NULL_TREE, const_ptr_type_node,
+	    tree_cons (NULL_TREE, sizetype,
+	      endlink))));
+  memcmp_ftype  /* memcmp prototype */
+    = build_function_type (integer_type_node,
+        tree_cons (NULL_TREE, ptr_type_node,
+          tree_cons (NULL_TREE, ptr_type_node,
+            tree_cons (NULL_TREE, sizetype,
+              endlink)))); 
+
+  ptr_ftype_ptr_int_int
+    = build_function_type (ptr_type_node,
+          tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, integer_type_node,
+		  tree_cons (NULL_TREE, integer_type_node, 
+		      endlink))));
+  ptr_ftype_ptr_ptr_int
+    = build_function_type (ptr_type_node,
+          tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, ptr_type_node,
+		  tree_cons (NULL_TREE, integer_type_node, 
+		      endlink))));
+  ptr_ftype_ptr_ptr_int_ptr_int
+    = build_function_type (void_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, ptr_type_node,
+		  tree_cons (NULL_TREE, integer_type_node,
+		      tree_cons (NULL_TREE, ptr_type_node,
+		          tree_cons (NULL_TREE, integer_type_node,
+			      endlink))))));
+  real_ftype_real
+    = build_function_type (float_type_node,
+	  tree_cons (NULL_TREE, float_type_node, 
+              endlink));
+
+  void_ftype_ptr
+     = build_function_type (void_type_node,
+	   tree_cons (NULL_TREE, ptr_type_node, endlink));
+
+  void_ftype_cptr_cptr_int
+    = build_function_type (void_type_node,
+	  tree_cons (NULL_TREE, const_ptr_type_node,
+	      tree_cons (NULL_TREE, const_ptr_type_node,
+		  tree_cons (NULL_TREE, integer_type_node,
+		      endlink))));
+
+  void_ftype_refptr_int_ptr_int
+    = build_function_type (void_type_node,
+	      tree_cons (NULL_TREE, build_reference_type(ptr_type_node),
+		tree_cons (NULL_TREE, integer_type_node,
+		  tree_cons (NULL_TREE, ptr_type_node,
+		    tree_cons (NULL_TREE, integer_type_node,
+		      endlink)))));
+
+  void_ftype_ptr_ptr_ptr_int
+    = build_function_type (void_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, ptr_type_node,
+		  tree_cons (NULL_TREE, ptr_type_node,
+		      tree_cons (NULL_TREE, integer_type_node,
+		          endlink)))));
+  void_ftype_ptr_ptr_ptr_luns
+    = build_function_type (void_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, ptr_type_node,
+		  tree_cons (NULL_TREE, ptr_type_node,
+		      tree_cons (NULL_TREE, long_unsigned_type_node,
+		          endlink)))));
+  void_ftype_ptr_int_int_int_int
+    = build_function_type (void_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, integer_type_node,
+		  tree_cons (NULL_TREE, integer_type_node,
+		      tree_cons (NULL_TREE, integer_type_node,
+		        tree_cons (NULL_TREE, integer_type_node,
+		          endlink))))));
+  void_ftype_ptr_luns_long_long_bool_ptr_int
+    = build_function_type (void_type_node,
+        tree_cons (NULL_TREE, ptr_type_node,
+	  tree_cons (NULL_TREE, long_unsigned_type_node,
+	    tree_cons (NULL_TREE, long_integer_type_node,
+	      tree_cons (NULL_TREE, long_integer_type_node,
+		tree_cons (NULL_TREE, boolean_type_node,
+		  tree_cons (NULL_TREE, ptr_type_node,
+		    tree_cons (NULL_TREE, integer_type_node,
+		      endlink))))))));
+  void_ftype_ptr_int_ptr_int_int_int
+    = build_function_type (void_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, integer_type_node,
+		  tree_cons (NULL_TREE, ptr_type_node,
+		      tree_cons (NULL_TREE, integer_type_node,
+		        tree_cons (NULL_TREE, integer_type_node,
+		          tree_cons (NULL_TREE, integer_type_node,
+		            endlink)))))));
+  void_ftype_ptr_luns_ptr_luns_luns_luns
+    = build_function_type (void_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, long_unsigned_type_node,
+		  tree_cons (NULL_TREE, ptr_type_node,
+		      tree_cons (NULL_TREE, long_unsigned_type_node,
+		          tree_cons (NULL_TREE, long_unsigned_type_node,
+		              tree_cons (NULL_TREE, long_unsigned_type_node,
+		                  endlink)))))));
+  void_ftype_ptr_int_ptr_int_ptr_int
+    = build_function_type (void_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, integer_type_node,
+		  tree_cons (NULL_TREE, ptr_type_node,
+		      tree_cons (NULL_TREE, integer_type_node,
+		        tree_cons (NULL_TREE, ptr_type_node,
+		          tree_cons (NULL_TREE, integer_type_node,
+		            endlink)))))));
+  void_ftype_long_int_ptr_int_ptr_int
+    = build_function_type (void_type_node,
+	  tree_cons (NULL_TREE, long_integer_type_node,
+	      tree_cons (NULL_TREE, integer_type_node,
+		  tree_cons (NULL_TREE, ptr_type_node,
+		      tree_cons (NULL_TREE, integer_type_node,
+		        tree_cons (NULL_TREE, ptr_type_node,
+		          tree_cons (NULL_TREE, integer_type_node,
+		            endlink)))))));
+   void_ftype_void
+     = build_function_type (void_type_node,
+	   tree_cons (NULL_TREE, void_type_node,
+	       endlink));
+
+  void_ftype_ptr_ptr_int
+     = build_function_type (void_type_node,
+	   tree_cons (NULL_TREE, ptr_type_node,
+	       tree_cons (NULL_TREE, ptr_type_node,
+		   tree_cons (NULL_TREE, integer_type_node,
+		       endlink))));
+
+  void_ftype_ptr_luns_luns_cptr_luns_luns_luns
+    = build_function_type (void_type_node,
+        tree_cons (NULL_TREE, ptr_type_node,
+	  tree_cons (NULL_TREE, long_unsigned_type_node,
+	    tree_cons (NULL_TREE, long_unsigned_type_node,
+	      tree_cons (NULL_TREE, const_ptr_type_node,
+	        tree_cons (NULL_TREE, long_unsigned_type_node,
+	          tree_cons (NULL_TREE, long_unsigned_type_node,
+	            tree_cons (NULL_TREE, long_unsigned_type_node,
+			       endlink))))))));
+
+  ptr_ftype_luns_ptr_int
+    = build_function_type (ptr_type_node,
+        tree_cons (NULL_TREE, long_unsigned_type_node,
+          tree_cons (NULL_TREE, ptr_type_node,
+            tree_cons (NULL_TREE, integer_type_node,
+		       endlink))));
+
+  double_ftype_double
+    = build_function_type (double_type_node,
+        tree_cons (NULL_TREE, double_type_node,
+		   endlink));
+
+/* These are compiler-internal function calls, not intended
+   to be directly called by user code */
+  builtin_function ("__allocate", ptr_ftype_luns_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("_allocate_global_memory", void_ftype_refptr_int_ptr_int, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("_allocate_memory", void_ftype_refptr_int_ptr_int, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__andpowerset", bool_ftype_ptr_ptr_ptr_luns, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__bitsetpowerset", void_ftype_ptr_int_int_int_int, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__cardpowerset", long_ftype_ptr_luns, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__cause_ex1", void_ftype_cptr_cptr_int, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__concatstring", ptr_ftype_ptr_ptr_int_ptr_int, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__continue", void_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__diffpowerset", void_ftype_ptr_ptr_ptr_luns, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__eqpowerset", bool_ftype_ptr_ptr_luns, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__ffsetclrpowerset", find_bit_ftype,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__flsetclrpowerset", find_bit_ftype,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__flsetpowerset", int_ftype_ptr_luns_long_ptr_int, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__ffsetpowerset", int_ftype_ptr_luns_long_ptr_int, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__inbitstring", bool_ftype_luns_ptr_luns_long_ptr_int, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__inpowerset", bool_ftype_luns_ptr_luns_long, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__lepowerset", bool_ftype_ptr_ptr_luns, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__ltpowerset", bool_ftype_ptr_ptr_luns, 
+		    NOT_BUILT_IN, NULL_PTR);
+  /* Currently under experimentation.  */
+  builtin_function ("memmove", memcpy_ftype,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("memcmp", memcmp_ftype,
+                    NOT_BUILT_IN, NULL_PTR);
+
+  /* this comes from c-decl.c (init_decl_processing) */
+  builtin_function ("__builtin_alloca",
+		    build_function_type (ptr_type_node,
+					 tree_cons (NULL_TREE,
+						    sizetype,
+						    endlink)),
+		    BUILT_IN_ALLOCA, "alloca");
+
+  builtin_function ("memset", ptr_ftype_ptr_int_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__notpowerset", bool_ftype_ptr_ptr_luns, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__orpowerset", bool_ftype_ptr_ptr_ptr_luns, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__psslice", void_ftype_ptr_int_ptr_int_int_int, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__pscpy", void_ftype_ptr_luns_luns_cptr_luns_luns_luns,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("_return_memory", void_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__setbitpowerset", void_ftype_ptr_luns_long_long_bool_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__terminate", void_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__unhandled_ex", void_ftype_cptr_cptr_int, 
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__xorpowerset", bool_ftype_ptr_ptr_ptr_luns, 
+		    NOT_BUILT_IN, NULL_PTR);
+
+  /* declare floating point functions */
+  builtin_function ("__sin", double_ftype_double, NOT_BUILT_IN, "sin");
+  builtin_function ("__cos", double_ftype_double, NOT_BUILT_IN, "cos");
+  builtin_function ("__tan", double_ftype_double, NOT_BUILT_IN, "tan");
+  builtin_function ("__asin", double_ftype_double, NOT_BUILT_IN, "asin");
+  builtin_function ("__acos", double_ftype_double, NOT_BUILT_IN, "acos");
+  builtin_function ("__atan", double_ftype_double, NOT_BUILT_IN, "atan");
+  builtin_function ("__exp", double_ftype_double, NOT_BUILT_IN, "exp");
+  builtin_function ("__log", double_ftype_double, NOT_BUILT_IN, "log");
+  builtin_function ("__log10", double_ftype_double, NOT_BUILT_IN, "log10");
+  builtin_function ("__sqrt", double_ftype_double, NOT_BUILT_IN, "sqrt");
+
+  tasking_init ();
+  timing_init ();
+  inout_init ();
+
+  /* These are predefined value builtin routine calls, built
+     by the compiler, but over-ridable by user procedures of
+     the same names.  Note the lack of a leading underscore. */
+  builtin_function ((ignore_case || ! special_UC) ?  "abs" : "ABS",
+		    chill_predefined_function_type,
+		    BUILT_IN_CH_ABS, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "abstime" : "ABSTIME",
+		    chill_predefined_function_type,
+		    BUILT_IN_ABSTIME, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "allocate" : "ALLOCATE",
+		    chill_predefined_function_type,
+		    BUILT_IN_ALLOCATE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "allocate_memory" : "ALLOCATE_MEMORY",
+		    chill_predefined_function_type,
+		    BUILT_IN_ALLOCATE_MEMORY, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "addr" : "ADDR",
+		    chill_predefined_function_type,
+		    BUILT_IN_ADDR, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "allocate_global_memory" : "ALLOCATE_GLOBAL_MEMORY",
+		    chill_predefined_function_type,
+		    BUILT_IN_ALLOCATE_GLOBAL_MEMORY, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "arccos" : "ARCCOS",
+		    chill_predefined_function_type,
+		    BUILT_IN_ARCCOS, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "arcsin" : "ARCSIN",
+		    chill_predefined_function_type,
+		    BUILT_IN_ARCSIN, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "arctan" : "ARCTAN",
+		    chill_predefined_function_type,
+		    BUILT_IN_ARCTAN, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "card" : "CARD",
+		    chill_predefined_function_type,
+		    BUILT_IN_CARD, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "cos" : "COS",
+		    chill_predefined_function_type,
+		    BUILT_IN_CH_COS, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "days" : "DAYS",
+		    chill_predefined_function_type,
+		    BUILT_IN_DAYS, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "descr" : "DESCR",
+		    chill_predefined_function_type,
+		    BUILT_IN_DESCR, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "getstack" : "GETSTACK",
+		    chill_predefined_function_type,
+		    BUILT_IN_GETSTACK, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "exp" : "EXP",
+		    chill_predefined_function_type,
+		    BUILT_IN_EXP, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "hours" : "HOURS",
+		    chill_predefined_function_type,
+		    BUILT_IN_HOURS, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "inttime" : "INTTIME",
+		    chill_predefined_function_type,
+		    BUILT_IN_INTTIME, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "length" : "LENGTH",
+		    chill_predefined_function_type,
+		    BUILT_IN_LENGTH, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "log" : "LOG",
+		    chill_predefined_function_type,
+		    BUILT_IN_LOG, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "lower" : "LOWER",
+		    chill_predefined_function_type,
+		    BUILT_IN_LOWER, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "ln" : "LN",
+		    chill_predefined_function_type,
+		    BUILT_IN_LN, NULL_PTR);
+  /* Note: these are *not* the C integer MAX and MIN.  They're
+     for powerset arguments. */
+  builtin_function ((ignore_case || ! special_UC) ?  "max" : "MAX",
+		    chill_predefined_function_type,
+		    BUILT_IN_MAX, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "millisecs" : "MILLISECS",
+		    chill_predefined_function_type,
+		    BUILT_IN_MILLISECS, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "min" : "MIN",
+		    chill_predefined_function_type,
+		    BUILT_IN_MIN, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "minutes" : "MINUTES",
+		    chill_predefined_function_type,
+		    BUILT_IN_MINUTES, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "num" : "NUM",
+		    chill_predefined_function_type,
+		    BUILT_IN_NUM, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "pred" : "PRED",
+		    chill_predefined_function_type,
+		    BUILT_IN_PRED, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "return_memory" : "RETURN_MEMORY",
+		    chill_predefined_function_type,
+		    BUILT_IN_RETURN_MEMORY, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "secs" : "SECS",
+		    chill_predefined_function_type,
+		    BUILT_IN_SECS, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "sin" : "SIN",
+		    chill_predefined_function_type,
+		    BUILT_IN_CH_SIN, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "size" : "SIZE",
+		    chill_predefined_function_type,
+		    BUILT_IN_SIZE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "sqrt" : "SQRT",
+		    chill_predefined_function_type,
+		    BUILT_IN_SQRT, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "succ" : "SUCC",
+		    chill_predefined_function_type,
+		    BUILT_IN_SUCC, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "tan" : "TAN",
+		    chill_predefined_function_type,
+		    BUILT_IN_TAN, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "terminate" : "TERMINATE",
+		    chill_predefined_function_type,
+		    BUILT_IN_TERMINATE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ?  "upper" : "UPPER",
+		    chill_predefined_function_type,
+		    BUILT_IN_UPPER, NULL_PTR);
+
+  build_chill_descr_type ();
+  build_chill_inttime_type ();
+  
+  endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
+
+  start_identifier_warnings ();
+
+  pass = 1;
+}
+
+/* Return a definition for a builtin function named NAME and whose data type
+   is TYPE.  TYPE should be a function type with argument types.
+   FUNCTION_CODE tells later passes how to compile calls to this function.
+   See tree.h for its possible values.
+
+   If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
+   the name to be called if we can't opencode the function.  */
+
+tree
+builtin_function (name, type, function_code, library_name)
+     char *name;
+     tree type;
+     enum built_in_function function_code;
+     char *library_name;
+{
+  tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
+  DECL_EXTERNAL (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  /* If -traditional, permit redefining a builtin function any way you like.
+     (Though really, if the program redefines these functions,
+     it probably won't work right unless compiled with -fno-builtin.)  */
+  if (flag_traditional && name[0] != '_')
+    DECL_BUILT_IN_NONANSI (decl) = 1;
+  if (library_name)
+    DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name);
+  make_decl_rtl (decl, NULL_PTR, 1);
+  pushdecl (decl);
+  if (function_code != NOT_BUILT_IN)
+    {
+      DECL_BUILT_IN (decl) = 1;
+      DECL_SET_FUNCTION_CODE (decl, function_code);
+    }
+
+  return decl;
+}
+
+/* Print a warning if a constant expression had overflow in folding.
+   Invoke this function on every expression that the language
+   requires to be a constant expression. */
+
+void
+constant_expression_warning (value)
+     tree value;
+{
+  if ((TREE_CODE (value) == INTEGER_CST || TREE_CODE (value) == REAL_CST
+       || TREE_CODE (value) == COMPLEX_CST)
+      && TREE_CONSTANT_OVERFLOW (value) && pedantic)
+    pedwarn ("overflow in constant expression");
+}
+
+
+/* Finish processing of a declaration;
+   If the length of an array type is not known before,
+   it must be determined now, from the initial value, or it is an error.  */
+
+void
+finish_decl (decl)
+     tree decl;
+{
+  register tree type = TREE_TYPE (decl);
+  int was_incomplete = (DECL_SIZE (decl) == 0);
+  int temporary = allocation_temporary_p ();
+
+  /* Pop back to the obstack that is current for this binding level.
+     This is because MAXINDEX, rtl, etc. to be made below
+     must go in the permanent obstack.  But don't discard the
+     temporary data yet.  */
+  pop_obstacks ();
+#if 0 /* pop_obstacks was near the end; this is what was here.  */
+  if (current_scope == global_scope && temporary)
+    end_temporary_allocation ();
+#endif
+
+  if (TREE_CODE (decl) == VAR_DECL)
+    {
+      if (DECL_SIZE (decl) == 0
+	  && TYPE_SIZE (TREE_TYPE (decl)) != 0)
+	layout_decl (decl, 0);
+
+      if (DECL_SIZE (decl) == 0 && TREE_CODE (TREE_TYPE (decl)) != ERROR_MARK)
+	{
+	  error_with_decl (decl, "storage size of `%s' isn't known");
+	  TREE_TYPE (decl) = error_mark_node;
+	}
+
+      if ((DECL_EXTERNAL (decl) || TREE_STATIC (decl))
+	  && DECL_SIZE (decl) != 0)
+	{
+	  if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST)
+	    constant_expression_warning (DECL_SIZE (decl));
+	}
+    }
+
+  /* Output the assembler code and/or RTL code for variables and functions,
+     unless the type is an undefined structure or union.
+     If not, it will get done when the type is completed.  */
+
+  if (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL)
+    {
+      /* The last argument (at_end) is set to 1 as a kludge to force
+	 assemble_variable to be called. */
+      if (TREE_CODE (TREE_TYPE (decl)) != ERROR_MARK)
+	rest_of_decl_compilation (decl, (char*) 0, global_bindings_p (), 1);
+
+      /* Compute the RTL of a decl if not yet set.
+	 (For normal user variables, satisfy_decl sets it.) */
+      if (! TREE_STATIC (decl) && ! DECL_EXTERNAL (decl))
+	{
+	  if (was_incomplete)
+	    {
+	      /* If we used it already as memory, it must stay in memory.  */
+	      TREE_ADDRESSABLE (decl) = TREE_USED (decl);
+	      /* If it's still incomplete now, no init will save it.  */
+	      if (DECL_SIZE (decl) == 0)
+		DECL_INITIAL (decl) = 0;
+	      expand_decl (decl);
+	    }
+	}
+    }
+
+  if (TREE_CODE (decl) == TYPE_DECL)
+    {
+      rest_of_decl_compilation (decl, NULL_PTR,
+				global_bindings_p (), 0);
+    }
+
+  /* ??? After 2.3, test (init != 0) instead of TREE_CODE.  */
+  if (!(TREE_CODE (decl) == FUNCTION_DECL && DECL_INLINE (decl))
+      && temporary && TREE_PERMANENT (decl))
+    {
+      /* We need to remember that this array HAD an initialization,
+	 but discard the actual temporary nodes,
+	 since we can't have a permanent node keep pointing to them.  */
+      /* We make an exception for inline functions, since it's
+	 normal for a local extern redeclaration of an inline function
+	 to have a copy of the top-level decl's DECL_INLINE.  */
+      if (DECL_INITIAL (decl) != 0)
+	DECL_INITIAL (decl) = error_mark_node;
+    }
+
+#if 0
+  /* Resume permanent allocation, if not within a function.  */
+  /* The corresponding push_obstacks_nochange is in start_decl,
+     and in push_parm_decl and in grokfield.  */
+  pop_obstacks ();
+#endif
+
+  /* If we have gone back from temporary to permanent allocation,
+     actually free the temporary space that we no longer need.  */
+  if (temporary && !allocation_temporary_p ())
+    permanent_allocation (0);
+
+  /* At the end of a declaration, throw away any variable type sizes
+     of types defined inside that declaration.  There is no use
+     computing them in the following function definition.  */
+  if (current_scope == global_scope)
+    get_pending_sizes ();
+}
+
+/* If DECL has a cleanup, build and return that cleanup here.
+   This is a callback called by expand_expr.  */
+
+tree
+maybe_build_cleanup (decl)
+     tree decl;
+{
+  /* There are no cleanups in C.  */
+  return NULL_TREE;
+}
+
+/* Make TYPE a complete type based on INITIAL_VALUE.
+   Return 0 if successful, 1 if INITIAL_VALUE can't be deciphered,
+   2 if there was no information (in which case assume 1 if DO_DEFAULT).  */
+
+int
+complete_array_type (type, initial_value, do_default)
+     tree type, initial_value;
+     int do_default;
+{
+  /* Only needed so we can link with ../c-typeck.c. */
+  abort ();
+}
+
+/* Make sure that the tag NAME is defined *in the current binding level*
+   at least as a forward reference.
+   CODE says which kind of tag NAME ought to be.
+
+   We also do a push_obstacks_nochange
+   whose matching pop is in finish_struct.  */
+
+tree
+start_struct (code, name)
+     enum chill_tree_code code;
+     tree name;
+{
+  /* If there is already a tag defined at this binding level
+     (as a forward reference), just return it.  */
+
+  register tree ref = 0;
+
+  push_obstacks_nochange ();
+  if (current_scope == global_scope)
+    end_temporary_allocation ();
+
+  /* Otherwise create a forward-reference just so the tag is in scope.  */
+
+  ref = make_node (code);
+/*  pushtag (name, ref); */
+  return ref;
+}
+
+#if 0
+/* Function to help qsort sort FIELD_DECLs by name order.  */
+
+static int
+field_decl_cmp (x, y)
+     tree *x, *y;
+{
+  return (long)DECL_NAME (*x) - (long)DECL_NAME (*y);
+}
+#endif
+/* Fill in the fields of a RECORD_TYPE or UNION_TYPE node, T.
+   FIELDLIST is a chain of FIELD_DECL nodes for the fields.
+
+   We also do a pop_obstacks to match the push in start_struct.  */
+
+tree
+finish_struct (t, fieldlist)
+     register tree t, fieldlist;
+{
+  register tree x;
+
+  /* Install struct as DECL_CONTEXT of each field decl.
+     Also process specified field sizes.
+     Set DECL_FIELD_SIZE to the specified size, or 0 if none specified.
+     The specified size is found in the DECL_INITIAL.
+     Store 0 there, except for ": 0" fields (so we can find them
+     and delete them, below).  */
+
+  for (x = fieldlist; x; x = TREE_CHAIN (x))
+    {
+      DECL_CONTEXT (x) = t;
+      DECL_FIELD_SIZE (x) = 0;
+    }
+
+  TYPE_FIELDS (t) = fieldlist;
+
+  if (pass != 1)
+    t = layout_chill_struct_type (t);
+
+  /* The matching push is in start_struct.  */
+  pop_obstacks ();
+
+  return t;
+}
+
+/* Lay out the type T, and its element type, and so on.  */
+
+static void
+layout_array_type (t)
+     tree t;
+{
+  if (TYPE_SIZE (t) != 0)
+    return;
+  if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
+    layout_array_type (TREE_TYPE (t));
+  layout_type (t);
+}
+
+/* Begin compiling the definition of an enumeration type.
+   NAME is its name (or null if anonymous).
+   Returns the type object, as yet incomplete.
+   Also records info about it so that build_enumerator
+   may be used to declare the individual values as they are read.  */
+
+tree
+start_enum (name)
+     tree name;
+{
+  register tree enumtype;
+
+  /* If this is the real definition for a previous forward reference,
+     fill in the contents in the same object that used to be the
+     forward reference.  */
+
+#if 0
+  /* The corresponding pop_obstacks is in finish_enum.  */
+  push_obstacks_nochange ();
+  /* If these symbols and types are global, make them permanent.  */
+  if (current_scope == global_scope)
+    end_temporary_allocation ();
+#endif
+
+  enumtype = make_node (ENUMERAL_TYPE);
+/*  pushtag (name, enumtype); */
+  return enumtype;
+}
+
+/* Determine the precision this type needs.  */
+unsigned
+get_type_precision (minnode, maxnode)
+     tree minnode, maxnode;
+{
+  unsigned precision = 0;
+
+  if (TREE_INT_CST_HIGH (minnode) >= 0
+      ? tree_int_cst_lt (TYPE_MAX_VALUE (unsigned_type_node), maxnode)
+      : (tree_int_cst_lt (minnode, TYPE_MIN_VALUE (integer_type_node))
+	 || tree_int_cst_lt (TYPE_MAX_VALUE (integer_type_node), maxnode)))
+    precision = TYPE_PRECISION (long_long_integer_type_node);
+  else
+    {
+      HOST_WIDE_INT maxvalue = TREE_INT_CST_LOW (maxnode);
+      HOST_WIDE_INT minvalue = TREE_INT_CST_LOW (minnode);
+
+      if (maxvalue > 0)
+	precision = floor_log2 (maxvalue) + 1;
+      if (minvalue < 0)
+	{
+	  /* Compute number of bits to represent magnitude of a negative value.
+	     Add one to MINVALUE since range of negative numbers
+	     includes the power of two.  */
+	  unsigned negprecision = floor_log2 (-minvalue - 1) + 1;
+	  if (negprecision > precision)
+	    precision = negprecision;
+	  precision += 1;	/* room for sign bit */
+	}
+
+      if (!precision)
+	precision = 1;
+    }
+  return precision;
+}
+
+void
+layout_enum (enumtype)
+     tree enumtype;
+{
+  register tree pair, tem;
+  tree minnode = 0, maxnode = 0;
+  unsigned precision = 0;
+
+  /* Do arithmetic using double integers, but don't use fold/build. */
+  union tree_node enum_next_node;
+  /* This is 1 plus the last enumerator constant value.  */
+  tree enum_next_value = &enum_next_node;
+
+  /* Nonzero means that there was overflow computing enum_next_value.  */
+  int enum_overflow = 0;
+
+  tree values = TYPE_VALUES (enumtype);
+
+  if (TYPE_SIZE (enumtype) != NULL_TREE)
+    return;
+
+  /* Initialize enum_next_value to zero. */
+  TREE_TYPE (enum_next_value) = integer_type_node;
+  TREE_INT_CST_LOW (enum_next_value) = TREE_INT_CST_LOW (integer_zero_node);
+  TREE_INT_CST_HIGH (enum_next_value) = TREE_INT_CST_HIGH (integer_zero_node);
+
+  /* After processing and defining all the values of an enumeration type,
+     install their decls in the enumeration type and finish it off.
+
+     TYPE_VALUES currently contains a list of (purpose: NAME, value: DECL).
+     This gets converted to a list of (purpose: NAME, value: VALUE). */
+
+
+  /* For each enumerator, calculate values, if defaulted.
+     Convert to correct type (the enumtype).
+     Also, calculate the minimum and maximum values.  */
+
+  for (pair = values; pair; pair = TREE_CHAIN (pair))
+    {
+      tree decl = TREE_VALUE (pair);
+      tree value = DECL_INITIAL (decl);
+
+      /* Remove no-op casts from the value.  */
+      if (value != NULL_TREE)
+	STRIP_TYPE_NOPS (value);
+
+      if (value != NULL_TREE)
+	{
+	  if (TREE_CODE (value) == INTEGER_CST)
+	    {
+	      constant_expression_warning (value);
+	      if (tree_int_cst_lt (value, integer_zero_node))
+		{
+		  error ("enumerator value for `%s' is less then 0",
+			 IDENTIFIER_POINTER (DECL_NAME (decl)));
+		  value = error_mark_node;
+		}
+	    }
+	  else
+	    {
+	      error ("enumerator value for `%s' not integer constant",
+		     IDENTIFIER_POINTER (DECL_NAME (decl)));
+	      value = error_mark_node;
+	    }
+	}
+
+      if (value != error_mark_node)
+	{
+	  if (value == NULL_TREE) /* Default based on previous value.  */
+	    {
+	      value = enum_next_value;
+	      if (enum_overflow)
+		error ("overflow in enumeration values");
+	    }
+	  value = build_int_2 (TREE_INT_CST_LOW (value),
+			       TREE_INT_CST_HIGH (value));
+	  TREE_TYPE (value) = enumtype;
+	  DECL_INITIAL (decl) = value;
+	  CH_DERIVED_FLAG (value) = 1;
+      
+	  if (pair == values)
+	    minnode = maxnode = value;
+	  else
+	    {
+	      if (tree_int_cst_lt (maxnode, value))
+		maxnode = value;
+	      if (tree_int_cst_lt (value, minnode))
+		minnode = value;
+	    }
+
+	  /* Set basis for default for next value.  */
+	  add_double (TREE_INT_CST_LOW (value), TREE_INT_CST_HIGH (value), 1, 0,
+		      &TREE_INT_CST_LOW (enum_next_value),
+		      &TREE_INT_CST_HIGH (enum_next_value));
+	  enum_overflow = tree_int_cst_lt (enum_next_value, value);
+	}
+      else
+	DECL_INITIAL (decl) = value; /* error_mark_node */
+    }
+
+  /* Fix all error_mark_nodes in enum. Increment maxnode and assign value.
+     This is neccessary to make a duplicate value check in the enum */
+  for (pair = values; pair; pair = TREE_CHAIN (pair))
+    {
+      tree decl = TREE_VALUE (pair);
+      if (DECL_INITIAL (decl) == error_mark_node)
+	{
+	  tree value;
+	  add_double (TREE_INT_CST_LOW (maxnode), TREE_INT_CST_HIGH (maxnode), 1, 0,
+		      &TREE_INT_CST_LOW (enum_next_value),
+		      &TREE_INT_CST_HIGH (enum_next_value));
+	  value = build_int_2 (TREE_INT_CST_LOW (enum_next_value),
+			       TREE_INT_CST_HIGH (enum_next_value));
+	  TREE_TYPE (value) = enumtype;
+	  CH_DERIVED_FLAG (value) = 1;
+	  DECL_INITIAL (decl) = value;
+
+	  maxnode = value;
+	}
+    }
+
+  /* Now check if we have duplicate values within the enum */
+  for (pair = values; pair; pair = TREE_CHAIN (pair))
+    {
+      tree succ;
+      tree decl1 = TREE_VALUE (pair);
+      tree val1 = DECL_INITIAL (decl1);
+
+      for (succ = TREE_CHAIN (pair); succ; succ = TREE_CHAIN (succ))
+	{
+	  if (pair != succ)
+	    {
+	      tree decl2 = TREE_VALUE (succ);
+	      tree val2 = DECL_INITIAL (decl2);
+	      if (tree_int_cst_equal (val1, val2))
+		error ("enumerators `%s' and `%s' have equal values",
+		       IDENTIFIER_POINTER (DECL_NAME (decl1)),
+		       IDENTIFIER_POINTER (DECL_NAME (decl2)));
+	    }
+	}
+    }
+
+  TYPE_MIN_VALUE (enumtype) = minnode;
+  TYPE_MAX_VALUE (enumtype) = maxnode;
+
+  precision = get_type_precision (minnode, maxnode);
+
+  if (flag_short_enums || precision > TYPE_PRECISION (integer_type_node))
+    /* Use the width of the narrowest normal C type which is wide enough.  */
+    TYPE_PRECISION (enumtype) = TYPE_PRECISION (type_for_size (precision, 1));
+  else
+    TYPE_PRECISION (enumtype) = TYPE_PRECISION (integer_type_node);
+
+  layout_type (enumtype);
+
+#if 0
+  /* An enum can have some negative values; then it is signed.  */
+  TREE_UNSIGNED (enumtype) = ! tree_int_cst_lt (minnode, integer_zero_node);
+#else
+  /* Z200/1988 page 19 says:
+     For each pair of integer literal expression e1, e2 in the set list NUM (e1)
+     and NUM (e2) must deliver different non-negative results */
+  TREE_UNSIGNED (enumtype) = 1;
+#endif
+
+  for (pair = values; pair; pair = TREE_CHAIN (pair))
+    {
+      tree decl = TREE_VALUE (pair);
+      DECL_SIZE (decl) = TYPE_SIZE (enumtype);
+      DECL_ALIGN (decl) = TYPE_ALIGN (enumtype);
+
+      /* Set the TREE_VALUE to the name, rather than the decl,
+	 since that is what the rest of the compiler expects. */
+      TREE_VALUE (pair) = DECL_INITIAL (decl);
+    }
+
+  /* Fix up all variant types of this enum type.  */
+  for (tem = TYPE_MAIN_VARIANT (enumtype); tem; tem = TYPE_NEXT_VARIANT (tem))
+    {
+      TYPE_VALUES (tem) = TYPE_VALUES (enumtype);
+      TYPE_MIN_VALUE (tem) = TYPE_MIN_VALUE (enumtype);
+      TYPE_MAX_VALUE (tem) = TYPE_MAX_VALUE (enumtype);
+      TYPE_SIZE (tem) = TYPE_SIZE (enumtype);
+      TYPE_MODE (tem) = TYPE_MODE (enumtype);
+      TYPE_PRECISION (tem) = TYPE_PRECISION (enumtype);
+      TYPE_ALIGN (tem) = TYPE_ALIGN (enumtype);
+      TREE_UNSIGNED (tem) = TREE_UNSIGNED (enumtype);
+    }
+
+#if 0
+  /* This matches a push in start_enum.  */
+  pop_obstacks ();
+#endif
+}
+
+tree
+finish_enum (enumtype, values)
+     register tree enumtype, values;
+{
+  TYPE_VALUES (enumtype) = values = nreverse (values);
+
+  /* If satisfy_decl is called on one of the enum CONST_DECLs,
+     this will make sure that the enumtype gets laid out then. */
+  for ( ; values; values = TREE_CHAIN (values))
+    TREE_TYPE (TREE_VALUE (values)) = enumtype;
+
+  return enumtype;
+}
+
+
+/* Build and install a CONST_DECL for one value of the
+   current enumeration type (one that was begun with start_enum).
+   Return a tree-list containing the CONST_DECL and its value.
+   Assignment of sequential values by default is handled here.  */
+
+tree
+build_enumerator (name, value)
+     tree name, value;
+{
+  register tree decl;
+  int named = name != NULL_TREE;
+
+  if (pass == 2)
+    {
+      if (name)
+	(void) get_next_decl ();
+      return NULL_TREE;
+    }
+
+  if (name == NULL_TREE)
+    {
+      static int unnamed_value_warned = 0;
+      static int next_dummy_enum_value = 0;
+      char buf[20];
+      if (!unnamed_value_warned)
+	{
+	  unnamed_value_warned = 1;
+	  warning ("undefined value in SET mode is obsolete and deprecated.");
+	}
+      sprintf (buf, "__star_%d", next_dummy_enum_value++);
+      name = get_identifier (buf);
+    }
+
+  decl = build_decl (CONST_DECL, name, integer_type_node);
+  CH_DECL_ENUM (decl) = 1;
+  DECL_INITIAL (decl) = value;
+  if (named)
+    {
+      if (pass == 0)
+	{
+	  push_obstacks_nochange ();
+	  pushdecl (decl);
+	  finish_decl (decl);
+	}
+      else
+	save_decl (decl);
+    }
+  return build_tree_list (name, decl);
+
+#if 0
+  tree old_value = lookup_name_current_level (name);
+
+  if (old_value != NULL_TREE
+      && TREE_CODE (old_value)=!= CONST_DECL
+      && (value == NULL_TREE || operand_equal_p (value, old_value, 1)))
+    {
+      if (value == NULL_TREE)
+	{
+	  if (TREE_CODE (old_value) == CONST_DECL)
+	    value = DECL_INITIAL (old_value);
+	  else
+	    abort ();
+	}
+      return saveable_tree_cons (old_value, value, NULL_TREE);
+    }
+#endif
+}
+
+/* Record that this function is going to be a varargs function.
+   This is called before store_parm_decls, which is too early
+   to call mark_varargs directly.  */
+
+void
+c_mark_varargs ()
+{
+  c_function_varargs = 1;
+}
+
+/* Function needed for CHILL interface.  */
+tree
+get_parm_decls ()
+{
+  return current_function_parms;
+}
+
+/* Save and restore the variables in this file and elsewhere
+   that keep track of the progress of compilation of the current function.
+   Used for nested functions.  */
+
+struct c_function
+{
+  struct c_function *next;
+  struct scope *scope;
+  tree chill_result_decl;
+  int result_never_set;
+};
+
+struct c_function *c_function_chain;
+
+/* Save and reinitialize the variables
+   used during compilation of a C function.  */
+
+void
+push_chill_function_context ()
+{
+  struct c_function *p
+    = (struct c_function *) xmalloc (sizeof (struct c_function));
+
+  push_function_context ();
+
+  p->next = c_function_chain;
+  c_function_chain = p;
+
+  p->scope = current_scope;
+  p->chill_result_decl = chill_result_decl;
+  p->result_never_set = result_never_set;
+}
+
+/* Restore the variables used during compilation of a C function.  */
+
+void
+pop_chill_function_context ()
+{
+  struct c_function *p = c_function_chain;
+#if 0
+  tree link;
+  /* Bring back all the labels that were shadowed.  */
+  for (link = shadowed_labels; link; link = TREE_CHAIN (link))
+    if (DECL_NAME (TREE_VALUE (link)) != 0)
+      IDENTIFIER_LABEL_VALUE (DECL_NAME (TREE_VALUE (link)))
+	= TREE_VALUE (link);
+#endif
+
+  pop_function_context ();
+
+  c_function_chain = p->next;
+
+  current_scope = p->scope;
+  chill_result_decl = p->chill_result_decl;
+  result_never_set = p->result_never_set;
+
+  free (p);
+}
+
+/* Following from Jukka Virtanen's GNU Pascal */
+/* To implement WITH statement:
+
+   1) Call shadow_record_fields for each record_type element in the WITH
+      element list. Each call creates a new binding level.
+   
+   2) construct a component_ref for EACH field in the record,
+      and store it to the IDENTIFIER_LOCAL_VALUE after adding
+      the old value to the shadow list
+
+   3) let lookup_name do the rest
+
+   4) pop all of the binding levels after the WITH statement ends.
+      (restoring old local values) You have to keep track of the number
+      of times you called it.
+*/
+
+/*
+ * Save an arbitrary tree-expression as the IDENTIFIER_LOCAL_VALUE
+ * of a name.  Save the name's previous value.  Check for name 
+ * collisions with another value under the same name at the same
+ * nesting level.  This is used to implement the DO WITH construct
+ * and the temporary for the location iteration loop.
+ */
+void
+save_expr_under_name (name, expr)
+     tree name, expr;
+{
+  tree alias = build_alias_decl (NULL_TREE, NULL_TREE, name);
+
+  DECL_ABSTRACT_ORIGIN (alias) = expr;
+  TREE_CHAIN (alias) = NULL_TREE;
+  pushdecllist (alias, 0);
+}
+
+void
+do_based_decl (name, mode, base_var)
+     tree name, mode, base_var;
+{
+  tree decl;
+  if (pass == 1)
+    {
+      push_obstacks (&permanent_obstack, &permanent_obstack);
+      decl = make_node (BASED_DECL);
+      DECL_NAME (decl) = name;
+      TREE_TYPE (decl) = mode;
+      DECL_ABSTRACT_ORIGIN (decl) = base_var;
+      save_decl (decl);
+      pop_obstacks ();
+    }
+  else
+    {
+      tree base_decl;
+      decl = get_next_decl ();
+      if (name != DECL_NAME (decl))
+	abort();
+      /* FIXME: This isn't a complete test */
+      base_decl = lookup_name (base_var);
+      if (base_decl == NULL_TREE)
+	error ("BASE variable never declared");
+      else if (TREE_CODE (base_decl) == FUNCTION_DECL)
+	error ("cannot BASE a variable on a PROC/PROCESS name");
+    }
+}
+
+void
+do_based_decls (names, mode, base_var)
+     tree names, mode, base_var;
+{
+  if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST)
+    {
+      for (; names != NULL_TREE; names = TREE_CHAIN (names))
+	do_based_decl (names, mode, base_var);
+    }
+  else if (TREE_CODE (names) != ERROR_MARK)
+    do_based_decl (names, mode, base_var);
+}
+
+/*
+ * Declare the fields so that lookup_name() will find them as
+ * component refs for Pascal WITH or CHILL DO WITH.
+ *
+ * Proceeds to the inner layers of Pascal/CHILL variant record
+ *
+ * Internal routine of shadow_record_fields ()
+ */
+static void
+handle_one_level (parent, fields)
+     tree parent, fields;
+{
+  tree field, name;
+
+  switch (TREE_CODE (TREE_TYPE (parent))) 
+    {
+    case RECORD_TYPE:
+    case UNION_TYPE:
+      for (field = fields; field; field = TREE_CHAIN (field)) {
+	name = DECL_NAME (field);
+	if (name == NULL_TREE || name == ELSE_VARIANT_NAME)
+	  /* proceed through variant part */
+	  handle_one_level (parent, TYPE_FIELDS (TREE_TYPE (field)));
+	else 
+	  {
+	    tree field_alias = make_node (WITH_DECL);
+	    DECL_NAME (field_alias) = name;
+	    TREE_TYPE (field_alias) = TREE_TYPE (field);
+	    DECL_ABSTRACT_ORIGIN (field_alias) = parent;
+	    TREE_CHAIN (field_alias) = NULL_TREE;
+	    pushdecllist (field_alias, 0);
+	  }
+      }
+      break;
+    default:
+      error ("INTERNAL ERROR: handle_one_level is broken");
+    }
+}
+
+/*
+ * For each FIELD_DECL node in a RECORD_TYPE, we have to declare
+ * a name so that lookup_name will find a COMPONENT_REF node
+ * when the name is referenced. This happens in Pascal WITH statement.
+ */
+void
+shadow_record_fields (struct_val)
+     tree struct_val;
+{
+    tree type, parent;
+
+    if (pass == 1 || struct_val == NULL_TREE)
+      return;
+
+    handle_one_level (struct_val, TYPE_FIELDS (TREE_TYPE (struct_val)));
+}
+
+static char exception_prefix [] = "__Ex_";
+
+tree
+build_chill_exception_decl (name)
+     char *name;
+{
+  tree decl, ex_name, ex_init, ex_type;
+  int  name_len = strlen (name);
+  char *ex_string = (char *)
+          alloca (strlen (exception_prefix) + name_len + 1);
+
+  sprintf(ex_string, "%s%s", exception_prefix, name);
+  ex_name = get_identifier (ex_string);
+  decl = IDENTIFIER_LOCAL_VALUE (ex_name);
+  if (decl)
+    return decl;
+
+  /* finish_decl is too eager about switching back to the
+     ambient context.  This decl's rtl must live in the permanent_obstack.  */
+  push_obstacks (&permanent_obstack, &permanent_obstack);
+  push_obstacks_nochange ();
+  ex_type = build_array_type (char_type_node,
+			      build_index_2_type (integer_zero_node,
+						  build_int_2 (name_len, 0)));
+  decl = build_lang_decl (VAR_DECL, ex_name, ex_type);
+  ex_init = build_string (name_len, name);
+  TREE_TYPE (ex_init) = ex_type;
+  DECL_INITIAL (decl) = ex_init;
+  TREE_READONLY (decl) = 1;
+  TREE_STATIC (decl) = 1;
+  pushdecl_top_level (decl);
+  finish_decl (decl);
+  pop_obstacks ();		/* Return to the ambient context.  */
+  return decl;
+}
+
+extern tree      module_init_list;
+
+/*
+ * This function is called from the parser to preface the entire
+ * compilation.  It contains module-level actions and reach-bound
+ * initialization.
+ */
+void
+start_outer_function ()
+{
+  start_chill_function (pass < 2 ? get_identifier ("_GLOBAL_")
+			: DECL_NAME (global_function_decl),
+			void_type_node, NULL_TREE, NULL_TREE, NULL_TREE);
+  global_function_decl = current_function_decl;
+  global_scope = current_scope;
+  chill_at_module_level = 1;
+}
+
+/* This function finishes the global_function_decl, and if it is non-empty
+ * (as indiacted by seen_action), adds it to module_init_list.
+ */
+void
+finish_outer_function ()
+{
+  /* If there was module-level code in this module (not just function
+     declarations), we allocate space for this module's init list entry,
+     and fill in the module's function's address. */
+
+  extern tree initializer_type;
+  char *fname_str = IDENTIFIER_POINTER (DECL_NAME (current_function_decl));
+  char *init_entry_name = (char *)xmalloc ((unsigned)(strlen (fname_str) + 20));
+  tree  init_entry_id;
+  tree  init_entry_decl;
+  tree  initializer;
+      
+  finish_chill_function ();
+
+  chill_at_module_level = 0;
+
+
+  if (!seen_action)
+    return;
+
+  sprintf (init_entry_name, "__tmp_%s_init_entry",  fname_str);
+  init_entry_id = get_identifier (init_entry_name);
+
+  init_entry_decl = build1 (ADDR_EXPR,
+			    TREE_TYPE (TYPE_FIELDS (initializer_type)),
+			    global_function_decl);
+  TREE_CONSTANT (init_entry_decl) = 1;
+  initializer = build (CONSTRUCTOR, initializer_type, NULL_TREE,
+		       tree_cons (NULL_TREE, init_entry_decl,
+				  build_tree_list (NULL_TREE,
+						   null_pointer_node)));
+  TREE_CONSTANT (initializer) = 1;
+  init_entry_decl
+    = do_decl (init_entry_id, initializer_type, 1, 1, initializer, 0);
+  DECL_SOURCE_LINE (init_entry_decl) = 0;
+  if (pass == 1)
+    /* tell chill_finish_compile that there's 
+       module-level code to be processed. */
+    module_init_list = integer_one_node;
+  else if (build_constructor)
+    module_init_list = tree_cons (global_function_decl,
+				  init_entry_decl,
+				  module_init_list);
+
+  make_decl_rtl (global_function_decl, NULL, 0);
+}
diff --git a/gcc/ch/expr.c b/gcc/ch/expr.c
new file mode 100644
index 0000000..16b1e3c
--- /dev/null
+++ b/gcc/ch/expr.c
@@ -0,0 +1,4493 @@
+/* Convert language-specific tree expression to rtl instructions,
+   for GNU CHILL compiler.
+   Copyright (C) 1992, 93, 1994 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.  */
+
+
+#include "config.h"
+#include <stdio.h>
+#include "rtl.h"
+#include "tree.h"
+#include "flags.h"
+#include "expr.h"
+#include "ch-tree.h"
+#include "assert.h"
+#include "lex.h"
+#include "convert.h"
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+extern char **boolean_code_name;
+extern int  flag_old_strings;
+extern tree long_unsigned_type_node;
+extern int  ignore_case;
+extern int  special_UC;
+
+extern void check_for_full_enumeration_handling PROTO((tree));
+extern void chill_handle_case_default           PROTO((void));
+extern void error                               PROTO((char *, ...));
+extern void error_with_decl                     PROTO((tree, char *, ...));
+extern void fatal                               PROTO((char *, ...));
+extern void sorry                               PROTO((char *, ...));
+extern tree stabilize_reference                 PROTO((tree));
+extern void warning                             PROTO((char *, ...));
+
+/* definitions for duration built-ins */
+#define MILLISECS_MULTIPLIER                                 1
+#define SECS_MULTIPLIER            MILLISECS_MULTIPLIER * 1000
+#define MINUTES_MULTIPLIER                SECS_MULTIPLIER * 60
+#define HOURS_MULTIPLIER               MINUTES_MULTIPLIER * 60
+#define DAYS_MULTIPLIER                  HOURS_MULTIPLIER * 24
+
+/* the maximum value for each of the calls */
+#define MILLISECS_MAX                               0xffffffff
+#define SECS_MAX                                       4294967
+#define MINUTES_MAX                                      71582
+#define HOURS_MAX                                         1193
+#define DAYS_MAX                                            49
+
+/* forward declaration */
+rtx chill_expand_expr PROTO((tree, rtx, enum machine_mode, 
+			     enum expand_modifier));
+
+/* variable to hold the type the DESCR built-in returns */
+static tree descr_type = NULL_TREE;
+
+
+/* called from ch-lex.l */
+void
+init_chill_expand ()
+{
+  lang_expand_expr = chill_expand_expr;
+}
+
+/* Take the address of something that needs to be passed by reference. */
+tree
+force_addr_of (value)
+     tree value;
+{
+  /* FIXME.  Move to memory, if needed. */
+  if (TREE_CODE (value) == INDIRECT_REF)
+    return convert_to_pointer (ptr_type_node, TREE_OPERAND (value, 0));
+  mark_addressable (value);
+  return build1 (ADDR_EXPR, ptr_type_node, value);
+}
+
+/* Check that EXP has a known type. */
+
+tree
+check_have_mode (exp, context)
+     tree exp;
+     char *context;
+{
+  if (TREE_CODE (exp) != ERROR_MARK && TREE_TYPE (exp) == NULL_TREE)
+    {
+      if (TREE_CODE (exp) == CONSTRUCTOR)
+	error ("tuple without specified mode not allowed in %s", context);
+      else if (TREE_CODE (exp) == COND_EXPR || TREE_CODE (exp) == CASE_EXPR)
+	error ("conditional expression not allowed in %s", context);
+      else
+	error ("internal error:  unknown expression mode in %s", context);
+
+      return error_mark_node;
+    }
+  return exp;
+}
+
+/* Check that EXP is discrete.  Handle conversion if flag_old_strings. */
+
+tree
+check_case_selector (exp)
+     tree exp;
+{
+  if (exp != NULL_TREE && TREE_TYPE (exp) != NULL_TREE)
+    exp = convert_to_discrete (exp);
+  if (exp)
+    return exp;
+  error ("CASE selector is not a discrete expression");
+  return error_mark_node;
+}
+
+tree
+check_case_selector_list (list)
+     tree list;
+{
+  tree selector, exp, return_list = NULL_TREE;
+
+  for (selector = list; selector != NULL_TREE; selector = TREE_CHAIN (selector))
+    {
+      exp = check_case_selector (TREE_VALUE (selector));
+      if (exp == error_mark_node)
+	{
+	  return_list = error_mark_node;
+	  break;
+	}
+      return_list = tree_cons (TREE_PURPOSE (selector), exp, return_list);
+    }
+
+  return nreverse(return_list);
+}
+
+tree
+chill_expand_case_expr (expr)
+     tree expr;
+{
+  tree selector_list = TREE_OPERAND (expr, 0), selector;
+  tree alternatives  = TREE_OPERAND (expr, 1);
+  tree type = TREE_TYPE (expr);
+  int  else_seen = 0;
+  tree result;
+
+  if (TREE_CODE (selector_list) != TREE_LIST
+    || TREE_CODE (alternatives) != TREE_LIST)
+    abort();
+  if (TREE_CHAIN (selector_list) != NULL_TREE)
+    abort ();
+
+  /* make a temp for the case result */
+  result = decl_temp1 (get_unique_identifier ("CASE_EXPR"),
+		       type, 0, NULL_TREE, 0, 0);
+
+  selector = check_case_selector (TREE_VALUE (selector_list));
+
+  expand_start_case (1, selector, TREE_TYPE (selector), "CASE expression");
+
+  alternatives = nreverse (alternatives);
+  for ( ; alternatives != NULL_TREE; alternatives = TREE_CHAIN (alternatives))
+    { 
+      tree labels = TREE_PURPOSE (alternatives), t;
+      
+      if (labels == NULL_TREE)
+	{
+	  chill_handle_case_default ();
+	  else_seen++;
+        }
+      else
+	{
+	  tree label;
+	  if (labels != NULL_TREE)
+	    {
+	      for (label = TREE_VALUE (labels);
+		   label != NULL_TREE; label = TREE_CHAIN (label))
+		chill_handle_case_label (TREE_VALUE (label), selector);
+	      labels = TREE_CHAIN (labels);
+	      if (labels != NULL_TREE)
+		error ("The number of CASE selectors does not match the number "
+                       "of CASE label lists");
+		
+	    }
+        }
+
+      t = build (MODIFY_EXPR, type, result,
+		 convert (type, TREE_VALUE (alternatives)));
+      TREE_SIDE_EFFECTS (t) = 1;
+      expand_expr_stmt (t);
+      expand_exit_something ();
+    }
+
+  if (!else_seen)
+    {
+      chill_handle_case_default ();
+      expand_exit_something ();
+#if 0
+      expand_raise ();
+#endif
+
+      check_missing_cases (TREE_TYPE (selector));
+    }
+
+  expand_end_case (selector);
+  return result;
+}
+
+/* Hook used by expand_expr to expand CHILL-specific tree codes.  */
+
+rtx
+chill_expand_expr (exp, target, tmode, modifier)
+     tree exp;
+     rtx target;
+     enum machine_mode tmode;
+     enum expand_modifier modifier;
+{
+  tree type = TREE_TYPE (exp);
+  register enum machine_mode mode = TYPE_MODE (type);
+  register enum tree_code code = TREE_CODE (exp);
+  rtx original_target = target;
+  rtx op0, op1;
+  int ignore = target == const0_rtx;
+  char *lib_func;                   /* name of library routine */
+
+  if (ignore)
+    target = 0, original_target = 0;
+
+  /* No sense saving up arithmetic to be done
+     if it's all in the wrong mode to form part of an address.
+     And force_operand won't know whether to sign-extend or zero-extend.  */
+
+  if (mode != Pmode && modifier == EXPAND_SUM)
+    modifier = EXPAND_NORMAL;
+
+  switch (code)
+    {
+    case STRING_EQ_EXPR:
+    case STRING_LT_EXPR:
+      {
+	rtx func = gen_rtx (SYMBOL_REF, Pmode,
+			    code == STRING_EQ_EXPR ? "__eqstring"
+			    : "__ltstring");
+	tree exp0 = TREE_OPERAND (exp, 0);
+	tree exp1 = TREE_OPERAND (exp, 1);
+	tree size0, size1;
+	rtx op0, op1, siz0, siz1;
+	if (chill_varying_type_p (TREE_TYPE (exp0)))
+	  {
+	    exp0 = save_if_needed (exp0);
+	    size0 = convert (integer_type_node,
+			     build_component_ref (exp0, var_length_id));
+	    exp0 = build_component_ref (exp0, var_data_id);
+	  }
+	else
+	  size0 = size_in_bytes (TREE_TYPE (exp0));
+	if (chill_varying_type_p (TREE_TYPE (exp1)))
+	  {
+	    exp1 = save_if_needed (exp1);
+	    size1 = convert (integer_type_node,
+			     build_component_ref (exp1, var_length_id));
+	    exp1 = build_component_ref (exp1, var_data_id);
+	  }
+	else
+	  size1 = size_in_bytes (TREE_TYPE (exp1));
+
+	op0 = expand_expr (force_addr_of (exp0),
+			   NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
+	op1 = expand_expr (force_addr_of (exp1),
+			   NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
+	siz0 = expand_expr (size0, NULL_RTX, VOIDmode, 0);
+	siz1 = expand_expr (size1, NULL_RTX, VOIDmode, 0);
+	return emit_library_call_value (func, target,
+					0, QImode, 4,
+					op0, GET_MODE (op0),
+					siz0, TYPE_MODE (sizetype),
+					op1, GET_MODE (op1),
+					siz1, TYPE_MODE (sizetype));
+      }
+
+    case CASE_EXPR:
+      return expand_expr (chill_expand_case_expr (exp),
+			  NULL_RTX, VOIDmode, 0);
+      break;
+
+    case SLICE_EXPR:
+      {
+	tree func_call;
+	tree array = TREE_OPERAND (exp, 0);
+	tree min_value = TREE_OPERAND (exp, 1);
+	tree length = TREE_OPERAND (exp, 2);
+	tree new_type = TREE_TYPE (exp);
+	tree temp = decl_temp1 (get_unique_identifier ("BITSTRING"),
+				new_type, 0, NULL_TREE, 0, 0);
+	if (! CH_REFERABLE (array) && TYPE_MODE (TREE_TYPE (array)) != BLKmode)
+	  array = decl_temp1 (get_unique_identifier ("BSTRINGVAL"),
+				TREE_TYPE (array), 0, array, 0, 0);
+	func_call = build_chill_function_call (
+		    lookup_name (get_identifier ("__psslice")),
+			   tree_cons (NULL_TREE, 
+                             build_chill_addr_expr (temp, (char *)0),
+			       tree_cons (NULL_TREE, length,
+		                 tree_cons (NULL_TREE,
+                                    force_addr_of (array),
+			             tree_cons (NULL_TREE, powersetlen (array),
+			               tree_cons (NULL_TREE, convert (integer_type_node, min_value),
+				         tree_cons (NULL_TREE, length, NULL_TREE)))))));
+	expand_expr (func_call, const0_rtx, VOIDmode, 0);
+	emit_queue ();
+	return expand_expr (temp, ignore ? const0_rtx : target,
+			    VOIDmode, 0);
+      }
+      
+    /* void __concatstring (char *out, char *left, unsigned left_len,
+                            char *right, unsigned right_len) */
+    case CONCAT_EXPR:
+      {
+	tree exp0 = TREE_OPERAND (exp, 0);
+	tree exp1 = TREE_OPERAND (exp, 1);
+	rtx size0, size1;
+	rtx targetx;
+
+	if (TREE_CODE (exp1) == UNDEFINED_EXPR)
+	  {
+	    if (TYPE_MODE (TREE_TYPE (exp0)) == BLKmode
+		&& TYPE_MODE (TREE_TYPE (exp)) == BLKmode)
+	      {
+		rtx temp = expand_expr (exp0, target, tmode, modifier);
+		if (temp == target || target == NULL_RTX)
+		  return temp;
+		emit_block_move (target, temp, expr_size (exp0),
+				 TYPE_ALIGN (TREE_TYPE(exp0)) / BITS_PER_UNIT);
+		return target;
+	      }
+	    else
+	      {
+		exp0 = force_addr_of (exp0);
+		exp0 = convert (build_pointer_type (TREE_TYPE (exp)), exp0);
+		exp0 = build1 (INDIRECT_REF, TREE_TYPE (exp), exp0);
+		return expand_expr (exp0,
+				    NULL_RTX, Pmode, EXPAND_CONST_ADDRESS);
+	      }
+	  }
+
+	if (TREE_CODE (type) == ARRAY_TYPE)
+	  {
+	    /* No need to handle scalars or varying strings here, since that
+	       was done in convert or build_concat_expr. */
+	    size0 = expand_expr (size_in_bytes (TREE_TYPE (exp0)),
+				 NULL_RTX, Pmode, EXPAND_CONST_ADDRESS);
+
+	    size1 = expand_expr (size_in_bytes (TREE_TYPE (exp1)),
+				   NULL_RTX, Pmode, EXPAND_CONST_ADDRESS);
+
+	    /* build a temp for the result, target is its address */
+	    if (target == NULL_RTX)
+	      {
+		tree type0 = TREE_TYPE (exp0);
+		tree type1 = TREE_TYPE (exp1);
+		int	len0 = int_size_in_bytes (type0);
+		int	len1 = int_size_in_bytes (type1);
+
+		if (len0 < 0 && TYPE_ARRAY_MAX_SIZE (type0)
+		    && TREE_CODE (TYPE_ARRAY_MAX_SIZE (type0)) == INTEGER_CST)
+		  len0 = TREE_INT_CST_LOW (TYPE_ARRAY_MAX_SIZE (type0));
+
+		if (len1 < 0 && TYPE_ARRAY_MAX_SIZE (type1)
+		    && TREE_CODE (TYPE_ARRAY_MAX_SIZE (type1)) == INTEGER_CST)
+		  len1 = TREE_INT_CST_LOW (TYPE_ARRAY_MAX_SIZE (type1));
+
+		if (len0 < 0 || len1 < 0)
+		  fatal ("internal error - don't know how much space is needed for concatenation");
+		target = assign_stack_temp (mode, len0 + len1, 0);
+		preserve_temp_slots (target);
+	      }
+	  }
+	else if (TREE_CODE (type) == SET_TYPE)
+	  {
+	    if (target == NULL_RTX)
+	      {
+		target = assign_stack_temp (mode, int_size_in_bytes (type), 0);
+		preserve_temp_slots (target);
+	      }
+	  }
+	else
+	  abort ();
+
+	if (GET_CODE (target) == MEM)
+	  targetx = target;
+	else
+	  targetx = assign_stack_temp (mode, GET_MODE_SIZE (mode), 0);
+
+	/* expand 1st operand to a pointer to the array */
+	op0 = expand_expr (force_addr_of (exp0),
+			   NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
+
+	/* expand 2nd operand to a pointer to the array */
+	op1 = expand_expr (force_addr_of (exp1),
+			   NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
+
+	if (TREE_CODE (type) == SET_TYPE)
+	  {
+	    size0 = expand_expr (powersetlen (exp0),
+				 NULL_RTX, VOIDmode, 0);
+	    size1 = expand_expr (powersetlen (exp1),
+				 NULL_RTX, VOIDmode, 0);
+
+	    emit_library_call (gen_rtx(SYMBOL_REF, Pmode, "__concatps"),
+			       0, Pmode, 5, XEXP (targetx, 0), Pmode,
+			       op0, GET_MODE (op0),
+			       convert_to_mode (TYPE_MODE (sizetype),
+						size0, TREE_UNSIGNED (sizetype)),
+			       TYPE_MODE (sizetype),
+			       op1, GET_MODE (op1),
+			       convert_to_mode (TYPE_MODE (sizetype),
+						size1, TREE_UNSIGNED (sizetype)),
+			       TYPE_MODE (sizetype));
+	  }
+	else
+	  {
+	    /* copy left, then right array to target */
+	    emit_library_call (gen_rtx(SYMBOL_REF, Pmode, "__concatstring"),
+			       0, Pmode, 5, XEXP (targetx, 0), Pmode,
+			       op0, GET_MODE (op0),
+			       convert_to_mode (TYPE_MODE (sizetype),
+						size0, TREE_UNSIGNED (sizetype)),
+			       TYPE_MODE (sizetype),
+			       op1, GET_MODE (op1),
+			       convert_to_mode (TYPE_MODE (sizetype),
+						size1, TREE_UNSIGNED (sizetype)),
+			       TYPE_MODE (sizetype));
+	  }
+	if (targetx != target)
+	  emit_move_insn (target, targetx);
+	return target;
+      }
+
+      /* FIXME: the set_length computed below is a compile-time constant;
+	 you'll need to re-write that part for VARYING bit arrays, and
+	 possibly the set pointer will need to be adjusted to point past
+	 the word containing its dynamic length. */
+
+    /* void __notpowerset (char *out, char *src,
+       unsigned long bitlength) */
+    case SET_NOT_EXPR:
+      {
+	
+	tree expr = TREE_OPERAND (exp, 0);
+	tree tsize = powersetlen (expr);
+	rtx targetx;
+
+	if (TREE_CODE (TREE_TYPE (expr)) != SET_TYPE)
+	  tsize = fold (build (MULT_EXPR, sizetype, tsize, 
+			       size_int (BITS_PER_UNIT)));
+
+	/* expand 1st operand to a pointer to the set */
+	op0 = expand_expr (force_addr_of (expr),
+			   NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
+
+	/* build a temp for the result, target is its address */
+	if (target == NULL_RTX)
+	  {
+	    target = assign_stack_temp (TYPE_MODE (TREE_TYPE (exp)), 
+					int_size_in_bytes (TREE_TYPE (exp)),
+					0);
+	    preserve_temp_slots (target);
+	  }
+	if (GET_CODE (target) == MEM)
+	  targetx = target;
+	else
+	  targetx = assign_stack_temp (GET_MODE (target),
+				       GET_MODE_SIZE (GET_MODE (target)),
+				       0);
+	emit_library_call (gen_rtx(SYMBOL_REF, Pmode, "__notpowerset"), 
+			   0, VOIDmode, 3, XEXP (targetx, 0), Pmode,
+			   op0, GET_MODE (op0),
+			   expand_expr (tsize, NULL_RTX, MEM, 
+					EXPAND_CONST_ADDRESS),
+			   TYPE_MODE (long_unsigned_type_node));
+	if (targetx != target)
+	  emit_move_insn (target, targetx);
+	return target;
+      }
+
+    case SET_DIFF_EXPR:
+      lib_func = "__diffpowerset";
+      goto format_2;
+
+    case SET_IOR_EXPR:
+      lib_func = "__orpowerset";
+      goto format_2;
+
+    case SET_XOR_EXPR:
+      lib_func = "__xorpowerset";
+      goto format_2;
+
+    /* void __diffpowerset (char *out, char *left, char *right,
+                            unsigned bitlength) */
+    case SET_AND_EXPR:
+      lib_func = "__andpowerset";
+    format_2:
+      {
+	tree expr = TREE_OPERAND (exp, 0);
+	tree tsize = powersetlen (expr);
+	rtx targetx;
+
+	if (TREE_CODE (TREE_TYPE (expr)) != SET_TYPE)
+	  tsize = fold (build (MULT_EXPR, long_unsigned_type_node,
+			       tsize, 
+			       size_int (BITS_PER_UNIT)));
+
+	/* expand 1st operand to a pointer to the set */
+        op0 = expand_expr (force_addr_of (expr),
+			   NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
+
+	/* expand 2nd operand to a pointer to the set */
+        op1 = expand_expr (force_addr_of (TREE_OPERAND (exp, 1)),
+			   NULL_RTX, MEM,
+			   EXPAND_CONST_ADDRESS);
+
+/* FIXME: re-examine this code - the unary operator code above has recently
+   (93/03/12) been changed a lot.  Should this code also change? */
+	/* build a temp for the result, target is its address */
+	if (target == NULL_RTX)
+	  {
+	    target = assign_stack_temp (TYPE_MODE (TREE_TYPE (exp)), 
+					int_size_in_bytes (TREE_TYPE (exp)),
+					0);
+	    preserve_temp_slots (target);
+	  }
+	if (GET_CODE (target) == MEM)
+	  targetx = target;
+	else
+	  targetx = assign_stack_temp (GET_MODE (target),
+				       GET_MODE_SIZE (GET_MODE (target)), 0);
+	emit_library_call (gen_rtx(SYMBOL_REF, Pmode, lib_func),
+			   0, VOIDmode, 4, XEXP (targetx, 0), Pmode,
+			   op0, GET_MODE (op0), op1, GET_MODE (op1),
+			   expand_expr (tsize, NULL_RTX, MEM, 
+					EXPAND_CONST_ADDRESS),
+			   TYPE_MODE (long_unsigned_type_node));
+	if (target != targetx)
+	  emit_move_insn (target, targetx);
+	return target;
+      }
+
+    case SET_IN_EXPR:
+      {
+	extern tree lookup_name PROTO((tree));
+	tree set = TREE_OPERAND (exp, 1);
+	tree pos = convert (long_unsigned_type_node, TREE_OPERAND (exp, 0));
+	tree set_type = TREE_TYPE (set);
+	tree set_length = discrete_count (TYPE_DOMAIN (set_type));
+	tree min_val = convert (long_integer_type_node,
+				TYPE_MIN_VALUE (TYPE_DOMAIN (set_type)));
+	tree fcall;
+	
+	/* FIXME: Function-call not needed if pos and width are constant! */
+	if (! mark_addressable (set))
+	  {
+	    error ("powerset is not addressable");
+	    return const0_rtx;
+	  }
+	/* we use different functions for bitstrings and powersets */
+	if (CH_BOOLS_TYPE_P (set_type))
+	  fcall =
+             build_chill_function_call (
+               lookup_name (get_identifier ("__inbitstring")),
+	         tree_cons (NULL_TREE, 
+	           convert (long_unsigned_type_node, pos), 
+		     tree_cons (NULL_TREE,
+		       build1 (ADDR_EXPR, build_pointer_type (set_type), set),
+		         tree_cons (NULL_TREE, 
+		           convert (long_unsigned_type_node, set_length),
+		             tree_cons (NULL_TREE, min_val,
+                               tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                                 build_tree_list (NULL_TREE, get_chill_linenumber ())))))));
+	else
+	  fcall =
+             build_chill_function_call (
+               lookup_name (get_identifier ("__inpowerset")),
+	         tree_cons (NULL_TREE, 
+	           convert (long_unsigned_type_node, pos), 
+		     tree_cons (NULL_TREE,
+		       build1 (ADDR_EXPR, build_pointer_type (set_type), set),
+		         tree_cons (NULL_TREE, 
+		           convert (long_unsigned_type_node, set_length),
+		             build_tree_list (NULL_TREE, min_val)))));
+	return expand_expr (fcall, NULL_RTX, VOIDmode, 0);
+      }
+
+    case PACKED_ARRAY_REF:
+      {
+	extern tree lookup_name PROTO((tree));
+	tree array = TREE_OPERAND (exp, 0);
+	tree pos = save_expr (TREE_OPERAND (exp, 1));
+	tree array_type = TREE_TYPE (array);
+	tree array_length = discrete_count (TYPE_DOMAIN (array_type));
+	tree min_val = convert (long_integer_type_node,
+				TYPE_MIN_VALUE (TYPE_DOMAIN (array_type)));
+	tree fcall;
+	
+	/* FIXME: Function-call not needed if pos and width are constant! */
+	/* TODO: make sure this makes sense. */
+	if (! mark_addressable (array))
+	  {
+	    error ("array is not addressable");
+	    return const0_rtx;
+	  }
+	fcall =
+	  build_chill_function_call (
+               lookup_name (get_identifier ("__inpowerset")),
+	         tree_cons (NULL_TREE, 
+	           convert (long_unsigned_type_node, pos), 
+		     tree_cons (NULL_TREE,
+		       build1 (ADDR_EXPR, build_pointer_type (array_type), array),
+		         tree_cons (NULL_TREE, 
+		           convert (long_unsigned_type_node, array_length),
+		             build_tree_list (NULL_TREE, min_val)))));
+	return expand_expr (fcall, NULL_RTX, VOIDmode, 0);
+      }
+
+    case UNDEFINED_EXPR:
+      if (target == 0)
+	{
+	  target = assign_stack_temp (TYPE_MODE (TREE_TYPE (exp)), 
+				      int_size_in_bytes (TREE_TYPE (exp)), 0);
+	  preserve_temp_slots (target);
+	}
+      /* We don't actually need to *do* anything ... */
+      return target;
+
+    default:
+      break;
+    }
+
+  /* NOTREACHED */
+  return NULL;
+}
+
+/* Check that the argument list has a length in [min_length .. max_length].
+   (max_length == -1 means "infinite".)
+   If so return the actual length.
+   Otherwise, return an error message and return -1. */
+
+static int
+check_arglist_length (args, min_length, max_length, name)
+     tree args;
+     int min_length;
+     int max_length;
+     tree name;
+{
+  int length = list_length (args);
+  if (length < min_length)
+    error ("Too few arguments in call to `%s'", IDENTIFIER_POINTER (name));
+  else if (max_length != -1 && length > max_length)
+    error ("Too many arguments in call to `%s'", IDENTIFIER_POINTER (name));
+  else
+    return length;
+  return -1;
+}
+
+/*
+ * This is the code from c-typeck.c, with the C-specific cruft
+ * removed (possibly I just didn't understand it, but it was
+ * apparently simply discarding part of my LIST).
+ */
+static tree
+internal_build_compound_expr (list, first_p)
+     tree list;
+     int first_p;
+{
+  register tree rest;
+
+  if (TREE_CHAIN (list) == 0)
+    return TREE_VALUE (list);
+
+  rest = internal_build_compound_expr (TREE_CHAIN (list), FALSE);
+
+  if (! TREE_SIDE_EFFECTS (TREE_VALUE (list)))
+    return rest;
+
+  return build (COMPOUND_EXPR, TREE_TYPE (rest), TREE_VALUE (list), rest);
+}
+
+
+/* Given a list of expressions, return a compound expression
+   that performs them all and returns the value of the last of them.  */
+/* FIXME: this should be merged with the C version */
+tree
+build_chill_compound_expr (list)
+     tree list;
+{
+  return internal_build_compound_expr (list, TRUE);
+}
+
+/* Given an expression PTR for a pointer, return an expression
+   for the value pointed to.
+   do_empty_check is 0, don't perform a NULL pointer check,
+   else do it. */
+
+tree
+build_chill_indirect_ref (ptr, mode, do_empty_check)
+     tree ptr;
+     tree mode;
+     int do_empty_check;
+{
+  register tree type;
+
+  if (ptr == NULL_TREE || TREE_CODE (ptr) == ERROR_MARK)
+    return ptr;
+  if (mode != NULL_TREE && TREE_CODE (mode) == ERROR_MARK)
+    return error_mark_node;
+
+  type = TREE_TYPE (ptr);
+
+  if (TREE_CODE (type) == REFERENCE_TYPE)
+    {
+      type = TREE_TYPE (type);
+      ptr = convert (type, ptr);
+    }
+
+  /* check for ptr is really a POINTER */
+  if (TREE_CODE (type) != POINTER_TYPE)
+    {
+      error ("cannot dereference, not a pointer.");
+      return error_mark_node;
+    }
+  
+  if (mode && TREE_CODE (mode) == IDENTIFIER_NODE)
+    {
+      tree decl = lookup_name (mode);
+      if (decl == NULL_TREE || TREE_CODE (decl) != TYPE_DECL)
+	{
+	  if (pass == 2)
+	    error ("missing '.' operator or undefined mode name `%s'.",
+		   IDENTIFIER_POINTER (mode));
+#if 0
+	  error ("You have forgotten the '.' operator which must");
+	  error (" precede a STRUCT field reference, or `%s' is an undefined mode", 
+		 IDENTIFIER_POINTER (mode));
+#endif
+	  return error_mark_node;
+	}
+    }
+
+  if (mode)
+    {
+      mode = get_type_of (mode);
+      ptr = convert (build_pointer_type (mode), ptr);
+    }
+  else if (type == ptr_type_node)
+    {
+      error ("Can't dereference PTR value using unary `->'.");
+      return error_mark_node;
+    }
+
+  if (do_empty_check)
+    ptr = check_non_null (ptr);
+
+  type = TREE_TYPE (ptr);
+
+  if (TREE_CODE (type) == POINTER_TYPE)
+    {
+      if (TREE_CODE (ptr) == ADDR_EXPR
+	  && !flag_volatile
+	  && (TREE_TYPE (TREE_OPERAND (ptr, 0))
+	      == TREE_TYPE (type)))
+	return TREE_OPERAND (ptr, 0);
+      else
+	{
+	  tree t = TREE_TYPE (type);
+	  register tree ref = build1 (INDIRECT_REF,
+				      TYPE_MAIN_VARIANT (t), ptr);
+
+	  if (TYPE_SIZE (t) == 0 && TREE_CODE (t) != ARRAY_TYPE)
+	    {
+	      error ("dereferencing pointer to incomplete type");
+	      return error_mark_node;
+	    }
+	  if (TREE_CODE (t) == VOID_TYPE)
+	    warning ("dereferencing `void *' pointer");
+
+	  /* We *must* set TREE_READONLY when dereferencing a pointer to const,
+	     so that we get the proper error message if the result is used
+	     to assign to.  Also, &* is supposed to be a no-op.
+	     And ANSI C seems to specify that the type of the result
+	     should be the const type.  */
+	  /* A de-reference of a pointer to const is not a const.  It is valid
+	     to change it via some other pointer.  */
+	  TREE_READONLY (ref) = TYPE_READONLY (t);
+	  TREE_SIDE_EFFECTS (ref)
+	    = TYPE_VOLATILE (t) || TREE_SIDE_EFFECTS (ptr) || flag_volatile;
+	  TREE_THIS_VOLATILE (ref) = TYPE_VOLATILE (t) || flag_volatile;
+	  return ref;
+	}
+    }
+  else if (TREE_CODE (ptr) != ERROR_MARK)
+    error ("invalid type argument of `->'");
+  return error_mark_node;
+}
+
+/* NODE is a COMPONENT_REF whose mode is an IDENTIFIER,
+   which is replaced by the proper FIELD_DECL.
+   Also do the right thing for variant records. */
+
+tree
+resolve_component_ref (node)
+     tree node;
+{
+  tree datum = TREE_OPERAND (node, 0);
+  tree field_name = TREE_OPERAND (node, 1);
+  tree type = TREE_TYPE (datum);
+  tree field;
+  if (TREE_CODE (datum) == ERROR_MARK)
+    return error_mark_node;
+  if (TREE_CODE (type) == REFERENCE_TYPE)
+    {
+      type = TREE_TYPE (type);
+      TREE_OPERAND (node, 0) = datum = convert (type, datum);
+    }
+  if (TREE_CODE (type) != RECORD_TYPE)
+    {
+      error ("operand of '.' is not a STRUCT");
+      return error_mark_node;
+    }
+
+  TREE_READONLY (node) = TREE_READONLY (datum);
+  TREE_SIDE_EFFECTS (node) = TREE_SIDE_EFFECTS (datum);
+
+  for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (TREE_TYPE (field)) == UNION_TYPE)
+	{
+	  tree variant;
+	  for (variant = TYPE_FIELDS (TREE_TYPE (field));
+	       variant;  variant = TREE_CHAIN (variant))
+	    {
+	      tree vfield;
+	      for (vfield = TYPE_FIELDS (TREE_TYPE (variant));
+		   vfield; vfield = TREE_CHAIN (vfield))
+		{
+		  if (DECL_NAME (vfield) == field_name)
+		    { /* Found a variant field */
+		      datum = build (COMPONENT_REF, TREE_TYPE (field),
+				     datum, field);
+		      datum = build (COMPONENT_REF, TREE_TYPE (variant),
+				     datum, variant);
+		      TREE_OPERAND (node, 0) = datum;
+		      TREE_OPERAND (node, 1) = vfield;
+		      TREE_TYPE (node) = TREE_TYPE (vfield);
+		      TREE_READONLY (node) |= TYPE_READONLY (TREE_TYPE (node));
+#if 0
+		      if (flag_testing_tags)
+			{
+			  tree tagtest = NOT IMPLEMENTED;
+			  tree tagf = ridpointers[(int) RID_RANGEFAIL];
+			  node = check_expression (node, tagtest,
+						   tagf);
+			}
+#endif
+		      return node;
+		    }
+		}
+	    }
+	}
+
+      if (DECL_NAME (field) == field_name)
+	{ /* Found a fixed field */
+	  TREE_OPERAND (node, 1) = field;
+	  TREE_TYPE (node) = TREE_TYPE (field);
+	  TREE_READONLY (node) |= TYPE_READONLY (TREE_TYPE (node));
+	  return fold (node);
+	}
+    }
+
+  error ("No field named `%s'", IDENTIFIER_POINTER (field_name));
+  return error_mark_node;
+}
+
+tree
+build_component_ref (datum, field_name)
+  tree datum, field_name;
+{
+  tree node = build_nt (COMPONENT_REF, datum, field_name);
+  if (pass != 1)
+    node = resolve_component_ref (node);
+  return node;
+}
+
+/*
+ function checks (for build_chill_component_ref) if a given
+ type is really an instance type. CH_IS_INSTANCE_MODE is not
+ strict enough in this case, i.e. SYNMODE foo = STRUCT (a, b UINT)
+ is compatible to INSTANCE. */
+
+static int
+is_really_instance (type)
+     tree type;
+{
+  tree decl = TYPE_NAME (type);
+
+  if (decl == NULL_TREE)
+    /* this is not an instance */
+    return 0;
+
+  if (DECL_NAME (decl) == ridpointers[(int)RID_INSTANCE])
+    /* this is an instance */
+    return 1;
+
+  if (TYPE_FIELDS (type) == TYPE_FIELDS (instance_type_node))
+    /* we have a NEWMODE'd instance */
+    return 1;
+
+  return 0;
+}
+
+/* This function is called by the parse.
+   Here we check if the user tries to access a field in a type which is
+   layouted as a structure but isn't like INSTANCE, BUFFER, EVENT, ASSOCIATION,
+   ACCESS, TEXT, or VARYING array or character string.
+   We don't do this in build_component_ref cause this function gets
+   called from the compiler to access fields in one of the above mentioned
+   modes. */
+tree
+build_chill_component_ref (datum, field_name)
+     tree datum, field_name;
+{
+  tree type = TREE_TYPE (datum);
+  if ((type != NULL_TREE && TREE_CODE (type) == RECORD_TYPE) &&
+      ((CH_IS_INSTANCE_MODE (type) && is_really_instance (type)) ||
+	CH_IS_BUFFER_MODE (type) ||
+       CH_IS_EVENT_MODE (type) || CH_IS_ASSOCIATION_MODE (type) ||
+       CH_IS_ACCESS_MODE (type) || CH_IS_TEXT_MODE (type) ||
+       chill_varying_type_p (type)))
+    {
+      error ("operand of '.' is not a STRUCT");
+      return error_mark_node;
+    }
+  return build_component_ref (datum, field_name);
+}
+
+/*
+ * Check for invalid binary operands & unary operands
+ * RIGHT is 1 if checking right operand or unary operand;
+ * it is 0 if checking left operand.
+ *
+ * return 1 if the given operand is NOT compatible as the
+ * operand of the given operator
+ *
+ * return 0 if they might be compatible
+ */
+static int
+invalid_operand (code, type, right)
+     enum chill_tree_code code;
+     tree type;
+     int right; /* 1 if right operand */
+{
+  switch ((int)code)
+    {
+    case ADDR_EXPR:
+      break;
+    case BIT_AND_EXPR:
+    case BIT_IOR_EXPR:
+    case BIT_NOT_EXPR:
+    case BIT_XOR_EXPR:
+      goto relationals;
+    case CASE_EXPR:
+      break;
+    case CEIL_MOD_EXPR:
+      goto numerics;
+    case CONCAT_EXPR:           /* must be static or varying char array */
+      if (TREE_CODE (type) == CHAR_TYPE)
+	return 0;
+      if (TREE_CODE (type) == ARRAY_TYPE 
+	   && TREE_CODE (TREE_TYPE (type)) == CHAR_TYPE)
+	return 0;
+      if (!chill_varying_type_p (type))
+	  return 1;
+      if (TREE_CODE (TREE_TYPE (CH_VARYING_ARRAY_TYPE (type)))
+            == CHAR_TYPE)
+        return 0;
+      else
+        return 1;
+    /* note: CHILL conditional expressions (COND_EXPR) won't come
+     *  through here; they're routed straight to C-specific code */
+    case EQ_EXPR:
+      return 0;                  /* ANYTHING can be compared equal */
+    case FLOOR_MOD_EXPR:
+      if (TREE_CODE (type) == REAL_TYPE)
+	return 1;
+      goto numerics;
+    case GE_EXPR:
+    case GT_EXPR:
+      goto relatables;
+    case SET_IN_EXPR:
+      if (TREE_CODE (type) == SET_TYPE)
+        return 0;
+      else
+        return 1;
+    case PACKED_ARRAY_REF:
+      if (TREE_CODE (type) == ARRAY_TYPE)
+        return 0;
+      else
+        return 1;
+    case LE_EXPR:
+    case LT_EXPR:
+    relatables:
+      switch ((int)TREE_CODE(type))   /* right operand must be set/bitarray type */
+	{
+	case ARRAY_TYPE:
+	  if (TREE_CODE (TREE_TYPE (type)) == CHAR_TYPE)
+	    return 0;
+	  else
+	    return 1;
+	case BOOLEAN_TYPE:
+	case CHAR_TYPE:
+	case COMPLEX_TYPE:
+	case ENUMERAL_TYPE:
+	case INTEGER_TYPE:
+	case OFFSET_TYPE:
+	case POINTER_TYPE:
+	case REAL_TYPE:
+	case SET_TYPE:
+	  return 0;
+	case FILE_TYPE:
+	case FUNCTION_TYPE:
+	case GRANT_TYPE:
+	case LANG_TYPE:
+	case METHOD_TYPE:
+	  return 1;
+	case RECORD_TYPE:
+	  if (chill_varying_type_p (type)
+	      && TREE_CODE (TREE_TYPE (CH_VARYING_ARRAY_TYPE (type))) == CHAR_TYPE)
+	    return 0;
+	  else
+	    return 1;
+	case REFERENCE_TYPE:
+	case SEIZE_TYPE:
+	case UNION_TYPE:
+	case VOID_TYPE:
+	  return 1;
+	}
+      break;
+    case MINUS_EXPR:
+    case MULT_EXPR:
+      goto numerics;
+    case NEGATE_EXPR:
+      if (TREE_CODE (type) == BOOLEAN_TYPE)
+        return 0;
+      else
+	goto numerics;
+    case NE_EXPR:
+      return 0;                  /* ANYTHING can be compared unequal */
+    case NOP_EXPR:
+      return 0;                  /* ANYTHING can be converted */
+    case PLUS_EXPR:
+    numerics:
+      switch ((int)TREE_CODE(type))   /* left operand must be discrete type */
+	{
+	case ARRAY_TYPE:
+	  if (right || TREE_CODE (TREE_TYPE (type)) != BOOLEAN_TYPE)
+	    return 1;
+	  else
+	    return 0;
+	case CHAR_TYPE:
+	  return right;
+	case BOOLEAN_TYPE:
+	case COMPLEX_TYPE:
+	case FILE_TYPE:
+	case FUNCTION_TYPE:
+	case GRANT_TYPE:
+	case LANG_TYPE:
+	case METHOD_TYPE:
+	case RECORD_TYPE:
+	case REFERENCE_TYPE:
+	case SEIZE_TYPE:
+	case UNION_TYPE:
+	case VOID_TYPE:
+	  return 1;
+	case ENUMERAL_TYPE:
+	case INTEGER_TYPE:
+	case OFFSET_TYPE:
+	case POINTER_TYPE:
+	case REAL_TYPE:
+	case SET_TYPE:
+	  return 0;
+	}
+      break;
+    case RANGE_EXPR:
+      break;
+
+    case REPLICATE_EXPR:
+      switch ((int)TREE_CODE(type))   /* right operand must be set/bitarray type */
+	{
+	case COMPLEX_TYPE:
+	case FILE_TYPE:
+	case FUNCTION_TYPE:
+	case GRANT_TYPE:
+	case LANG_TYPE:
+	case METHOD_TYPE:
+	case OFFSET_TYPE:
+	case POINTER_TYPE:
+	case RECORD_TYPE:
+	case REAL_TYPE:
+	case SEIZE_TYPE:
+	case UNION_TYPE:
+	case VOID_TYPE:
+	  return 1;
+	case ARRAY_TYPE:
+	case BOOLEAN_TYPE:
+	case CHAR_TYPE:
+	case ENUMERAL_TYPE:
+	case INTEGER_TYPE:
+	case REFERENCE_TYPE:
+	case SET_TYPE:
+	  return 0;
+	}
+      
+    case TRUNC_DIV_EXPR:
+      goto numerics;
+    case TRUNC_MOD_EXPR:
+      if (TREE_CODE (type) == REAL_TYPE)
+	return 1;
+      goto numerics;
+    case TRUTH_ANDIF_EXPR:
+    case TRUTH_AND_EXPR:
+    case TRUTH_NOT_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case TRUTH_OR_EXPR:
+    relationals:
+      switch ((int)TREE_CODE(type))   /* left operand must be discrete type */
+	{
+	case ARRAY_TYPE:
+	case CHAR_TYPE:
+	case COMPLEX_TYPE:
+	case ENUMERAL_TYPE:
+	case FILE_TYPE:
+	case FUNCTION_TYPE:
+	case GRANT_TYPE:
+	case INTEGER_TYPE:
+	case LANG_TYPE:
+	case METHOD_TYPE:
+	case OFFSET_TYPE:
+	case POINTER_TYPE:
+	case REAL_TYPE:
+	case RECORD_TYPE:
+	case REFERENCE_TYPE:
+	case SEIZE_TYPE:
+	case UNION_TYPE:
+	case VOID_TYPE:
+	  return 1;
+	case BOOLEAN_TYPE:
+	case SET_TYPE:
+	  return 0;
+	}
+      break;
+
+    default:
+      return 1;       /* perhaps you forgot to add a new DEFTREECODE? */
+    }
+  return 1;
+}
+
+
+static int
+invalid_right_operand (code, type)
+     enum chill_tree_code code;
+     tree type;
+{
+  return invalid_operand (code, type, 1);
+}
+
+tree
+build_chill_abs (expr)
+     tree expr;
+{
+  tree temp;
+
+  if (TREE_CODE (TREE_TYPE (expr)) == REAL_TYPE
+      || discrete_type_p (TREE_TYPE (expr)))
+    temp = fold (build1 (ABS_EXPR, TREE_TYPE (expr), expr));
+  else 
+    {
+      error("ABS argument must be discrete or real mode");
+      return error_mark_node;
+    }
+  /* FIXME: should call
+   * cond_type_range_exception (temp);
+   */
+  return temp;
+}
+
+tree
+build_chill_abstime (exprlist)
+     tree exprlist;
+{
+  int  mask = 0, i, numargs;
+  tree args = NULL_TREE;
+  tree filename, lineno;
+  int  had_errors = 0;
+  tree tmp;
+
+  if (exprlist != NULL_TREE && TREE_CODE (exprlist) == ERROR_MARK)
+    return error_mark_node;
+
+  /* check for integer expressions */
+  i = 1;
+  tmp = exprlist;
+  while (tmp != NULL_TREE)
+    {
+      tree exp = TREE_VALUE (tmp);
+
+      if (exp == NULL_TREE || TREE_CODE (exp) == ERROR_MARK)
+	had_errors = 1;
+      else if (TREE_CODE (TREE_TYPE (exp)) != INTEGER_TYPE)
+	{
+	  error ("argument %d to ABSTIME must be of integer type.", i);
+	  had_errors = 1;
+	}
+      tmp = TREE_CHAIN (tmp);
+      i++;
+    }
+  if (had_errors)
+    return error_mark_node;
+
+  numargs = list_length (exprlist);
+  for (i = 0; i < numargs; i++)
+    mask |= (1 << i);
+
+  /* make it all arguments */
+  for (i = numargs; i < 6; i++)
+    exprlist = tree_cons (NULL_TREE, integer_zero_node, exprlist);
+
+  args = tree_cons (NULL_TREE, build_int_2 (mask, 0), exprlist);
+
+  filename = force_addr_of (get_chill_filename ());
+  lineno = get_chill_linenumber ();
+  args = chainon (args, tree_cons (NULL_TREE, filename,
+			  tree_cons (NULL_TREE, lineno, NULL_TREE)));
+
+  return build_chill_function_call (
+    lookup_name (get_identifier ("_abstime")), args);
+}
+
+
+tree
+build_allocate_memory_call (ptr, size)
+  tree ptr, size;
+{
+  int err = 0;
+    
+  /* check for ptr is referable */
+  if (! CH_REFERABLE (ptr))
+    {
+      error ("parameter 1 must be referable.");
+      err++;
+    }
+   /* check for pointer */
+  else if (TREE_CODE (TREE_TYPE (ptr)) != POINTER_TYPE)
+    {
+      error ("mode mismatch in parameter 1.");
+      err++;
+    }
+
+  /* check for size > 0 if it is a constant */
+  if (TREE_CODE (size) == INTEGER_CST && TREE_INT_CST_LOW (size) <= 0)
+    {
+      error ("parameter 2 must be a positive integer.");
+      err++;
+    }
+  if (err)
+    return error_mark_node;
+
+  if (TREE_TYPE (ptr) != ptr_type_node)
+    ptr = build_chill_cast (ptr_type_node, ptr);
+
+  return build_chill_function_call (
+    lookup_name (get_identifier ("_allocate_memory")),
+           tree_cons (NULL_TREE, ptr,
+	     tree_cons (NULL_TREE, size,
+	       tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+		 tree_cons (NULL_TREE, get_chill_linenumber (), 
+			    NULL_TREE)))));
+}
+
+
+tree
+build_allocate_global_memory_call (ptr, size)
+  tree ptr, size;
+{
+  int err = 0;
+    
+  /* check for ptr is referable */
+  if (! CH_REFERABLE (ptr))
+    {
+      error ("parameter 1 must be referable.");
+      err++;
+    }
+  /* check for pointer */
+  else if (TREE_CODE (TREE_TYPE (ptr)) != POINTER_TYPE)
+    {
+      error ("mode mismatch in parameter 1.");
+      err++;
+    }
+
+  /* check for size > 0 if it is a constant */
+  if (TREE_CODE (size) == INTEGER_CST && TREE_INT_CST_LOW (size) <= 0)
+    {
+      error ("parameter 2 must be a positive integer.");
+      err++;
+    }
+  if (err)
+    return error_mark_node;
+    
+  if (TREE_TYPE (ptr) != ptr_type_node)
+    ptr = build_chill_cast (ptr_type_node, ptr);
+
+  return build_chill_function_call (
+    lookup_name (get_identifier ("_allocate_global_memory")),
+           tree_cons (NULL_TREE, ptr,
+	     tree_cons (NULL_TREE, size,
+	       tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+		 tree_cons (NULL_TREE, get_chill_linenumber (), 
+			    NULL_TREE)))));
+}
+
+
+tree
+build_return_memory (ptr)
+  tree ptr;
+{
+  /* check input */
+  if (ptr == NULL_TREE || TREE_CODE (ptr) == ERROR_MARK)
+      return error_mark_node;
+  
+  /* check for pointer */
+  if (TREE_CODE (TREE_TYPE (ptr)) != POINTER_TYPE)
+    {
+      error ("mode mismatch in parameter 1.");
+      return error_mark_node;
+    }
+
+  if (TREE_TYPE (ptr) != ptr_type_node)
+    ptr = build_chill_cast (ptr_type_node, ptr);
+
+  return build_chill_function_call (
+    lookup_name (get_identifier ("_return_memory")),
+      tree_cons (NULL_TREE, ptr,
+	tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+	  tree_cons (NULL_TREE, get_chill_linenumber (), 
+		     NULL_TREE))));
+}
+
+
+/* Compute the number of runtime members of the
+ * given powerset.
+ */
+tree
+build_chill_card (powerset)
+     tree powerset;
+{
+  if (pass == 2)
+    {
+      tree temp;
+      tree card_func = lookup_name (get_identifier ("__cardpowerset"));
+      
+      if (powerset == NULL_TREE || TREE_CODE (powerset) == ERROR_MARK)
+	return error_mark_node;
+      
+      if (TREE_CODE (powerset) == IDENTIFIER_NODE)
+	powerset = lookup_name (powerset);
+
+      if (TREE_CODE (TREE_TYPE(powerset)) == SET_TYPE)
+	{ int size;
+
+	  /* Do constant folding, if possible. */
+	  if (TREE_CODE (powerset) == CONSTRUCTOR & TREE_CONSTANT (powerset)
+	      && (size = int_size_in_bytes (TREE_TYPE (powerset))) >= 0)
+	    {
+	      int bit_size = size * BITS_PER_UNIT;
+	      char* buffer = (char*) alloca (bit_size);
+	      temp = get_set_constructor_bits (powerset, buffer, bit_size);
+	      if (!temp)
+		{ int i;
+		  int count = 0;
+		  for (i = 0; i < bit_size; i++)
+		    if (buffer[i])
+		      count++;
+		  temp = build_int_2 (count, 0);
+		  TREE_TYPE (temp) = TREE_TYPE (TREE_TYPE (card_func));
+		  return temp;
+		}
+	    }
+	  temp = build_chill_function_call (card_func,
+		     tree_cons (NULL_TREE, force_addr_of (powerset),
+		       tree_cons (NULL_TREE, powersetlen (powerset), NULL_TREE)));
+	  /* FIXME: should call
+	   * cond_type_range_exception (op0);
+	   */
+	  return temp;
+	}
+      error("CARD argument must be powerset mode");
+      return error_mark_node;
+    }
+  return NULL_TREE;
+}
+
+/* function to build the type needed for the DESCR-built-in
+ */
+
+void build_chill_descr_type ()
+{
+  tree decl1, decl2;
+  
+  if (descr_type != NULL_TREE)
+    /* already done */
+    return;
+  
+  decl1 = build_decl (FIELD_DECL, get_identifier ("datap"), ptr_type_node);
+  decl2 = build_decl (FIELD_DECL, get_identifier ("len"),
+		      TREE_TYPE (lookup_name (
+					      get_identifier ((ignore_case || ! special_UC) ? "ulong" : "ULONG"))));
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+  decl2 = build_chill_struct_type (decl1);
+  descr_type = build_decl (TYPE_DECL, get_identifier ("__tmp_DESCR_type"), decl2);
+  pushdecl (descr_type);
+  DECL_SOURCE_LINE (descr_type) = 0;
+  satisfy_decl (descr_type, 0);
+}
+
+/* build a pointer to a descriptor.
+ * descriptor = STRUCT (datap PTR,
+ *			len ULONG);
+ * This descriptor is build in variable descr_type.
+ */
+
+tree
+build_chill_descr (expr)
+    tree expr;
+{
+  if (pass == 2)
+    {
+      tree tuple, decl, descr_var, datap, len, tmp;
+      int is_static;
+
+      if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+	return error_mark_node;
+      
+      /* check for expression is referable */
+      if (! CH_REFERABLE (expr))
+	{
+	  error ("expression for DESCR-builtin must be referable.");
+	  return error_mark_node;
+	}
+      
+      mark_addressable (expr);
+#if 0
+      datap = build1 (ADDR_EXPR, build_chill_pointer_type (descr_type), expr);
+#else
+      datap = build_chill_arrow_expr (expr, 1);
+#endif
+      len = size_in_bytes (TREE_TYPE (expr));
+      
+      descr_var = get_unique_identifier ("DESCR");
+      tuple = build_nt (CONSTRUCTOR, NULL_TREE,
+			tree_cons (NULL_TREE, datap,
+				   tree_cons (NULL_TREE, len, NULL_TREE)));
+
+      is_static = (current_function_decl == global_function_decl) && TREE_STATIC (expr);
+      decl = decl_temp1 (descr_var, TREE_TYPE (descr_type), is_static,
+			 tuple, 0, 0);
+#if 0
+      tmp = force_addr_of (decl);
+#else
+      tmp = build_chill_arrow_expr (decl, 1);
+#endif
+      return tmp;
+    }
+  return NULL_TREE;
+}
+
+/* this function process the builtin's
+   MILLISECS, SECS, MINUTES, HOURS and DAYS.
+   The built duration value is in milliseconds. */
+
+tree
+build_chill_duration (expr, multiplier, fnname, maxvalue)
+     tree           expr;
+     unsigned long  multiplier;
+     tree           fnname;
+     unsigned long  maxvalue;
+{
+  tree temp;
+
+  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+    return error_mark_node;
+
+  if (TREE_CODE (TREE_TYPE (expr)) != INTEGER_TYPE)
+    {
+      error ("argument to `%s' must be of integer type.", IDENTIFIER_POINTER (fnname));
+      return error_mark_node;
+    }
+
+  temp = convert (duration_timing_type_node, expr);
+  temp = fold (build (MULT_EXPR, duration_timing_type_node,
+		      temp, build_int_2 (multiplier, 0)));
+
+  if (range_checking)
+    temp = check_range (temp, expr, integer_zero_node, build_int_2 (maxvalue, 0));
+
+  return temp;
+}
+
+/* build function call to one of the floating point functions */
+static tree
+build_chill_floatcall (expr, chillname, funcname)
+     tree expr;
+     char *chillname;
+     char *funcname;
+{
+  tree result;
+  tree type;
+
+  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+    return error_mark_node;
+
+  /* look if expr is a REAL_TYPE */
+  type = TREE_TYPE (expr);
+  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+    return error_mark_node;
+  if (TREE_CODE (type) != REAL_TYPE)
+    {
+      error ("argument 1 to `%s' must be of floating point mode", chillname);
+      return error_mark_node;
+    }
+  result = build_chill_function_call (
+             lookup_name (get_identifier (funcname)),
+               tree_cons (NULL_TREE, expr, NULL_TREE));
+  return result;
+}
+
+/* common function for ALLOCATE and GETSTACK */
+static tree
+build_allocate_getstack (mode, value, chill_name, fnname, filename, linenumber)
+     tree mode;
+     tree value;
+     char *chill_name;
+     char *fnname;
+     tree filename;
+     tree linenumber;
+{
+  tree type, result;
+  tree expr = NULL_TREE;
+  tree args, tmpvar, fncall, ptr, init, outlist = NULL_TREE;
+
+  if (mode == NULL_TREE || TREE_CODE (mode) == ERROR_MARK)
+    return error_mark_node;
+
+  if (TREE_CODE (mode) == TYPE_DECL)
+    type = TREE_TYPE (mode);
+  else
+    type = mode;
+
+  /* check if we have a mode */
+  if (TREE_CODE_CLASS (TREE_CODE (type)) != 't')
+    {
+      error ("First argument to `%s' must be a mode", chill_name);
+      return error_mark_node;
+    }
+
+  /* check if we have a value if type is READonly */
+  if (TYPE_READONLY_PROPERTY (type) && value == NULL_TREE)
+    {
+      error ("READonly modes for %s must have a value", chill_name);
+      return error_mark_node;
+    }
+
+  if (value != NULL_TREE)
+    {
+      if (TREE_CODE (value) == ERROR_MARK)
+	return error_mark_node;
+      expr = chill_convert_for_assignment (type, value, "assignment");
+    }
+
+  /* build function arguments */
+  if (filename == NULL_TREE)
+    args = tree_cons (NULL_TREE, size_in_bytes (type), NULL_TREE);
+  else
+    args = tree_cons (NULL_TREE, size_in_bytes (type),
+             tree_cons (NULL_TREE, force_addr_of (filename),
+               tree_cons (NULL_TREE, linenumber, NULL_TREE)));
+
+  ptr = build_chill_pointer_type (type);
+  tmpvar = decl_temp1 (get_unique_identifier (chill_name),
+		       ptr, 0, NULL_TREE, 0, 0);
+  fncall = build_chill_function_call (
+             lookup_name (get_identifier (fnname)), args);
+  outlist = tree_cons (NULL_TREE,
+               build_chill_modify_expr (tmpvar, fncall), outlist);
+  if (expr == NULL_TREE)
+    {
+      /* set allocated memory to 0 */
+      fncall = build_chill_function_call (
+                 lookup_name (get_identifier ("memset")),
+                   tree_cons (NULL_TREE, convert (ptr_type_node, tmpvar),
+                     tree_cons (NULL_TREE, integer_zero_node,
+                       tree_cons (NULL_TREE, size_in_bytes (type), NULL_TREE))));
+      outlist = tree_cons (NULL_TREE, fncall, outlist);
+    }
+  else
+    {
+      /* write the init value to allocated memory */
+      outlist = tree_cons (NULL_TREE,
+                  build_chill_modify_expr (build_chill_indirect_ref (tmpvar, NULL_TREE, 0),
+					   expr), 
+			   outlist);
+    }
+  outlist = tree_cons (NULL_TREE, tmpvar, outlist);
+  result = build_chill_compound_expr (nreverse (outlist));
+  return result;
+}
+
+/* process the ALLOCATE built-in */
+tree
+build_chill_allocate (mode, value)
+     tree mode;
+     tree value;
+{
+  return build_allocate_getstack (mode, value, "ALLOCATE", "__allocate",
+				  get_chill_filename (), get_chill_linenumber ());
+}
+
+/* process the GETSTACK built-in */
+tree
+build_chill_getstack (mode, value)
+     tree mode;
+     tree value;
+{
+  return build_allocate_getstack (mode, value, "GETSTACK", "__builtin_alloca",
+				  NULL_TREE, NULL_TREE);
+}
+
+/* process the TERMINATE built-in */
+tree
+build_chill_terminate (ptr)
+     tree ptr;
+{
+  tree result;
+  tree type;
+
+  if (ptr == NULL_TREE || TREE_CODE (ptr) == ERROR_MARK)
+    return error_mark_node;
+
+  type = TREE_TYPE (ptr);
+  if (type == NULL_TREE || TREE_CODE (type) != POINTER_TYPE)
+    {
+      error ("argument to TERMINATE must be a reference primitive value");
+      return error_mark_node;
+    }
+  result = build_chill_function_call (
+	     lookup_name (get_identifier ("__terminate")),
+	       tree_cons (NULL_TREE, convert (ptr_type_node, ptr),
+                 tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                   tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
+  return result;
+}
+
+/* build the type passed to _inttime function */
+void
+build_chill_inttime_type ()
+{
+  tree idxlist;
+  tree arrtype;
+  tree decl;
+
+  idxlist = build_tree_list (NULL_TREE,
+               build_chill_range_type (NULL_TREE,
+				       integer_zero_node,
+				       build_int_2 (5, 0)));
+  arrtype = build_chill_array_type (ptr_type_node, idxlist, 0, NULL_TREE);
+
+  decl = build_decl (TYPE_DECL, get_identifier ("__tmp_INTTIME_type"), arrtype);
+  pushdecl (decl);
+  DECL_SOURCE_LINE (decl) = 0;
+  satisfy_decl (decl, 0);
+}
+
+tree
+build_chill_inttime (t, loclist)
+     tree t, loclist;
+{
+  int  had_errors = 0, cnt;
+  tree tmp;
+  tree init = NULL_TREE;
+  int  numargs;
+  tree tuple, var;
+
+  if (t == NULL_TREE || TREE_CODE (t) == ERROR_MARK)
+    return error_mark_node;
+  if (loclist == NULL_TREE || TREE_CODE (loclist) == ERROR_MARK)
+    return error_mark_node;
+
+  /* check first argument to be NEWMODE TIME */
+  if (TREE_TYPE (t) != abs_timing_type_node)
+    {
+      error ("argument 1 to INTTIME must be of mode TIME.");
+      had_errors = 1;
+    }
+
+  cnt = 2;
+  tmp = loclist;
+  while (tmp != NULL_TREE)
+    {
+      tree loc = TREE_VALUE (tmp);
+      char errmsg[200];
+      char *p, *p1;
+      int  write_error = 0;
+
+      sprintf (errmsg, "argument %d to INTTIME must be ", cnt);
+      p = errmsg + strlen (errmsg);
+      p1 = p;
+      
+      if (loc == NULL_TREE || TREE_CODE (loc) == ERROR_MARK)
+	had_errors = 1;
+      else
+	{
+	  if (! CH_REFERABLE (loc))
+	    {
+	      strcpy (p, "referable");
+	      p += strlen (p);
+	      write_error = 1;
+	      had_errors = 1;
+	    }
+	  if (TREE_CODE (TREE_TYPE (loc)) != INTEGER_TYPE)
+	    {
+	      if (p != p1)
+		{
+		  strcpy (p, " and ");
+		  p += strlen (p);
+		}
+	      strcpy (p, "of integer type");
+	      write_error = 1;
+	      had_errors = 1;
+	    }
+	  /* FIXME: what's about ranges can't hold the result ?? */
+	  if (write_error)
+	    error ("%s.", errmsg);
+	}
+      /* next location */
+      tmp = TREE_CHAIN (tmp);
+      cnt++;
+    }
+
+  if (had_errors)
+    return error_mark_node;
+
+  /* make it always 6 arguments */
+  numargs = list_length (loclist);
+  for (cnt = numargs; cnt < 6; cnt++)
+    init = tree_cons (NULL_TREE, null_pointer_node, init);
+
+  /* append the given one's */
+  tmp = loclist;
+  while (tmp != NULL_TREE)
+    {
+      init = chainon (init,
+		      build_tree_list (NULL_TREE,
+				       build_chill_descr (TREE_VALUE (tmp))));
+      tmp = TREE_CHAIN (tmp);
+    }
+
+  tuple = build_nt (CONSTRUCTOR, NULL_TREE, init);
+  var = decl_temp1 (get_unique_identifier ("INTTIME"),
+		    TREE_TYPE (lookup_name (get_identifier ("__tmp_INTTIME_type"))),
+		    0, tuple, 0, 0);
+
+  return build_chill_function_call (
+    lookup_name (get_identifier ("_inttime")),
+       tree_cons (NULL_TREE, t,
+          tree_cons (NULL_TREE, force_addr_of (var),
+		     NULL_TREE)));
+}
+
+
+/* Compute the runtime length of the given string variable
+ * or expression.
+ */
+tree
+build_chill_length (expr)
+     tree expr;
+{
+  if (pass == 2)
+    {
+      tree type;
+      
+      if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+	return error_mark_node;
+      
+      if (TREE_CODE (expr) == IDENTIFIER_NODE)
+	expr = lookup_name (expr);
+
+      type = TREE_TYPE (expr);
+      
+      if (TREE_CODE(type) == ERROR_MARK)
+	return type;
+      if (chill_varying_type_p (type))
+	{ 
+	  tree temp = convert (integer_type_node,
+			  build_component_ref (expr, var_length_id));
+	  /* FIXME: should call
+	   * cond_type_range_exception (temp);
+	   */
+	  return temp;
+	}
+      
+      if ((TREE_CODE (type) == ARRAY_TYPE ||
+	   /* should work for a bitstring too */
+	   (TREE_CODE (type) == SET_TYPE && TREE_CODE (TREE_TYPE (type)) == BOOLEAN_TYPE)) &&
+	  integer_zerop (TYPE_MIN_VALUE (TYPE_DOMAIN (type))))
+	{
+	  tree temp =  fold (build (PLUS_EXPR, chill_integer_type_node,
+				    integer_one_node,
+				    TYPE_MAX_VALUE (TYPE_DOMAIN (type))));
+	  return convert (chill_integer_type_node, temp);
+	}
+      
+      if (CH_IS_BUFFER_MODE (type) || CH_IS_EVENT_MODE (type))
+        {
+          tree len = max_queue_size (type);
+          
+          if (len == NULL_TREE)
+            len = integer_minus_one_node;
+          return len;
+        }
+
+      if (CH_IS_TEXT_MODE (type))
+	{
+	  if (TREE_CODE (expr) == TYPE_DECL)
+	    {
+	      /* text mode name */
+	      return text_length (type);
+	    }
+	  else
+	    {
+	      /* text location */
+	      tree temp = build_component_ref (
+			    build_component_ref (expr, get_identifier ("tloc")),
+                                var_length_id);
+	      return convert (integer_type_node, temp);
+	    }
+	}
+ 
+      error("LENGTH argument must be string, buffer, event mode, text location or mode");
+      return error_mark_node;
+    }
+  return NULL_TREE;
+}
+
+/* Compute the declared minimum/maximum value of the variable,
+ * expression or declared type
+ */
+static tree
+build_chill_lower_or_upper (what, is_upper)
+     tree what;
+     int is_upper;  /* o -> LOWER; 1 -> UPPER */
+{
+  if (pass == 2)
+    {
+      tree type;
+      struct ch_class class;
+
+      if (what == NULL_TREE || TREE_CODE (what) == ERROR_MARK)
+	return error_mark_node;
+      
+      if (TREE_CODE_CLASS (TREE_CODE (what)) == 't')
+	type = what;
+      else
+	type = TREE_TYPE (what);
+      if (type == NULL_TREE)
+	{
+	  if (is_upper)
+	    error ("UPPER argument must have a mode, or be a mode");
+	  else
+	    error ("LOWER argument must have a mode, or be a mode");
+	  return error_mark_node;
+	}
+      while (TREE_CODE (type) == REFERENCE_TYPE)
+	type = TREE_TYPE (type);
+      if (chill_varying_type_p (type))
+	type = CH_VARYING_ARRAY_TYPE (type);
+     
+      if (discrete_type_p (type))
+	{
+	  tree val = is_upper ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type);
+	  class.kind = CH_VALUE_CLASS;
+	  class.mode = type;
+	  return convert_to_class (class, val);
+	}
+      else if (TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == SET_TYPE)
+	{
+	  if (TYPE_STRING_FLAG (type))
+	    {
+	      class.kind = CH_DERIVED_CLASS;
+	      class.mode = integer_type_node;
+	    }
+	  else
+	    {
+	      class.kind = CH_VALUE_CLASS;
+	      class.mode = TYPE_DOMAIN (type);
+	    }
+	  type = TYPE_DOMAIN (type);
+	  return convert_to_class (class,
+				   is_upper
+				   ? TYPE_MAX_VALUE (type)
+				   : TYPE_MIN_VALUE (type));
+	}
+      if (is_upper)
+	error("UPPER argument must be string, array, mode or integer");
+      else
+	error("LOWER argument must be string, array, mode or integer");
+      return error_mark_node;
+    }
+  return NULL_TREE;
+}
+
+tree
+build_chill_lower (what)
+     tree what;
+{
+  return build_chill_lower_or_upper (what, 0);
+}
+
+static tree
+build_max_min (expr, max_min)
+     tree expr;
+     int max_min; /* 0: calculate MIN; 1: calculate MAX */
+{
+  if (pass == 2)
+    {
+      tree type, temp, setminval;
+      tree set_base_type;
+      int size_in_bytes;
+      
+      if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+	return error_mark_node;
+      
+      if (TREE_CODE (expr) == IDENTIFIER_NODE)
+	expr = lookup_name (expr);
+
+      type = TREE_TYPE (expr);
+      set_base_type = TYPE_DOMAIN (type);
+      setminval = TYPE_MIN_VALUE (set_base_type);
+      
+      if (TREE_CODE (type) != SET_TYPE)
+	{
+	  error("%s argument must be POWERSET mode",
+		max_min ? "MAX" : "MIN");
+	  return error_mark_node;
+	}
+
+      /* find max/min of constant powerset at compile time */
+      if (TREE_CODE (expr) == CONSTRUCTOR && TREE_CONSTANT (expr)
+	  && (size_in_bytes = int_size_in_bytes (type)) >= 0)
+	{
+	  HOST_WIDE_INT min_val = -1, max_val = -1;
+	  HOST_WIDE_INT i, i_hi = 0;
+	  HOST_WIDE_INT size_in_bits = size_in_bytes * BITS_PER_UNIT;
+	  char *buffer = (char*) alloca (size_in_bits);
+	  if (buffer == NULL
+	      || get_set_constructor_bits (expr, buffer, size_in_bits))
+	    abort ();
+	  for (i = 0; i < size_in_bits; i++)
+	    {
+	      if (buffer[i])
+		{
+		  if (min_val < 0)
+		    min_val = i;
+		  max_val = i;
+		}
+	    }
+	  if (min_val < 0)
+	    error ("%s called for empty POWERSET", max_min ? "MAX" : "MIN");
+	  i = max_min ? max_val : min_val;
+	  temp = TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (expr)));
+	  add_double (i, i_hi,
+		      TREE_INT_CST_LOW (temp), TREE_INT_CST_HIGH (temp),
+		      &i, &i_hi);
+	  temp = build_int_2 (i, i_hi);
+	  TREE_TYPE (temp) = set_base_type;
+	  return temp;
+	}
+      else
+	{
+	  tree parmlist, filename, lineno;
+	  char *funcname;
+	  
+	  /* set up to call appropriate runtime function */
+	  if (max_min)
+	    funcname = "__flsetpowerset";
+	  else
+	    funcname = "__ffsetpowerset";
+	  
+	  setminval = convert (long_integer_type_node, setminval);
+	  filename = force_addr_of (get_chill_filename());
+	  lineno = get_chill_linenumber();
+	  parmlist = tree_cons (NULL_TREE, force_addr_of (expr),
+		       tree_cons (NULL_TREE, powersetlen (expr),
+			 tree_cons (NULL_TREE, setminval,
+			   tree_cons (NULL_TREE, filename,
+			     build_tree_list (NULL_TREE, lineno)))));
+	  temp = lookup_name (get_identifier (funcname));
+	  temp = build_chill_function_call (temp, parmlist);
+	  TREE_TYPE (temp) = set_base_type;
+	  return temp;
+	}
+    }
+  return NULL_TREE;
+}
+
+
+/* Compute the current runtime maximum value of the powerset
+ */
+tree
+build_chill_max (expr)
+     tree expr;
+{
+  return build_max_min (expr, 1);
+}
+
+
+/* Compute the current runtime minimum value of the powerset
+ */
+tree
+build_chill_min (expr)
+     tree expr;
+{
+  return build_max_min (expr, 0);
+}
+
+
+/* Build a conversion from the given expression to an INT,
+ * but only when the expression's type is the same size as
+ * an INT.
+ */
+tree
+build_chill_num (expr)
+     tree expr;
+{
+  if (pass == 2)
+    {
+      tree temp;
+      int need_unsigned;
+
+      if (expr == NULL_TREE || TREE_CODE(expr) == ERROR_MARK)
+	return error_mark_node;
+      
+      if (TREE_CODE (expr) == IDENTIFIER_NODE)
+	expr = lookup_name (expr);
+
+      expr = convert_to_discrete (expr);
+      if (expr == NULL_TREE)
+	{
+	  error ("argument to NUM is not discrete");
+	  return error_mark_node;
+	}
+
+      /* enumeral types and string slices of length 1 must be kept unsigned */
+      need_unsigned = (TREE_CODE (TREE_TYPE (expr)) == ENUMERAL_TYPE)
+	|| TREE_UNSIGNED (TREE_TYPE (expr));
+
+      temp = type_for_size (TYPE_PRECISION (TREE_TYPE (expr)), 
+			    need_unsigned);
+      if (temp == NULL_TREE)
+	{
+	  error ("No integer mode which matches expression's mode");
+	  return integer_zero_node;
+	}
+      temp = convert (temp, expr);
+
+      if (TREE_CONSTANT (temp))
+	{
+	  if (tree_int_cst_lt (temp, 
+			       TYPE_MIN_VALUE (TREE_TYPE (temp))))
+	    error ("NUM's parameter is below its mode range");
+	  if (tree_int_cst_lt (TYPE_MAX_VALUE (TREE_TYPE (temp)),
+	                       temp))
+	    error ("NUM's parameter is above its mode range");
+	}
+#if 0
+      else
+	{
+	  if (range_checking)
+	    cond_overflow_exception (temp, 
+	      TYPE_MIN_VALUE (TREE_TYPE (temp)),
+	      TYPE_MAX_VALUE (TREE_TYPE (temp)));
+	}
+#endif
+
+      /* NUM delivers the INT derived class */
+      CH_DERIVED_FLAG (temp) = 1;
+      
+      return temp;
+    }
+  return NULL_TREE;
+}
+
+
+static tree
+build_chill_pred_or_succ (expr, op)
+     tree expr;
+     enum tree_code op; /* PLUS_EXPR for SUCC; MINUS_EXPR for PRED. */
+{
+  struct ch_class class;
+  tree etype, cond;
+  tree limit;
+
+  if (pass == 1)
+    return NULL_TREE;
+
+  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+    return error_mark_node;
+  
+  /* disallow numbered SETs */
+  if (TREE_CODE (TREE_TYPE (expr)) == ENUMERAL_TYPE
+      && CH_ENUM_IS_NUMBERED (TREE_TYPE (expr)))
+    {
+      error ("Cannot take SUCC or PRED of a numbered SET");
+      return error_mark_node;
+    }
+  
+  if (TREE_CODE (TREE_TYPE (expr)) == POINTER_TYPE)
+    {
+      if (TREE_TYPE (TREE_TYPE (expr)) == void_type_node)
+	{
+	  error ("SUCC or PRED must not be done on a PTR.");
+	  return error_mark_node;
+	}
+      pedwarn ("SUCC or PRED for a reference type is not standard.");
+      return fold (build (op, TREE_TYPE (expr),
+			  expr,
+			  size_in_bytes (TREE_TYPE (TREE_TYPE (expr)))));
+    }
+
+  expr = convert_to_discrete (expr);
+
+  if (expr == NULL_TREE)
+    {
+      error ("SUCC or PRED argument must be a discrete mode");
+      return error_mark_node;
+    }
+
+  class = chill_expr_class (expr);
+  if (class.mode)
+    class.mode = CH_ROOT_MODE (class.mode);
+  etype = class.mode;
+  expr = convert (etype, expr);
+
+  /* Exception if expression is already at the
+     min (PRED)/max(SUCC) valid value for its type. */
+  cond = fold (build (op == PLUS_EXPR ? GE_EXPR : LE_EXPR,
+		      boolean_type_node,
+		      expr,
+		      convert (etype,
+			       op == PLUS_EXPR ? TYPE_MAX_VALUE (etype)
+			       : TYPE_MIN_VALUE (etype))));
+  if (TREE_CODE (cond) == INTEGER_CST
+      && tree_int_cst_equal (cond, integer_one_node))
+    {
+      error ("Taking the %s of a value already at its %s value",
+	     op == PLUS_EXPR ? "SUCC" : "PRED",
+	     op == PLUS_EXPR ? "maximum" : "minimum");
+      return error_mark_node;
+    }
+
+  if (range_checking)
+    expr = check_expression (expr, cond,
+			     ridpointers[(int) RID_OVERFLOW]);
+
+  expr = fold (build (op, etype, expr, 
+	   convert (etype, integer_one_node)));
+  return convert_to_class (class, expr);
+}
+
+/* Compute the value of the CHILL `size' operator just
+ * like the C 'sizeof' operator (code stolen from c-typeck.c)
+ * TYPE may be a location or mode tree.  In pass 1, we build
+ * a function-call syntax tree;  in pass 2, we evaluate it.
+ */
+tree
+build_chill_sizeof (type)
+     tree type;
+{
+  if (pass == 2)
+    {
+      tree temp;
+      struct ch_class class;
+      enum tree_code code;
+      tree signame = NULL_TREE;
+
+      if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+	return error_mark_node;
+
+      if (TREE_CODE (type) == IDENTIFIER_NODE)
+	type = lookup_name (type);
+
+      code = TREE_CODE (type);
+      if (code == ERROR_MARK)
+	return error_mark_node;
+      
+      if (TREE_CODE_CLASS (TREE_CODE (type)) != 't')
+	{
+	  if (TREE_CODE (type) == TYPE_DECL && CH_DECL_SIGNAL (type))
+	    signame = DECL_NAME (type);
+	type = TREE_TYPE (type);
+	}
+
+      if (code == FUNCTION_TYPE)
+	{
+	  if (pedantic || warn_pointer_arith)
+	    pedwarn ("size applied to a function mode");
+	  return error_mark_node;
+	}
+      if (code == VOID_TYPE)
+	{
+	  if (pedantic || warn_pointer_arith)
+	    pedwarn ("sizeof applied to a void mode");
+	  return error_mark_node;
+	}
+      if (TYPE_SIZE (type) == 0)
+	{
+	  error ("sizeof applied to an incomplete mode");
+	  return error_mark_node;
+	}
+      
+      temp = size_binop (CEIL_DIV_EXPR, TYPE_SIZE (type),
+			 size_int (TYPE_PRECISION (char_type_node)));
+      if (signame != NULL_TREE)
+        {
+          /* we have a signal definition. This signal may have no
+             data items specified. The definition however says that
+             there are data, cause we cannot build a structure without
+             fields. In this case return 0. */
+          if (IDENTIFIER_SIGNAL_DATA (signame) == 0)
+            temp = integer_zero_node;
+        }
+      
+      /* FIXME: should call
+       * cond_type_range_exception (temp);
+       */
+      class.kind = CH_DERIVED_CLASS;
+      class.mode = integer_type_node;
+      return convert_to_class (class, temp);
+    }
+  return NULL_TREE;
+}
+
+/* Compute the declared maximum value of the variable,
+ * expression or declared type
+ */
+tree
+build_chill_upper (what)
+     tree what;
+{
+  return build_chill_lower_or_upper (what, 1);
+}
+
+/*
+ * Here at the site of a function/procedure call..  We need to build
+ * temps for the INOUT and OUT parameters, and copy the actual parameters
+ * into the temps.  After the call, we 'copy back' the values from the
+ * temps to the actual parameter variables.  This somewhat verbose pol-
+ * icy meets the requirement that the actual parameters are undisturbed
+ * if the function/procedure causes an exception.  They are updated only
+ * upon a normal return from the function.
+ *
+ * Note: the expr_list, which collects all of the above assignments, etc,
+ * is built in REVERSE execution order.  The list is corrected by nreverse
+ * inside the build_chill_compound_expr call.
+ */
+tree
+build_chill_function_call (function, expr)
+     tree function, expr;
+{
+  register tree typetail, valtail, typelist;
+  register tree temp, actual_args = NULL_TREE;
+  tree name = NULL_TREE;
+  tree function_call;
+  tree fntype;
+  int parmno = 1;            /* parameter number for error message */
+  int callee_raise_exception = 0;
+
+  /* list of assignments to run after the actual call,
+     copying from the temps back to the user's variables. */
+  tree copy_back = NULL_TREE;
+
+  /* list of expressions to run before the call, copying from
+     the user's variable to the temps that are passed to the function */
+  tree expr_list = NULL_TREE;
+ 
+  if (function == NULL_TREE || TREE_CODE (function) == ERROR_MARK)
+    return error_mark_node;
+
+  if (expr != NULL_TREE && TREE_CODE (expr) == ERROR_MARK)
+    return error_mark_node;
+
+  if (pass < 2)
+    return error_mark_node;
+
+  fntype = TREE_TYPE (function);
+  if (TREE_CODE (function) == FUNCTION_DECL)
+    {
+      callee_raise_exception = TYPE_RAISES_EXCEPTIONS (fntype) != NULL_TREE;
+
+      /* Differs from default_conversion by not setting TREE_ADDRESSABLE
+	 (because calling an inline function does not mean the function
+	 needs to be separately compiled).  */
+      fntype = build_type_variant (fntype,
+				   TREE_READONLY (function),
+				   TREE_THIS_VOLATILE (function));
+      name = DECL_NAME (function);
+
+      /* check that function is not a PROCESS */
+      if (CH_DECL_PROCESS (function))
+	{
+	  error ("cannot call a PROCESS, you START a PROCESS");
+	  return error_mark_node;
+	}
+
+      function = build1 (ADDR_EXPR, build_pointer_type (fntype), function);
+    }
+  else if (TREE_CODE (fntype) == POINTER_TYPE)
+    {
+      fntype = TREE_TYPE (fntype);
+      callee_raise_exception = TYPE_RAISES_EXCEPTIONS (fntype) != NULL_TREE;
+
+      /* Z.200 6.7 Call Action:
+	 "A procedure call causes the EMPTY exception if the
+	 procedure primitive value delivers NULL. */
+      if (TREE_CODE (function) != ADDR_EXPR
+	  || TREE_CODE (TREE_OPERAND (function, 0)) != FUNCTION_DECL)
+	function = check_non_null (function);
+    }
+
+  typelist = TYPE_ARG_TYPES (fntype);
+  if (callee_raise_exception)
+    {
+      /* remove last two arguments from list for subsequent checking.
+	  They will get added automatically after checking */
+      int len = list_length (typelist);
+      int i;
+      tree newtypelist = NULL_TREE;
+      tree wrk = typelist;
+      
+      for (i = 0; i < len - 3; i++)
+	{
+	    newtypelist = tree_cons (TREE_PURPOSE (wrk), TREE_VALUE (wrk), newtypelist);
+	      wrk = TREE_CHAIN (wrk);
+	  }
+      /* add the void_type_node */
+      newtypelist = tree_cons (NULL_TREE, void_type_node, newtypelist);
+      typelist = nreverse (newtypelist);
+    }
+
+  /* Scan the given expressions and types, producing individual
+     converted arguments and pushing them on ACTUAL_ARGS in 
+     reverse order.  */
+  for (valtail = expr, typetail = typelist;
+       valtail != NULL_TREE && typetail != NULL_TREE;  parmno++,
+       valtail = TREE_CHAIN (valtail), typetail = TREE_CHAIN (typetail))
+    {
+      register tree actual = TREE_VALUE (valtail);
+      register tree attr   = TREE_PURPOSE (typetail)
+	? TREE_PURPOSE (typetail) : ridpointers[(int) RID_IN];
+      register tree type   = TREE_VALUE (typetail);
+      char place[30];
+      sprintf (place, "parameter %d", parmno);
+ 	  
+      /* if we have reached void_type_node in typelist we are at the
+	  end of formal parameters and then we have too many actual
+	   parameters */
+      if (type == void_type_node)
+	 break;
+
+      /* check if actual is a TYPE_DECL. FIXME: what else ? */
+      if (TREE_CODE (actual) == TYPE_DECL)
+	{
+	  error ("invalid %s", place);
+	  actual = error_mark_node;
+	}
+      /* INOUT or OUT param to handle? */
+      else if (attr == ridpointers[(int) RID_OUT]
+	  || attr == ridpointers[(int)RID_INOUT])
+	{
+	  char temp_name[20]; 
+	  tree parmtmp;
+	  tree in_actual = NULL_TREE, out_actual;
+
+	  /* actual parameter must be a location so we can
+	     build a reference to it */
+	  if (!CH_LOCATION_P (actual))
+	    {
+	      error ("%s parameter %d must be a location", 
+		     (attr == ridpointers[(int) RID_OUT]) ?
+		     "OUT" : "INOUT", parmno);
+	      continue;
+	    }
+	  if (TYPE_READONLY_PROPERTY (TREE_TYPE (actual))
+	      || TREE_READONLY (actual))
+	    {
+	      error ("%s parameter %d is READ-only", 
+		     (attr == ridpointers[(int) RID_OUT]) ?
+		     "OUT" : "INOUT", parmno);
+	      continue;
+	    }
+
+	  sprintf (temp_name, "PARM_%d_%s",  parmno,
+		   (attr == ridpointers[(int)RID_OUT]) ?
+		   "OUT" : "INOUT");
+	  parmtmp = decl_temp1 (get_unique_identifier (temp_name),
+				TREE_TYPE (type), 0, NULL_TREE, 0, 0);
+	  /* this temp *must not* be optimized into a register */
+	  mark_addressable (parmtmp);
+
+	  if (attr == ridpointers[(int)RID_INOUT])
+	    {
+	      tree in_actual = chill_convert_for_assignment (TREE_TYPE (type),
+							     actual, place);
+	      tree tmp = build_chill_modify_expr (parmtmp, in_actual);
+	      expr_list = tree_cons (NULL_TREE, tmp, expr_list);
+	    }
+	  if (in_actual != error_mark_node)
+	    {
+	      /* list of copy back assignments to perform, from the temp
+		 back to the actual parameter */
+	      out_actual = chill_convert_for_assignment (TREE_TYPE (actual),
+							 parmtmp, place);
+	      copy_back = tree_cons (NULL_TREE,
+				     build_chill_modify_expr (actual,
+							      out_actual),
+				     copy_back);
+	    }
+	  /* we can do this because build_chill_function_type
+	     turned these parameters into REFERENCE_TYPEs. */
+	  actual = build1 (ADDR_EXPR, type, parmtmp);
+	}
+      else if (attr == ridpointers[(int) RID_LOC])
+	{
+	  int is_location = chill_location (actual);
+	  if (is_location)
+	    {
+	      if (is_location == 1)
+		{
+		  error ("LOC actual parameter %d is a non-referable location",
+			 parmno);
+		  actual = error_mark_node;
+		}
+	      else if (! CH_READ_COMPATIBLE (type, TREE_TYPE (actual)))
+		{
+		  error ("mode mismatch in parameter %d", parmno);
+		  actual = error_mark_node;
+		}
+	      else
+		actual = convert (type, actual);
+	    }
+	  else
+	    {
+	      actual = chill_convert_for_assignment (TREE_TYPE (type),
+						     actual, place);
+	      sprintf (place, "parameter_%d", parmno);
+	      actual = decl_temp1 (get_identifier (place),
+				   TREE_TYPE (type), 0, actual, 0, 0);
+	      actual = convert (type, actual);
+	    }
+	  mark_addressable (actual);
+	}
+      else
+	actual = chill_convert_for_assignment (type, actual, place);
+
+      actual_args = tree_cons (NULL_TREE, actual, actual_args);
+    }
+ 
+  if (valtail != 0 && TREE_VALUE (valtail) != void_type_node)
+    {
+      char *errstr = "too many arguments to procedure";
+      if (name)
+	error ("%s `%s'", errstr, IDENTIFIER_POINTER (name));
+      else
+	error (errstr);
+      return error_mark_node;
+    }
+  else if (typetail != 0 && TREE_VALUE (typetail) != void_type_node)
+    {
+      char *errstr = "too few arguments to procedure";
+      if (name)
+	error ("%s `%s'", errstr, IDENTIFIER_POINTER (name));
+      else
+	error (errstr);
+      return error_mark_node;
+    }
+  
+  if (callee_raise_exception)
+    {
+      /* add linenumber and filename of the caller as arguments */
+      actual_args = tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+			              actual_args);
+      actual_args = tree_cons (NULL_TREE, get_chill_linenumber (), actual_args);
+    }
+  
+  function_call = build (CALL_EXPR, TREE_TYPE (fntype),
+			  function, nreverse (actual_args), NULL_TREE);
+  TREE_SIDE_EFFECTS (function_call) = 1;
+
+  if (copy_back == NULL_TREE && expr_list == NULL_TREE)
+    return function_call;        /* no copying to do, either way */
+  else
+    {
+      tree result_type = TREE_TYPE (fntype);
+      tree result_tmp = NULL_TREE;
+
+      /* no result wanted from procedure call */
+      if (result_type == NULL_TREE || result_type == void_type_node)
+	expr_list = tree_cons (NULL_TREE, function_call, expr_list);
+      else
+	{
+	  /* create a temp for the function's result. this is so that we can
+	     evaluate this temp as the last expression in the list, which will
+	     make the function's return value the value of the whole list of
+	     expressions (by the C rules for compound expressions) */
+	  result_tmp = decl_temp1 (get_unique_identifier ("FUNC_RESULT"),
+				   result_type, 0, NULL_TREE, 0, 0);
+	  expr_list = tree_cons (NULL_TREE, 
+	         	build_chill_modify_expr (result_tmp, function_call),
+				 expr_list);
+	}
+
+      expr_list = chainon (copy_back, expr_list);
+
+      /* last, but not least, the function's result */
+      if (result_tmp != NULL_TREE)
+	expr_list = tree_cons (NULL_TREE, result_tmp, expr_list);
+      temp = build_chill_compound_expr (nreverse (expr_list));
+      return temp;
+    }
+}
+
+/* We saw something that looks like a function call,
+   but if it's pass 1, we're not sure. */
+
+tree
+build_generalized_call (func, args)
+     tree func, args;
+{
+  tree type = TREE_TYPE (func);
+
+  if (pass == 1)
+    return build (CALL_EXPR, NULL_TREE, func, args, NULL_TREE);
+
+  /* Handle string repetition */
+  if (TREE_CODE (func) == INTEGER_CST)
+    {
+      if (args == NULL_TREE || TREE_CHAIN (args) != NULL_TREE)
+	{
+	  error ("syntax error (integer used as function)");
+	  return error_mark_node;
+	}
+      if (TREE_CODE (args) == TREE_LIST)
+	args = TREE_VALUE (args);
+      return build_chill_repetition_op (func, args);
+    }
+
+  if (args != NULL_TREE)
+    {
+      if (TREE_CODE (args) == RANGE_EXPR)
+	{
+	  tree lo = TREE_OPERAND (args, 0), hi = TREE_OPERAND (args, 1);
+	  if (TREE_CODE_CLASS (TREE_CODE (func)) == 't')
+	    return build_chill_range_type (func, lo, hi);
+	  else
+	    return build_chill_slice_with_range (func, lo, hi);
+	}
+      else if (TREE_CODE (args) != TREE_LIST)
+	{
+	  error ("syntax error - missing operator, comma, or '('?");
+	  return error_mark_node;
+	}
+    }
+
+  if (TREE_CODE (func) == TYPE_DECL)
+    {
+      if (CH_DECL_SIGNAL (func))
+	return build_signal_descriptor (func, args);
+      func = TREE_TYPE (func);
+    }
+
+  if (TREE_CODE_CLASS (TREE_CODE (func)) == 't'
+      && args != NULL_TREE && TREE_CHAIN (args) == NULL_TREE)
+    return build_chill_cast (func, TREE_VALUE (args));
+
+  if (TREE_CODE (type) == FUNCTION_TYPE
+      || (TREE_CODE (type) == POINTER_TYPE
+	  && TREE_TYPE (type) != NULL_TREE
+	  && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE))
+    {
+      /* Check for a built-in Chill function.  */
+      if (TREE_CODE (func) == FUNCTION_DECL
+	  && DECL_BUILT_IN (func)
+	  && DECL_FUNCTION_CODE (func) > END_BUILTINS)
+	{
+	  tree fnname = DECL_NAME (func);
+	  switch ((enum chill_built_in_function)DECL_FUNCTION_CODE (func))
+	    {
+	    case BUILT_IN_CH_ABS:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_abs (TREE_VALUE (args));
+	    case BUILT_IN_ABSTIME:
+	      if (check_arglist_length (args, 0, 6, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_abstime (args);
+	    case BUILT_IN_ADDR:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+#if 0
+	      return build_chill_addr_expr (TREE_VALUE (args), (char *)0);
+#else
+	      return build_chill_arrow_expr (TREE_VALUE (args), 0);
+#endif
+	    case BUILT_IN_ALLOCATE_GLOBAL_MEMORY:
+	      if (check_arglist_length (args, 2, 2, fnname) < 0)
+		return error_mark_node;
+	      return build_allocate_global_memory_call
+		(TREE_VALUE (args),
+		 TREE_VALUE (TREE_CHAIN (args)));
+	    case BUILT_IN_ALLOCATE:
+	      if (check_arglist_length (args, 1, 2, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_allocate (TREE_VALUE (args),
+                       TREE_CHAIN (args) == NULL_TREE ? NULL_TREE : TREE_VALUE (TREE_CHAIN (args)));
+	    case BUILT_IN_ALLOCATE_MEMORY:
+	      if (check_arglist_length (args, 2, 2, fnname) < 0)
+		return error_mark_node;
+	      return build_allocate_memory_call
+		(TREE_VALUE (args),
+		 TREE_VALUE (TREE_CHAIN (args)));
+	    case BUILT_IN_ASSOCIATE:
+	      if (check_arglist_length (args, 2, 3, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_associate
+		(TREE_VALUE (args),
+		 TREE_VALUE (TREE_CHAIN (args)),
+		 TREE_CHAIN (TREE_CHAIN (args)));
+	    case BUILT_IN_ARCCOS:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_floatcall (TREE_VALUE (args),
+					    IDENTIFIER_POINTER (fnname),
+					    "__acos");
+	    case BUILT_IN_ARCSIN:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_floatcall (TREE_VALUE (args),
+					    IDENTIFIER_POINTER (fnname),
+					    "__asin");
+	    case BUILT_IN_ARCTAN:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_floatcall (TREE_VALUE (args),
+					    IDENTIFIER_POINTER (fnname),
+					    "__atan");
+	    case BUILT_IN_CARD:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_card (TREE_VALUE (args));
+	    case BUILT_IN_CONNECT:
+	      if (check_arglist_length (args, 3, 5, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_connect 
+		(TREE_VALUE (args),
+		 TREE_VALUE (TREE_CHAIN (args)),
+		 TREE_VALUE (TREE_CHAIN (TREE_CHAIN (args))),
+		 TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (args))));
+	    case BUILT_IN_COPY_NUMBER:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_copy_number (TREE_VALUE (args));
+	    case BUILT_IN_CH_COS:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_floatcall (TREE_VALUE (args),
+					    IDENTIFIER_POINTER (fnname),
+					    "__cos");
+	    case BUILT_IN_CREATE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_create (TREE_VALUE (args));
+	    case BUILT_IN_DAYS:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_duration (TREE_VALUE (args), DAYS_MULTIPLIER,
+					   fnname, DAYS_MAX);
+	    case BUILT_IN_CH_DELETE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_delete (TREE_VALUE (args));
+	    case BUILT_IN_DESCR:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_descr (TREE_VALUE (args));
+	    case BUILT_IN_DISCONNECT:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_disconnect (TREE_VALUE (args));
+	    case BUILT_IN_DISSOCIATE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_dissociate (TREE_VALUE (args));
+	    case BUILT_IN_EOLN:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_eoln (TREE_VALUE (args));
+	    case BUILT_IN_EXISTING:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_existing (TREE_VALUE (args));
+	    case BUILT_IN_EXP:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_floatcall (TREE_VALUE (args),
+					    IDENTIFIER_POINTER (fnname),
+					    "__exp");
+	    case BUILT_IN_GEN_CODE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_gen_code (TREE_VALUE (args));
+	    case BUILT_IN_GEN_INST:
+	      if (check_arglist_length (args, 2, 2, fnname) < 0)
+		return error_mark_node;
+	      return build_gen_inst (TREE_VALUE (args),
+		 TREE_VALUE (TREE_CHAIN (args)));
+	    case BUILT_IN_GEN_PTYPE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_gen_ptype (TREE_VALUE (args));
+	    case BUILT_IN_GETASSOCIATION:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_getassociation (TREE_VALUE (args));
+	    case BUILT_IN_GETSTACK:
+	      if (check_arglist_length (args, 1, 2, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_getstack (TREE_VALUE (args),
+		       TREE_CHAIN (args) == NULL_TREE ? NULL_TREE : TREE_VALUE (TREE_CHAIN (args)));
+	    case BUILT_IN_GETTEXTACCESS:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_gettextaccess (TREE_VALUE (args));
+	    case BUILT_IN_GETTEXTINDEX:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_gettextindex (TREE_VALUE (args));
+	    case BUILT_IN_GETTEXTRECORD:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_gettextrecord (TREE_VALUE (args));
+	    case BUILT_IN_GETUSAGE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_getusage (TREE_VALUE (args));
+	    case BUILT_IN_HOURS:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_duration (TREE_VALUE (args), HOURS_MULTIPLIER,
+					   fnname, HOURS_MAX);
+	    case BUILT_IN_INDEXABLE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_indexable (TREE_VALUE (args));
+	    case BUILT_IN_INTTIME:
+	      if (check_arglist_length (args, 2, 7, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_inttime (TREE_VALUE (args),
+		 TREE_CHAIN (args));
+	    case BUILT_IN_ISASSOCIATED:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_isassociated (TREE_VALUE (args));
+	    case BUILT_IN_LENGTH:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_length (TREE_VALUE (args));
+	    case BUILT_IN_LN:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_floatcall (TREE_VALUE (args),
+					    IDENTIFIER_POINTER (fnname),
+					    "__log");
+	    case BUILT_IN_LOG:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_floatcall (TREE_VALUE (args),
+					    IDENTIFIER_POINTER (fnname),
+					    "__log10");
+	    case BUILT_IN_LOWER:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_lower (TREE_VALUE (args));
+	    case BUILT_IN_MAX:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_max (TREE_VALUE (args));
+	    case BUILT_IN_MILLISECS:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_duration (TREE_VALUE (args), MILLISECS_MULTIPLIER,
+					   fnname, MILLISECS_MAX);
+	    case BUILT_IN_MIN:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_min (TREE_VALUE (args));
+	    case BUILT_IN_MINUTES:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_duration (TREE_VALUE (args), MINUTES_MULTIPLIER,
+					   fnname, MINUTES_MAX);
+	    case BUILT_IN_MODIFY:
+	      if (check_arglist_length (args, 1, -1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_modify (TREE_VALUE (args), TREE_CHAIN (args));
+	    case BUILT_IN_NUM:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_num (TREE_VALUE (args));
+	    case BUILT_IN_OUTOFFILE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_outoffile (TREE_VALUE (args));
+	    case BUILT_IN_PRED:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_pred_or_succ (TREE_VALUE (args), MINUS_EXPR);
+	    case BUILT_IN_PROC_TYPE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_proc_type (TREE_VALUE (args));
+	    case BUILT_IN_QUEUE_LENGTH:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_queue_length (TREE_VALUE (args));
+	    case BUILT_IN_READABLE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_readable (TREE_VALUE (args));
+	    case BUILT_IN_READRECORD:
+	      if (check_arglist_length (args, 1, 3, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_readrecord (TREE_VALUE (args), TREE_CHAIN (args));
+	    case BUILT_IN_READTEXT:
+	      if (check_arglist_length (args, 2, -1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_readtext (TREE_VALUE (args),
+					   TREE_CHAIN (args));
+	    case BUILT_IN_RETURN_MEMORY:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_return_memory (TREE_VALUE (args));
+	    case BUILT_IN_SECS:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_duration (TREE_VALUE (args), SECS_MULTIPLIER,
+					   fnname, SECS_MAX);
+	    case BUILT_IN_SEQUENCIBLE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_sequencible (TREE_VALUE (args));
+	    case BUILT_IN_SETTEXTACCESS:
+	      if (check_arglist_length (args, 2, 2, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_settextaccess (TREE_VALUE (args),
+						TREE_VALUE (TREE_CHAIN (args)));
+	    case BUILT_IN_SETTEXTINDEX:
+	      if (check_arglist_length (args, 2, 2, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_settextindex (TREE_VALUE (args),
+					       TREE_VALUE (TREE_CHAIN (args)));
+	    case BUILT_IN_SETTEXTRECORD:
+	      if (check_arglist_length (args, 2, 2, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_settextrecord (TREE_VALUE (args),
+						TREE_VALUE (TREE_CHAIN (args)));
+	    case BUILT_IN_CH_SIN:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_floatcall (TREE_VALUE (args),
+					    IDENTIFIER_POINTER (fnname),
+					    "__sin");
+	    case BUILT_IN_SIZE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_sizeof (TREE_VALUE (args));
+	    case BUILT_IN_SQRT:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_floatcall (TREE_VALUE (args),
+					    IDENTIFIER_POINTER (fnname),
+					    "__sqrt");
+	    case BUILT_IN_SUCC:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_pred_or_succ (TREE_VALUE (args), PLUS_EXPR);
+	    case BUILT_IN_TAN:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_floatcall (TREE_VALUE (args),
+					    IDENTIFIER_POINTER (fnname),
+					    "__tan");
+	    case BUILT_IN_TERMINATE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_terminate (TREE_VALUE (args));
+	    case BUILT_IN_UPPER:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_upper (TREE_VALUE (args));
+	    case BUILT_IN_VARIABLE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_variable (TREE_VALUE (args));
+	    case BUILT_IN_WRITEABLE:
+	      if (check_arglist_length (args, 1, 1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_writeable (TREE_VALUE (args));
+	    case BUILT_IN_WRITERECORD:
+	      if (check_arglist_length (args, 2, 3, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_writerecord (TREE_VALUE (args), TREE_CHAIN (args));
+	    case BUILT_IN_WRITETEXT:
+	      if (check_arglist_length (args, 2, -1, fnname) < 0)
+		return error_mark_node;
+	      return build_chill_writetext (TREE_VALUE (args),
+					    TREE_CHAIN (args));
+
+	    case BUILT_IN_EXPIRED:
+	    case BUILT_IN_WAIT:
+	      sorry ("unimplemented builtin function `%s'",
+		     IDENTIFIER_POINTER (fnname));
+	      break;
+	    default:
+	      error ("internal error - bad builtin function `%s'",
+		     IDENTIFIER_POINTER (fnname));
+	    }
+	}
+      return build_chill_function_call (func, args);
+    }
+
+  if (chill_varying_type_p (TREE_TYPE (func)))
+    type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)));
+
+  if (CH_STRING_TYPE_P (type))
+    {
+      if (args == NULL_TREE)
+	{
+	  error ("empty expression in string index");
+	  return error_mark_node;
+	}
+      if (TREE_CHAIN (args) != NULL)
+	{
+	  error ("only one expression allowed in string index");
+	  return error_mark_node;
+	}
+      if (flag_old_strings)
+	return build_chill_slice_with_length (func,
+					      TREE_VALUE (args),
+					      integer_one_node);
+      else if (CH_BOOLS_TYPE_P (type))
+	return build_chill_bitref (func, args);
+      else
+	return build_chill_array_ref (func, args);
+    }
+
+  else if (TREE_CODE (type) == ARRAY_TYPE)
+    return build_chill_array_ref (func, args);
+
+  if (TREE_CODE (func) != ERROR_MARK)
+    error ("invalid: primval ( untyped_exprlist )");
+  return error_mark_node;
+}
+
+/* Given a set stored as one bit per char (in BUFFER[0 .. BIT_SIZE-1]),
+   return a CONTRUCTOR, of type TYPE (a SET_TYPE). */
+tree
+expand_packed_set (buffer, bit_size, type)
+     char *buffer;
+     int   bit_size;
+     tree type;
+{
+  /* The ordinal number corresponding to the first stored bit. */
+  HOST_WIDE_INT first_bit_no =
+    TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (type)));
+  tree list = NULL_TREE;
+  int i;
+
+  for (i = 0; i < bit_size; i++)
+    if (buffer[i])
+      {
+	int next_0;
+	for (next_0 = i + 1; 
+	     next_0 < bit_size && buffer[next_0]; next_0++)
+	  ;
+	if (next_0 == i + 1)
+	  list = tree_cons (NULL_TREE, 
+		   build_int_2 (i + first_bit_no, 0), list);
+	else
+	  {
+	    list = tree_cons (build_int_2 (i + first_bit_no, 0),
+			      build_int_2 (next_0 - 1 + first_bit_no, 0), list);
+	    /* advance i past the range of 1-bits */
+	    i = next_0;
+	  }
+      }
+  list = build (CONSTRUCTOR, type, NULL_TREE, nreverse (list));
+  TREE_CONSTANT (list) = 1;
+  return list;
+}
+
+/*
+ * fold a set represented as a CONSTRUCTOR list.
+ * An empty set has a NULL_TREE in its TREE_OPERAND (set, 1) slot.
+ */
+static tree
+fold_set_expr (code, op0, op1)
+     enum chill_tree_code code;
+     tree op0, op1;
+{
+  tree temp;
+  char *buffer0, *buffer1, *bufferr;
+  int i, size0, size1, first_unused_bit;
+
+  if (! TREE_CONSTANT (op0) || TREE_CODE (op0) != CONSTRUCTOR)
+      return NULL_TREE;
+
+  if (op1 
+      && (! TREE_CONSTANT (op1) || TREE_CODE (op1) != CONSTRUCTOR))
+    return NULL_TREE;
+
+  size0 = int_size_in_bytes (TREE_TYPE (op0)) * BITS_PER_UNIT;
+  if (size0 < 0)
+    {
+      error ("operand is variable-size bitstring/power-set");
+      return error_mark_node;
+    }
+  buffer0 = (char*) alloca (size0);
+
+  temp = get_set_constructor_bits (op0, buffer0, size0);
+  if (temp)
+    return NULL_TREE;
+  
+  if (op0 && op1)
+    {
+      size1 = int_size_in_bytes (TREE_TYPE (op1)) * BITS_PER_UNIT;
+      if (size1 < 0)
+	{
+	  error ("operand is variable-size bitstring/power-set");
+	  return error_mark_node;
+	}
+      if (size0 != size1)
+	return NULL_TREE;
+      buffer1 = (char*) alloca (size1);
+      temp = get_set_constructor_bits (op1, buffer1, size1);
+      if (temp)
+	return NULL_TREE;
+    }
+
+  bufferr = (char*) alloca (size0); /* result buffer */
+
+  switch ((int)code)
+    {
+    case SET_NOT_EXPR:
+    case BIT_NOT_EXPR:
+      for (i = 0; i < size0; i++) 
+	bufferr[i] = 1 & ~buffer0[i];
+      goto build_result;
+    case SET_AND_EXPR:
+    case BIT_AND_EXPR:
+      for (i = 0; i < size0; i++)
+	bufferr[i] = buffer0[i] & buffer1[i];
+      goto build_result;
+    case SET_IOR_EXPR:
+    case BIT_IOR_EXPR:
+      for (i = 0; i < size0; i++)
+	bufferr[i] = buffer0[i] | buffer1[i];
+      goto build_result;
+    case SET_XOR_EXPR:
+    case BIT_XOR_EXPR:
+      for (i = 0; i < size0; i++) 
+	bufferr[i] = (buffer0[i] ^ buffer1[i]) & 1;      
+      goto build_result;
+    case SET_DIFF_EXPR:
+    case MINUS_EXPR:
+      for (i = 0; i < size0; i++)
+	bufferr[i] = buffer0[i] & ~buffer1[i];
+      goto build_result;
+    build_result:
+      /* mask out unused bits. Same as runtime library does. */
+      first_unused_bit = TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (op0))))
+	- TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (op0)))) + 1;
+      for (i = first_unused_bit; i < size0 ; i++)
+	bufferr[i] = 0;
+      return expand_packed_set (bufferr, size0, TREE_TYPE (op0));
+    case EQ_EXPR:
+      for (i = 0; i < size0; i++)
+	if (buffer0[i] != buffer1[i])
+	  return boolean_false_node;
+      return boolean_true_node;
+      
+    case NE_EXPR:
+      for (i = 0; i < size0; i++)
+	if (buffer0[i] != buffer1[i])
+	  return boolean_true_node;
+      return boolean_false_node;
+
+    default:
+      return NULL_TREE;
+    }
+}
+
+/*
+ * build a set or bit-array expression.  Type-checking is
+ * done elsewhere.
+ */
+static tree
+build_compare_set_expr (code, op0, op1)
+     enum chill_tree_code code;
+     tree op0, op1;
+{
+  tree result_type = NULL_TREE;
+  char *fnname;
+  tree x;
+
+  /* These conversions are needed if -fold-strings. */
+  if (TREE_CODE (TREE_TYPE (op0)) == BOOLEAN_TYPE)
+    {
+      if (CH_BOOLS_ONE_P (TREE_TYPE (op1)))
+	return build_compare_discrete_expr (code,
+					    op0,
+					    convert (boolean_type_node, op1));
+      else
+	op0 = convert (bitstring_one_type_node, op0);
+    }
+  if (TREE_CODE (TREE_TYPE (op1)) == BOOLEAN_TYPE)
+    {
+      if (CH_BOOLS_ONE_P (TREE_TYPE (op0)))
+	return build_compare_discrete_expr (code,
+					    convert (boolean_type_node, op0),
+					    op1);
+      else
+	op1 = convert (bitstring_one_type_node, op1);
+    }
+
+  switch ((int)code)
+    {
+    case EQ_EXPR:
+      {
+	tree temp = fold_set_expr (EQ_EXPR, op0, op1);
+	if (temp) 
+	  return temp;
+	fnname = "__eqpowerset";
+	goto compare_powerset;
+      }
+      break;
+
+    case GE_EXPR:
+      /* switch operands and fall thru */
+      x = op0;
+      op0 = op1;
+      op1 = x;
+
+    case LE_EXPR:
+      fnname = "__lepowerset";
+      goto compare_powerset;
+
+    case GT_EXPR:
+      /* switch operands and fall thru */
+      x = op0;
+      op0 = op1;
+      op1 = x;
+
+    case LT_EXPR:
+      fnname = "__ltpowerset";
+      goto compare_powerset;
+
+    case NE_EXPR:
+      return invert_truthvalue (build_compare_set_expr (EQ_EXPR, op0, op1));
+
+    compare_powerset:
+      {
+	tree tsize = powersetlen (op0);
+	
+	if (TREE_CODE (TREE_TYPE (op0)) != SET_TYPE)
+	  tsize = fold (build (MULT_EXPR, sizetype, tsize,
+			       size_int (BITS_PER_UNIT)));
+
+	return build_chill_function_call (lookup_name (get_identifier (fnname)),
+	       tree_cons (NULL_TREE, force_addr_of (op0),
+	         tree_cons (NULL_TREE, force_addr_of (op1),
+		   tree_cons (NULL_TREE, tsize, NULL_TREE))));
+      }
+      break;
+
+    default:
+      if ((int) code >= (int)LAST_AND_UNUSED_TREE_CODE)
+	{
+	  error ("tree code `%s' unhandled in build_compare_set_expr",
+		 tree_code_name[(int)code]);
+	  return error_mark_node;
+	}
+      break;
+    }
+
+  return build ((enum tree_code)code, result_type, 
+		op0, op1);
+}
+
+/* Convert a varying string (or array) to dynamic non-varying string:
+   EXP becomes EXP.var_data(0 UP EXP.var_length). */
+
+tree
+varying_to_slice (exp)
+     tree exp;
+{
+  if (!chill_varying_type_p (TREE_TYPE (exp)))
+    return exp;
+  else
+    { tree size, data, data_domain, doamin, min;
+      tree novelty = CH_NOVELTY (TREE_TYPE (exp));
+      exp = save_if_needed (exp);
+      size = build_component_ref (exp, var_length_id);
+      data = build_component_ref (exp, var_data_id);
+      TREE_TYPE (data) = copy_novelty (novelty, TREE_TYPE (data));
+      data_domain = TYPE_DOMAIN (TREE_TYPE (data));
+      if (data_domain != NULL_TREE
+	  && TYPE_MIN_VALUE (data_domain) != NULL_TREE)
+	min = TYPE_MIN_VALUE (data_domain);
+      else
+	min = integer_zero_node;
+      return build_chill_slice (data, min, size);
+    }
+}
+
+/* Convert a scalar argument to a string or array type.  This is a subroutine
+   of `build_concat_expr'.  */
+
+static tree
+scalar_to_string (exp)
+     tree exp;
+{
+  tree type = TREE_TYPE (exp);
+
+  if (SCALAR_P (type))
+    {
+      int was_const = TREE_CONSTANT (exp);
+      if (TREE_TYPE (exp) == char_type_node)
+	exp = convert (string_one_type_node, exp);
+      else if (TREE_TYPE (exp) == boolean_type_node)
+	exp = convert (bitstring_one_type_node, exp);
+      else
+	exp = convert (build_array_type_for_scalar (type), exp);
+      TREE_CONSTANT (exp) = was_const;
+      return exp;
+    }
+  return varying_to_slice (exp);
+}
+
+/* FIXME:  Generalize this to general arrays (not just strings),
+   at least for the compiler-generated case of padding fixed-length arrays. */
+
+static tree
+build_concat_expr (op0, op1)
+     tree op0, op1;
+{
+  tree orig_op0 = op0, orig_op1 = op1;
+  tree type0, type1, size0, size1, res;
+
+  op0 = scalar_to_string (op0);
+  type0 = TREE_TYPE (op0);
+  op1 = scalar_to_string (op1);
+  type1 = TREE_TYPE (op1);
+  size1 = size_in_bytes (type1);
+
+  /* try to fold constant string literals */
+  if (TREE_CODE (op0) == STRING_CST
+      && (TREE_CODE (op1) == STRING_CST 
+	  || TREE_CODE (op1) == UNDEFINED_EXPR)
+      && TREE_CODE (size1) == INTEGER_CST)
+    {
+      int len0 = TREE_STRING_LENGTH (op0);
+      int len1 = TREE_INT_CST_LOW (size1);
+      char *result = xmalloc (len0 + len1 + 1);
+      memcpy (result, TREE_STRING_POINTER (op0), len0);
+      if (TREE_CODE (op1) == UNDEFINED_EXPR)
+	memset (&result[len0], '\0', len1);
+      else
+	memcpy (&result[len0], TREE_STRING_POINTER (op1), len1);
+      return build_chill_string (len0 + len1, result);
+    }
+  else if (TREE_CODE (type0) == TREE_CODE (type1))
+    {
+      tree result_size;
+      struct ch_class result_class;
+      struct ch_class class0;
+      struct ch_class class1;
+
+      class0 = chill_expr_class (orig_op0);
+      class1 = chill_expr_class (orig_op1);
+
+      if (TREE_CODE (type0) == SET_TYPE)
+	{
+	  result_size = size_binop (PLUS_EXPR,
+				    discrete_count (TYPE_DOMAIN (type0)),
+				    discrete_count (TYPE_DOMAIN (type1)));
+	  result_class.mode = build_bitstring_type (result_size);
+	}
+      else
+	{
+	  tree max0 = TYPE_MAX_VALUE (type0);
+	  tree max1 = TYPE_MAX_VALUE (type1);
+
+	  /* new array's dynamic size (in bytes). */
+	  size0     = size_in_bytes (type0);
+	  /* size1 was computed above.  */
+
+	  result_size = size_binop (PLUS_EXPR, size0, size1);
+	  /* new array's type. */
+	  result_class.mode = build_string_type (char_type_node, result_size);
+
+	  if (max0 || max1)
+	    {
+	      max0 = max0 == 0 ? size0 : convert (sizetype, max0);
+	      max1 = max1 == 0 ? size1 : convert (sizetype, max1);
+	      TYPE_MAX_VALUE (result_class.mode)
+		= size_binop (PLUS_EXPR, max0, max1);
+	    }
+	}
+
+      if (class0.kind == CH_VALUE_CLASS || class1.kind == CH_VALUE_CLASS)
+	{
+	  tree novelty0 = CH_NOVELTY (TREE_TYPE (orig_op0));
+	  result_class.kind = CH_VALUE_CLASS;
+	  if (class0.kind == CH_VALUE_CLASS && novelty0 != NULL_TREE)
+	    SET_CH_NOVELTY_NONNIL (result_class.mode, novelty0);
+	  else if (class1.kind == CH_VALUE_CLASS)
+	    SET_CH_NOVELTY (result_class.mode,
+			    CH_NOVELTY (TREE_TYPE (orig_op1)));
+	}
+      else
+	result_class.kind = CH_DERIVED_CLASS;
+
+      if (TREE_CODE (result_class.mode) == SET_TYPE
+	  && TREE_CONSTANT (op0) && TREE_CONSTANT (op1)
+	  && TREE_CODE (op0) == CONSTRUCTOR && TREE_CODE (op1) == CONSTRUCTOR)
+	{
+	  HOST_WIDE_INT size0, size1;  char *buffer;
+	  size0 = TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type0))) + 1;
+	  size1 = TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type1))) + 1;
+	  buffer = (char*) alloca (size0 + size1);
+	  if (size0 < 0 || size1 < 0
+	      || get_set_constructor_bits (op0, buffer, size0)
+	      || get_set_constructor_bits (op1, buffer + size0, size1))
+	    abort ();
+	  res = expand_packed_set (buffer, size0 + size1, result_class.mode);
+	}
+      else
+	res = build (CONCAT_EXPR, result_class.mode, op0, op1);
+      return convert_to_class (result_class, res);
+    }
+  else
+    {
+      error ("incompatible modes in concat expression");
+      return error_mark_node;
+    }
+}
+
+/*
+ * handle varying and fixed array compare operations
+ */
+static tree
+build_compare_string_expr (code, op0, op1)
+     enum chill_tree_code code;
+     tree op0, op1;
+{
+  if (op0 == NULL_TREE || TREE_CODE (op0) == ERROR_MARK)
+    return error_mark_node;
+  if (op1 == NULL_TREE || TREE_CODE (op1) == ERROR_MARK)
+    return error_mark_node;
+
+  if (tree_int_cst_equal (TYPE_SIZE (TREE_TYPE (op0)),
+			  TYPE_SIZE (TREE_TYPE (op1)))
+      && ! chill_varying_type_p (TREE_TYPE (op0))
+      && ! chill_varying_type_p (TREE_TYPE (op1)))
+    {
+      tree size = size_in_bytes (TREE_TYPE (op0));
+      tree temp = lookup_name (get_identifier ("memcmp"));
+      temp = build_chill_function_call (temp,
+		 tree_cons (NULL_TREE, force_addr_of (op0),
+		     tree_cons (NULL_TREE, force_addr_of (op1),
+		       tree_cons (NULL_TREE, size, NULL_TREE))));
+      return build_compare_discrete_expr (code, temp, integer_zero_node);
+    }
+
+  switch ((int)code)
+    {
+    case EQ_EXPR:
+      code = STRING_EQ_EXPR;
+      break;
+    case GE_EXPR:
+      return invert_truthvalue (build_compare_string_expr (LT_EXPR, op0, op1));
+    case LE_EXPR:
+      return invert_truthvalue (build_compare_string_expr (LT_EXPR, op1, op0));
+    case GT_EXPR:
+      return build_compare_string_expr (LT_EXPR, op1, op0);
+    case LT_EXPR:
+      code = STRING_LT_EXPR;
+      break;
+    case NE_EXPR:
+      return invert_truthvalue (build_compare_string_expr (EQ_EXPR, op0, op1));
+    default:
+      error ("Invalid operation on array of chars");
+      return error_mark_node;
+    }
+
+  return build (code, boolean_type_node, op0, op1);
+}
+
+tree
+compare_records (exp0, exp1)
+     tree exp0, exp1;
+{
+  tree type = TREE_TYPE (exp0);
+  tree field;
+  int have_variants = 0;
+
+  tree result = boolean_true_node;
+  extern int maximum_field_alignment;
+
+  if (TREE_CODE (type) != RECORD_TYPE)
+    abort ();
+
+  exp0 = save_if_needed (exp0);
+  exp1 = save_if_needed (exp1);
+
+  for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
+    {
+      if (DECL_NAME (field) == NULL_TREE)
+	{
+	  have_variants = 1;
+	  break;
+	}
+    }
+
+  /* in case of -fpack we always do a memcmp */
+  if (maximum_field_alignment != 0)
+    {
+      tree memcmp_func = lookup_name (get_identifier ("memcmp"));
+      tree arg1 = force_addr_of (exp0);
+      tree arg2 = force_addr_of (exp1);
+      tree arg3 = size_in_bytes (type);
+      tree fcall = build_chill_function_call (memcmp_func,
+                     tree_cons (NULL_TREE, arg1,
+                       tree_cons (NULL_TREE, arg2,
+                         tree_cons (NULL_TREE, arg3, NULL_TREE))));
+
+      if (have_variants)
+	warning ("comparison of variant structures is unsafe");
+      result = build_chill_binary_op (EQ_EXPR, fcall, integer_zero_node);
+      return result;
+    }
+
+  if (have_variants)
+    {
+      sorry ("compare with variant records");
+      return error_mark_node;
+    }
+
+  for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
+    {
+      tree exp0fld = build_component_ref (exp0, DECL_NAME (field));
+      tree exp1fld = build_component_ref (exp1, DECL_NAME (field));
+      tree eq_flds = build_chill_binary_op (EQ_EXPR, exp0fld, exp1fld);
+      result = build_chill_binary_op (TRUTH_AND_EXPR, result, eq_flds);
+    }
+  return result;
+}
+
+int
+compare_int_csts (op, val1, val2)
+     enum tree_code op;
+     tree val1, val2;
+{
+  int result;
+  tree tmp;
+  tree type1 = TREE_TYPE (val1);
+  tree type2 = TREE_TYPE (val2);
+  switch (op)
+    {
+    case GT_EXPR:
+    case GE_EXPR:
+      tmp = val1;  val1 = val2;  val2 = tmp;
+      tmp = type1;  type1 = type2; type2 = tmp;
+      op = (op == GT_EXPR) ? LT_EXPR : LE_EXPR;
+      /* ... fall through ... */
+    case LT_EXPR:
+    case LE_EXPR:
+      if (!TREE_UNSIGNED (type1))
+	{
+	  if (!TREE_UNSIGNED (type2))
+	    result = INT_CST_LT (val1, val2);
+	  else if (TREE_INT_CST_HIGH (val1) < 0)
+	    result = 1;
+	  else
+	    result = INT_CST_LT_UNSIGNED (val1, val2);
+	}
+      else
+	{
+	  if (!TREE_UNSIGNED (type2) && TREE_INT_CST_HIGH (val2) < 0)
+	    result = 0;
+	  else
+	    result = INT_CST_LT_UNSIGNED (val1, val2);
+	}
+      if (op == LT_EXPR || result == 1)
+	break;
+      /* else fall through ... */
+    case NE_EXPR:
+    case EQ_EXPR:
+      if (TREE_INT_CST_LOW (val1) == TREE_INT_CST_LOW (val2)
+	  && TREE_INT_CST_HIGH (val1) == TREE_INT_CST_HIGH (val2)
+	  /* They're bitwise equal.
+	     Check for one being negative and the other unsigned. */
+	  && (TREE_INT_CST_HIGH (val2) >= 0
+	      || TREE_UNSIGNED (TREE_TYPE (val1))
+	      == TREE_UNSIGNED (TREE_TYPE (val2))))
+	result = 1;
+      else
+	result = 0;
+      if (op == NE_EXPR)
+	result = !result;
+      break;
+    }
+  return result;
+}
+
+/* Build an expression to compare discrete values VAL1 and VAL2.
+   This does not check that they are discrete, nor that they are
+   compatible;  if you need such checks use build_compare_expr. */
+
+tree
+build_compare_discrete_expr (op, val1, val2)
+     enum chill_tree_code op;
+     tree val1, val2;
+{
+  tree type1 = TREE_TYPE (val1);
+  tree type2 = TREE_TYPE (val2);
+  tree tmp;
+
+  if (TREE_CODE (val1) == INTEGER_CST && TREE_CODE (val2) == INTEGER_CST)
+    {
+      if (compare_int_csts (op, val1, val2))
+	return boolean_true_node;
+      else	
+	return boolean_false_node;
+    }
+
+  if (TREE_UNSIGNED (type1) != TREE_UNSIGNED (type2))
+    {
+      switch (op)
+	{
+	case GT_EXPR:
+	case GE_EXPR:
+	  tmp = val1;  val1 = val2;  val2 = tmp;
+	  tmp = type1;  type1 = type2; type2 = tmp;
+	  op = (op == GT_EXPR) ? LT_EXPR : LE_EXPR;
+	  /* ... fall through ... */
+	case LT_EXPR:
+	case LE_EXPR:
+	  if (TREE_UNSIGNED (type2))
+	    {
+	      tmp = build_int_2_wide (0, 0);
+	      TREE_TYPE (tmp) = type1;
+	      val1 = save_expr (val1);
+	      tmp = fold (build (LT_EXPR, boolean_type_node, val1, tmp));
+	      if (TYPE_PRECISION (type2) < TYPE_PRECISION (type1))	
+		{
+		  type2 = unsigned_type (type1);
+		  val2 = convert_to_integer (type2, val2);
+		}
+	      val1 = convert_to_integer (type2, val1);
+	      return fold (build (TRUTH_OR_EXPR, boolean_type_node,
+				  tmp,
+				  fold (build (op, boolean_type_node,
+					       val1, val2))));
+	    }
+	unsigned_vs_signed: /* val1 is unsigned, val2 is signed */
+	  tmp = build_int_2_wide (0, 0);
+	  TREE_TYPE (tmp) = type2;
+	  val2 = save_expr (val2);
+	  tmp = fold (build (GE_EXPR, boolean_type_node, val2, tmp));
+	  if (TYPE_PRECISION (type1) < TYPE_PRECISION (type2))	
+	    {
+	      type1 = unsigned_type (type2);
+	      val1 = convert_to_integer (type1, val1);
+	    }
+	  val2 = convert_to_integer (type1, val2);
+	  return fold (build (TRUTH_AND_EXPR, boolean_type_node, tmp,
+			      fold (build (op, boolean_type_node,
+					   val1, val2))));
+	case EQ_EXPR:
+	  if (TREE_UNSIGNED (val2))
+	    {
+	      tmp = val1;  val1 = val2;  val2 = tmp;
+	      tmp = type1;  type1 = type2; type2 = tmp;
+	    }
+	  goto unsigned_vs_signed;
+	case NE_EXPR:
+	  tmp = build_compare_expr (EQ_EXPR, val1, val2);
+	  return build_chill_unary_op (TRUTH_NOT_EXPR, tmp);
+	}
+    }
+  if (TYPE_PRECISION (type1) > TYPE_PRECISION (type2))
+    val2 = convert (type1, val2);
+  else if (TYPE_PRECISION (type1) < TYPE_PRECISION (type2))
+    val1 = convert (type2, val1);
+  return fold (build (op, boolean_type_node, val1, val2));
+}
+
+tree
+build_compare_expr (op, val1, val2)
+     enum chill_tree_code op;
+     tree val1, val2;
+{
+  tree tmp;
+  tree type1, type2;
+  val1 = check_have_mode (val1, "relational expression");
+  val2 = check_have_mode (val2, "relational expression");
+  if (val1 == NULL_TREE || TREE_CODE (val1) == ERROR_MARK)
+    return error_mark_node;
+  if (val2 == NULL_TREE || TREE_CODE (val2) == ERROR_MARK)
+    return error_mark_node;
+
+  if (pass == 1)
+    return build (op, NULL_TREE, val1, val2);
+
+  if (!CH_COMPATIBLE_CLASSES (val1, val2))
+    {
+      error ("incompatible operands to %s", boolean_code_name [op]);
+      return error_mark_node;
+    }
+
+  tmp = CH_ROOT_MODE (TREE_TYPE (val1));
+  if (tmp != TREE_TYPE (val1))
+    val1 = convert (tmp, val1);
+  tmp = CH_ROOT_MODE (TREE_TYPE (val2));
+  if (tmp != TREE_TYPE (val2))
+    val2 = convert (tmp, val2);
+
+  type1 = TREE_TYPE (val1);
+  type2 = TREE_TYPE (val2);
+
+  if (TREE_CODE (type1) == SET_TYPE)
+    tmp =  build_compare_set_expr (op, val1, val2);
+
+  else if (discrete_type_p (type1))
+    tmp = build_compare_discrete_expr (op, val1, val2);
+
+  else if (chill_varying_type_p (type1) || chill_varying_type_p (type2)
+      || (TREE_CODE (type1) == ARRAY_TYPE
+	  && TREE_CODE (TREE_TYPE (type1)) == CHAR_TYPE)
+      || (TREE_CODE (type2) == ARRAY_TYPE
+	  && TREE_CODE (TREE_TYPE (type2)) == CHAR_TYPE) )
+    tmp =  build_compare_string_expr (op, val1, val2);
+
+  else if ((TREE_CODE (type1) == RECORD_TYPE
+	    || TREE_CODE (type2) == RECORD_TYPE)
+	   && (op == EQ_EXPR || op == NE_EXPR))
+    {
+      /* This is for handling INSTANCEs being compared against NULL. */
+      if (val1 == null_pointer_node)
+	val1 = convert (type2, val1);
+      if (val2 == null_pointer_node)
+	val2 = convert (type1, val2);
+
+      tmp = compare_records (val1, val2);
+      if (op == NE_EXPR)
+	tmp = build_chill_unary_op (TRUTH_NOT_EXPR, tmp);
+    }
+
+  else if (TREE_CODE (type1) == REAL_TYPE || TREE_CODE (type2) == REAL_TYPE
+	   || (op == EQ_EXPR || op == NE_EXPR))
+    {
+      tmp = build (op, boolean_type_node, val1, val2);
+      CH_DERIVED_FLAG (tmp) = 1; /* Optimization to avoid copy_node. */
+      tmp = fold (tmp);
+    }
+
+  else
+    {
+      error ("relational operator not allowed for this mode");
+      return error_mark_node;
+    }
+
+  if (!CH_DERIVED_FLAG (tmp))
+    {
+      tmp = copy_node (tmp);
+      CH_DERIVED_FLAG (tmp) = 1;
+    }
+  return tmp;
+}
+
+tree
+finish_chill_binary_op (node)
+     tree node;
+{
+  tree op0 = check_have_mode (TREE_OPERAND (node, 0), "binary expression");
+  tree op1 = check_have_mode (TREE_OPERAND (node, 1), "binary expression");
+  tree type0 = TREE_TYPE (op0);
+  tree type1 = TREE_TYPE (op1);
+  enum tree_code code0;
+  enum tree_code code1;
+  tree folded;
+
+  if (TREE_CODE (op0) == ERROR_MARK || TREE_CODE (op1) == ERROR_MARK)
+    return error_mark_node;
+
+  if (UNSATISFIED (op0) || UNSATISFIED (op1))
+    {
+      UNSATISFIED_FLAG (node) = 1;
+      return node;
+    }
+#if 0
+  /* assure that both operands have a type */
+  if (! type0 && type1)
+    {
+      op0 = convert (type1, op0);
+      type0 = TREE_TYPE (op0);
+    }
+  if (! type1 && type0)
+    {
+      op1 = convert (type0, op1);
+      type1 = TREE_TYPE (op1);
+    }
+#endif
+  UNSATISFIED_FLAG (node) = 0;
+#if 0
+
+  { int op0f = TREE_CODE (op0) == FUNCTION_DECL;
+    int op1f = TREE_CODE (op1) == FUNCTION_DECL;
+    if (op0f)
+      op0 = convert (build_pointer_type (TREE_TYPE (op0)), op0);
+    if (op1f)
+      op1 = convert (build_pointer_type (TREE_TYPE (op1)), op1);
+    if ((op0f || op1f)
+	&& code != EQ_EXPR && code != NE_EXPR)
+      error ("Cannot use %s operator on PROC mode variable",
+	     tree_code_name[(int)code]);
+  }
+
+  if (invalid_left_operand (type0, code))
+    {
+      error ("invalid left operand of %s", tree_code_name[(int)code]);
+      return error_mark_node;
+    }
+  if (invalid_right_operand (code, type1))
+    {
+      error ("invalid right operand of %s", tree_code_name[(int)code]);
+      return error_mark_node;
+    }
+#endif
+
+  switch (TREE_CODE (node))
+    {
+    case CONCAT_EXPR:
+      return build_concat_expr (op0, op1);
+
+    case REPLICATE_EXPR:
+      op0 = fold (op0);
+      if (!TREE_CONSTANT (op0) || !TREE_CONSTANT (op1))
+	{
+	  error ("repetition expression must be constant");
+	  return error_mark_node;
+	}
+      else
+	return build_chill_repetition_op (op0, op1);
+
+    case FLOOR_MOD_EXPR:
+    case TRUNC_MOD_EXPR:
+      if (TREE_CODE (type0) != INTEGER_TYPE)
+	{
+	  error ("left argument to MOD/REM operator must be integral");
+	  return error_mark_node;
+	}
+      if (TREE_CODE (type1) != INTEGER_TYPE)
+	{
+	  error ("right argument to MOD/REM operator must be integral");
+	  return error_mark_node;
+	}
+      break;
+
+    case MINUS_EXPR:
+      if (TREE_CODE (type1) == SET_TYPE)
+	{
+	  tree temp = fold_set_expr (MINUS_EXPR, op0, op1);
+
+	  if (temp)
+	    return temp;
+	  if (TYPE_MODE (type1) == BLKmode)
+	    TREE_SET_CODE (node, SET_DIFF_EXPR);
+	  else
+	    {
+	      op1 = build_chill_unary_op (BIT_NOT_EXPR, op1);
+	      TREE_OPERAND (node, 1) = op1;
+	      TREE_SET_CODE (node, BIT_AND_EXPR);
+	    }
+	}
+      break;
+
+    case TRUNC_DIV_EXPR:
+      if (TREE_CODE (type0) == REAL_TYPE || TREE_CODE (type1) == REAL_TYPE)
+	TREE_SET_CODE (node, RDIV_EXPR);
+      break;
+
+    case BIT_AND_EXPR:
+      if (TYPE_MODE (type1) == BLKmode)
+	TREE_SET_CODE (node, SET_AND_EXPR);
+      goto fold_set_binop;
+    case BIT_IOR_EXPR:
+      if (TYPE_MODE (type1) == BLKmode)
+	TREE_SET_CODE (node, SET_IOR_EXPR);
+      goto fold_set_binop;
+    case BIT_XOR_EXPR:
+      if (TYPE_MODE (type1) == BLKmode)
+	TREE_SET_CODE (node, SET_XOR_EXPR);
+      goto fold_set_binop;
+    case SET_AND_EXPR:
+    case SET_IOR_EXPR:
+    case SET_XOR_EXPR:
+    case SET_DIFF_EXPR:
+    fold_set_binop:
+      if (TREE_CODE (type0) == SET_TYPE)
+	{
+	  tree temp = fold_set_expr (TREE_CODE (node), op0, op1);
+
+	  if (temp)
+	    return temp;
+	}
+      break;
+
+    case SET_IN_EXPR:
+      if (TREE_CODE (type1) != SET_TYPE || CH_BOOLS_TYPE_P (type1))
+	{
+	  error ("right operand of IN is not a powerset");
+	  return error_mark_node;
+	}
+      if (!CH_COMPATIBLE (op0, TYPE_DOMAIN (type1)))
+	{
+	  error ("left operand of IN incompatible with right operand");
+	  return error_mark_node;
+	}
+      type0 = CH_ROOT_MODE (type0);
+      if (type0 != TREE_TYPE (op0))
+	TREE_OPERAND (node, 0) = op0 = convert (type0, op0);
+      TREE_TYPE (node) = boolean_type_node;
+      CH_DERIVED_FLAG (node) = 1;
+      node = fold (node);
+      if (!CH_DERIVED_FLAG (node))
+	{
+	  node = copy_node (node);
+	  CH_DERIVED_FLAG (node) = 1;
+	}
+      return node;
+    case NE_EXPR:
+    case EQ_EXPR:
+    case GE_EXPR:
+    case GT_EXPR:
+    case LE_EXPR:
+    case LT_EXPR:
+      return build_compare_expr (TREE_CODE (node), op0, op1);
+    default:
+      ;
+    }
+
+  if (!CH_COMPATIBLE_CLASSES (op0, op1))
+    {
+      error ("incompatible operands to %s", tree_code_name[(int) TREE_CODE (node)]);
+      return error_mark_node;
+    }
+
+
+ finish:
+  if (TREE_TYPE (node) == NULL_TREE)
+    {
+      struct ch_class class;
+      class = CH_ROOT_RESULTING_CLASS (op0, op1);
+      TREE_OPERAND (node, 0) = op0 = convert_to_class (class, op0);
+      type0 = TREE_TYPE (op0);
+      TREE_OPERAND (node, 1) = op1 = convert_to_class (class, op1);
+      type1 = TREE_TYPE (op1);
+      TREE_TYPE (node) = class.mode;
+      folded = convert_to_class (class, fold (node));
+    }
+  else
+    folded = fold (node);
+#if 0
+  if (folded == node)
+    TREE_CONSTANT (folded) = TREE_CONSTANT (op0) & TREE_CONSTANT (op1);
+#endif
+  if (TREE_CODE (node) == TRUNC_DIV_EXPR)
+    if (TREE_CONSTANT (op1))
+      {
+	if (tree_int_cst_equal (op1, integer_zero_node))
+	  {
+	    error ("division by zero");
+	    return integer_zero_node;
+	  }
+      }
+    else if (range_checking)
+      {
+#if 0
+	tree test = build (EQ_EXPR, boolean_type_node, op1, integer_zero_node);
+	/* Should this be overflow? */
+	folded = check_expression (folded, test,
+				   ridpointers[(int) RID_RANGEFAIL]);
+#endif
+      }
+  return folded;
+}
+
+/*
+ * This implements the '->' operator, which, like the '&' in C,
+ * returns a pointer to an object, which has the type of
+ * pointer-to-that-object.
+ *
+ * FORCE is 0 when we're evaluating a user-level syntactic construct,
+ * and 1 when we're calling from inside the compiler.
+ */
+tree
+build_chill_arrow_expr (ref, force)
+     tree ref;
+     int force;
+{
+  tree addr_type;
+  tree result;
+
+  if (pass == 1)
+    {
+      error ("-> operator not allow in constant expression");
+      return error_mark_node;
+    }
+
+  if (ref == NULL_TREE || TREE_CODE (ref) == ERROR_MARK)
+    return ref;
+
+  while (TREE_CODE (TREE_TYPE (ref)) == REFERENCE_TYPE)
+    ref = convert (TREE_TYPE (TREE_TYPE (ref)), ref);
+
+  if (!force && ! CH_LOCATION_P (ref))
+    {
+      if (TREE_CODE (ref) == STRING_CST)
+	pedwarn ("taking the address of a string literal is non-standard");
+      else if (TREE_CODE (TREE_TYPE (ref)) == FUNCTION_TYPE)
+	pedwarn ("taking the address of a function is non-standard");
+      else
+	{
+	  error ("ADDR requires a LOCATION argument");
+	  return error_mark_node;
+	}
+      /* FIXME: Should we be sure that ref isn't a
+	 function if we're being pedantic? */
+    }
+
+  addr_type = build_pointer_type (TREE_TYPE (ref));
+
+#if 0
+  /* This transformation makes chill_expr_class return CH_VALUE_CLASS
+     when it should return CH_REFERENCE_CLASS.  That could be fixed,
+     but we probably don't want this transformation anyway. */
+  if (TREE_CODE (ref) == NOP_EXPR) /* RETYPE_EXPR */
+    {
+      tree addr;
+      while (TREE_CODE (ref) == NOP_EXPR) /* RETYPE_EXPR */
+	ref = TREE_OPERAND (ref, 0);
+      mark_addressable (ref);
+      addr = build1 (ADDR_EXPR, 
+		     build_pointer_type (TREE_TYPE (ref)), ref);
+      return build1 (NOP_EXPR, /* RETYPE_EXPR */
+		      addr_type,
+		      addr);
+    } 
+  else
+#endif
+    {
+      if (! mark_addressable (ref))
+	{
+	  error ("-> expression is not addressable");
+	  return error_mark_node;
+	}
+      result = build1 (ADDR_EXPR, addr_type, ref);
+      if (staticp (ref)
+	  && ! (TREE_CODE (ref) == FUNCTION_DECL
+		&& DECL_CONTEXT (ref) != 0))
+	TREE_CONSTANT (result) = 1;
+      return result;
+    }
+}
+
+/*
+ * This implements the ADDR builtin function, which returns a 
+ * free reference, analogous to the C 'void *'.
+ */
+tree
+build_chill_addr_expr (ref, errormsg)
+     tree ref;
+     char *errormsg;
+{
+  if (ref == error_mark_node)
+    return ref;
+
+  if (! CH_LOCATION_P (ref)
+      && TREE_CODE (TREE_TYPE (ref)) != FUNCTION_TYPE)
+    {
+      error ("ADDR parameter must be a LOCATION", errormsg);
+      return error_mark_node;
+    }
+  ref = build_chill_arrow_expr (ref, 1);
+
+  if (ref != NULL_TREE && TREE_CODE (ref) != ERROR_MARK)
+    TREE_TYPE (ref) = ptr_type_node;
+  else if (errormsg == NULL)
+    {
+      error ("possible internal error in build_chill_arrow_expr");
+      return error_mark_node;
+    }
+  else
+    {
+      error ("%s is not addressable", errormsg);
+      return error_mark_node;
+    }
+  return ref;
+}
+
+tree
+build_chill_binary_op (code, op0, op1)
+     enum chill_tree_code code;
+     tree op0, op1;
+{
+  register tree result;
+
+  if (op0 == NULL_TREE || TREE_CODE (op0) == ERROR_MARK)
+    return error_mark_node;
+  if (op1 == NULL_TREE || TREE_CODE (op1) == ERROR_MARK)
+    return error_mark_node;
+
+  result = build (code, NULL_TREE, op0, op1);
+
+  if (pass != 1)
+    result = finish_chill_binary_op (result);
+  return result;
+}
+
+/*
+ * process a string repetition phrase '(' COUNT ')' STRING
+ */
+tree
+string_char_rep (count, string)
+     int count;
+     tree string;
+{
+  int slen, charindx, repcnt;
+  char ch;
+  char *temp;
+  char *inp;
+  char *outp;
+  tree type;
+
+  if (string == NULL_TREE || TREE_CODE (string) == ERROR_MARK)
+    return error_mark_node;
+
+  type = TREE_TYPE (string);
+  slen = int_size_in_bytes (type);
+  temp = xmalloc (slen * count);
+  inp = &ch;
+  outp = temp;
+  if (TREE_CODE (string) == STRING_CST)  
+    inp = TREE_STRING_POINTER (string);
+  else                           /* single character */
+    ch = (char)TREE_INT_CST_LOW (string);
+
+  /* copy the string/char COUNT times into the output buffer */
+  for (outp = temp, repcnt = 0; repcnt < count; repcnt++)
+    for (charindx = 0; charindx < slen; charindx++)
+      *outp++ = inp[charindx];
+  return build_chill_string (slen * count, temp);
+}
+
+/* Build a bit-string constant containing with the given LENGTH
+   containing all ones (if VALUE is true), or all zeros (if VALUE is false). */
+
+tree
+build_boring_bitstring (length, value)
+     long length;
+     int value;
+{
+  tree result;
+  tree list;  /* Value of CONSTRUCTOR_ELTS in the result. */
+  if (value && length > 0)
+    list = tree_cons (integer_zero_node, size_int (length - 1), NULL_TREE);
+  else
+    list = NULL_TREE;
+		
+  result = build (CONSTRUCTOR,
+		  build_bitstring_type (size_int (length)),
+		  NULL_TREE,
+		  list);
+  TREE_CONSTANT (result) = 1;
+  CH_DERIVED_FLAG (result) = 1;
+  return result;
+}
+
+/*
+ * handle a string repetition, with the syntax:
+ *        ( COUNT ) 'STRING'
+ * COUNT is required to be constant, positive and folded.
+ */
+tree
+build_chill_repetition_op (count_op, string)
+     tree count_op;
+     tree string;
+{
+  int count;
+  tree type = TREE_TYPE (string);
+
+  if (TREE_CODE (count_op) != INTEGER_CST)
+    {
+      error ("repetition count is not an integer constant");
+      return error_mark_node;
+    }
+
+  count = TREE_INT_CST_LOW (count_op);
+
+  if (count < 0)
+    {
+      error ("repetition count < 0");
+      return error_mark_node;
+    }
+  if (! TREE_CONSTANT (string))
+    {
+      error ("repetition value not constant");
+      return error_mark_node;
+    }
+
+  if (TREE_CODE (string) == STRING_CST)
+    return string_char_rep (count, string);
+
+  switch ((int)TREE_CODE (type))
+    {
+    case BOOLEAN_TYPE:
+      if (TREE_CODE (string) == INTEGER_CST)
+	return build_boring_bitstring (count, TREE_INT_CST_LOW (string));
+      error ("bitstring repetition of non-constant boolean");
+      return error_mark_node;
+
+    case CHAR_TYPE:
+      return string_char_rep (count, string);
+
+    case SET_TYPE:
+      { int i, tree_const = 1;
+	tree new_list = NULL_TREE;
+	tree vallist;
+	tree result;
+	tree domain = TYPE_DOMAIN (type);
+	tree orig_length;
+	HOST_WIDE_INT orig_len;
+
+	if (!CH_BOOLS_TYPE_P (type)) /* cannot replicate a powerset */
+	  break;
+
+	orig_length = discrete_count (domain);
+
+	if (TREE_CODE (string) != CONSTRUCTOR || !TREE_CONSTANT (string)
+	    || TREE_CODE (orig_length) != INTEGER_CST)
+	  {
+	    error ("string repetition operand is non-constant bitstring");
+	    return error_mark_node;
+	  }
+
+			       
+	orig_len = TREE_INT_CST_LOW (orig_length);
+
+	/* if the set is empty, this is NULL */
+	vallist = TREE_OPERAND (string, 1);
+
+	if (vallist == NULL_TREE) /* No bits are set. */
+	  return build_boring_bitstring (count * orig_len, 0);
+	else if (TREE_CHAIN (vallist) == NULL_TREE
+		 && (TREE_PURPOSE (vallist) == NULL_TREE
+		     ? (orig_len == 1
+			&& tree_int_cst_equal (TYPE_MIN_VALUE (domain),
+					       TREE_VALUE (vallist)))
+		     : (tree_int_cst_equal (TYPE_MIN_VALUE (domain),
+					    TREE_PURPOSE (vallist))
+			&& tree_int_cst_equal (TYPE_MAX_VALUE (domain),
+					       TREE_VALUE (vallist)))))
+	  return build_boring_bitstring (count * orig_len, 1);
+
+	for (i = 0; i < count; i++)
+	  {
+	    tree origin = build_int_2 (i * orig_len, 0);
+	    tree temp;
+
+	    /* scan down the given value list, building
+	       new bit-positions */
+	    for (temp = vallist; temp; temp = TREE_CHAIN (temp))
+	      {
+		tree new_value
+		  = fold (size_binop (PLUS_EXPR, origin, TREE_VALUE (temp)));
+		tree new_purpose = NULL_TREE;
+		if (! TREE_CONSTANT (TREE_VALUE (temp)))
+		  tree_const = 0;
+		if (TREE_PURPOSE (temp))
+		  {
+		    new_purpose = fold (size_binop (PLUS_EXPR,
+						    origin,
+						    TREE_PURPOSE (temp)));
+		    if (! TREE_CONSTANT (TREE_PURPOSE (temp)))
+		      tree_const = 0;
+		  }
+
+		new_list = tree_cons (new_purpose,
+					  new_value, new_list);
+	      }
+	  }
+	result = build (CONSTRUCTOR,
+			build_bitstring_type (size_int (count * orig_len)),
+			NULL_TREE, nreverse (new_list));
+	TREE_CONSTANT (result) = tree_const;
+	CH_DERIVED_FLAG (result) = CH_DERIVED_FLAG (string);
+	return result;
+      }
+
+    default:
+      error ("non-char, non-bit string repetition");
+      return error_mark_node;
+  }
+  return error_mark_node;
+}
+
+tree
+finish_chill_unary_op (node)
+     tree node;
+{
+  enum chill_tree_code code = TREE_CODE (node);
+  tree op0 = check_have_mode (TREE_OPERAND (node, 0), "unary expression");
+  tree type0 = TREE_TYPE (op0);
+  struct ch_class class;
+
+  if (TREE_CODE (op0) == ERROR_MARK)
+    return error_mark_node;
+  /* The expression codes of the data types of the arguments tell us
+     whether the arguments are integers, floating, pointers, etc.  */
+
+  if (TREE_CODE (type0) == REFERENCE_TYPE)
+    {
+      op0 = convert (TREE_TYPE (type0), op0);
+      type0 = TREE_TYPE (op0);
+    }
+
+  if (invalid_right_operand (code, type0))
+    {
+      error ("invalid operand of %s", 
+	     tree_code_name[(int)code]);
+      return error_mark_node;
+    }
+  switch ((int)TREE_CODE (type0))
+    {
+    case ARRAY_TYPE:
+      if (TREE_CODE ( TREE_TYPE (type0)) == BOOLEAN_TYPE)
+	code = SET_NOT_EXPR;
+      else
+	{
+	  error ("right operand of %s is not array of boolean",
+		 tree_code_name[(int)code]);
+	  return error_mark_node;
+	}
+      break;
+    case BOOLEAN_TYPE:
+      switch ((int)code)
+	{
+	case BIT_NOT_EXPR:
+	case TRUTH_NOT_EXPR:
+	  return invert_truthvalue (truthvalue_conversion (op0));
+
+	default:
+	  error ("%s operator applied to boolean variable",
+		 tree_code_name[(int)code]);
+	  return error_mark_node;
+	}
+      break;
+
+    case SET_TYPE:
+      switch ((int)code)
+	{
+	case BIT_NOT_EXPR:
+	case NEGATE_EXPR:
+	  {
+	    tree temp = fold_set_expr (BIT_NOT_EXPR, op0, NULL_TREE);
+
+	    if (temp) 
+	      return temp;
+
+	    code = SET_NOT_EXPR;
+	  }
+	  break;
+
+	default:
+	  error ("invalid right operand of %s", tree_code_name[(int)code]);
+	  return error_mark_node;
+	}
+
+    }
+
+  class = chill_expr_class (op0);
+  if (class.mode)
+    class.mode = CH_ROOT_MODE (class.mode);
+  TREE_SET_CODE (node, code);
+  TREE_OPERAND (node, 0) = op0 = convert_to_class (class, op0);
+  TREE_TYPE (node) = TREE_TYPE (op0);
+
+  node = convert_to_class (class, fold (node));
+
+  /* FIXME: should call
+   * cond_type_range_exception (op0);
+   */
+  return node;
+}
+
+/* op is TRUTH_NOT_EXPR, BIT_NOT_EXPR, or NEGATE_EXPR */
+
+tree
+build_chill_unary_op (code, op0)
+     enum chill_tree_code code;
+     tree op0;
+{
+  register tree result = NULL_TREE;
+  struct ch_class class;
+  tree type0 = TREE_TYPE (op0);
+
+  if (op0 == NULL_TREE || TREE_CODE (op0) == ERROR_MARK)
+    return error_mark_node;
+
+  result = build1 (code, NULL_TREE, op0);
+
+  if (pass != 1)
+    result = finish_chill_unary_op (result);
+  return result;
+}
+
+tree
+truthvalue_conversion (expr)
+     tree expr;
+{
+  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+    return error_mark_node;
+
+#if 0        /* what about a LE_EXPR (integer_type, integer_type ) */
+  if (TREE_CODE (TREE_TYPE (expr)) != BOOLEAN_TYPE)
+    error ("non-boolean mode in conditional expression");
+#endif
+
+  switch ((int)TREE_CODE (expr))
+    {
+      /* It is simpler and generates better code to have only TRUTH_*_EXPR
+	 or comparison expressions as truth values at this level.  */
+#if 0
+    case COMPONENT_REF:
+      /* A one-bit unsigned bit-field is already acceptable.  */
+      if (1 == TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (expr, 1)))
+	  && TREE_UNSIGNED (TREE_OPERAND (expr, 1)))
+	return expr;
+      break;
+#endif
+
+    case EQ_EXPR:
+      /* It is simpler and generates better code to have only TRUTH_*_EXPR
+	 or comparison expressions as truth values at this level.  */
+    case NE_EXPR: case LE_EXPR: case GE_EXPR: case LT_EXPR: case GT_EXPR:
+    case TRUTH_ANDIF_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case TRUTH_AND_EXPR:
+    case TRUTH_OR_EXPR:
+    case ERROR_MARK:
+      return expr;
+
+    case INTEGER_CST:
+      return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
+
+    case REAL_CST:
+      return real_zerop (expr) ? boolean_false_node : boolean_true_node;
+
+    case ADDR_EXPR:
+      if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 0)))
+	return build (COMPOUND_EXPR, boolean_type_node,
+		      TREE_OPERAND (expr, 0), boolean_true_node);
+      else
+	return boolean_true_node;
+
+    case NEGATE_EXPR:
+    case ABS_EXPR:
+    case FLOAT_EXPR:
+    case FFS_EXPR:
+      /* These don't change whether an object is non-zero or zero.  */
+      return truthvalue_conversion (TREE_OPERAND (expr, 0));
+
+    case LROTATE_EXPR:
+    case RROTATE_EXPR:
+      /* These don't change whether an object is zero or non-zero, but
+	 we can't ignore them if their second arg has side-effects.  */
+      if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 1)))
+	return build (COMPOUND_EXPR, boolean_type_node, TREE_OPERAND (expr, 1),
+		      truthvalue_conversion (TREE_OPERAND (expr, 0)));
+      else
+	return truthvalue_conversion (TREE_OPERAND (expr, 0));
+      
+    case COND_EXPR:
+      /* Distribute the conversion into the arms of a COND_EXPR.  */
+      return fold (build (COND_EXPR, boolean_type_node, TREE_OPERAND (expr, 0),
+			  truthvalue_conversion (TREE_OPERAND (expr, 1)),
+			  truthvalue_conversion (TREE_OPERAND (expr, 2))));
+
+    case CONVERT_EXPR:
+      /* Don't cancel the effect of a CONVERT_EXPR from a REFERENCE_TYPE,
+	 since that affects how `default_conversion' will behave.  */
+      if (TREE_CODE (TREE_TYPE (expr)) == REFERENCE_TYPE
+	  || TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == REFERENCE_TYPE)
+	break;
+      /* fall through... */
+    case NOP_EXPR:
+      /* If this is widening the argument, we can ignore it.  */
+      if (TYPE_PRECISION (TREE_TYPE (expr))
+	  >= TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (expr, 0))))
+	return truthvalue_conversion (TREE_OPERAND (expr, 0));
+      break;
+
+    case BIT_XOR_EXPR:
+    case MINUS_EXPR:
+      /* These can be changed into a comparison of the two objects.  */
+      if (TREE_TYPE (TREE_OPERAND (expr, 0))
+	  == TREE_TYPE (TREE_OPERAND (expr, 1)))
+	return build_chill_binary_op (NE_EXPR, TREE_OPERAND (expr, 0),
+				      TREE_OPERAND (expr, 1));
+      return build_chill_binary_op (NE_EXPR, TREE_OPERAND (expr, 0),
+				    fold (build1 (NOP_EXPR,
+					    TREE_TYPE (TREE_OPERAND (expr, 0)),
+					    TREE_OPERAND (expr, 1))));
+    }
+
+  return build_chill_binary_op (NE_EXPR, expr, boolean_false_node);
+}
+
+
+/*
+ * return a folded tree for the powerset's length in bits.  If a
+ * non-set is passed, we assume it's an array or boolean bytes.
+ */
+tree
+powersetlen (powerset)
+     tree powerset;
+{
+  tree domain, temp;
+
+  if (powerset == NULL_TREE || TREE_CODE (powerset) == ERROR_MARK)
+    return error_mark_node;
+
+  return discrete_count (TYPE_DOMAIN (TREE_TYPE (powerset)));
+}
diff --git a/gcc/ch/lang-specs.h b/gcc/ch/lang-specs.h
new file mode 100644
index 0000000..be02c11
--- /dev/null
+++ b/gcc/ch/lang-specs.h
@@ -0,0 +1,42 @@
+/* Definitions for specs for GNU CHILL.
+   Copyright (C) 1995 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 the contribution to the `default_compilers' array in gcc.c for
+   CHILL.  */
+
+  {".ch",   "@chill" },
+  {".chi",  "@chill" },
+  {"@chill",
+   "cpp -lang-chill %{nostdinc*} %{C} %{v} %{A*} %{I*} %{P} %I\
+	%{C:%{!E:%eGNU CHILL does not support -C without using -E}}\
+        -undef -D__GNUCHILL__=%v1 -D__GNUC_MINOR__=%v2\
+        %c %{Os:-D__OPTIMIZE_SIZE__} %{O*:-D__OPTIMIZE__} %{traditional} %{ftraditional:-traditional}\
+        %{traditional-cpp:-traditional} %{!undef:%{!ansi:%p} %P} %{trigraphs}\
+	%{g*} %{W*} %{w} %{pedantic*} %{H} %{d*} %C %{D*} %{U*} %{i*} %Z\
+        %i %{!E:%g.i}%{E:%W{o*}} \n",
+   "%{!E:cc1chill %g.i %1 \
+		   %{!Q:-quiet} -dumpbase %b.ch %{d*} %{m*} %{a}\
+		   %{g*} %{O*} %{W*} %{w} %{pedantic*} %{itu} \
+		   %{v:-version} %{pg:-p} %{p} %{f*} %{I*} \
+		   %{aux-info*} %X \
+		   %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
+		   %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\
+              %{!S:as %a %Y \
+		      %{c:%W{o*}%{!o*:-o %w%b%O}}%{!c:-o %d%w%u%O}\
+                      %{!pipe:%g.s} %A\n }}"},
diff --git a/gcc/ch/lang.c b/gcc/ch/lang.c
new file mode 100644
index 0000000..b52bca6
--- /dev/null
+++ b/gcc/ch/lang.c
@@ -0,0 +1,306 @@
+/* Language-specific hook definitions for CHILL front end.
+   Copyright (C) 1992, 93, 1994 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.  */
+
+
+#include "config.h"
+#include "tree.h"
+#include "ch-tree.h"
+#include "lex.h"
+#include <stdio.h>
+#include "input.h"
+
+/* Type node for boolean types.  */
+
+tree boolean_type_node;
+
+/* True if STRING(INDEX) yields a CHARS(1) (or BOOLS(1)) rather than
+   a CHAR (or BOOL).  Also, makes CHARS(1) similar for CHAR,
+   and BOOLS(1) similar to BOOL.  This is for compatibility
+   for the 1984 version of Z.200.*/
+int flag_old_strings = 0;
+
+/* This is set non-zero to force user input tokens to lower case.
+   This is non-standard.  See Z.200, page 8. */
+int ignore_case = 1;
+
+/* True if reserved and predefined words ('special' words in the Z.200
+   terminology) are in uppercase.  Obviously, this had better not be 
+   true if we're ignoring input case. */
+int special_UC = 0;
+
+/* The actual name of the input file, regardless of any #line directives */
+char* chill_real_input_filename;
+extern FILE* finput;
+
+extern int maximum_field_alignment;
+
+extern void error             PROTO((char *, ...));
+extern void error_with_decl   PROTO((tree, char *, ...));
+extern void fatal             PROTO((char *, ...));
+extern int  floor_log2_wide   PROTO((unsigned HOST_WIDE_INT));
+extern void pedwarn_with_decl PROTO((tree, char *, ...));
+extern void sorry             PROTO((char *, ...));
+extern int  type_hash_list    PROTO((tree));
+
+/* return 1 if the expression tree given has all
+   constant nodes as its leaves; return 0 otherwise. */
+int
+deep_const_expr (exp)
+     tree exp;
+{
+  enum chill_tree_code code;
+  int length;
+  int i;
+
+  if (exp == NULL_TREE)
+    return 0;
+
+  code = TREE_CODE (exp);
+  length = tree_code_length[(int) code];
+
+  /* constant leaf?  return TRUE */
+  if (TREE_CODE_CLASS (code) == 'c')
+    return 1;
+
+  /* recursively check next level down */
+  for (i = 0; i < length; i++)
+    if (! deep_const_expr (TREE_OPERAND (exp, i)))
+      return 0;
+  return 1;      
+}
+
+
+tree
+const_expr (exp)
+     tree exp;
+{
+  if (TREE_CODE (exp) == INTEGER_CST)
+    return exp;
+  if (TREE_CODE (exp) == CONST_DECL)
+    return const_expr (DECL_INITIAL (exp));
+  if (TREE_CODE_CLASS (TREE_CODE (exp)) == 'd'
+      && DECL_INITIAL (exp) != NULL_TREE
+      && TREE_READONLY (exp))
+    return DECL_INITIAL (exp);
+  if (deep_const_expr (exp))
+    return exp;
+  if (TREE_CODE (exp) != ERROR_MARK)
+    error ("non-constant expression");
+  return error_mark_node;
+}
+
+/* Each of the functions defined here
+   is an alternative to a function in objc-actions.c.  */
+   
+/* Used by c-lex.c, but only for objc.  */
+tree
+lookup_interface (arg)
+     tree arg;
+{
+  return 0;
+}
+
+int
+maybe_objc_comptypes (lhs, rhs)
+     tree lhs, rhs;
+{
+  return -1;
+}
+
+tree
+maybe_building_objc_message_expr ()
+{
+  return 0;
+}
+
+int
+recognize_objc_keyword ()
+{
+  return 0;
+}
+
+void
+lang_init_options ()
+{
+}
+
+/* used by print-tree.c */
+
+void
+lang_print_xnode (file, node, indent)
+     FILE *file;
+     tree node;
+     int indent;
+{
+}
+
+void
+GNU_xref_begin ()
+{
+  fatal ("GCC does not yet support XREF");
+}
+
+void
+GNU_xref_end ()
+{
+  fatal ("GCC does not yet support XREF");
+}
+
+/*
+ * process chill-specific compiler command-line options
+ */
+int
+lang_decode_option (argc, argv)
+     int argc;
+     char **argv;
+{
+  char *p = argv[0];
+  static explicit_ignore_case = 0;
+  if (!strcmp(p, "-lang-chill"))
+    ; /* do nothing */
+  else if (!strcmp (p, "-fruntime-checking"))
+    {
+      range_checking = 1;
+      empty_checking = 1;
+    }
+  else if (!strcmp (p, "-fno-runtime-checking"))
+    {
+      range_checking = 0;
+      empty_checking = 0;
+      runtime_checking_flag = 0;
+    }
+  else if (!strcmp (p, "-flocal-loop-counter"))
+    flag_local_loop_counter = 1;
+  else if (!strcmp (p, "-fno-local-loop-counter"))
+    flag_local_loop_counter = 0;
+  else if (!strcmp (p, "-fold-strings"))
+    flag_old_strings = 1;
+  else if (!strcmp (p, "-fno-old-strings"))
+    flag_old_strings = 0;
+  else if (!strcmp (p, "-fignore-case"))
+    {
+      explicit_ignore_case = 1;
+      if (special_UC)
+	{
+	  error ("Ignoring case upon input and");
+	  error ("making special words uppercase wouldn't work.");
+	}
+      else
+	ignore_case = 1;
+    }
+  else if (!strcmp (p, "-fno-ignore-case"))
+    ignore_case = 0;
+  else if (!strcmp (p, "-fspecial_UC"))
+    {
+      if (explicit_ignore_case)
+	{
+	  error ("Making special words uppercase and");
+	  error (" ignoring case upon input wouldn't work.");
+	}
+      else
+	special_UC = 1, ignore_case = 0;
+    }
+  else if (!strcmp (p, "-fspecial_LC"))
+    special_UC = 0;
+  else if (!strcmp (p, "-fpack"))
+    maximum_field_alignment = BITS_PER_UNIT;
+  else if (!strcmp (p, "-fno-pack"))
+    maximum_field_alignment = 0;
+  else if (!strcmp (p, "-fchill-grant-only"))
+    grant_only_flag = 1;
+  else if (!strcmp (p, "-fgrant-only"))
+    grant_only_flag = 1;
+  /* user has specified a seize-file path */
+  else if (p[0] == '-' && p[1] == 'I')
+    register_seize_path (&p[2]);
+  if (!strcmp(p, "-itu"))        /* Force Z.200 semantics */
+    {
+      pedantic = 1;   /* FIXME: new flag name? */
+      flag_local_loop_counter = 1;      
+    }
+  else
+    return c_decode_option (argc, argv);
+
+  return 1;
+}
+
+void
+chill_print_error_function (file)
+     char *file;
+{
+  static tree last_error_function = NULL_TREE;
+  static struct module *last_error_module = NULL;
+
+  if (last_error_function == current_function_decl
+      && last_error_module == current_module)
+    return;
+
+  last_error_function = current_function_decl;
+  last_error_module = current_module;
+
+  if (file)
+    fprintf (stderr, "%s: ", file);
+
+  if (current_function_decl == global_function_decl
+      || current_function_decl == NULL_TREE)
+    {
+      if (current_module == NULL)
+	fprintf (stderr, "At top level:\n");
+      else
+	fprintf (stderr, "In module %s:\n",
+		 IDENTIFIER_POINTER (current_module->name));
+    }
+  else
+    {
+      char *kind = "function";
+      char *name = (*decl_printable_name) (current_function_decl, 2);
+      fprintf (stderr, "In %s `%s':\n", kind, name);
+    }
+}
+
+/* Print an error message for invalid use of an incomplete type.
+   VALUE is the expression that was used (or 0 if that isn't known)
+   and TYPE is the type that was invalid.  */
+
+void
+incomplete_type_error (value, type)
+     tree value;
+     tree type;
+{
+  error ("internal error - use of undefined type");
+}
+
+void
+lang_init ()
+{
+  extern void (*print_error_function) PROTO((char*));
+
+  chill_real_input_filename = input_filename;
+
+  /* the beginning of the file is a new line; check for # */
+  /* With luck, we discover the real source file's name from that
+     and put it in input_filename.  */
+
+  ungetc (check_newline (), finput);
+
+  /* set default grant file */
+  set_default_grant_file ();
+
+  print_error_function = chill_print_error_function;
+}
diff --git a/gcc/ch/parse.c b/gcc/ch/parse.c
new file mode 100644
index 0000000..32f72e5
--- /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
diff --git a/gcc/ch/runtime/allmem.c b/gcc/ch/runtime/allmem.c
new file mode 100644
index 0000000..8cf2be5
--- /dev/null
+++ b/gcc/ch/runtime/allmem.c
@@ -0,0 +1,73 @@
+/* Implement runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser
+
+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.  */
+
+#define __CHILL_LIB__
+
+#include <stdlib.h>
+#include "config.h"
+#include "rtltypes.h"
+
+extern void __cause_ex1 (char *exname, char *file, int lineno);
+
+/* define needed exceptions */
+EXCEPTION (protectionfail);
+EXCEPTION (rangefail);
+EXCEPTION (spacefail);
+
+/*
+ * function _allocate_memory
+ *
+ * parameters:
+ *  ptr			pointer to location where pointer should be written
+ *  size		number of bytes to allocate
+ *  filename            source file which issued the call
+ *  linenumber          line number within that source file
+ *
+ * returns:
+ *  void
+ *
+ * exceptions:
+ *  spacefail
+ *  protectionfail
+ *  rangefail
+ *
+ * abstract:
+ *  allocate memory from heap
+ *
+*/
+
+void
+_allocate_memory (ptr, size, filename, linenumber)
+     void **ptr;
+     int size;
+     char *filename;
+     int   linenumber;
+{
+  void	*tmp;
+    
+  if (!ptr)
+    __cause_ex1 ("protectionfail", filename, linenumber);
+  if (size < 0)
+    __cause_ex1 ("rangefail", filename, linenumber);
+  tmp = malloc (size);
+  if (!tmp)
+    __cause_ex1 ("spacefail", filename, linenumber);
+  *ptr = tmp;
+}
diff --git a/gcc/ch/runtime/andps.c b/gcc/ch/runtime/andps.c
new file mode 100644
index 0000000..fd7d609
--- /dev/null
+++ b/gcc/ch/runtime/andps.c
@@ -0,0 +1,76 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __andpowerset
+ *
+ * parameters:
+ *	out		return from __andpowerset
+ *	left		left powerset
+ *	right		right powerset
+ *	bitlength	length of powerset in bits
+ *
+ * returns:
+ *	void
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  and's two powersets
+ *
+ */
+
+void
+__andpowerset (out, left, right, bitlength)
+     SET_WORD      *out;
+     SET_WORD      *left;
+     SET_WORD      *right;
+     unsigned long  bitlength;
+{
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      *((SET_CHAR *)out) = *((SET_CHAR *)left) &
+                           *((SET_CHAR *)right);
+      MASK_UNUSED_CHAR_BITS((SET_CHAR *)out, bitlength);
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      *((SET_SHORT *)out) = *((SET_SHORT *)left) &
+                            *((SET_SHORT *)right);
+      MASK_UNUSED_SHORT_BITS((SET_SHORT *)out, bitlength);
+    }
+  else
+    {
+      unsigned long len = BITS_TO_WORDS (bitlength);
+      register unsigned long i;
+    
+      for (i = 0; i < len; i++)
+	out[i] = left[i] & right[i];
+      MASK_UNUSED_WORD_BITS ((out + len - 1), 
+			     bitlength % SET_WORD_SIZE);
+    }
+}
diff --git a/gcc/ch/runtime/auxtypes.h b/gcc/ch/runtime/auxtypes.h
new file mode 100644
index 0000000..627da11
--- /dev/null
+++ b/gcc/ch/runtime/auxtypes.h
@@ -0,0 +1,45 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#ifndef _auxtypes_h_
+#define _auxtypes_h_
+
+
+typedef enum { False, True } Boolean;
+
+#define VARYING_STRING(strlen) \
+  struct { unsigned short len; char body[strlen]; }
+
+typedef struct {
+  unsigned short len;
+  char           body[1];
+} VarString; 
+
+/* Macros for moving an (U)INT and (U)LONG without alignment worries */
+#define MOV2(tgt,src) \
+  *((char*)(tgt)  ) = *((char*)(src)  ), \
+  *((char*)(tgt)+1) = *((char*)(src)+1)
+#define MOV4(tgt,src) \
+  *((char*)(tgt)  ) = *((char*)(src)  ), \
+  *((char*)(tgt)+1) = *((char*)(src)+1), \
+  *((char*)(tgt)+2) = *((char*)(src)+2), \
+  *((char*)(tgt)+3) = *((char*)(src)+3)
+
+#endif
diff --git a/gcc/ch/runtime/basicio.c b/gcc/ch/runtime/basicio.c
new file mode 100644
index 0000000..b13b0b8
--- /dev/null
+++ b/gcc/ch/runtime/basicio.c
@@ -0,0 +1,467 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+   
+   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.  */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <limits.h>
+#include <errno.h>
+
+#include <string.h>
+#include <stdlib.h>
+
+#include "fileio.h"
+
+#ifndef PATH_MAX
+#define PATH_MAX _POSIX_PATH_MAX
+#endif
+
+static
+void
+GetSetAttributes( Association_Mode* the_assoc )
+{
+  struct stat statbuf;
+  int retco;
+
+  if( (retco = stat( the_assoc->pathname, &statbuf )) )
+    return;
+
+  if( S_ISREG(statbuf.st_mode) )
+    {
+      SET_FLAG( the_assoc, IO_EXISTING );
+      if( !TEST_FLAG( the_assoc, IO_VARIABLE ) )
+        SET_FLAG( the_assoc, IO_INDEXABLE );
+    }
+  else
+    if( S_ISCHR(statbuf.st_mode) || S_ISFIFO(statbuf.st_mode) )
+      {
+	SET_FLAG( the_assoc, IO_EXISTING );
+	CLR_FLAG( the_assoc, IO_INDEXABLE );
+      }
+  SET_FLAG( the_assoc, IO_SEQUENCIBLE );
+
+  /* FIXME: File size and computation of number of records for outoffile ? */
+
+  if( !access( the_assoc->pathname, R_OK ) )
+    SET_FLAG( the_assoc, IO_READABLE );
+  if( !access( the_assoc->pathname, W_OK ) )
+    SET_FLAG( the_assoc, IO_WRITEABLE );
+}
+
+static
+void 
+makeName( Association_Mode* the_assoc, char* the_path, int the_path_len,
+	 char* file, int line)
+{
+  int namlen;
+  if( ! the_assoc->pathname && 
+      ! (the_assoc->pathname = (char*)malloc( PATH_MAX )) )
+    CHILLEXCEPTION( file, line, SPACEFAIL, PATHNAME_ALLOC );
+
+  if( the_path[0] != DIRSEP )
+    {
+      if( !getcwd( the_assoc->pathname, PATH_MAX ) )
+	{
+	  the_assoc->syserrno = errno;
+	  CHILLEXCEPTION( file, line, ASSOCIATEFAIL, GETCWD_FAILS );
+	}
+      namlen = strlen( the_assoc->pathname );
+      the_assoc->pathname[namlen++] = DIRSEP;  
+    }
+  else
+    namlen = 0;
+
+  strncpy( the_assoc->pathname + namlen, the_path, the_path_len );
+  the_assoc->pathname[namlen+the_path_len] = '\0';
+}
+
+/*
+ * ASSOCIATE
+ */
+/* Caution: returns an Association mode location (!) */
+Association_Mode*
+__associate( Association_Mode* the_assoc,
+	     char*             the_path,
+	     int               the_path_len,
+	     char*             the_mode,
+	     int               the_mode_len,
+	     char*             file,
+	     int               line )
+{
+  if( !the_assoc )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ASSOCIATION );
+
+  if( TEST_FLAG(the_assoc, IO_ISASSOCIATED) )
+    CHILLEXCEPTION( file, line, ASSOCIATEFAIL, IS_ASSOCIATED );
+
+  /* clear all flags */
+  the_assoc->flags = 0;
+
+  if( ! the_path_len )
+    CHILLEXCEPTION( file, line, ASSOCIATEFAIL, NO_PATH_NAME );
+
+  makeName( the_assoc, the_path, the_path_len, file, line );
+  GetSetAttributes( the_assoc );
+
+  CLR_FLAG( the_assoc, IO_VARIABLE );
+  if ( the_mode )
+    {
+      if( !strncmp( the_mode, "VARIABLE", 8 ) )
+	{
+	  SET_FLAG( the_assoc, IO_VARIABLE );
+	  CLR_FLAG( the_assoc, IO_INDEXABLE );
+	}
+      else
+	if( strlen( the_mode ) )
+	  CHILLEXCEPTION( file, line, ASSOCIATEFAIL, INVALID_ASSOCIATION_MODE );
+    }
+
+  SET_FLAG( the_assoc, IO_ISASSOCIATED );
+  return the_assoc;
+}
+
+/*
+ *  DISSOCIATE
+ */
+void
+__dissociate( Association_Mode* the_assoc, char* file, int line )
+{
+  if( !the_assoc )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ASSOCIATION );
+
+  if( !TEST_FLAG( the_assoc, IO_ISASSOCIATED ) )
+    CHILLEXCEPTION( file, line, NOTASSOCIATED, IS_NOT_ASSOCIATED );
+
+  if( the_assoc->access )
+    __disconnect( the_assoc->access, file, line );
+
+  the_assoc->access = NULL;
+  CLR_FLAG( the_assoc, IO_ISASSOCIATED );
+
+  /* free allocated memory */
+  if (the_assoc->pathname)
+    {
+      free (the_assoc->pathname);
+      the_assoc->pathname = 0;
+    }
+  if (the_assoc->bufptr)
+    {
+      free (the_assoc->bufptr);
+      the_assoc->bufptr = 0;
+    }
+}
+
+/*
+ * CREATE
+ */
+void __create( Association_Mode* the_assoc, char* file, int line )
+{
+  if( !the_assoc )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ASSOCIATION );
+
+  if( !TEST_FLAG( the_assoc, IO_ISASSOCIATED ) )
+    CHILLEXCEPTION( file, line, NOTASSOCIATED, IS_NOT_ASSOCIATED );
+
+  if( TEST_FLAG( the_assoc, IO_EXISTING ) )
+    CHILLEXCEPTION( file, line, CREATEFAIL, FILE_EXISTING );
+
+  if( (the_assoc->handle = open( the_assoc->pathname, O_CREAT+O_TRUNC+O_WRONLY, 0666 ))
+      == -1 )
+      CHILLEXCEPTION( file, line, CREATEFAIL, CREATE_FAILS );
+
+  the_assoc->usage = ReadWrite;
+  GetSetAttributes( the_assoc );
+
+  close( the_assoc->handle );
+}
+
+/*
+ * MODIFY
+ */
+void
+__modify( Association_Mode* the_assoc,
+	  char*             the_path,
+	  int               the_path_len,
+	  char*             the_mode,
+	  int               the_mode_len,
+	  char*             file,
+	  int               line )
+{
+  if( !the_assoc )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ASSOCIATION );
+
+  if( !TEST_FLAG( the_assoc, IO_ISASSOCIATED ) )
+    CHILLEXCEPTION( file, line, NOTASSOCIATED, IS_NOT_ASSOCIATED );
+
+  if( the_path_len )
+    {
+      char* oldname;
+
+      if( ! (oldname = (char*)malloc( PATH_MAX )) )
+	CHILLEXCEPTION( file, line, SPACEFAIL, PATHNAME_ALLOC );
+      strcpy( oldname, the_assoc->pathname );
+
+      makeName( the_assoc, the_path, the_path_len, file, line );
+
+      if( rename( oldname, the_assoc->pathname ) )
+	{
+	  free( oldname );
+	  CHILLEXCEPTION( file, line, MODIFYFAIL, RENAME_FAILS );
+	}
+      free( oldname );
+    }
+  else
+    {
+      /* FIXME: other options? */
+    }
+}
+
+static
+/*** char* DirMode[] = { "rb", "r+b", "r+b" }; ***/
+int DirMode[] = { O_RDONLY, O_RDWR, O_RDWR };
+
+static
+/*** char* SeqMode [] = { "rb", "r+b", "r+b" }; ***/
+int SeqMode[] = { O_RDONLY, O_RDWR, O_RDWR };
+
+/*
+ * CONNECT
+ */
+void
+__connect( void*             the_transfer,
+	   Association_Mode* the_assoc,
+	   Usage_Mode        the_usage,
+	   Where_Mode        the_where,
+	   Boolean           with_index,
+	   signed long       the_index,
+	   char*             file,
+	   int               line )
+{
+  Access_Mode*  the_access;
+  off_t         filepos;
+  off_t         savepos;
+  char          dummy;
+  unsigned long nbytes;
+  int           oflag;
+
+  if( !the_transfer )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ACCESS );
+  if( !the_assoc )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ASSOCIATION );
+
+  if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ))
+    {
+      if( ! ((Text_Mode*)the_transfer)->access_sub )
+	CHILLEXCEPTION( file, line, EMPTY, NO_ACCESS_SUBLOCATION );
+      the_access = ((Text_Mode*)the_transfer)->access_sub;
+      SET_FLAG( the_access, IO_TEXTIO );
+    }
+  else
+    {
+      the_access = (Access_Mode*)the_transfer;
+      CLR_FLAG( the_access, IO_TEXTIO );
+    }
+
+  /* FIXME: This should be an (implementation-dependent) static check
+     if( with_index && the_access->rectype > Fixed )
+     CHILLEXCEPTION( file, line, CONNECTFAIL, IMPL_RESTRICTION );
+     */
+
+  if( ! TEST_FLAG(the_assoc, IO_ISASSOCIATED) )
+    CHILLEXCEPTION( file, line, NOTASSOCIATED, IS_NOT_ASSOCIATED );
+
+  if( ! TEST_FLAG( the_assoc, IO_EXISTING ) )
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_EXISTING );
+
+  if( ! TEST_FLAG( the_assoc, IO_READABLE ) &&
+      ( the_usage = ReadOnly || the_usage == ReadWrite ) )    
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_READABLE );
+
+  if( ! TEST_FLAG( the_assoc, IO_WRITEABLE ) &&
+      ( the_usage = WriteOnly || the_usage == ReadWrite ) )    
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_WRITEABLE );
+
+  if( ! TEST_FLAG( the_assoc, IO_INDEXABLE ) 
+      && TEST_FLAG( the_access, IO_INDEXED ) )
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_INDEXABLE );
+
+  if( ! TEST_FLAG( the_assoc, IO_SEQUENCIBLE ) 
+      && ! TEST_FLAG( the_access, IO_INDEXED ) )
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_SEQUENCIBLE );
+
+  if( the_where == Same && the_assoc->access == NULL )
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NO_CURRENT_POS );
+
+  /* This dynamic condition is not checked for text connections. */
+  if( ! TEST_FLAG( the_access, IO_TEXTIO ) )
+    if( ! TEST_FLAG( the_assoc, IO_VARIABLE ) 
+	&& the_access->rectype > Fixed 
+	&& ( the_usage == WriteOnly || the_usage == ReadWrite ) )
+      CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_VARIABLE );
+ 
+  if( TEST_FLAG( the_assoc, IO_VARIABLE )
+      && the_access->rectype == Fixed 
+      && ( the_usage == ReadOnly || the_usage == ReadWrite ) )
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_FIXED );
+ 
+  if( ! TEST_FLAG( the_access, IO_INDEXED ) && the_usage == ReadWrite )
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_INDEXED );
+
+  /* Access location may be connected to a different association. */
+  if( the_access->association && the_access->association != the_assoc )
+    __disconnect( the_access, file, line );
+
+  /* Is the association location already connected? */
+  if( the_assoc->access )
+    {
+      /* save position just in case we need it for the_where == Same */
+      if( (savepos = lseek( the_assoc->handle, 0L, SEEK_CUR )) == -1L )
+	CHILLEXCEPTION( file, line, CONNECTFAIL, LSEEK_FAILS );
+
+      /* text: read correction, flush buffer */
+      if( the_assoc->bufptr ){
+	savepos -= the_assoc->bufptr->len - the_assoc->bufptr->cur;
+	the_assoc->bufptr->len = the_assoc->bufptr->cur = 0;
+      }
+
+      /* implicit disconnect */
+      __disconnect( the_assoc->access, file, line );
+    }
+
+  the_assoc->usage = the_usage;
+  CLR_FLAG( the_access, IO_OUTOFFILE );
+ 
+  if( TEST_FLAG( the_access, IO_INDEXED ) )
+    {
+      if( (the_assoc->handle = open( the_assoc->pathname, DirMode[the_usage] )) == -1 )
+	CHILLEXCEPTION( file, line, CONNECTFAIL, OPEN_FAILS );
+
+      /* Set base index. */
+      switch( the_where )
+	{
+	case First: 
+	  filepos = 0;
+	  break;
+	case Same: 
+	  filepos = savepos;
+	  break;
+	case Last: 
+	  if( lseek( the_assoc->handle, 0L, SEEK_END ) == -1L )
+	    CHILLEXCEPTION( file, line, CONNECTFAIL, LSEEK_FAILS );
+	  filepos = lseek( the_assoc->handle, 0L, SEEK_CUR );
+	  break;
+	}
+
+      /* Set current index */
+      if( with_index )
+	{
+	  if( the_index < the_access->lowindex
+	      || the_access->highindex < the_index )
+	    CHILLEXCEPTION( file, line, RANGEFAIL, BAD_INDEX );
+	  filepos += (the_index - the_access->lowindex) * the_access->reclength;
+	}
+      if( lseek( the_assoc->handle, filepos, SEEK_SET ) == -1L )
+	CHILLEXCEPTION( file, line, CONNECTFAIL, LSEEK_FAILS );
+      the_access->base = filepos;
+    }
+  else
+    {
+      /* for association to text for reading: allocate buffer */
+      if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ) &&
+	  the_usage == ReadOnly &&
+	  !the_assoc->bufptr )
+	{
+	  if( ! (the_assoc->bufptr = (readbuf_t*)malloc( sizeof(readbuf_t) )) )
+	    CHILLEXCEPTION( file, line, CONNECTFAIL, BUFFER_ALLOC ); 
+	  memset (the_assoc->bufptr, 0, sizeof (readbuf_t));
+	}
+      if( (the_assoc->handle = open( the_assoc->pathname, SeqMode[the_usage] )) == -1 )
+	CHILLEXCEPTION( file, line, CONNECTFAIL, OPEN_FAILS );
+
+      /* Set base index. */
+      switch( the_where )
+	{
+	case First: 
+	  filepos = 0;
+	  break;
+	case Same: 
+	  filepos = savepos;
+	  break;
+	case Last:
+	  if( lseek( the_assoc->handle, 0L, SEEK_END ) == -1L )
+	    CHILLEXCEPTION( file, line, CONNECTFAIL, LSEEK_FAILS );
+	  filepos = lseek( the_assoc->handle, 0L, SEEK_CUR );
+	  break;
+	}
+
+      /* file truncation for sequential, Write Only */
+      /***************************** FIXME: cannot truncate at Same
+	if( the_usage == WriteOnly )
+	{
+	if( fseek( the_assoc->file_ptr, filepos, SEEK_SET ) == -1L )
+        CHILLEXCEPTION( file, line, CONNECTFAIL, FSEEK_FAILS );
+	fclose( the_assoc->file_ptr );
+	if( !(the_assoc->file_ptr = fopen( the_assoc->pathname, "ab" )) )
+        CHILLEXCEPTION( file, line, CONNECTFAIL, OPEN_FAILS );
+	}
+	else
+	***************************/
+      if( (filepos = lseek( the_assoc->handle, filepos, SEEK_SET )) == -1L )
+	CHILLEXCEPTION( file, line, CONNECTFAIL, LSEEK_FAILS );
+    }
+
+  the_access->association = the_assoc;
+  the_assoc->access = the_access;
+  /* for text: set carriage control default */
+  if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ) ){
+    the_assoc->ctl_pre  = '\0';
+    the_assoc->ctl_post = '\n';
+  }
+}
+
+void
+__disconnect( void* the_transfer, char* file, int line )
+{
+  Access_Mode* the_access;
+
+  if( !the_transfer )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ACCESS );
+
+  if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ))
+    {
+      the_access = ((Text_Mode*)the_transfer)->access_sub;
+      CLR_FLAG( the_access, IO_TEXTIO );
+    }
+  else
+    the_access = (Access_Mode*)the_transfer;
+
+  if( !the_access->association )
+    CHILLEXCEPTION( file, line, NOTCONNECTED, IS_NOT_CONNECTED );
+
+  close( the_access->association->handle );
+  /* FIXME: check result */
+
+  if( the_access->store_loc )
+    free( the_access->store_loc );
+  the_access->store_loc           = NULL;
+  the_access->association->access = NULL;
+  the_access->association         = NULL;
+}
diff --git a/gcc/ch/runtime/bitstring.h b/gcc/ch/runtime/bitstring.h
new file mode 100644
index 0000000..0a8ce62
--- /dev/null
+++ b/gcc/ch/runtime/bitstring.h
@@ -0,0 +1,29 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#ifndef _bitstring_h_
+#define _bitstring_h_
+
+int __inpowerset( int i, char* string, int strlen, int dummy );
+void __setbitpowerset (char *powerset, unsigned long bitlength,
+		       long minval, long bitno, char newval,
+		       char *filename, int lineno);
+		       
+#endif
diff --git a/gcc/ch/runtime/cause.c b/gcc/ch/runtime/cause.c
new file mode 100644
index 0000000..d4d0794
--- /dev/null
+++ b/gcc/ch/runtime/cause.c
@@ -0,0 +1,48 @@
+/* Implement runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser
+
+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.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+
+/*
+ * function cause_exception
+ *
+ * parameters:
+ *  exname		exception name
+ *  file		file name
+ *  lineno		line number
+ *   user_arg		user specified argument
+ *
+ * returns:
+ *  void
+ *
+ * abstract:
+ *  dummy for ChillLib but may be overwritten by the user
+ *
+ */
+void
+cause_exception (exname, file, lineno, user_arg)
+     char *exname;
+     char *file;
+     int lineno;
+     int user_arg;
+{
+}
diff --git a/gcc/ch/runtime/concatps.c b/gcc/ch/runtime/concatps.c
new file mode 100644
index 0000000..4dacda6
--- /dev/null
+++ b/gcc/ch/runtime/concatps.c
@@ -0,0 +1,93 @@
+/* Implement powerset-related runtime actions for CHILL.
+   Copyright (C) 1992, 93, 1994 Free Software Foundation, Inc.
+   Author: Bill Cox
+
+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.  */
+
+#define __CHILL_LIB__
+
+#include "powerset.h"
+
+extern void cause_exception (char *exname, char *file, int lineno);
+
+/*
+ * function __concatps
+ *
+ * parameters:
+ *     OUT      - pointer to output PS
+ *     LEFT     - pointer to left PS
+ *     LEFTLEN  - length of left PS in bits
+ *     RIGHT    - pointer to right PS
+ *     RIGHTLEN - length of right PS in bits
+ *
+ * returns:
+ *     void
+ *
+ * exceptions:
+ *     none
+ *
+ * abstract:
+ *     concatenates two powersets into the output powerset.
+ *
+ */
+
+extern void
+__pscpy (SET_WORD      *dps,
+	 unsigned long  dbl,
+	 unsigned long  doffset,
+	 SET_WORD      *sps,
+	 unsigned long  sbl,
+	 unsigned long  start,
+	 unsigned long  length);
+
+void
+__concatps (out, left, leftlen, right, rightlen)
+     SET_WORD      *out;
+     SET_WORD      *left;
+     unsigned long  leftlen;
+     SET_WORD      *right;
+     unsigned long  rightlen;
+{
+  /* allocated sizes for each set involved */
+  unsigned long outall, leftall, rightall;
+
+  if (!out)
+    {
+      /* FIXME: cause an exception */
+    }
+  else if (leftlen == 0 || !left)
+    {
+      if (rightlen == 0 || !right)
+	return;               /* no work to do */
+      __pscpy (out, rightlen, (unsigned long)0,
+	       right, rightlen, (unsigned long)0, rightlen);
+    }
+  else if (rightlen == 0 || !right)
+    {
+      if (leftlen == 0 || !left)
+	return;               /* no work to do */
+      __pscpy (out, leftlen, (unsigned long)0,
+	       left, leftlen, (unsigned long)0, leftlen);
+    }
+  /* copy the left powerset into bits 0..leftlen - 1 */
+  __pscpy (out, leftlen + rightlen, (unsigned long)0,
+	   left, leftlen, (unsigned long)0, leftlen);
+
+  /* copy the right powerset into bits leftlen..leftlen+rightlen-1 */
+  __pscpy (out, leftlen + rightlen, leftlen,
+	   right, rightlen, (unsigned long)0, rightlen);
+}
diff --git a/gcc/ch/runtime/copyps.c b/gcc/ch/runtime/copyps.c
new file mode 100644
index 0000000..226f429
--- /dev/null
+++ b/gcc/ch/runtime/copyps.c
@@ -0,0 +1,111 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __powerset_copy
+ *    This is more general than __psslice, since it
+ *    can be told where in the destination powerset (DOFFSET
+ *    parameter) to start storing the slice.
+ *
+ * parameters:
+ *      dps             dest powerset
+ *      dbl             destination bit length
+ *      doffset         offset bit number (zero origin)
+ *	sps		sourcepowerset
+ *	sbl     	source powerset length in bits
+ *      start           starting bit number
+ *      end             ending bit number
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  Extract into a powerset a slice of another powerset.
+ *
+ */
+void
+__pscpy (dps, dbl, doffset, sps, sbl, start, length)
+     SET_WORD      *dps;
+     unsigned long  dbl;
+     unsigned long  doffset;
+     const SET_WORD*sps;
+     unsigned long  sbl;
+     unsigned long  start;
+     unsigned long  length;
+{
+  unsigned long end = start + length - 1;
+  unsigned long src, dst;
+
+  /* assert end >= start;
+     assert end - start + 1 <= dbl;
+     assert "the sets don't overlap in memory" */
+
+  /* assert doffset >= 0 and < dbl */
+
+  for (src = start, dst = doffset; src <= end; src++, dst++)
+    {
+      char tmp;
+
+      if (sbl <= SET_CHAR_SIZE)                /* fetch a bit */
+	tmp = GET_BIT_IN_CHAR (*((SET_CHAR *)sps), src);
+      else if (sbl <= SET_SHORT_SIZE)
+	tmp = GET_BIT_IN_SHORT (*((SET_SHORT *)sps), src);
+      else
+	tmp = GET_BIT_IN_WORD (sps[src / SET_WORD_SIZE], src % SET_WORD_SIZE);
+
+      if (tmp & 1)
+	{
+	  if (dbl <= SET_CHAR_SIZE)            /* store a 1-bit */
+	    SET_BIT_IN_CHAR (*((SET_CHAR *)dps), dst);
+	  else if (dbl <= SET_SHORT_SIZE)
+	    SET_BIT_IN_SHORT (*((SET_SHORT *)dps), dst);
+	  else
+	    SET_BIT_IN_WORD (dps[dst / SET_WORD_SIZE], dst % SET_WORD_SIZE);
+	}
+      else
+	{
+	  if (dbl <= SET_CHAR_SIZE)            /* store a 0-bit */
+	    CLEAR_BIT_IN_CHAR (*((SET_CHAR *)dps), dst);
+	  else if (dbl <= SET_SHORT_SIZE)
+	    CLEAR_BIT_IN_SHORT (*((SET_SHORT *)dps), dst);
+	  else
+	    CLEAR_BIT_IN_WORD (dps[dst / SET_WORD_SIZE], dst % SET_WORD_SIZE);
+	}
+    }
+  if (dbl <= SET_CHAR_SIZE)         /* clear unused bits in output bitstring */
+    {
+      MASK_UNUSED_CHAR_BITS ((SET_CHAR *)dps, dbl);
+    }
+  else if (dbl <= SET_SHORT_SIZE)
+    {
+      MASK_UNUSED_SHORT_BITS ((SET_SHORT *)dps, dbl);
+    }
+  else
+    {
+      MASK_UNUSED_WORD_BITS ((SET_WORD *)(dps + (dbl/SET_WORD_SIZE)), 
+			     dbl % SET_WORD_SIZE);
+    }
+}
diff --git a/gcc/ch/runtime/eqps.c b/gcc/ch/runtime/eqps.c
new file mode 100644
index 0000000..4ac002d
--- /dev/null
+++ b/gcc/ch/runtime/eqps.c
@@ -0,0 +1,88 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __eqpowerset
+ *
+ * parameters:
+ *	left		left powerset
+ *	right		right powerset
+ *	bitlength	length of powerset in bits
+ *
+ * returns:
+ *    1 if powersets are equal, bit for bit
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  compares two powersets for equality
+ *
+ */
+int
+__eqpowerset (left, right, bitlength)
+     SET_WORD *left;
+     SET_WORD *right;
+     unsigned long bitlength;
+{
+#ifndef USE_CHARS
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      SET_CHAR c = *(SET_CHAR *)left ^ *(SET_CHAR *)right;
+      MASK_UNUSED_CHAR_BITS (&c, bitlength);
+      return (c == 0) ? 1 : 0;
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      SET_SHORT c = *(SET_SHORT *)left ^ *(SET_SHORT *)right;
+      MASK_UNUSED_SHORT_BITS (&c, bitlength);
+      return (c == 0) ? 1 : 0;
+    }
+  else if (bitlength <= SET_WORD_SIZE)
+    {
+      SET_WORD c = *(SET_WORD *)left ^ *(SET_WORD *)right;
+      MASK_UNUSED_WORD_BITS (&c, bitlength % SET_WORD_SIZE);
+      return (c == 0) ? 1 : 0;
+    }
+  else
+#endif
+    {
+      SET_WORD c;
+      register unsigned long i;
+      unsigned long len = bitlength / SET_WORD_SIZE;
+
+      for (i = 0; i < len; i++) /* a word-oriented memcmp */
+	if (left[i] != right[i])
+	  return 0;
+      /* do the last (possibly partial) word */
+      bitlength %= SET_WORD_SIZE;
+      if (bitlength == 0)
+	return 1;
+      c = left[i] ^ right[i];
+      MASK_UNUSED_WORD_BITS (&c, bitlength);
+      return (c == 0) ? 1 : 0;
+    }
+}
diff --git a/gcc/ch/runtime/fileio.h b/gcc/ch/runtime/fileio.h
new file mode 100644
index 0000000..fb15b8f
--- /dev/null
+++ b/gcc/ch/runtime/fileio.h
@@ -0,0 +1,153 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#ifndef _fileio_h_
+#define _fileio_h_
+
+#include <stdio.h>
+
+#include "auxtypes.h"
+#include "ioerror.h"
+#include "iomodes.h"
+
+#define DIRSEP '/'
+
+#define TEST_FLAG(Xloc,Flag) (((Xloc)->flags) & (Flag))
+#define SET_FLAG(Xloc,Flag)  (Xloc)->flags |= (Flag)
+#define CLR_FLAG(Xloc,Flag)  (Xloc)->flags = ((Xloc)->flags & ~(Flag))
+
+Boolean
+__isassociated( Association_Mode* the_assoc, char* file, int line );
+
+Boolean
+__existing( Association_Mode* the_assoc, char* file, int line );
+
+Boolean
+__readable( Association_Mode* the_assoc, char* file, int line );
+
+Boolean
+__writeable( Association_Mode* the_assoc, char* file, int line );
+
+Boolean
+__indexable( Association_Mode* the_assoc, char* file, int line );
+
+Boolean
+__sequencible( Association_Mode* the_assoc, char* file, int line );
+
+Boolean
+__variable( Association_Mode* the_assoc, char* file, int line );
+
+typedef signed long int Index_t;
+
+Association_Mode*
+__associate( Association_Mode* the_assoc,
+             char*             the_path,
+             int               the_path_len,
+             char*             the_mode,
+             int               the_mode_len,
+             char*             file,
+             int               line );
+
+void
+__dissociate( Association_Mode* the_assoc, char* file, int line );
+
+void
+__create( Association_Mode* the_assoc, char* file, int line );
+
+void
+__delete( Association_Mode* the_assoc, char* file, int line );
+
+void
+__modify( Association_Mode* the_assoc,
+          char*             the_path,
+          int               the_path_len,
+          char*             the_mode,
+          int               the_mode_len,
+          char*             file,
+          int               line );
+
+void
+__connect( void*             the_transfer, 
+           Association_Mode* the_assoc,
+           Usage_Mode        the_usage,
+           Where_Mode        the_where,
+           Boolean           with_index,
+           signed long       the_index,
+           char*             file,
+           int               line );
+
+void
+__disconnect( void* the_transfer, char* file, int line );
+
+Association_Mode*
+__getassociation( void* the_transfer, char* file, int line );
+
+Usage_Mode
+__getusage( void* the_transfer, char* file, int line );
+
+Boolean
+__outoffile( void* the_transfer, char* file, int line );
+
+void*
+__readrecord( Access_Mode*  the_access,
+              signed long   the_index,
+              char*         the_buf_addr,
+              char*         file,
+              int           line );
+
+void
+__writerecord( Access_Mode*  the_access,
+               signed long   the_index,
+               char*         the_val_addr,
+               unsigned long the_val_len,
+               char*         file,
+               int           line );
+
+VarString*
+__gettextrecord( Text_Mode* the_text, char* file, int line );
+
+unsigned long
+__gettextindex( Text_Mode* the_text, char* file, int line );
+
+Access_Mode*
+__gettextaccess( Text_Mode* the_text, char* file, int line );
+
+Boolean
+__eoln( Text_Mode* the_text, char* file, int line );
+
+void
+__settextrecord( Text_Mode* the_text,
+                 VarString* the_text_rec,
+                 char*      file,
+                 int        line );
+
+void
+__settextindex( Text_Mode*  the_text,
+                signed long the_text_index, 
+                char*       file,
+                int         line );
+
+void
+__settextaccess( Text_Mode*   the_text,
+                 Access_Mode* the_access,
+                 char*        file,
+                 int          line );
+
+#endif
diff --git a/gcc/ch/runtime/flsetps.c b/gcc/ch/runtime/flsetps.c
new file mode 100644
index 0000000..1a79076
--- /dev/null
+++ b/gcc/ch/runtime/flsetps.c
@@ -0,0 +1,107 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+extern void __cause_ex1 (char *exname, char *file, int lineno);
+
+/*
+ * function __flsetpowerset
+ *
+ * parameters:
+ *	ps		powerset
+ *	bitlength	length of powerset
+ *      minval          set low bound
+ *      filename        caller's file name
+ *      lineno          caller's line number
+ *
+ * returns:
+ *	int		largest enumeration value
+ * exceptions:
+ *      "empty"         if set is empty
+ *
+ * abstract:
+ *  Find last bit set in a powerset and return the corresponding value.
+ *
+ */
+long
+__flsetpowerset (ps, bitlength, minval, filename, lineno)
+     SET_WORD      *ps;
+     unsigned long  bitlength;
+     long           minval;
+     char          *filename;
+     int            lineno;
+{
+  unsigned long bitno;
+
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      SET_CHAR cset = *((SET_CHAR *)ps);
+      if (cset != 0)
+	{
+	  /* found a bit set .. calculate which */
+	  for (bitno = SET_CHAR_SIZE; bitno >= 1; bitno--)
+	    if (GET_BIT_IN_CHAR (cset, bitno - 1))
+	      break;
+	  /* return its index */
+	  return bitno + minval - 1;
+	}
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      SET_SHORT sset = *((SET_SHORT *)ps);
+      if (sset != 0)
+	{
+	  /* found a bit set .. calculate which */
+	  for (bitno = SET_SHORT_SIZE; bitno >= 1; bitno--)
+	    if (GET_BIT_IN_SHORT (sset, bitno - 1))
+	      break;
+	  /* return its index */
+	  return bitno + minval - 1;
+	}
+    }
+  else /* set composed of array of one or more WORDs */
+    {
+      SET_WORD	*endp = ps;
+      SET_WORD	*p = ps + BITS_TO_WORDS(bitlength) - 1;
+      unsigned long cnt;
+      
+      /* FIXME: bitorder problems? */
+      for (cnt = ((bitlength - 1) / SET_WORD_SIZE) * SET_WORD_SIZE;
+	   p >= endp; p--, cnt -= SET_WORD_SIZE)
+	{
+	  SET_WORD c = *p;
+	  if (c)
+	    {
+	      /* found a bit set .. calculate which */
+	      for (bitno = SET_WORD_SIZE; bitno >= 1; bitno--)
+		if (GET_BIT_IN_WORD (c, bitno - 1))
+		  break;
+	      return cnt + bitno + minval - 1;
+	    }
+	}
+    }
+  /* no bits found - raise exception */
+  __cause_ex1 ("empty", filename, lineno);
+}
diff --git a/gcc/ch/runtime/format.h b/gcc/ch/runtime/format.h
new file mode 100644
index 0000000..8b554f4
--- /dev/null
+++ b/gcc/ch/runtime/format.h
@@ -0,0 +1,71 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#ifndef _format_h_
+#define _format_h_
+
+#include "iomodes.h"
+#include "fileio.h"
+
+extern Text_Mode __stdin_text;
+extern Text_Mode __stdout_text;
+extern Text_Mode __stderr_text;
+
+void
+__readtext_f( Text_Mode*      TextLoc,
+              signed long     Index,
+              char*           fmtptr,
+              int             fmtlen,
+              __tmp_IO_list*  ioptr,
+              int             iolen,
+              char*           file,
+              int             line );
+
+void
+__readtext_s( void*           string_ptr,
+              int             string_len,
+              char*           fmtptr,
+              int             fmtlen,
+              __tmp_IO_list*  ioptr,
+              int             iolen,
+              char*           file,
+              int             line );
+
+void
+__writetext_f( Text_Mode*      Text_Loc,
+               signed long     Index,
+               char*           fmtptr,
+               int             fmtlen,
+               __tmp_IO_list*  ioptr,
+               int             iolen,
+               char*           file,
+               int             line );
+
+void
+__writetext_s( void*           string_ptr,
+               int             string_len,
+               char*           fmtptr,
+               int             fmtlen,
+               __tmp_IO_list*  ioptr,
+               int             iolen,
+               char*           file,
+               int             line );
+
+#endif _format_h_
diff --git a/gcc/ch/runtime/getassoc.c b/gcc/ch/runtime/getassoc.c
new file mode 100644
index 0000000..1bc92aa
--- /dev/null
+++ b/gcc/ch/runtime/getassoc.c
@@ -0,0 +1,37 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#include "fileio.h"
+
+Association_Mode*
+__getassociation( void* the_transfer, char* file, int line )
+{
+  Access_Mode* the_access;
+
+  if( !the_transfer )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ACCESS );
+
+  if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ))
+    the_access = ((Text_Mode*)the_transfer)->access_sub;
+  else
+    the_access = (Access_Mode*)the_transfer;
+
+  return the_access->association;
+}
diff --git a/gcc/ch/runtime/gettextaccess.c b/gcc/ch/runtime/gettextaccess.c
new file mode 100644
index 0000000..28f976d
--- /dev/null
+++ b/gcc/ch/runtime/gettextaccess.c
@@ -0,0 +1,31 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#include "fileio.h"
+
+Access_Mode*
+__gettextaccess( Text_Mode* the_text, char* file, int line )
+{
+  if( !the_text )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_TEXT );
+
+  return the_text->access_sub;
+}
+
diff --git a/gcc/ch/runtime/getusage.c b/gcc/ch/runtime/getusage.c
new file mode 100644
index 0000000..2fcaf77
--- /dev/null
+++ b/gcc/ch/runtime/getusage.c
@@ -0,0 +1,40 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#include "fileio.h"
+
+Usage_Mode
+__getusage( void* the_transfer, char* file, int line )
+{
+  Access_Mode* the_access;
+
+  if( !the_transfer )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ACCESS );
+
+  if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ))
+    the_access = ((Text_Mode*)the_transfer)->access_sub;
+  else
+    the_access = (Access_Mode*)the_transfer;
+
+  if( !the_access->association )
+    CHILLEXCEPTION( file, line, NOTCONNECTED, IS_NOT_CONNECTED );
+  return the_access->association->usage;
+}
+
diff --git a/gcc/ch/runtime/inps.c b/gcc/ch/runtime/inps.c
new file mode 100644
index 0000000..d01d76a
--- /dev/null
+++ b/gcc/ch/runtime/inps.c
@@ -0,0 +1,65 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __inpowerset
+ *
+ * parameters:
+ *	bitno		bit number within set
+ *	powerset	the powerset
+ *	bitlength	length of powerset in bits
+ *      minval          number of lowest bit stored
+ *
+ * returns:
+ *	int		1 .. found
+ *			0 .. not found
+ *
+ * exceptions:
+ *  rangefail
+ *
+ * abstract:
+ *  checks if a given value is included in a powerset
+ *
+ */
+int
+__inpowerset (bitno, powerset, bitlength, minval)
+     unsigned long  bitno;
+     SET_WORD      *powerset;
+     unsigned long  bitlength;
+     long           minval;
+{
+  if (bitno < minval || (bitno - minval) >= bitlength)
+    return 0;
+    
+  bitno -= minval;
+  if (bitlength <= SET_CHAR_SIZE)
+    return GET_BIT_IN_CHAR (*((SET_CHAR *)powerset), bitno);
+  else if (bitlength <= SET_SHORT_SIZE)
+    return GET_BIT_IN_SHORT (*((SET_SHORT *)powerset), bitno);
+  else
+    return GET_BIT_IN_WORD (powerset[bitno / SET_WORD_SIZE],
+			    bitno % SET_WORD_SIZE);
+}
diff --git a/gcc/ch/runtime/ioerror.c b/gcc/ch/runtime/ioerror.c
new file mode 100644
index 0000000..8c9fad4
--- /dev/null
+++ b/gcc/ch/runtime/ioerror.c
@@ -0,0 +1,45 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#include <setjmp.h>
+
+/* define names of IO-exceptions */
+
+char * __IO_exception_names[] =
+{
+  "UNUSED",
+  "notassociated",
+  "associatefail",
+  "createfail",
+  "deletefail",
+  "modifyfail",
+  "connectfail",
+  "notconnected",
+  "empty",
+  "rangefail",
+  "spacefail",
+  "readfail",
+  "writefail",
+  "textfail",
+};
+
+jmp_buf __io_exception;
+
+jmp_buf __rw_exception;
diff --git a/gcc/ch/runtime/ioerror.h b/gcc/ch/runtime/ioerror.h
new file mode 100644
index 0000000..e2ddfe5
--- /dev/null
+++ b/gcc/ch/runtime/ioerror.h
@@ -0,0 +1,161 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#ifndef _ioerror_h_
+#define _ioerror_h_
+
+#include <setjmp.h>
+
+/* Note: numbers must be in the same order as
+   strings in ioerror.c */
+typedef enum 
+{ NOTASSOCIATED = 1,
+  ASSOCIATEFAIL,
+  CREATEFAIL, 
+  DELETEFAIL,
+  MODIFYFAIL,
+  CONNECTFAIL,
+  NOTCONNECTED,
+  EMPTY,
+  RANGEFAIL,
+  SPACEFAIL,
+  READFAIL,
+  WRITEFAIL,
+  TEXTFAIL
+} io_exceptions_t;
+
+#ifndef FIRST_IO_ERROR_NUMBER
+#define FIRST_IO_ERROR_NUMBER 0
+#endif
+
+typedef enum {
+  FIRST_AND_UNUSED = FIRST_IO_ERROR_NUMBER,
+  INTERNAL_ERROR,
+  INVALID_IO_LIST,
+  REPFAC_OVERFLOW,
+  CLAUSE_WIDTH_OVERFLOW,
+  UNMATCHED_CLOSING_PAREN,
+  UNMATCHED_OPENING_PAREN,
+  BAD_FORMAT_SPEC_CHAR,
+  NO_PAD_CHAR,
+  IO_CONTROL_NOT_VALID,
+  DUPLICATE_QUALIFIER,
+  NO_FRACTION_WIDTH,
+  NO_EXPONENT_WIDTH,
+  FRACTION_WIDTH_OVERFLOW,
+  EXPONENT_WIDTH_OVERFLOW,
+  NO_FRACTION,
+  NO_EXPONENT,
+  NEGATIVE_FIELD_WIDTH,
+  TEXT_LOC_OVERFLOW,
+  IOLIST_EXHAUSTED,
+  CONVCODE_MODE_MISFIT,
+  SET_CONVERSION_ERROR,
+  BOOL_CONVERSION_ERROR,
+  NON_INT_FIELD_WIDTH,
+  EXCESS_IOLIST_ELEMENTS,
+  NOT_ENOUGH_CHARS,
+  NO_CHARS_FOR_INT,
+  NO_CHARS_FOR_FLOAT,
+  NO_EXPONENT_VAL,
+  INT_VAL_OVERFLOW,
+  REAL_OVERFLOW,
+  NO_DIGITS_FOR_INT,
+  NO_DIGITS_FOR_FLOAT,
+  NO_CHARS_FOR_SET,
+  NO_CHARS_FOR_CHAR,
+  NO_CHARS_FOR_BOOLS,
+  NO_CHARS_FOR_CHARS,
+  NO_CHARS_FOR_TEXT,
+  NO_CHARS_FOR_EDIT,
+  NO_SPACE_TO_SKIP,
+  FORMAT_TEXT_MISMATCH,
+  INTEGER_RANGE_ERROR,
+  SET_RANGE_ERROR,
+  CHAR_RANGE_ERROR,
+  INVALID_CHAR,
+/* end of formatting errors */
+  NULL_ASSOCIATION,
+  NULL_ACCESS,
+  NULL_TEXT,
+  IS_NOT_ASSOCIATED,
+  IS_ASSOCIATED,
+  GETCWD_FAILS,
+  INVALID_ASSOCIATION_MODE,
+  FILE_EXISTING,
+  CREATE_FAILS,
+  DELETE_FAILS,
+  RENAME_FAILS,
+  IMPL_RESTRICTION,
+  NOT_EXISTING,
+  NOT_READABLE,
+  NOT_WRITEABLE,
+  NOT_INDEXABLE,
+  NOT_SEQUENCIBLE,
+  NO_CURRENT_POS,
+  NOT_VARIABLE,
+  NOT_FIXED,
+  NOT_INDEXED, 
+  LENGTH_CHANGE,
+  LSEEK_FAILS,
+  BUFFER_ALLOC,
+  OPEN_FAILS,
+  NO_ACCESS_SUBLOCATION, 
+  BAD_INDEX,
+  IS_NOT_CONNECTED,
+  NO_PATH_NAME,
+  PATHNAME_ALLOC,
+  BAD_USAGE,
+  OUT_OF_FILE,
+  NULL_STORE_LOC,
+  STORE_LOC_ALLOC,
+  OS_IO_ERROR,
+  RECORD_TOO_LONG,
+  RECORD_TOO_SHORT,
+  BAD_TEXTINDEX,
+  NULL_TEXTREC
+} io_info_word_t;
+
+
+extern
+char* io_info_text [];
+
+extern
+char* exc_text [];
+ 
+extern 
+jmp_buf __io_exception;
+
+extern 
+jmp_buf __rw_exception;
+
+void __cause_exception (char *ex, char* f, int line, int info);
+extern char * __IO_exception_names[];
+
+#define IOEXCEPTION(EXC,INFO) \
+    longjmp( __io_exception, (EXC<<16) + INFO )
+
+#define RWEXCEPTION(EXC,INFO) \
+    longjmp( __rw_exception, (EXC<<16) + INFO )
+
+#define CHILLEXCEPTION(FILE,LINE,EXC,INFO) \
+    __cause_exception (__IO_exception_names[EXC], FILE, LINE, INFO);
+
+#endif
diff --git a/gcc/ch/runtime/iomodes.h b/gcc/ch/runtime/iomodes.h
new file mode 100644
index 0000000..8e254e2
--- /dev/null
+++ b/gcc/ch/runtime/iomodes.h
@@ -0,0 +1,251 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#ifndef _iomodes_h_
+#define _iomodes_h_
+
+#include "auxtypes.h"
+
+typedef enum { ReadOnly, WriteOnly, ReadWrite
+} Usage_Mode;
+
+typedef enum { First, Same, Last
+} Where_Mode;
+
+typedef enum { None, Fixed, VaryingChars
+} Record_t;
+
+/* association flags */
+#define IO_ISASSOCIATED 0x00000001
+#define IO_EXISTING     0x00000002
+#define IO_READABLE     0x00000004
+#define IO_WRITEABLE    0x00000008
+#define IO_INDEXABLE    0x00000010
+#define IO_SEQUENCIBLE  0x00000020
+#define IO_VARIABLE     0x00000040
+#define IO_FIRSTLINE    0x00000100
+#define IO_FORCE_PAGE   0x00000200
+
+struct Access_Mode;
+
+#define READBUFLEN 512
+typedef struct
+{
+  unsigned long len;
+  unsigned long cur;
+  char buf[READBUFLEN];
+} readbuf_t;
+
+typedef struct Association_Mode {
+  unsigned long       flags;      /* INIT = 0 */
+  char*               pathname;
+  struct Access_Mode* access;
+  int                 handle;
+  readbuf_t*          bufptr;
+  long                syserrno;
+  char                usage;
+  char                ctl_pre;
+  char                ctl_post;
+} Association_Mode;
+
+/*
+   rectype   indexed   max. reclength    act. reclength
+   ---------------------------------------------------
+   None        T/F        0
+   Fixed       T/F     SIZE(recmode)  =  SIZE(recmode)
+   Varying       F     SIZE(recmode) >=  length
+*/
+
+/* access/text flags */
+#define IO_TEXTLOCATION 0x80000000
+#define IO_INDEXED      0x00000001
+#define IO_TEXTIO       0x00000002
+#define IO_OUTOFFILE    0x00010000
+
+typedef struct Access_Mode {
+  unsigned long     flags;     /* INIT */   
+  unsigned long     reclength; /* INIT */
+  signed long       lowindex;  /* INIT */
+  signed long       highindex; /* INIT */
+  Association_Mode* association;
+  unsigned long     base;
+  char*             store_loc;
+  Record_t          rectype;   /* INIT */
+} Access_Mode;
+
+typedef struct Text_Mode {
+  unsigned long flags;         /* INIT */
+  VarString*    text_record;   /* INIT */
+  Access_Mode*  access_sub;    /* INIT */
+  unsigned long actual_index;
+} Text_Mode;
+
+typedef enum
+{
+    __IO_UNUSED,
+
+    __IO_ByteVal,
+    __IO_UByteVal,
+    __IO_IntVal,
+    __IO_UIntVal,
+    __IO_LongVal,
+    __IO_ULongVal,
+
+    __IO_ByteLoc,
+    __IO_UByteLoc,
+    __IO_IntLoc,
+    __IO_UIntLoc,
+    __IO_LongLoc,
+    __IO_ULongLoc,
+
+    __IO_ByteRangeLoc,
+    __IO_UByteRangeLoc,
+    __IO_IntRangeLoc,
+    __IO_UIntRangeLoc,
+    __IO_LongRangeLoc,
+    __IO_ULongRangeLoc,
+
+    __IO_BoolVal,
+    __IO_BoolLoc,
+    __IO_BoolRangeLoc,
+
+    __IO_SetVal,
+    __IO_SetLoc,
+    __IO_SetRangeLoc,
+
+    __IO_CharVal,
+    __IO_CharLoc,
+    __IO_CharRangeLoc,
+
+    __IO_CharStrLoc,
+
+    __IO_CharVaryingLoc,
+
+    __IO_BitStrLoc,
+
+    __IO_RealVal,
+    __IO_RealLoc,
+    __IO_LongRealVal,
+    __IO_LongRealLoc
+} __tmp_IO_enum;
+
+typedef struct
+{
+    long        value;
+    char*       name;
+} __tmp_IO_enum_table_type;
+
+typedef struct
+{
+    long                      value;
+    __tmp_IO_enum_table_type* name_table;
+} __tmp_WIO_set;
+
+typedef struct
+{
+    char*       ptr;
+    long        lower;
+    long        upper;
+} __tmp_IO_charrange;
+
+typedef union
+{
+      signed long  slong;
+    unsigned long  ulong;
+}  __tmp_IO_long;
+
+typedef struct
+{
+    void*         ptr;
+    __tmp_IO_long lower;
+    __tmp_IO_long upper;
+} __tmp_IO_intrange;
+
+typedef struct
+{
+    void*           ptr;
+    unsigned long   lower;
+    unsigned long   upper;
+} __tmp_RIO_boolrange;
+
+typedef struct
+{
+    void*                     ptr;
+    long                      length;
+    __tmp_IO_enum_table_type* name_table;
+} __tmp_RIO_set;
+
+typedef struct
+{
+    void*                      ptr;
+    long                       length;
+    __tmp_IO_enum_table_type*  name_table;
+    unsigned long              lower;
+    unsigned long              upper;
+} __tmp_RIO_setrange;
+
+typedef struct
+{
+    char*       string;
+    long        string_length;
+} __tmp_IO_charstring;
+
+typedef union
+{
+    char                     __valbyte;
+    unsigned char            __valubyte;
+    short                    __valint;
+    unsigned short           __valuint;
+    long                     __vallong;
+    unsigned long            __valulong;
+    void*                    __locint;
+    __tmp_IO_intrange        __locintrange;
+
+    unsigned char            __valbool;
+    unsigned char*           __locbool;
+    __tmp_RIO_boolrange      __locboolrange;
+
+    __tmp_WIO_set            __valset;
+    __tmp_RIO_set            __locset;
+    __tmp_RIO_setrange       __locsetrange;
+
+    unsigned char            __valchar;
+    unsigned char*           __locchar;
+    __tmp_IO_charrange       __loccharrange;
+
+    __tmp_IO_charstring      __loccharstring;
+
+    float                    __valreal;
+    float*                   __locreal;
+    double                   __vallongreal;
+    double*                  __loclongreal;
+} __tmp_IO_union;
+
+/*
+ * CAUTION: The longest variant of __tmp_IO_union is 5 words long.
+ * Together with __descr this caters for double alignment where required.
+ */
+typedef struct
+{
+    __tmp_IO_union    __t;
+    __tmp_IO_enum     __descr;
+} __tmp_IO_list;
+
+#endif
diff --git a/gcc/ch/runtime/ltps.c b/gcc/ch/runtime/ltps.c
new file mode 100644
index 0000000..747be42
--- /dev/null
+++ b/gcc/ch/runtime/ltps.c
@@ -0,0 +1,86 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __ltpowerset
+ *
+ * parameters:
+ *	left		powerset
+ *	right		powerset
+ *	bitlength	length of powerset
+ *
+ * returns:
+ *	int		1 .. left is proper subset of right
+ *                           (excludes case where left == right)
+ *			0 .. not
+ *
+ * abstract:
+ *  check if one powerset is included in another
+ *
+ */
+int
+__ltpowerset (left, right, bitlength)
+     SET_WORD      *left;
+     SET_WORD      *right;
+     unsigned long  bitlength;
+{
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      if ((*((SET_CHAR *)left) & *((SET_CHAR *)right))
+	  != *((SET_CHAR *)left))
+	return 0;
+      if (*((SET_CHAR *)left) != *((SET_CHAR *)right))
+	return 1;
+      return 0;
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      if ((*((SET_SHORT *)left) & *((SET_SHORT *)right))
+	  != *((SET_SHORT *)left))
+	return 0;
+      if (*((SET_SHORT *)left) != *((SET_SHORT *)right))
+	return 1;
+      return 0;
+    }
+  else
+    {
+      SET_WORD	*endp = left + BITS_TO_WORDS(bitlength);
+      int all_equal = 1;              /* assume all bits are equal */
+    
+      while (left < endp)
+	{
+	  if ((*right & *left) != *left)
+	    return 0;
+	  if (*left != *right)
+	    all_equal = 0;
+	  left++;
+	  right++;
+	}
+      if (left == endp && all_equal)    /* exclude TRUE return for == case */
+	return 0;
+      return 1;
+    }
+}
diff --git a/gcc/ch/runtime/ltstr.c b/gcc/ch/runtime/ltstr.c
new file mode 100644
index 0000000..683a947
--- /dev/null
+++ b/gcc/ch/runtime/ltstr.c
@@ -0,0 +1,55 @@
+/* Implement string-related runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Bill Cox
+
+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.  */
+
+#define MIN(a, b)  ((a) < (b) ? (a) : (b))
+
+/*
+ * function __ltstring
+ *
+ * parameters:
+ *     S1 - pointer to left string
+ *     LEN1 - length of left string
+ *     S2 - pointer to right string
+ *     LEN2 - length of right string
+ *
+ * returns:
+ *     1 if left string is a proper subset of the right string, 0 otherwise
+ *
+ * exceptions:
+ *     none
+ *
+ * abstract:
+ *     compares two character strings for subset relationship
+ *
+ */
+
+int __ltstring (s1, len1, s2, len2)
+     char *s1;
+     int len1;
+     char *s2;
+     int len2;
+{
+  int i;
+
+  i = memcmp (s1, s2, MIN (len1, len2));
+  if (i)
+    return (i < 0);
+  return (len1 < len2);
+}
diff --git a/gcc/ch/runtime/rts.h b/gcc/ch/runtime/rts.h
new file mode 100644
index 0000000..27019e7
--- /dev/null
+++ b/gcc/ch/runtime/rts.h
@@ -0,0 +1,52 @@
+/* GNU CHILL compiler regression test file
+ 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. */
+
+#ifndef __rts_h_
+#define __rts_h_
+
+typedef enum
+{
+  UNUSED,
+  Process,
+  Signal,
+  Buffer,
+  Event,
+  Synonym,
+  Exception,
+  LAST_AND_UNUSED,
+} TaskingEnum;
+
+typedef void (*EntryPoint) ();
+
+typedef struct
+{
+  char       *name;
+  short      *value;
+  int         value_defined;
+  EntryPoint  entry;
+  unsigned char /*TaskingEnum*/ type;
+} TaskingStruct;
+
+typedef struct
+{
+  short ptype;
+  short pcopy;
+} INSTANCE;
+
+#endif /* __rts_h_ */
diff --git a/gcc/ch/runtime/sliceps.c b/gcc/ch/runtime/sliceps.c
new file mode 100644
index 0000000..939a0b8
--- /dev/null
+++ b/gcc/ch/runtime/sliceps.c
@@ -0,0 +1,65 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+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.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __powerset_slice
+ *
+ * parameters:
+ *      dps             dest powerset
+ *      dbl             destination bit length
+ *	sps		sourcepowerset
+ *	sbl     	source powerset length in bits
+ *      start           starting bit number
+ *      end             ending bit number
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  Extract into a powerset a slice of another powerset.
+ *
+ */
+extern void
+__pscpy (SET_WORD      *dps,
+	 unsigned long  dbl,
+	 unsigned long  doffset,
+	 SET_WORD      *sps,
+	 unsigned long  sbl,
+	 unsigned long  start,
+	 unsigned long  length);
+
+void
+__psslice (dps, dbl, sps, sbl, start, length)
+     SET_WORD      *dps;
+     unsigned long  dbl;
+     SET_WORD      *sps;
+     unsigned long  sbl;
+     unsigned long  start;
+     unsigned long  length;
+{
+  /* simply supply a zero destination offset and copy the slice */
+  __pscpy (dps, dbl, (unsigned long)0, sps, sbl, start, length);
+}
diff --git a/gcc/ch/runtime/unhex.c b/gcc/ch/runtime/unhex.c
new file mode 100644
index 0000000..3bd23dc
--- /dev/null
+++ b/gcc/ch/runtime/unhex.c
@@ -0,0 +1,57 @@
+/* Implement runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser
+
+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.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include <stdlib.h>
+#include <setjmp.h>
+
+/*
+ * function unhandled_exception
+ *
+ * parameter:
+ *  exname		name of exception
+ *  file		filename
+ *  lineno		line number
+ *  user_arg		user specified argument
+ *
+ * returns:
+ *  never
+ *
+ * abstract:
+ *  print an error message about unhandled exception and call abort
+ *
+ */
+
+void
+unhandled_exception (exname, file, lineno, user_arg)
+     char *exname;
+     char *file;
+     int lineno;
+     int user_arg;
+{
+  sleep (1); /* give previous output a chance to finish */
+  fprintf (stderr, "ChillLib: unhandled exception `%s' in file %s at line %d\n",
+	   exname, file, lineno);
+  fflush (stderr);
+  abort ();
+} /* unhandled_exception */
diff --git a/gcc/ch/runtime/unhex1.c b/gcc/ch/runtime/unhex1.c
new file mode 100644
index 0000000..375f6a5
--- /dev/null
+++ b/gcc/ch/runtime/unhex1.c
@@ -0,0 +1,58 @@
+/* Implement runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser
+
+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.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include <stdlib.h>
+#include <setjmp.h>
+
+extern void cause_exception (char *ex, char *file, int lineno, int arg);
+extern void unhandled_exception (char *ex, char *file, int lineno, int arg);
+
+/*
+ * function __unhandled_ex
+ *
+ * parameter:
+ *  exname		name of exception
+ *  file		filename
+ *  lineno		line number
+ *
+ * returns:
+ *  never
+ *
+ * abstract:
+ *  This function gets called by compiler generated code when an unhandled
+ *  exception occures.
+ *  First cause_exception gets called (which may be user defined) and
+ *  then the standard unhandled exception routine gets called.
+ *
+ */
+
+void
+__unhandled_ex (exname, file, lineno)
+     char *exname;
+     char *file;
+     int lineno;
+{
+    cause_exception (exname, file, lineno, 0);
+    unhandled_exception (exname, file, lineno, 0);
+} /* unhandled_exception */
diff --git a/gcc/ch/satisfy.c b/gcc/ch/satisfy.c
new file mode 100644
index 0000000..a9f3c87
--- /dev/null
+++ b/gcc/ch/satisfy.c
@@ -0,0 +1,628 @@
+/* Name-satisfaction for GNU Chill compiler.
+   Copyright (C) 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.  */
+
+#include <stdio.h>
+#include "config.h"
+#include "tree.h"
+#include "flags.h"
+#include "ch-tree.h"
+#include "lex.h"
+
+#define SATISFY(ARG) ((ARG) = satisfy(ARG, chain))
+
+extern void error           PROTO((char *, ...));
+extern void error_with_decl PROTO((tree, char *, ...));
+extern void expand_decl     PROTO((tree));
+extern void layout_enum     PROTO((tree));
+
+struct decl_chain
+{
+  struct decl_chain *prev;
+  /* DECL can be a decl, or a POINTER_TYPE or a REFERENCE_TYPE. */
+  tree decl;
+};
+
+/* forward declaration */
+tree satisfy PROTO((tree, struct decl_chain *));
+
+static struct decl_chain dummy_chain;
+#define LOOKUP_ONLY (chain==&dummy_chain)
+
+/* Recursive helper routine to logically reverse the chain. */
+static void
+cycle_error_print (chain, decl)
+     struct decl_chain *chain;
+     tree decl;
+{
+  if (chain->decl != decl)
+    {
+      cycle_error_print (chain->prev, decl);
+      if (TREE_CODE_CLASS (TREE_CODE (chain->decl)) == 'd')
+	error_with_decl (chain->decl, "  `%s', which depends on ...");
+    }
+}
+
+tree
+safe_satisfy_decl (decl, prev_chain)
+     tree decl;
+     struct decl_chain *prev_chain;
+{
+  struct decl_chain new_link;
+  struct decl_chain *link;
+  struct decl_chain *chain = prev_chain;
+  char *save_filename = input_filename;
+  int save_lineno = lineno;
+  tree result = decl;
+  
+  if (decl == NULL_TREE)
+    return decl;
+
+  if (!LOOKUP_ONLY)
+    {
+      int pointer_type_breaks_cycle = 0;
+      /* Look for a cycle.
+	 We could do this test more efficiently by setting a flag.  FIXME */
+      for (link = prev_chain; link != NULL; link = link->prev)
+	{
+	  if (TREE_CODE_CLASS (TREE_CODE (link->decl)) != 'd')
+	    pointer_type_breaks_cycle = 1;
+	  if (link->decl == decl)
+	    {
+	      if (!pointer_type_breaks_cycle)
+		{
+		  error_with_decl (decl, "Cycle: `%s' depends on ...");
+		  cycle_error_print (prev_chain, decl);
+		  error_with_decl (decl, "  `%s'");
+		  return error_mark_node;
+		}
+	      /* There is a cycle, but it includes a pointer type,
+		 so we're OK.  However, we still have to continue
+		 the satisfy (for example in case this is a TYPE_DECL
+		 that points to a LANG_DECL).  The cycle-check for
+		 POINTER_TYPE/REFERENCE_TYPE should stop the recursion. */
+	      break;
+	    }
+	}
+
+      new_link.decl = decl;
+      new_link.prev = prev_chain;
+      chain = &new_link;
+    }
+
+  input_filename = DECL_SOURCE_FILE (decl);
+  lineno = DECL_SOURCE_LINE (decl);
+
+  switch ((enum chill_tree_code)TREE_CODE (decl))
+    {
+    case ALIAS_DECL:
+      if (!LOOKUP_ONLY && !DECL_POSTFIX_ALL(decl))
+	result = safe_satisfy_decl (DECL_ABSTRACT_ORIGIN (decl), chain);
+      break;
+    case BASED_DECL:
+      SATISFY (TREE_TYPE (decl));
+      SATISFY (DECL_ABSTRACT_ORIGIN (decl));
+      break;
+    case CONST_DECL:
+      SATISFY (TREE_TYPE (decl));
+      SATISFY (DECL_INITIAL (decl));
+      if (!LOOKUP_ONLY)
+	{
+	  if (DECL_SIZE (decl) == 0)
+	    {
+	      tree init_expr = DECL_INITIAL (decl);
+	      tree init_type;
+	      tree specified_mode = TREE_TYPE (decl);
+
+	      if (init_expr == NULL_TREE
+		  || TREE_CODE (init_expr) == ERROR_MARK)
+		goto bad_const;
+	      init_type = TREE_TYPE (init_expr);
+	      if (specified_mode == NULL_TREE)
+		{
+		  if (init_type == NULL_TREE)
+		    {
+		      check_have_mode (init_expr, "SYN without mode");
+		      goto bad_const;
+		    }
+		  TREE_TYPE (decl) = init_type;
+		  CH_DERIVED_FLAG (decl) = CH_DERIVED_FLAG (init_expr);
+		}
+	      else if (CH_IS_ASSOCIATION_MODE (specified_mode) ||
+		       CH_IS_ACCESS_MODE (specified_mode) || CH_IS_TEXT_MODE (specified_mode) ||
+		       CH_IS_BUFFER_MODE (specified_mode) || CH_IS_EVENT_MODE (specified_mode))
+		{
+		  error ("SYN of this mode not allowed");
+		  goto bad_const;
+		}
+	      else if (!CH_COMPATIBLE (init_expr, specified_mode))
+		{
+		  error ("mode of SYN incompatible with value");
+		  goto bad_const;
+		} 
+	      else if (discrete_type_p (specified_mode)
+		       && TREE_CODE (init_expr) == INTEGER_CST
+		       && (compare_int_csts (LT_EXPR, init_expr,
+					     TYPE_MIN_VALUE (specified_mode))
+			   || compare_int_csts (GT_EXPR, init_expr,
+						TYPE_MAX_VALUE(specified_mode))
+			   ))
+		{
+		  error ("SYN value outside range of its mode");
+		  /* set an always-valid initial value to prevent 
+		     other errors. */
+		  DECL_INITIAL (decl) = TYPE_MIN_VALUE (specified_mode);
+		}
+	      else if (CH_STRING_TYPE_P (specified_mode) 
+		       && (init_type && CH_STRING_TYPE_P (init_type))
+		       && integer_zerop (string_assignment_condition (specified_mode, init_expr)))
+		{
+		  error ("INIT string too large for mode");
+		  DECL_INITIAL (decl) = error_mark_node;
+		}
+	      else
+		{
+		  struct ch_class class;
+		  class.mode = TREE_TYPE (decl);
+		  class.kind = CH_VALUE_CLASS;
+		  DECL_INITIAL (decl)
+		    = convert_to_class (class, DECL_INITIAL (decl));
+		}
+	      /* DECL_SIZE is set to prevent re-doing this stuff. */
+	      DECL_SIZE (decl) = TYPE_SIZE (TREE_TYPE (decl));
+	      if (! TREE_CONSTANT (DECL_INITIAL (decl))
+		  && TREE_CODE (DECL_INITIAL (decl)) != ERROR_MARK)
+		{
+		  error_with_decl (decl,
+				   "value of %s is not a valid constant");
+		  DECL_INITIAL (decl) = error_mark_node;
+		}
+	    }
+	  result = DECL_INITIAL (decl);
+	}
+      break;
+    bad_const:
+      DECL_INITIAL (decl) = error_mark_node;
+      TREE_TYPE (decl) = error_mark_node;
+      return error_mark_node;
+    case FUNCTION_DECL:
+      SATISFY (TREE_TYPE (decl));
+      if (CH_DECL_PROCESS (decl))
+	safe_satisfy_decl (DECL_TASKING_CODE_DECL (decl), 
+			   prev_chain);
+      break;
+    case PARM_DECL:
+      SATISFY (TREE_TYPE (decl));
+      break;
+    /* RESULT_DECL doesn't need to be satisfied;  
+       it's only built internally in pass 2 */
+    case TYPE_DECL:
+      SATISFY (TREE_TYPE (decl));
+      if (CH_DECL_SIGNAL (decl))
+	safe_satisfy_decl (DECL_TASKING_CODE_DECL (decl), 
+			   prev_chain);
+      if (!LOOKUP_ONLY)
+	{
+	  if (TYPE_NAME (TREE_TYPE (decl)) == NULL_TREE)
+	    TYPE_NAME (TREE_TYPE (decl)) = decl;
+	  layout_decl (decl, 0);
+	  if (CH_DECL_SIGNAL (decl) && CH_TYPE_NONVALUE_P (TREE_TYPE (decl)))
+	    error ("mode with non-value property in signal definition");
+	  result = TREE_TYPE (decl);
+	}
+      break;
+    case VAR_DECL:
+      SATISFY (TREE_TYPE (decl));
+      if (!LOOKUP_ONLY)
+	{
+	  layout_decl (decl, 0);
+	  if (TREE_READONLY (TREE_TYPE (decl)))
+	    TREE_READONLY (decl) = 1;
+	}
+      break;
+    default:
+      ;
+    }
+
+  /* Now set the DECL_RTL, if needed. */
+  if (!LOOKUP_ONLY && DECL_RTL (decl) == 0
+      && (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL
+	  || TREE_CODE (decl) == CONST_DECL))
+    {
+      if (TREE_CODE (decl) == FUNCTION_DECL && decl_function_context (decl))
+	make_function_rtl (decl);
+      else if (!TREE_STATIC (decl) && !DECL_EXTERNAL (decl))
+	expand_decl (decl);
+      else
+	{ char * asm_name;
+	  if (current_module == 0 || TREE_PUBLIC (decl)
+	      || current_function_decl)
+	    asm_name = NULL;
+	  else
+	    {
+	      asm_name = (char*)
+		alloca (IDENTIFIER_LENGTH (current_module->prefix_name)
+			+ IDENTIFIER_LENGTH (DECL_NAME (decl)) + 3);
+	      sprintf (asm_name, "%s__%s",
+		       IDENTIFIER_POINTER (current_module->prefix_name),
+		       IDENTIFIER_POINTER (DECL_NAME (decl)));
+	    }
+	  make_decl_rtl (decl, asm_name, TREE_PUBLIC (decl));
+	}
+    }
+
+  input_filename = save_filename;
+  lineno = save_lineno;
+
+  return result;
+}
+
+tree
+satisfy_decl (decl, lookup_only)
+     tree decl;
+     int lookup_only;
+{
+  return safe_satisfy_decl (decl, lookup_only ? &dummy_chain : NULL);
+}
+
+static void
+satisfy_list (exp, chain)
+     register tree exp;
+     struct decl_chain *chain;
+{
+  for (; exp != NULL_TREE; exp = TREE_CHAIN (exp))
+    {
+      SATISFY (TREE_VALUE (exp));
+      SATISFY (TREE_PURPOSE (exp));
+    }
+}
+
+static void
+satisfy_list_values (exp, chain)
+     register tree exp;
+     struct decl_chain *chain;
+{
+  for (; exp != NULL_TREE; exp = TREE_CHAIN (exp))
+    {
+      SATISFY (TREE_VALUE (exp));
+    }
+}
+
+tree
+satisfy (exp, chain)
+     tree exp;
+     struct decl_chain *chain;
+{
+  int arg_length;
+  int i;
+  tree decl;
+
+  if (exp == NULL_TREE)
+    return NULL_TREE;
+
+#if 0
+  if (!UNSATISFIED (exp))
+    return exp;
+#endif
+
+  switch (TREE_CODE_CLASS (TREE_CODE (exp)))
+    {
+    case 'd':
+      if (!LOOKUP_ONLY)
+	return safe_satisfy_decl (exp, chain);
+      break;
+    case 'r':
+    case 's':
+    case '<':
+    case 'e':
+      switch ((enum chill_tree_code)TREE_CODE (exp))
+	{
+	case REPLICATE_EXPR:
+	  goto binary_op;
+	case TRUTH_NOT_EXPR:
+	  goto unary_op;
+	case COMPONENT_REF:
+	  SATISFY (TREE_OPERAND (exp, 0));
+	  if (!LOOKUP_ONLY && TREE_TYPE (exp) == NULL_TREE)
+	    return resolve_component_ref (exp);
+	  return exp;
+	case CALL_EXPR:
+	  SATISFY (TREE_OPERAND (exp, 0));
+	  SATISFY (TREE_OPERAND (exp, 1));
+	  if (!LOOKUP_ONLY && TREE_TYPE (exp) == NULL_TREE)
+	    return build_generalized_call (TREE_OPERAND (exp, 0),
+					   TREE_OPERAND (exp, 1));
+	  return exp;
+	case CONSTRUCTOR:
+	  { tree link = TREE_OPERAND (exp, 1);
+	    int expand_needed = TREE_TYPE (exp)
+	      && TREE_CODE_CLASS (TREE_CODE (TREE_TYPE (exp))) != 't';
+	    for (; link != NULL_TREE; link = TREE_CHAIN (link))
+	      {
+		SATISFY (TREE_VALUE (link));
+		if (!TUPLE_NAMED_FIELD (link))
+		  SATISFY (TREE_PURPOSE (link));
+	      }
+	    SATISFY (TREE_TYPE (exp));
+	    if (expand_needed && !LOOKUP_ONLY)
+	      {
+		tree type = TREE_TYPE (exp);
+		TREE_TYPE (exp) = NULL_TREE; /* To force expansion. */
+		return chill_expand_tuple (type, exp);
+	      }
+	    return exp;
+	  }
+	default:
+	  ;
+	}
+      arg_length = tree_code_length[TREE_CODE (exp)];
+      for (i = 0; i < arg_length; i++)
+	SATISFY (TREE_OPERAND (exp, i));
+      return exp;
+    case '1':
+    unary_op:
+      SATISFY (TREE_OPERAND (exp, 0));
+      if ((enum chill_tree_code)TREE_CODE (exp) == PAREN_EXPR)
+	return TREE_OPERAND (exp, 0);
+      if (!LOOKUP_ONLY)
+	return finish_chill_unary_op (exp);
+      break;
+    case '2':
+    binary_op:
+      SATISFY (TREE_OPERAND (exp, 0));
+      SATISFY (TREE_OPERAND (exp, 1));
+      if (!LOOKUP_ONLY && TREE_CODE (exp) != RANGE_EXPR)
+	return finish_chill_binary_op (exp);
+      break;
+    case 'x':
+      switch ((enum chill_tree_code)TREE_CODE (exp))
+	{
+	case IDENTIFIER_NODE:
+	  decl = lookup_name (exp);
+	  if (decl == NULL)
+	    {
+	      if (LOOKUP_ONLY)
+		return exp;
+	      error ("undeclared identifier `%s'", IDENTIFIER_POINTER (exp));
+	      return error_mark_node;
+	    }
+	  if (LOOKUP_ONLY)
+	    return decl;
+	  return safe_satisfy_decl (decl, chain);
+	case TREE_LIST:
+	  satisfy_list (exp, chain);
+	  break;
+	default:
+	  ;
+	}
+      break;
+    case 't':
+      /* If TYPE_SIZE is non-NULL, exp and its subfields has already been
+	 satified and laid out.  The exception is pointer and reference types,
+	 which we layout before we lay out their TREE_TYPE. */
+      if (TYPE_SIZE (exp) && TREE_CODE (exp) != POINTER_TYPE
+	  && TREE_CODE (exp) != REFERENCE_TYPE)
+	return exp;
+      if (TYPE_MAIN_VARIANT (exp) != exp)
+	SATISFY (TYPE_MAIN_VARIANT (exp));
+      switch ((enum chill_tree_code)TREE_CODE (exp))
+	{
+	case LANG_TYPE:
+	  {
+	    tree d = TYPE_DOMAIN (exp);
+	    tree t = satisfy (TREE_TYPE (exp), chain);
+	    SATISFY (d);
+	    /* It is possible that one of the above satisfy calls recursively
+	       caused exp to be satisfied, in which case we're done. */
+	    if (TREE_CODE (exp) != LANG_TYPE)
+	      return exp;
+	    TREE_TYPE (exp) = t;
+	    TYPE_DOMAIN (exp) = d;
+	    if (!LOOKUP_ONLY)
+	      exp = smash_dummy_type (exp);
+	  }
+	  break;
+	case ARRAY_TYPE:
+	  SATISFY (TREE_TYPE (exp));
+	  SATISFY (TYPE_DOMAIN (exp));
+	  SATISFY (TYPE_ATTRIBUTES (exp));
+	  if (!LOOKUP_ONLY)
+	    CH_TYPE_NONVALUE_P (exp) = CH_TYPE_NONVALUE_P (TREE_TYPE (exp));
+	  if (!TYPE_SIZE (exp)  && !LOOKUP_ONLY)
+	    exp = layout_chill_array_type (exp);
+	  break;
+	case FUNCTION_TYPE:
+	  SATISFY (TREE_TYPE (exp));
+	  if (TREE_CODE_CLASS (TREE_CODE (TREE_TYPE (exp))) != 't'
+	      && !LOOKUP_ONLY && TREE_CODE (TREE_TYPE (exp)) != ERROR_MARK)
+	    {
+	      error ("RETURNS spec with invalid mode");
+	      TREE_TYPE (exp) = error_mark_node;
+	    }
+	  satisfy_list_values (TYPE_ARG_TYPES (exp), chain);
+	  if (!TYPE_SIZE (exp)  && !LOOKUP_ONLY)
+	    layout_type (exp);
+	  break;
+	case ENUMERAL_TYPE:
+	  if (TYPE_SIZE (exp) == NULL_TREE && !LOOKUP_ONLY)
+	    { tree pair;
+	      /* FIXME:  Should this use satisfy_decl? */
+	      for (pair = TYPE_VALUES (exp); pair; pair = TREE_CHAIN (pair))
+		SATISFY (DECL_INITIAL (TREE_VALUE (pair)));
+	      layout_enum (exp);
+	    }
+	  break;
+	case INTEGER_TYPE:
+	  SATISFY (TYPE_MIN_VALUE (exp));
+	  SATISFY (TYPE_MAX_VALUE (exp));
+	  if (TREE_TYPE (exp) != NULL_TREE)
+	    { /* A range type */
+	      if (TREE_TYPE (exp) != ridpointers[(int) RID_RANGE]
+		  && TREE_TYPE (exp) != ridpointers[(int) RID_BIN]
+		  && TREE_TYPE (exp) != string_index_type_dummy)
+		SATISFY (TREE_TYPE (exp));
+	      if (!TYPE_SIZE (exp)  && !LOOKUP_ONLY)
+		exp = layout_chill_range_type (exp, 1);
+	    }
+	  break;
+	case POINTER_TYPE:
+	case REFERENCE_TYPE:
+	  if (LOOKUP_ONLY)
+	    SATISFY (TREE_TYPE (exp));
+	  else
+	    {
+	      struct decl_chain *link;
+	      int already_seen = 0;
+	      for (link = chain; ; link = link->prev)
+		{
+		  if (link == NULL)
+		    {	
+		      struct decl_chain new_link;
+		      new_link.decl = exp;
+		      new_link.prev = chain;
+		      TREE_TYPE (exp) = satisfy (TREE_TYPE (exp), &new_link);
+		      break;
+		    }
+		  else if (link->decl == exp)
+		    {
+		      already_seen = 1;
+		      break;
+		    }
+		}
+	      if (!TYPE_SIZE (exp))
+		{
+		  layout_type (exp);
+		  if (TREE_CODE (exp) == REFERENCE_TYPE)
+		    CH_NOVELTY (exp) = CH_NOVELTY (TREE_TYPE (exp));
+		  if (! already_seen)
+		    {
+		      tree valtype = TREE_TYPE (exp);
+		      if (TREE_CODE_CLASS (TREE_CODE (valtype)) != 't')
+			{
+			  if (TREE_CODE (valtype) != ERROR_MARK)
+			    error ("operand to REF is not a mode");
+			  TREE_TYPE (exp) = error_mark_node;
+			  return error_mark_node;
+			}
+		      else if (TREE_CODE (exp) == POINTER_TYPE
+			       && TYPE_POINTER_TO (valtype) == NULL)
+			TYPE_POINTER_TO (valtype) = exp;
+		    }
+		}
+	    }
+	  break;
+	case RECORD_TYPE:
+	  {
+	    /* FIXME: detected errors in here will be printed as
+	       often as this sequence runs. Find another way or
+	       place to print the errors. */
+	    /* if we have an ACCESS or TEXT mode we have to set
+	       maximum_field_alignment to 0 to fit with runtime
+	       system, even when we compile with -fpack. */
+	    extern int maximum_field_alignment;
+	    int save_maximum_field_alignment = maximum_field_alignment;
+
+	    if (CH_IS_ACCESS_MODE (exp) || CH_IS_TEXT_MODE (exp))
+	      maximum_field_alignment = 0;
+
+	    for (decl = TYPE_FIELDS (exp); decl; decl = TREE_CHAIN (decl))
+	      {
+		SATISFY (TREE_TYPE (decl));
+		if (!LOOKUP_ONLY)
+		  {
+		    /* if we have a UNION_TYPE here (variant structure), check for
+		       non-value mode in it. This is not allowed (Z.200/pg. 33) */
+		    if (TREE_CODE (TREE_TYPE (decl)) == UNION_TYPE &&
+			CH_TYPE_NONVALUE_P (TREE_TYPE (decl)))
+		      {
+			error ("field with non-value mode in variant structure not allowed");
+			TREE_TYPE (decl) = error_mark_node;
+		      }
+		    /* RECORD_TYPE gets the non-value property if one of the
+		       fields has the non-value property */
+		    CH_TYPE_NONVALUE_P (exp) |= CH_TYPE_NONVALUE_P (TREE_TYPE (decl));
+		  }
+		if (TREE_CODE (decl) == CONST_DECL)
+		  {
+		    SATISFY (DECL_INITIAL (decl));
+		    if (!LOOKUP_ONLY)
+		      {
+			if (CH_IS_BUFFER_MODE (exp) || CH_IS_EVENT_MODE (exp))
+			  DECL_INITIAL (decl)
+			    = check_queue_size (exp, DECL_INITIAL (decl));
+			else if (CH_IS_TEXT_MODE (exp) &&
+				 DECL_NAME (decl) == get_identifier ("__textlength"))
+			  DECL_INITIAL (decl)
+			    = check_text_length (exp, DECL_INITIAL (decl));
+		      }
+		  }
+		else if (TREE_CODE (decl) == FIELD_DECL)
+		  {
+		    SATISFY (DECL_INITIAL (decl));
+		  }
+	      }
+	    satisfy_list (TYPE_TAG_VALUES (exp), chain);
+	    if (!TYPE_SIZE (exp)  && !LOOKUP_ONLY)
+	      exp = layout_chill_struct_type (exp);
+	    maximum_field_alignment = save_maximum_field_alignment;
+
+	    /* perform some checks on nonvalue modes, they are record_mode's */
+	    if (!LOOKUP_ONLY)
+	      {
+		if (CH_IS_BUFFER_MODE (exp))
+		  {
+		    tree elemmode = buffer_element_mode (exp);
+		    if (elemmode != NULL_TREE && CH_TYPE_NONVALUE_P (elemmode))
+		      {
+			error ("buffer element mode must not have non-value property");
+			invalidate_buffer_element_mode (exp);
+		      }
+		  }
+		else if (CH_IS_ACCESS_MODE (exp))
+		  {
+		    tree recordmode = access_recordmode (exp);
+		    if (recordmode != NULL_TREE && CH_TYPE_NONVALUE_P (recordmode))
+		      {
+			error ("recordmode must not have the non-value property");
+			invalidate_access_recordmode (exp);
+		      }
+		  }
+	      }
+	  }
+	  break;
+	case SET_TYPE:
+	  SATISFY (TYPE_DOMAIN (exp));
+	  if (!TYPE_SIZE (exp)  && !LOOKUP_ONLY)
+	    exp = layout_powerset_type (exp);
+	  break;
+	case UNION_TYPE:
+	  for (decl = TYPE_FIELDS (exp); decl; decl = TREE_CHAIN (decl))
+	    {
+	      SATISFY (TREE_TYPE (decl));
+	      if (!LOOKUP_ONLY)
+		CH_TYPE_NONVALUE_P (exp) |= CH_TYPE_NONVALUE_P (TREE_TYPE (decl));
+	    }
+	  if (!TYPE_SIZE (exp)  && !LOOKUP_ONLY)
+	    exp = layout_chill_variants (exp);
+	  break;
+	default:
+	  ;
+	}
+    }
+  return exp;
+}
diff --git a/gcc/ch/tasking.c b/gcc/ch/tasking.c
new file mode 100644
index 0000000..95c81c6
--- /dev/null
+++ b/gcc/ch/tasking.c
@@ -0,0 +1,3423 @@
+/* Implement tasking-related actions for CHILL.
+   Copyright (C) 1992, 93, 1994 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.  */
+
+#include <stdio.h>
+#include <limits.h>
+#include <string.h>
+#include "config.h"
+#include "tree.h"
+#include "rtl.h"
+#include "ch-tree.h"
+#include "flags.h"
+#include "input.h"
+#include "obstack.h"
+#include "assert.h"
+#include "tasking.h"
+#include "lex.h"
+
+/* external functions */
+extern void emit_jump       PROTO((rtx));
+extern void error           PROTO((char *, ...));
+extern void error_with_decl PVPROTO ((tree, char *, ...));
+extern void push_obstacks   PROTO((struct obstack *, struct obstack *));
+extern void warning         PROTO((char *, ...));
+
+/* from ch-lex.l, from compiler directives */
+extern tree process_type;
+extern tree send_signal_prio;
+extern tree send_buffer_prio;
+
+tree tasking_message_type;
+tree instance_type_node;
+tree generic_signal_type_node;
+
+/* the type a tasking code variable has */
+tree chill_taskingcode_type_node;
+
+/* forward declarations */
+void validate_process_parameters PROTO((tree));
+tree make_process_struct         PROTO((tree, tree));
+
+/* list of this module's process, buffer, etc. decls.
+ This is a list of TREE_VECs, chain by their TREE_CHAINs. */
+tree tasking_list = NULL_TREE;
+/* The parts of a tasking_list element. */
+#define TASK_INFO_PDECL(NODE) TREE_VEC_ELT(NODE,0)
+#define TASK_INFO_ENTRY(NODE) TREE_VEC_ELT(NODE,1)
+#define TASK_INFO_CODE_DECL(NODE) TREE_VEC_ELT(NODE,2)
+#define TASK_INFO_STUFF_NUM(NODE) TREE_VEC_ELT(NODE,3)
+#define TASK_INFO_STUFF_TYPE(NODE) TREE_VEC_ELT(NODE,4)
+
+/* name template for process argument type */
+static char * struct_name = "__tmp_%s_arg_type";
+
+/* name template for process arguments for debugging type */
+static char * struct_debug_name = "__tmp_%s_debug_type";
+
+/* name template for process argument variable */
+static char * data_name = "__tmp_%s_arg_variable";
+
+/* name template for process wrapper */
+static char * wrapper_name = "__tmp_%s_wrapper";
+
+extern int ignoring;
+static tree void_ftype_void;
+static tree pointer_to_instance;
+static tree infinite_buffer_event_length_node;
+
+tree
+get_struct_type_name (name)
+     tree name;
+{
+  char *idp = IDENTIFIER_POINTER (name);        /* process name */
+  char *tmpname = xmalloc (strlen (idp) + strlen (struct_name) + 1);
+
+  sprintf (tmpname, struct_name, idp);
+  return get_identifier (tmpname);
+}
+
+tree
+get_struct_debug_type_name (name)
+     tree name;
+{
+  char *idp = IDENTIFIER_POINTER (name);        /* process name */
+  char *tmpname = xmalloc (strlen (idp) + strlen (struct_debug_name) + 1);
+
+  sprintf (tmpname, struct_debug_name, idp);
+  return get_identifier (tmpname);
+}
+
+
+tree
+get_tasking_code_name (name)
+     tree name;
+{
+  char *skelname = "__tmp_%s_code";
+  char *name_str = IDENTIFIER_POINTER (name);
+  char *tmpname  = (char *)alloca (IDENTIFIER_LENGTH (name) +
+				   strlen (skelname) + 1);
+
+  sprintf (tmpname, skelname, name_str);
+  return get_identifier (tmpname);
+}
+
+
+static tree
+get_struct_variable_name (name)
+     tree name;
+{
+  char *idp = IDENTIFIER_POINTER (name);        /* process name */
+  char *tmpname = xmalloc (strlen (idp) + strlen (data_name) + 1);
+
+  sprintf (tmpname, data_name, idp);
+  return get_identifier (tmpname);
+}
+
+static tree
+get_process_wrapper_name (name)
+    tree name;
+{
+  char *idp = IDENTIFIER_POINTER (name);
+  char *tmpname = xmalloc (strlen (idp) + strlen (wrapper_name) + 1);
+    
+  sprintf (tmpname, wrapper_name, idp);
+  return get_identifier (tmpname);
+}
+
+/*
+ * If this is a quasi declaration - parsed within a SPEC MODULE,
+ * QUASI_FLAG is TRUE, to indicate that the variable should not
+ * be initialized.  The other module will do that.
+ */
+tree
+generate_tasking_code_variable (name, tasking_code_ptr, quasi_flag)
+     tree name, *tasking_code_ptr;
+     int  quasi_flag;
+{
+
+  tree decl;
+  tree tasking_code_name = get_tasking_code_name (name);
+  
+  if (pass == 2 && ! quasi_flag && *tasking_code_ptr != NULL_TREE)
+    {
+      /* check for value should be assigned is out of range */
+      if (TREE_INT_CST_LOW (*tasking_code_ptr) >
+	  TREE_INT_CST_LOW (TYPE_MAX_VALUE (chill_taskingcode_type_node)))
+	  error ("Tasking code %d out of range for `%s'.",
+		 TREE_INT_CST_LOW (*tasking_code_ptr),
+		 IDENTIFIER_POINTER (name));
+    }
+
+  decl = do_decl (tasking_code_name, 
+		  chill_taskingcode_type_node, 1, 1,
+		  quasi_flag ? NULL_TREE : *tasking_code_ptr, 
+		  0);
+
+  /* prevent granting of this type */
+  DECL_SOURCE_LINE (decl) = 0;
+
+  if (pass == 2 && ! quasi_flag && *tasking_code_ptr != NULL_TREE)
+    *tasking_code_ptr = fold (build (PLUS_EXPR, chill_taskingcode_type_node,
+				     integer_one_node,
+				     *tasking_code_ptr));
+  return decl;
+}
+
+
+/*
+ * If this is a quasi declaration - parsed within a SPEC MODULE,
+ * QUASI_FLAG is TRUE, to indicate that the variable should not
+ * be initialized.  The other module will do that.  This is just 
+ * for BUFFERs and EVENTs.
+ */
+tree
+decl_tasking_code_variable (name, tasking_code_ptr, quasi_flag)
+     tree name, *tasking_code_ptr;
+     int  quasi_flag;
+{
+  extern struct obstack permanent_obstack;
+  tree tasking_code_name = get_tasking_code_name (name);
+  tree decl;
+
+  /* guarantee that RTL for the code_variable resides in
+     the permanent obstack.  The BUFFER or EVENT may be
+     declared in a PROC, not at global scope... */
+  push_obstacks (&permanent_obstack, &permanent_obstack);
+  push_obstacks_nochange ();
+
+  if (pass == 2 && ! quasi_flag && *tasking_code_ptr != NULL_TREE)
+    {
+      /* check for value should be assigned is out of range */
+      if (TREE_INT_CST_LOW (*tasking_code_ptr) >
+	  TREE_INT_CST_LOW (TYPE_MAX_VALUE (chill_taskingcode_type_node)))
+	  error ("Tasking code %d out of range for `%s'.",
+		 TREE_INT_CST_LOW (*tasking_code_ptr),
+		 IDENTIFIER_POINTER (name));
+    }
+
+  decl = decl_temp1 (tasking_code_name, 
+		     chill_taskingcode_type_node, 1,
+		     quasi_flag ? NULL_TREE : *tasking_code_ptr, 
+		     0, 0);
+  /* prevent granting of this type */
+  DECL_SOURCE_LINE (decl) = 0;
+
+  /* Return to the ambient context.  */
+  pop_obstacks ();
+
+  if (pass == 2 && ! quasi_flag && *tasking_code_ptr != NULL_TREE)
+    *tasking_code_ptr = fold (build (PLUS_EXPR, chill_taskingcode_type_node,
+				     integer_one_node,
+				     *tasking_code_ptr));
+  return decl;
+}
+
+/*
+ * Transmute a process parameter list into an argument structure 
+ * TYPE_DECL for the start_process call to reference.  Create a 
+ * proc_type variable for later.  Returns the new struct type.
+ */
+tree
+make_process_struct (name, processparlist)
+     tree name, processparlist;
+{
+  tree temp;
+  tree a_parm;
+  tree field_decls = NULL_TREE;
+
+  if (name == NULL_TREE || TREE_CODE (name) == ERROR_MARK)
+    return error_mark_node;
+
+  if (processparlist == NULL_TREE)
+    return tree_cons (NULL_TREE, NULL_TREE, void_list_node);
+
+  if (TREE_CODE (processparlist) == ERROR_MARK)
+    return error_mark_node;
+
+  /* build list of field decls for build_chill_struct_type */
+  for (a_parm = processparlist; a_parm != NULL_TREE; 
+       a_parm = TREE_CHAIN (a_parm))
+    {
+      tree parnamelist = TREE_VALUE (a_parm);
+      tree purpose     = TREE_PURPOSE (a_parm);
+      tree mode        = TREE_VALUE (purpose);
+      tree parm_attr   = TREE_PURPOSE (purpose);
+      tree field;
+
+      /* build a FIELD_DECL node */
+      if (parm_attr != NULL_TREE)
+	{
+	  if (parm_attr == ridpointers[(int)RID_LOC])
+	    mode = build_chill_reference_type (mode);
+	  else if (parm_attr == ridpointers[(int)RID_IN])
+	    ;
+	  else if (pass == 1)
+	    {
+	      for (field = parnamelist; field != NULL_TREE;
+		   field = TREE_CHAIN (field))
+	        error ("invalid attribute for argument `%s' (only IN or LOC allowed).",
+		       IDENTIFIER_POINTER (TREE_VALUE (field)));
+	    }
+	}
+
+      field = grok_chill_fixedfields (parnamelist, mode, NULL_TREE);
+
+      /* chain the fields in reverse */
+      if (field_decls == NULL_TREE)
+	field_decls = field;
+      else
+	chainon (field_decls, field);
+    }
+
+  temp = build_chill_struct_type (field_decls);
+  return temp;
+}
+
+/* Build a function for a PROCESS  and define some
+   types for the process arguments.
+   After the PROCESS a wrapper function will be 
+   generated which gets the PROCESS arguments via a pointer
+   to a structure having the same layout as the arguments.
+   This wrapper function then will call the PROCESS.
+   The advantage in doing it this way is, that PROCESS
+   arguments may be displayed by gdb without any change
+   to gdb.
+*/
+tree
+build_process_header (plabel, paramlist)
+     tree plabel, paramlist;
+{
+  tree struct_ptr_type = NULL_TREE;
+  tree new_param_list = NULL_TREE;
+  tree struct_decl = NULL_TREE;
+  tree process_struct = NULL_TREE;
+  tree struct_debug_type = NULL_TREE;
+  tree code_decl;
+    
+  if (! global_bindings_p ())
+    {
+      error ("PROCESS may only be declared at module level");
+      return error_mark_node;
+    }
+
+  if (paramlist)
+    {
+      /* must make the structure OUTSIDE the parameter scope */
+      if (pass == 1)
+	{
+	  process_struct = make_process_struct (plabel, paramlist);
+	  struct_ptr_type = build_chill_pointer_type (process_struct);
+	}
+      else
+	{
+	  process_struct = NULL_TREE;
+	  struct_ptr_type = NULL_TREE;
+	}
+		          
+      struct_decl = push_modedef (get_struct_type_name (plabel),
+				  struct_ptr_type, -1);
+      DECL_SOURCE_LINE (struct_decl) = 0;
+      struct_debug_type = push_modedef (get_struct_debug_type_name (plabel),
+					process_struct, -1);
+      DECL_SOURCE_LINE (struct_debug_type) = 0;
+
+      if (pass == 2)
+        {
+          /* build a list of PARM_DECL's */
+          tree  wrk = paramlist;
+          tree  tmp, list = NULL_TREE;
+          
+          while (wrk != NULL_TREE)
+            {
+              tree wrk1 = TREE_VALUE (wrk);
+                
+              while (wrk1 != NULL_TREE)
+                {
+                  tmp = make_node (PARM_DECL);
+                  DECL_ASSEMBLER_NAME (tmp) = DECL_NAME (tmp) = TREE_VALUE (wrk1);
+                  if (list == NULL_TREE)
+                    new_param_list = list = tmp;
+                  else
+                    {
+                      TREE_CHAIN (list) = tmp;
+                      list = tmp;
+                    }
+                  wrk1 = TREE_CHAIN (wrk1);
+                }
+              wrk = TREE_CHAIN (wrk);
+            }
+        }
+      else
+        {
+          /* build a list of modes */
+          tree  wrk = paramlist;
+          
+          while (wrk != NULL_TREE)
+            {
+              tree wrk1 = TREE_VALUE (wrk);
+              
+              while (wrk1 != NULL_TREE)
+                {
+                  new_param_list = tree_cons (TREE_PURPOSE (TREE_PURPOSE (wrk)),
+                                              TREE_VALUE (TREE_PURPOSE (wrk)),
+                                              new_param_list);
+                  wrk1 = TREE_CHAIN (wrk1);
+                }
+              wrk = TREE_CHAIN (wrk);
+            }
+          new_param_list = nreverse (new_param_list);
+        }
+    }
+
+  /* declare the code variable outside the process */
+  code_decl = generate_tasking_code_variable (plabel, 
+					      &process_type, 0);
+
+  /* start the parameter scope */
+  push_chill_function_context ();
+
+  if (! start_chill_function (plabel, void_type_node, 
+			      new_param_list, NULL_TREE, NULL_TREE))
+    return error_mark_node;
+
+  current_module->procedure_seen = 1; 
+  CH_DECL_PROCESS (current_function_decl) = 1;
+  /* remember the code variable in the function decl */
+  DECL_TASKING_CODE_DECL (current_function_decl) = 
+    (struct lang_decl *)code_decl;
+  if (paramlist == NULL_TREE)
+      /* do it here, cause we don't have a wrapper */
+    add_taskstuff_to_list (code_decl, "_TT_Process", process_type,
+			   current_function_decl, NULL_TREE);
+
+  return perm_tree_cons (code_decl, struct_decl, NULL_TREE);
+}
+
+/* Generate a function which gets a pointer
+   to an argument block and call the corresponding
+   PROCESS
+*/
+void
+build_process_wrapper (plabel, processdata)
+    tree        plabel;
+    tree        processdata;
+{
+  tree  args = NULL_TREE;
+  tree  wrapper = NULL_TREE;
+  tree  parammode = TREE_VALUE (processdata);
+  tree  code_decl = TREE_PURPOSE (processdata);
+  tree  func = lookup_name (plabel);
+    
+  /* check the mode. If it is an ERROR_MARK there was an error
+     in build_process_header, if it is a NULL_TREE the process
+     don't have parameters, so we must not generate a wrapper */
+  if (parammode == NULL_TREE ||
+      TREE_CODE (parammode) == ERROR_MARK)
+    return;
+    
+  /* get the function name */
+  wrapper = get_process_wrapper_name (plabel);
+    
+  /* build the argument */
+  if (pass == 2)
+    {
+      /* build a PARM_DECL */
+      args = make_node (PARM_DECL);
+      DECL_ASSEMBLER_NAME (args) = DECL_NAME (args) = get_identifier ("x");
+    }
+  else
+    {
+      /* build a tree list with the mode */
+      args = tree_cons (NULL_TREE,
+                        TREE_TYPE (parammode),
+                        NULL_TREE);
+    }
+    
+  /* start the function */
+  push_chill_function_context ();
+    
+  if (! start_chill_function (wrapper, void_type_node,
+                              args, NULL_TREE, NULL_TREE))
+    return;
+
+  /* to avoid granting */
+  DECL_SOURCE_LINE (current_function_decl) = 0;
+
+  if (! ignoring)
+    {
+      /* make the call to the PROCESS */
+      tree      wrk;
+      tree      x = lookup_name (get_identifier ("x"));
+      /* no need to check this pointer to be NULL */
+      tree      indref = build_chill_indirect_ref (x, NULL_TREE, 0);
+        
+      args = NULL_TREE;
+      wrk = TYPE_FIELDS (TREE_TYPE (TREE_TYPE (x)));
+      while (wrk != NULL_TREE)
+        {
+          args = tree_cons (NULL_TREE,
+                            build_component_ref (indref, DECL_NAME (wrk)),
+                            args);
+          wrk = TREE_CHAIN (wrk);
+        }
+      CH_DECL_PROCESS (func) = 0;
+      expand_expr_stmt (
+        build_chill_function_call (func, nreverse (args)));
+      CH_DECL_PROCESS (func) = 1;
+    }
+
+  add_taskstuff_to_list (code_decl, "_TT_Process", process_type,
+                         func, current_function_decl);
+    
+  /* finish the function */
+  finish_chill_function ();
+  pop_chill_function_context (); 
+}
+
+/* Generate errors for INOUT, OUT parameters.
+
+   "Only if LOC is specified may the mode have the non-value
+    property"
+ */
+
+void
+validate_process_parameters (parms)
+     tree parms;
+{
+}
+
+/*
+ * build the tree for a start process action.  Loop through the
+ * actual parameters, making a constructor list, which we use to
+ * initialize the argument structure.  NAME is the process' name.
+ * COPYNUM is its copy number, whatever that is.  EXPRLIST is the
+ * list of actual parameters passed by the start call.  They must
+ * match. EXPRLIST must still be in reverse order;  we'll reverse it here.
+ *
+ * Note: the OPTSET name is not now used - it's here for 
+ * possible future support for the optional 'SET instance-var'
+ * clause.
+ */
+void
+build_start_process (process_name, copynum,
+		     exprlist, optset)
+     tree process_name, copynum, exprlist, optset;
+{
+  tree process_decl, struct_type_node;
+  tree result;
+  tree valtail, typetail;
+  tree tuple, actuallist = NULL_TREE;
+  tree typelist;
+  int  parmno = 2;
+  tree args;
+  tree filename, linenumber;
+  
+  if (exprlist != NULL_TREE && TREE_CODE (exprlist) == ERROR_MARK)
+    process_decl = NULL_TREE;
+  else if (! ignoring)
+    {
+      process_decl = lookup_name (process_name);
+      if (process_decl == NULL_TREE)
+	error ("process name %s never declared",
+	       IDENTIFIER_POINTER (process_name));
+      else if (TREE_CODE (process_decl) != FUNCTION_DECL
+	  || ! CH_DECL_PROCESS (process_decl))
+	{
+	  error ("You may only START a process, not a proc");
+	  process_decl = NULL_TREE;
+	}
+      else if (DECL_EXTERNAL (process_decl))
+        {
+          args = TYPE_ARG_TYPES (TREE_TYPE (process_decl));
+          if (TREE_VALUE (args) != void_type_node)
+              struct_type_node = TREE_TYPE (TREE_VALUE (args));
+          else
+              struct_type_node = NULL_TREE;
+        }
+      else
+        {
+          tree  debug_type = lookup_name (
+                               get_struct_debug_type_name (DECL_NAME (process_decl)));
+
+          if (debug_type == NULL_TREE)
+              /* no debug type, no arguments */
+              struct_type_node = NULL_TREE;
+          else
+              struct_type_node = TREE_TYPE (debug_type);
+        }
+    }
+
+  /* begin a new name scope */
+  pushlevel (1);
+  clear_last_expr ();
+  push_momentary ();
+  if (pass == 2)
+    expand_start_bindings (0);
+
+  if (! ignoring && process_decl != NULL_TREE)
+    {
+      if (optset == NULL_TREE) ;
+      else if (!CH_REFERABLE (optset))
+	{
+	  error ("SET expression not a location.");
+	  optset = NULL_TREE;
+	}
+      else if (!CH_IS_INSTANCE_MODE (TREE_TYPE (optset)))
+	{
+	  error ("SET location must be INSTANCE mode");
+	  optset = NULL_TREE;
+	}
+      if (optset)
+	optset = force_addr_of (optset);
+      else
+	optset = convert (ptr_type_node, integer_zero_node);
+
+      if (struct_type_node != NULL_TREE)
+	{
+	  typelist = TYPE_FIELDS (struct_type_node);
+
+	  for (valtail = nreverse (exprlist), typetail = typelist;
+	       valtail != NULL_TREE && typetail != NULL_TREE;  parmno++,
+	       valtail = TREE_CHAIN (valtail), typetail = TREE_CHAIN (typetail))
+	    {
+	      register tree actual  = valtail  ? TREE_VALUE (valtail)  : 0;
+	      register tree type    = typetail ? TREE_TYPE (typetail) : 0;
+	      char place[30];
+	      sprintf (place, "signal field %d", parmno);
+	      actual = chill_convert_for_assignment (type, actual, place);
+	      actuallist = tree_cons (NULL_TREE, actual, 
+				      actuallist);
+	    }
+
+	  tuple = build_nt (CONSTRUCTOR, NULL_TREE, 
+			    nreverse (actuallist));
+	}
+      else
+	{
+	  valtail = NULL_TREE;
+	  typetail = NULL_TREE;
+	}
+  
+      if (valtail != 0 && TREE_VALUE (valtail) != void_type_node)
+	{
+	  char *errstr = "too many arguments to process";
+	  if (process_name)
+	    error ("%s `%s'", errstr, IDENTIFIER_POINTER (process_name));
+	  else
+	    error (errstr);
+	}
+      else if (typetail != 0 && TREE_VALUE (typetail) != void_type_node)
+	{
+	  char *errstr = "too few arguments to process";
+	  if (process_name)
+	    error ("%s `%s'", errstr, IDENTIFIER_POINTER (process_name));
+	  else
+	    error (errstr);
+	}
+      else
+      {
+	tree process_decl = lookup_name (process_name);
+	tree process_type = (tree)DECL_TASKING_CODE_DECL (process_decl);
+	tree struct_size, struct_pointer;
+	
+	if (struct_type_node != NULL_TREE)
+	  {
+	    result = 
+	      decl_temp1 (get_unique_identifier ("START_ARG"),
+			  struct_type_node, 0, tuple, 0, 0);
+	    /* prevent granting of this type */
+	    DECL_SOURCE_LINE (result) = 0;
+
+	    mark_addressable (result);
+	    struct_pointer
+	      = build1 (ADDR_EXPR,
+			build_chill_pointer_type (struct_type_node),
+			result);
+	    struct_size = size_in_bytes (struct_type_node);
+	  }
+	else
+	  {
+	    struct_size = integer_zero_node;
+	    struct_pointer = null_pointer_node;
+	  }
+
+	filename = force_addr_of (get_chill_filename ());
+	linenumber = get_chill_linenumber ();
+	
+	expand_expr_stmt (
+          build_chill_function_call (lookup_name (get_identifier ("__start_process")),
+	    tree_cons (NULL_TREE, process_type,
+              tree_cons (NULL_TREE, convert (integer_type_node, copynum),
+		tree_cons (NULL_TREE, struct_size,
+		  tree_cons (NULL_TREE, struct_pointer,
+		    tree_cons (NULL_TREE, optset,
+		      tree_cons (NULL_TREE, filename,
+		        build_tree_list (NULL_TREE, linenumber)))))))));
+      }
+    }
+  /* end of scope */
+
+  if (pass == 2)
+    expand_end_bindings (getdecls (), kept_level_p (), 0);
+  poplevel (kept_level_p (), 0, 0);
+  pop_momentary ();
+}
+
+/*
+ * A CHILL SET which represents all of the possible tasking
+ * elements.
+ */
+static tree
+build_tasking_enum ()
+{
+  tree result, decl1;
+  tree enum1;
+  tree list = NULL_TREE;
+  tree value = integer_zero_node;
+
+  enum1  = start_enum (NULL_TREE);
+  result = build_enumerator (get_identifier ("_TT_UNUSED"),
+			     value);
+  list = chainon (result, list);
+  value = fold (build (PLUS_EXPR, integer_type_node,
+		       value, integer_one_node));
+		      
+  result = build_enumerator (get_identifier ("_TT_Process"),
+			     value);
+  list = chainon (result, list);
+  value = fold (build (PLUS_EXPR, integer_type_node,
+		       value, integer_one_node));
+		      
+  result = build_enumerator (get_identifier ("_TT_Signal"),
+			     value);
+  list = chainon (result, list);
+  value = fold (build (PLUS_EXPR, integer_type_node,
+		       value, integer_one_node));
+
+  result = build_enumerator (get_identifier ("_TT_Buffer"),
+			     value);
+  list = chainon (result, list);
+  value = fold (build (PLUS_EXPR, integer_type_node,
+		       value, integer_one_node));
+  
+  result = build_enumerator (get_identifier ("_TT_Event"),
+			     value);
+  list = chainon (result, list);
+  value = fold (build (PLUS_EXPR, integer_type_node,
+		       value, integer_one_node));
+
+  result = build_enumerator (get_identifier ("_TT_Synonym"),
+			     value);
+  list = chainon (result, list);
+  value = fold (build (PLUS_EXPR, integer_type_node,
+		       value, integer_one_node));
+  
+  result = build_enumerator (get_identifier ("_TT_Exception"),
+			     value);
+  list = chainon (result, list);  
+  value = fold (build (PLUS_EXPR, integer_type_node,
+		       value, integer_one_node));
+
+  result = finish_enum (enum1, list); 
+
+  decl1 = build_decl (TYPE_DECL, 
+		      get_identifier ("__tmp_TaskingEnum"),
+		      result);
+  pushdecl (decl1);
+  satisfy_decl (decl1, 0);
+  return decl1;
+}
+
+tree
+build_tasking_struct ()
+{  
+  tree listbase, decl1, decl2, result;
+  tree enum_type = TREE_TYPE (build_tasking_enum ());
+  /* We temporarily reset the maximum_field_alignment to zero so the
+     compiler's init data structures can be compatible with the
+     run-time system, even when we're compiling with -fpack. */
+  extern int maximum_field_alignment;
+  int save_maximum_field_alignment = maximum_field_alignment;
+  maximum_field_alignment = 0;
+
+  decl1 = build_decl (FIELD_DECL, get_identifier ("TaskName"),
+		      build_chill_pointer_type (char_type_node));
+  DECL_INITIAL (decl1) = NULL_TREE;
+  listbase = decl1;
+
+  decl2 = build_decl (FIELD_DECL, get_identifier ("TaskValue"),
+		      build_chill_pointer_type (chill_taskingcode_type_node));
+  TREE_CHAIN (decl1) = decl2;
+  DECL_INITIAL (decl2) = NULL_TREE;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL, get_identifier ("TaskValueDefined"),
+                      integer_type_node);
+  TREE_CHAIN (decl1) = decl2;
+  DECL_INITIAL (decl2) = NULL_TREE;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL, get_identifier ("TaskEntry"),
+                      build_chill_pointer_type (void_ftype_void));
+  TREE_CHAIN (decl1) = decl2;
+  DECL_INITIAL (decl2) = NULL_TREE;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL, get_identifier ("TaskType"),
+		      enum_type);
+  TREE_CHAIN (decl1) = decl2;
+  DECL_INITIAL (decl2) = NULL_TREE;
+  decl1 = decl2;
+
+  TREE_CHAIN (decl2) = NULL_TREE;
+  result = build_chill_struct_type (listbase);
+  satisfy_decl (result, 0);
+  maximum_field_alignment = save_maximum_field_alignment;
+  return result;
+}
+
+/*
+ * build data structures describing each task/signal, etc.
+ * in current module.
+ */
+void
+tasking_setup ()
+{
+  tree tasknode;
+  tree struct_type;
+
+  if (pass == 1)
+    return;
+
+  struct_type = TREE_TYPE (lookup_name (
+		  get_identifier ("__tmp_TaskingStruct")));
+
+  for (tasknode = tasking_list; tasknode != NULL_TREE; 
+       tasknode = TREE_CHAIN (tasknode))
+    {
+      /* This is the tasking_code_variable's decl */
+      tree stuffnumber = TASK_INFO_STUFF_NUM (tasknode);
+      tree code_decl   = TASK_INFO_CODE_DECL (tasknode);
+      tree proc_decl   = TASK_INFO_PDECL (tasknode);
+      tree entry       = TASK_INFO_ENTRY (tasknode);
+      tree name = DECL_NAME (proc_decl);
+      char *init_struct = (char *) alloca (IDENTIFIER_LENGTH(name) + 20);
+      /* take care of zero termination */
+      tree task_name;
+      /* these are the fields of the struct, in declaration order */
+      tree init_flag = (stuffnumber == NULL_TREE) ? 
+	integer_zero_node : integer_one_node;
+      tree type = DECL_INITIAL (TASK_INFO_STUFF_TYPE (tasknode));
+      tree int_addr;
+      tree entry_point;
+      tree name_ptr;
+      tree decl;
+      tree struct_id;
+      tree initializer;
+      
+      if (TREE_CODE (proc_decl) == FUNCTION_DECL
+	  && CH_DECL_PROCESS (proc_decl) 
+	  && ! DECL_EXTERNAL (proc_decl))
+        {
+          if (entry == NULL_TREE)
+	    entry = proc_decl;
+	  mark_addressable (entry);
+	  entry_point = build1 (ADDR_EXPR, 
+				build_chill_pointer_type (void_ftype_void),
+				entry);
+        }
+      else
+	entry_point = build1 (NOP_EXPR, 
+                        build_chill_pointer_type (void_ftype_void), 
+                          null_pointer_node);
+
+      /* take care of zero termination */
+      task_name = 
+	build_chill_string (IDENTIFIER_LENGTH (name) + 1,
+			    IDENTIFIER_POINTER (name));
+
+      mark_addressable (code_decl);
+      int_addr = build1 (ADDR_EXPR,
+			 build_chill_pointer_type (chill_integer_type_node),
+			 code_decl);
+
+      mark_addressable (task_name);
+      name_ptr = build1 (ADDR_EXPR,
+		   build_chill_pointer_type (char_type_node), 
+		     task_name);
+
+      sprintf (init_struct, "__tmp_%s_struct", 
+	       IDENTIFIER_POINTER (name));
+
+      struct_id = get_identifier (init_struct);
+      initializer = build (CONSTRUCTOR, struct_type, NULL_TREE,
+		      tree_cons (NULL_TREE, name_ptr,
+                        tree_cons (NULL_TREE, int_addr,
+                          tree_cons (NULL_TREE, init_flag,
+                            tree_cons (NULL_TREE, entry_point,
+                              tree_cons (NULL_TREE, type, NULL_TREE))))));
+      TREE_CONSTANT (initializer) = 1;
+      decl = decl_temp1 (struct_id, struct_type, 1, initializer, 0, 0);
+      /* prevent granting of this type */
+      DECL_SOURCE_LINE (decl) = 0;
+
+      /* pass the decl to tasking_registry() in the symbol table */
+      IDENTIFIER_LOCAL_VALUE (struct_id) = decl;
+    }
+}
+
+
+/*
+ * Generate code to register the tasking-related stuff
+ * with the runtime.  Only in pass 2.
+ */
+void
+tasking_registry ()
+{
+  tree tasknode, fn_decl;
+
+  if (pass == 1)
+    return;
+
+  fn_decl = lookup_name (get_identifier ("__register_tasking"));
+
+  for (tasknode = tasking_list; tasknode != NULL_TREE; 
+       tasknode = TREE_CHAIN (tasknode))
+    {
+      tree proc_decl = TASK_INFO_PDECL (tasknode);
+      tree name = DECL_NAME (proc_decl);
+      tree arg_decl;
+      char *init_struct = (char *) alloca (IDENTIFIER_LENGTH (name) + 20);
+
+      sprintf (init_struct, "__tmp_%s_struct", 
+	       IDENTIFIER_POINTER (name));
+      arg_decl = lookup_name (get_identifier (init_struct));
+
+      expand_expr_stmt (
+        build_chill_function_call (fn_decl,
+	  build_tree_list (NULL_TREE, force_addr_of (arg_decl))));
+    }
+}
+
+/*
+ * Put a tasking entity (a PROCESS, or SIGNAL) onto
+ * the list for tasking_setup (). CODE_DECL is the integer code
+ * variable's DECL, which describes the shadow integer which 
+ * accompanies each tasking entity.  STUFFTYPE is a string
+ * representing the sort of tasking entity we have here (i.e. 
+ * process, signal, etc.).  STUFFNUMBER is an enumeration
+ * value saying the same thing.  PROC_DECL is the declaration of
+ * the entity.  It's a FUNCTION_DECL if the entity is a PROCESS, it's
+ * a TYPE_DECL if the entity is a SIGNAL.
+ */
+void
+add_taskstuff_to_list (code_decl, stufftype, stuffnumber,
+		       proc_decl, entry)
+     tree code_decl;
+     char *stufftype;
+     tree stuffnumber, proc_decl, entry;
+{
+  if (pass == 1)
+    /* tell chill_finish_compile that there's
+       task-level code to be processed. */
+    tasking_list = integer_one_node;
+
+  /* do only in pass 2 so we know in chill_finish_compile whether
+     to generate a constructor function, and to avoid double the
+     correct number of entries. */
+  else /* pass == 2 */
+    {
+      tree task_node = make_tree_vec (5);
+      TASK_INFO_PDECL (task_node) = proc_decl;
+      TASK_INFO_ENTRY (task_node) = entry;
+      TASK_INFO_CODE_DECL (task_node) = code_decl;
+      TASK_INFO_STUFF_NUM (task_node) = stuffnumber;
+      TASK_INFO_STUFF_TYPE (task_node)
+	= lookup_name (get_identifier (stufftype));
+      TREE_CHAIN (task_node) = tasking_list;
+      tasking_list = task_node;
+    }
+}
+
+/*
+ * These next routines are called out of build_generalized_call
+ */
+tree
+build_copy_number (instance_expr)
+     tree instance_expr;
+{
+  tree result;
+
+  if (instance_expr == NULL_TREE 
+      || TREE_CODE (instance_expr) == ERROR_MARK)
+    return error_mark_node;
+  if (! CH_IS_INSTANCE_MODE (TREE_TYPE (instance_expr)))
+    {
+      error ("COPY_NUMBER argument must be INSTANCE expression");
+      return error_mark_node;
+    }
+  result = build_component_ref (instance_expr,
+				get_identifier (INS_COPY));
+  CH_DERIVED_FLAG (result) = 1;
+  return result;
+}
+
+
+tree
+build_gen_code (decl)
+     tree decl;
+{
+  tree result;
+
+  if (decl == NULL_TREE || TREE_CODE (decl) == ERROR_MARK)
+    return error_mark_node;
+
+  if ((TREE_CODE (decl) == FUNCTION_DECL && CH_DECL_PROCESS (decl))
+      || (TREE_CODE (decl) == TYPE_DECL && CH_DECL_SIGNAL (decl)))
+    result = (tree)(DECL_TASKING_CODE_DECL (decl));
+  else
+    {
+      error ("GEN_CODE argument must be a process or signal name.");
+      return error_mark_node;
+    }
+  CH_DERIVED_FLAG (result) = 1;
+  return (result);
+}
+
+
+tree
+build_gen_inst (process, copyn)
+     tree process, copyn;
+{
+  tree ptype;
+  tree result;
+
+  if (copyn == NULL_TREE || TREE_CODE (copyn) == ERROR_MARK)
+    return error_mark_node;
+  if (process == NULL_TREE || TREE_CODE (process) == ERROR_MARK)
+    return error_mark_node;
+
+  if (TREE_CODE (TREE_TYPE (copyn)) != INTEGER_TYPE)
+    {
+      error ("GEN_INST parameter 2 must be an integer mode");
+      copyn = integer_zero_node;
+    }
+
+  copyn = check_range (copyn, copyn, 
+		       TYPE_MIN_VALUE (chill_taskingcode_type_node),
+		       TYPE_MAX_VALUE (chill_taskingcode_type_node));
+
+  if (TREE_CODE (process) == FUNCTION_DECL
+      && CH_DECL_PROCESS (process))
+    ptype = (tree)DECL_TASKING_CODE_DECL (process);
+  else if (TREE_TYPE (process) != NULL_TREE
+	   && TREE_CODE (TREE_TYPE (process)) == INTEGER_TYPE)
+    {
+      process = check_range (process, process, 
+			     TYPE_MIN_VALUE (chill_taskingcode_type_node),
+			     TYPE_MAX_VALUE (chill_taskingcode_type_node));
+      ptype = convert (chill_taskingcode_type_node, process);
+    }
+  else
+    {
+      error ("GEN_INST parameter 1 must be a PROCESS or an integer expression");
+      return (error_mark_node);
+    }
+  
+  result = convert (instance_type_node,
+	     build_nt (CONSTRUCTOR, NULL_TREE,
+	       tree_cons (NULL_TREE, ptype,
+	         tree_cons (NULL_TREE, 
+	           convert (chill_taskingcode_type_node, copyn), NULL_TREE))));
+  CH_DERIVED_FLAG (result) = 1;
+  return result;
+}
+
+
+tree
+build_gen_ptype (process_decl)
+     tree process_decl;
+{
+  tree result;
+
+  if (process_decl == NULL_TREE || TREE_CODE (process_decl) == ERROR_MARK)
+    return error_mark_node;
+
+  if (TREE_CODE (process_decl) != FUNCTION_DECL
+      || ! CH_DECL_PROCESS (process_decl))
+    {
+      error_with_decl (process_decl, "%s is not a declared process");
+      return error_mark_node;
+    }
+
+  result = (tree)DECL_TASKING_CODE_DECL (process_decl);
+  CH_DERIVED_FLAG (result) = 1;
+  return result;
+}
+
+
+tree
+build_proc_type (instance_expr)
+     tree instance_expr;
+{
+  tree result;
+
+  if (instance_expr == NULL_TREE || TREE_CODE (instance_expr) == ERROR_MARK)
+    return error_mark_node;
+
+  if (! CH_IS_INSTANCE_MODE (TREE_TYPE (instance_expr)))
+    {
+      error ("PROC_TYPE argument must be INSTANCE expression");
+      return error_mark_node;
+    }
+  result = build_component_ref (instance_expr,
+				get_identifier (INS_PTYPE));
+  CH_DERIVED_FLAG (result) = 1;
+  return result;
+}
+
+tree
+build_queue_length (buf_ev)
+     tree buf_ev;
+{
+  if (buf_ev == NULL_TREE || TREE_CODE (buf_ev) == ERROR_MARK)
+    return error_mark_node;
+  if (TREE_TYPE (buf_ev) == NULL_TREE ||
+      TREE_CODE (TREE_TYPE (buf_ev)) == ERROR_MARK)
+    return error_mark_node;
+
+  if (CH_IS_BUFFER_MODE (TREE_TYPE (buf_ev)) ||
+      CH_IS_EVENT_MODE (TREE_TYPE (buf_ev)))
+    {
+      char *field_name;
+      tree  arg1, arg2;
+
+      if (CH_IS_EVENT_MODE (TREE_TYPE (buf_ev)))
+	{
+	  field_name = "__event_data";
+	  arg2 = integer_one_node;
+	}
+      else
+	{
+	  field_name = "__buffer_data";
+	  arg2 = integer_zero_node;
+	}
+      arg1 = build_component_ref (buf_ev, get_identifier (field_name));
+      return build_chill_function_call (
+                lookup_name (get_identifier ("__queue_length")),
+                   tree_cons (NULL_TREE, arg1,
+                      tree_cons (NULL_TREE, arg2, NULL_TREE)));
+    }
+
+  error ("QUEUE_LENGTH argument must be a BUFFER/EVENT location.");
+  return error_mark_node;
+}
+
+tree
+build_signal_struct_type (signame, sigmodelist, optsigdest)
+     tree signame, sigmodelist, optsigdest;
+{
+  tree decl, temp;
+
+  if (pass == 1)
+    {
+      int  fldcnt = 0;
+      tree mode, field_decls = NULL_TREE;
+
+      for (mode = sigmodelist; mode != NULL_TREE; mode = TREE_CHAIN (mode))
+	{ 
+	  tree field;
+	  char fldname[20];
+      
+	  if (TREE_VALUE (mode) == NULL_TREE)
+	    continue;
+	  sprintf (fldname, "fld%03d", fldcnt++);
+	  field = build_decl (FIELD_DECL,
+			      get_identifier (fldname),
+			      TREE_VALUE (mode));
+	  if (field_decls == NULL_TREE)
+	    field_decls = field;
+	  else
+	    chainon (field_decls, field);
+	}
+      if (field_decls == NULL_TREE)
+	field_decls = build_decl (FIELD_DECL,
+				  get_identifier ("__tmp_empty"),
+				  boolean_type_node); 
+      temp = build_chill_struct_type (field_decls);
+
+      /* save the destination process name of the signal */
+      IDENTIFIER_SIGNAL_DEST (signame) = optsigdest;
+      IDENTIFIER_SIGNAL_DATA (signame) = fldcnt;
+    }
+  else
+    {
+      /* optsigset is only valid in pass 2, so we have to save it now */
+      IDENTIFIER_SIGNAL_DEST (signame) = optsigdest;
+      temp = NULL_TREE; /* Actually, don't care. */
+    }
+  
+  decl = push_modedef (signame, temp, -1);
+  if (decl != NULL_TREE)
+    CH_DECL_SIGNAL (decl) = 1;
+  return decl;
+}
+
+/*
+ * An instance type is a unique process identifier in the CHILL
+ * tasking arena.  It consists of a process type and a copy number.
+ */
+void
+build_instance_type ()
+{
+  tree decl1, decl2, tdecl;
+
+  decl1 = build_decl (FIELD_DECL, get_identifier (INS_PTYPE), 
+		      chill_taskingcode_type_node);
+
+  TREE_CHAIN (decl1) = decl2 =
+    build_decl (FIELD_DECL, get_identifier (INS_COPY), 
+		chill_taskingcode_type_node);
+  TREE_CHAIN (decl2) = NULL_TREE;
+
+  instance_type_node = build_chill_struct_type (decl1);
+  tdecl = build_decl (TYPE_DECL, ridpointers[(int) RID_INSTANCE],
+		      instance_type_node);
+  TYPE_NAME (instance_type_node) = tdecl;
+  CH_NOVELTY (instance_type_node) = tdecl;
+  DECL_SOURCE_LINE (tdecl) = 0;
+  pushdecl (tdecl);
+
+  pointer_to_instance = build_chill_pointer_type (instance_type_node);
+}
+
+#if 0
+ *
+ * The tasking message descriptor looks like this C structure:
+ *
+ * typedef struct
+ *   {
+ *     short *sc;                 /* ptr to code integer */
+ *     int    data_len;           /* length of signal/buffer data msg */
+ *     void  *data;               /* ptr to signal/buffer data */
+ *   } SignalDescr;
+ *
+ *
+#endif
+
+void
+build_tasking_message_type ()
+{
+  tree type_name;
+  tree temp;
+  /* We temporarily reset maximum_field_alignment to deal with
+     the runtime system. */
+  extern int maximum_field_alignment;
+  int save_maximum_field_alignment = maximum_field_alignment;
+  tree field1, field2, field3;
+
+  maximum_field_alignment = 0;
+  field1 = build_decl (FIELD_DECL, 
+		       get_identifier ("_SD_code_ptr"),
+		       build_pointer_type (chill_integer_type_node));
+  field2 = build_decl (FIELD_DECL,
+		       get_identifier ("_SD_data_len"),
+		       integer_type_node);
+  field3 = build_decl (FIELD_DECL,
+		       get_identifier ("_SD_data_ptr"),
+		       ptr_type_node);
+  TREE_CHAIN (field1) = field2;
+  TREE_CHAIN (field2) = field3;
+  temp = build_chill_struct_type (field1);
+  
+  type_name = get_identifier ("__tmp_SD_struct");
+  tasking_message_type = build_decl (TYPE_DECL, type_name, temp);
+
+  /* This won't get seen in pass 2, so lay it out now.  */
+  layout_chill_struct_type (temp);
+  pushdecl (tasking_message_type);
+  maximum_field_alignment = save_maximum_field_alignment;
+}
+
+tree
+build_signal_descriptor (sigdef, exprlist)
+     tree sigdef, exprlist;
+{
+  tree fieldlist, typetail, valtail;
+  tree actuallist = NULL_TREE;
+  tree signame = DECL_NAME (sigdef);
+  tree dataptr, datalen;
+  int  parmno = 1;
+
+  if (sigdef == NULL_TREE
+      || TREE_CODE (sigdef) == ERROR_MARK)
+    return error_mark_node;
+
+  if (exprlist != NULL_TREE
+      && TREE_CODE (exprlist) == ERROR_MARK)
+    return error_mark_node;
+
+  if (TREE_CODE (sigdef) != TYPE_DECL
+      || ! CH_DECL_SIGNAL (sigdef))
+    {
+      error ("SEND requires a SIGNAL; %s is not a SIGNAL name", 
+	     signame);
+      return error_mark_node;
+    }
+  if (CH_TYPE_NONVALUE_P (TREE_TYPE (sigdef)))
+    return error_mark_node;
+
+  fieldlist = TYPE_FIELDS (TREE_TYPE (sigdef));
+  if (IDENTIFIER_SIGNAL_DATA (signame) == 0)
+    fieldlist = TREE_CHAIN (fieldlist);
+
+  for (valtail = exprlist, typetail = fieldlist;
+       valtail != NULL_TREE && typetail != NULL_TREE;  
+       parmno++, valtail = TREE_CHAIN (valtail),
+       typetail = TREE_CHAIN (typetail))
+    {
+      register tree actual  = valtail  ? TREE_VALUE (valtail) : 0;
+      register tree type    = typetail ? TREE_TYPE (typetail) : 0;
+      char place[30];
+      sprintf (place, "signal field %d", parmno);
+      actual = chill_convert_for_assignment (type, actual, place);
+      actuallist = tree_cons (NULL_TREE,  actual, actuallist);
+    }
+  if (valtail != 0 && TREE_VALUE (valtail) != void_type_node)
+    {
+      error ("too many values for SIGNAL `%s'",
+	     IDENTIFIER_POINTER (signame));
+      return error_mark_node;
+    }
+  else if (typetail != 0 && TREE_VALUE (typetail) != void_type_node)
+    {
+      error ("too few values for SIGNAL `%s'",
+	   IDENTIFIER_POINTER (signame));
+      return error_mark_node;
+    }
+
+  {
+    /* build signal data structure */
+    tree sigdataname = get_unique_identifier (
+                         IDENTIFIER_POINTER (signame));
+    if (exprlist == NULL_TREE)
+      {
+	dataptr = null_pointer_node;
+	datalen = integer_zero_node;
+      }
+    else
+      {
+	tree tuple = build_nt (CONSTRUCTOR,
+		       NULL_TREE, nreverse (actuallist));
+	tree decl = decl_temp1 (sigdataname, TREE_TYPE (sigdef), 
+			   0, tuple, 0, 0);
+	/* prevent granting of this type */
+	DECL_SOURCE_LINE (decl) = 0;
+
+	dataptr = force_addr_of (decl);
+	datalen = size_in_bytes (TREE_TYPE (decl));
+      }
+    
+    /* build descriptor pointing to signal data */
+    {
+      tree decl, tuple;
+      tree tasking_message_var = get_unique_identifier (
+                                   IDENTIFIER_POINTER (signame));
+
+      tree tasking_code = 
+	(tree)DECL_TASKING_CODE_DECL (lookup_name (signame));
+
+      mark_addressable (tasking_code);
+      tuple = build_nt (CONSTRUCTOR, NULL_TREE,
+		tree_cons (NULL_TREE, 
+		  build1 (ADDR_EXPR, 
+		    build_chill_pointer_type (chill_integer_type_node), 
+			  tasking_code),
+		      tree_cons (NULL_TREE, datalen,
+		        tree_cons (NULL_TREE, dataptr, NULL_TREE))));
+			      
+      decl = decl_temp1 (tasking_message_var,
+			 TREE_TYPE (tasking_message_type), 0,
+			 tuple, 0, 0);
+      /* prevent granting of this type */
+      DECL_SOURCE_LINE (decl) = 0;
+
+      tuple = force_addr_of (decl);
+      return tuple;
+    }
+  }
+}
+
+void
+expand_send_signal (sigmsgbuffer, optroutinginfo, optsendto,
+		   optpriority, signame)
+     tree sigmsgbuffer;
+     tree optroutinginfo;
+     tree optsendto;
+     tree optpriority;
+     tree signame;
+{
+  tree routing_size, routing_addr;
+  tree filename, linenumber;
+  tree sigdest = IDENTIFIER_SIGNAL_DEST (signame);
+
+  /* check the presence of priority */
+  if (optpriority == NULL_TREE)
+    {
+      if (send_signal_prio == NULL_TREE)
+	{
+	  /* issue a warning in case of -Wall */
+	  if (extra_warnings)
+	    {
+	      warning ("Signal sent without priority");
+	      warning (" and no default priority was set.");
+	      warning (" PRIORITY defaulted to 0");
+	    }
+	  optpriority = integer_zero_node;
+	}
+      else
+	optpriority = send_signal_prio;
+    }
+
+  /* check the presence of a destination.
+     optdest either may be an instance location
+     or a process declaration */
+  if (optsendto == NULL_TREE)
+    {
+      if (sigdest == NULL_TREE)
+        {
+	  error ("SEND without a destination instance");
+	  error (" and no destination process specified");
+	  error (" for the signal");
+	  optsendto = convert (instance_type_node,
+			       null_pointer_node);
+        }
+      else
+        {
+	  /* build an instance [sigdest; -1] */
+	  tree process_name = DECL_NAME (sigdest);
+	  tree copy_number = fold (build (MINUS_EXPR, integer_type_node,
+					  integer_zero_node,
+					  integer_one_node));
+	  tree tasking_code = (tree)DECL_TASKING_CODE_DECL (
+                                lookup_name (process_name));
+
+	  optsendto = build (CONSTRUCTOR, instance_type_node, NULL_TREE,
+                        tree_cons (NULL_TREE, tasking_code,
+                          tree_cons (NULL_TREE, copy_number, NULL_TREE)));
+	  /* as our system doesn't allow that and Z.200 specifies it,
+	     we issue a warning */
+	  warning ("SEND to ANY copy of process `%s'.", IDENTIFIER_POINTER (process_name));
+        }
+    }
+  else if (! CH_IS_INSTANCE_MODE (TREE_TYPE (optsendto)))
+    {
+      error ("SEND TO must be an INSTANCE mode");
+      optsendto = convert (instance_type_node, null_pointer_node);
+    }
+  else
+    optsendto = check_non_null (convert (instance_type_node, optsendto));
+
+  /* check the routing stuff */
+  if (optroutinginfo != NULL_TREE)
+    {
+      tree routing_name;
+      tree decl;
+
+      if (TREE_TYPE (optroutinginfo) == NULL_TREE)
+	{
+	  error ("SEND WITH must have a mode");
+	  optroutinginfo = integer_zero_node;
+	}
+      routing_name = get_unique_identifier ("RI");
+      decl = decl_temp1 (routing_name,
+			 TREE_TYPE (optroutinginfo), 0,
+			 optroutinginfo, 0, 0);
+      /* prevent granting of this type */
+      DECL_SOURCE_LINE (decl) = 0;
+
+      routing_addr = force_addr_of (decl);
+      routing_size = size_in_bytes (TREE_TYPE (decl));
+    }
+  else
+    {
+      routing_size = integer_zero_node;
+      routing_addr = null_pointer_node;
+    }
+  /* get filename and linenumber */
+  filename = force_addr_of (get_chill_filename ());
+  linenumber = get_chill_linenumber ();
+  
+  /* Now (at last!) we can call the runtime */
+  expand_expr_stmt (
+    build_chill_function_call (lookup_name (get_identifier ("__send_signal")),
+      tree_cons (NULL_TREE, sigmsgbuffer,
+        tree_cons (NULL_TREE, optsendto,
+	  tree_cons (NULL_TREE, optpriority,
+	    tree_cons (NULL_TREE, routing_size,
+	      tree_cons (NULL_TREE, routing_addr,
+                tree_cons (NULL_TREE, filename,
+		  tree_cons (NULL_TREE, linenumber, NULL_TREE)))))))));
+}
+
+#if 0
+ * The following code builds a RECEIVE CASE action, which actually
+ * has 2 different functionalities:
+ *
+ * 1) RECEIVE signal CASE action
+ *   which looks like this:
+ *
+ *    SIGNAL advance;
+ *    SIGNAL terminate = (CHAR);
+ *    SIGNAL sig1 = (CHAR);
+ *
+ *    DCL user, system INSTANCE;
+ *    DCL count INT, char_code CHAR;
+ *    DCL instance_loc INSTANCE;
+ *
+ *    workloop:
+ *      RECEIVE CASE SET instance_loc;
+ *        (advance): 
+ *           count + := 1;
+ *        (terminate IN char_code):
+ *           SEND sig1(char_code) TO system;
+ *           EXIT workloop; 
+ *      ELSE 
+ *        STOP;
+ *      ESAC;
+ *
+ * Because we don''t know until we get to the ESAC how
+ * many signals need processing, we generate the following
+ * C-equivalent code:
+ *
+ * /* define the codes for the signals */
+ * static short __tmp_advance_code;
+ * static short __tmp_terminate_code;
+ * static short __tmp_sig1_code;
+ *
+ * /* define the types of the signals */
+ * typedef struct
+ *  {
+ *     char fld0;
+ *  } __tmp_terminate_struct;
+ *
+ * typedef struct
+ *  {
+ *     char fld0;
+ *  } __tmp_sig1_struct;
+ *
+ * static INSTANCE user, system, instance_loc;
+ * static short count;
+ * static char char_code;
+ *
+ * {               /* start a new symbol context */
+ *   int    number_of_sigs;
+ *   short *sig_code [];
+ *   void  *sigdatabuf;
+ *   int    sigdatalen;
+ *   short  sigcode;
+ *
+ *   goto __rcsetup;
+ *
+ *  __rcdoit: ;
+ *   int timedout = __wait_signal (&sigcode
+ *                                 number_of_sigs,
+ *                                 sig_code,
+ *                                 sigdatabuf,
+ *                                 sigdatalen,
+ *                                 &instance_loc);
+ *   if (sigcode == __tmp_advance_code)
+ *     {
+ *       /* code for advance alternative's action_statement_list */
+ *       count++;
+ *     }
+ *   else if (sigcode == __tmp_terminate_code)
+ *     {
+ *        /* copy signal's data to where they belong,
+ *           with range-check, if enabled */
+ *        char_code = ((__tmp_terminate_struct *)sigdatabuf)->fld0;
+ *
+ *       /* code for terminate alternative's action_statement_list */
+ *        __send_signal (sig1 ..... );
+ *        goto __workloop_end;
+ *     }
+ *   else
+ *     {
+ *        /* code here for the ELSE action_statement_list */
+ *        __stop_process ();
+ *     }
+ *   goto __rc_done;
+ *
+ * __rcsetup:
+ *   union { __tmp_terminate_struct terminate; 
+ *	     __tmp_sig1_struct } databuf;
+ *   short *sig_code_ptr [2] = { &__tmp_advance_code,
+ *                               &__tmp_terminate_code };
+ *   sigdatabuf = &databuf;
+ *   sigdatalen = sizeof (databuf);
+ *   sig_code = &sig_code_ptr[0];
+ *   number_of_sigs = 2;
+ *   goto __rcdoit;
+ *
+ * __rc_done: ;
+ * }               /* end the new symbol context */
+ * __workloop_end: ;
+ *
+ *
+ * 2) RECEIVE buffer CASE action:
+ *   which looks like this:
+ *
+ *    NEWMODE m_s = STRUCT (mini INT, maxi INT);
+ *    DCL b1 BUFFER INT;
+ *    DCL b2 BUFFER (30) s;
+ *
+ *    DCL i INT, s m_s, ins INSTANCE;
+ *    DCL count INT;
+ *
+ *    workloop:
+ *      RECEIVE CASE SET ins;
+ *        (b1 IN i):
+ *          count +:= i;
+ *        (b2 in s):
+ *          IF count < s.mini OR count > s.maxi THEN
+ *            EXIT workloop;
+ *          FI;
+ *        ELSE
+ *          STOP;
+ *      ESAC;
+ *
+ * Because we don''t know until we get to the ESAC how
+ * many buffers need processing, we generate the following
+ * C-equivalent code:
+ *
+ * typedef struct
+ * {
+ *    short mini;
+ *    short maxi;
+ * } m_s;
+ *
+ * static void *b1;
+ * static void *b2;
+ * static short i;
+ * static m_s s;
+ * static INSTANCE ins;
+ * static short count;
+ *
+ * workloop:
+ * {                     /* start a new symbol context */
+ *   int     number_of_sigs;
+ *   void   *sig_code [];
+ *   void   *sigdatabuf;
+ *   int     sigdatalen;
+ *   void   *buflocation;
+ *   int     timedout;
+ *
+ *   goto __rcsetup;
+ *
+ *  __rcdoit:
+ *   timedout = __wait_buffer (&buflocation,
+ *                             number_of_sigs,
+ *                             sig_code,
+ *                             sigdatabuf,
+ *                             sigdatalen,
+ *                             &ins, ...);
+ *   if (buflocation == &b1)
+ *     {
+ *       i = ((short *)sigdatabuf)->fld0;
+ *       count += i;
+ *     }
+ *   else if (buflocation == &b2)
+ *     {
+ *       s = ((m_s)*sigdatabuf)->fld1;
+ *       if (count < s.mini || count > s.maxi)
+ *         goto __workloop_end;
+ *     }
+ *   else
+ *       __stop_process ();
+ *   goto __rc_done;
+ *
+ *  __rcsetup:
+ *   typedef struct
+ *   {
+ *      void      *p;
+ *      unsigned   maxqueuesize;
+ *   } Buffer_Descr;
+ *   union { short    b1,
+ *           m_s      b2 } databuf;
+ *   Buffer_Descr bufptr [2] =
+ *       {
+ *         { &b1, -1 },
+ *         { &b2, 30 },
+ *       };
+ *   void * bufarray[2] = { &bufptr[0],
+ *                          &bufptr[1] };
+ *   sigdatabuf = &databuf;
+ *   sigdatalen = sizeof (databuf);
+ *   sig_code = &bufarray[0];
+ *   number_of_sigs = 2;
+ *   goto __rcdoit;
+ *
+ *  __rc_done;
+ * }          /* end of symbol context */
+ * __workloop_end:
+ *
+#endif
+
+struct rc_state_type
+{
+  struct rc_state_type *enclosing;
+  rtx  rcdoit;
+  rtx  rcsetup;
+  tree n_sigs;
+  tree sig_code;
+  tree databufp;
+  tree datalen;
+  tree else_clause;
+  tree received_signal;
+  tree received_buffer;
+  tree to_loc;
+  int  sigseen;
+  int  bufseen;
+  tree actuallist;
+  int  call_generated;
+  int  if_generated;
+  int  bufcnt;
+};
+
+struct rc_state_type *current_rc_state = NULL;
+
+/* 
+ * this function tells if there is an if to terminate
+ * or not
+ */
+int
+build_receive_case_if_generated()
+{
+  if (!current_rc_state)
+    {
+      error ("internal error: RECEIVE CASE stack invalid.");
+      abort ();
+    }
+  return current_rc_state->if_generated;
+}
+
+/* build_receive_case_start returns an INTEGER_CST node
+   containing the case-label number to be used by
+   build_receive_case_end to generate correct labels */
+tree
+build_receive_case_start (optset)
+     tree optset;
+{
+  /* counter to generate unique receive_case labels */
+  static int rc_lbl_count = 0;
+  tree current_label_value = 
+    build_int_2 ((HOST_WIDE_INT)rc_lbl_count, 0);
+  tree sigcodename, filename, linenumber;
+  
+  struct rc_state_type *rc_state
+    = (struct rc_state_type*) xmalloc (sizeof (struct rc_state_type));
+  rc_state->rcdoit = gen_label_rtx ();
+  rc_state->rcsetup = gen_label_rtx ();
+  rc_state->enclosing = current_rc_state;
+  current_rc_state = rc_state;
+  rc_state->sigseen = 0;
+  rc_state->bufseen = 0;
+  rc_state->call_generated = 0;
+  rc_state->if_generated = 0;
+  rc_state->bufcnt = 0;
+
+  rc_lbl_count++;
+  if (optset == NULL_TREE || TREE_CODE (optset) == ERROR_MARK)
+    optset = null_pointer_node;
+  else
+    {
+      if (CH_IS_INSTANCE_MODE (TREE_TYPE (optset)) && CH_LOCATION_P (optset))
+	optset = force_addr_of (optset);
+      else
+	{
+	  error ("SET requires INSTANCE location");
+	  optset = null_pointer_node;
+	}			 
+    }
+
+  rc_state->to_loc = build_timeout_preface ();
+  
+  rc_state->n_sigs =
+    decl_temp1 (get_identifier ("number_of_sigs"),
+		integer_type_node, 0, integer_zero_node, 0, 0);
+
+  rc_state->sig_code =
+    decl_temp1 (get_identifier ("sig_codep"),
+		ptr_type_node, 0, null_pointer_node, 0, 0);
+
+  rc_state->databufp =
+    decl_temp1 (get_identifier ("databufp"),
+		ptr_type_node, 0, null_pointer_node, 0, 0);
+
+  rc_state->datalen =
+    decl_temp1 (get_identifier ("datalen"),
+		integer_type_node, 0, integer_zero_node, 0, 0);
+
+  rc_state->else_clause =
+    decl_temp1 (get_identifier ("else_clause"),
+		integer_type_node, 0, integer_zero_node, 0, 0);
+
+  /* wait_signal will store the signal number in here */
+  sigcodename = get_identifier ("received_signal");
+  rc_state->received_signal = 
+    decl_temp1 (sigcodename, chill_integer_type_node, 0, 
+		NULL_TREE, 0, 0);
+
+  /* wait_buffer will store the buffer address in here */
+  sigcodename = get_unique_identifier ("received_buffer");
+  rc_state->received_buffer =
+    decl_temp1 (sigcodename, ptr_type_node, 0,
+		NULL_TREE, 0, 0);
+
+  /* now jump to the end of RECEIVE CASE actions, to
+     set up variables for them. */
+  emit_jump (rc_state->rcsetup);
+
+  /* define the __rcdoit label. We come here after
+     initialization of all variables, to execute the
+     actions. */
+  emit_label (rc_state->rcdoit);
+
+  filename = force_addr_of (get_chill_filename ());
+  linenumber = get_chill_linenumber ();
+  
+  /* Argument list for calling the runtime routine.  We'll call it
+     the first time we call build_receive_case_label, when we know
+     whether to call wait_signal or wait_buffer. NOTE: at this time
+     the first argument will be set. */
+  rc_state->actuallist = 
+    tree_cons (NULL_TREE, NULL_TREE,
+      tree_cons (NULL_TREE, rc_state->n_sigs,
+        tree_cons (NULL_TREE, rc_state->sig_code,
+          tree_cons (NULL_TREE, rc_state->databufp,
+            tree_cons (NULL_TREE, rc_state->datalen,
+              tree_cons (NULL_TREE, optset, 
+	        tree_cons (NULL_TREE, rc_state->else_clause,
+	          tree_cons (NULL_TREE, rc_state->to_loc,
+		    tree_cons (NULL_TREE, filename,
+		      tree_cons (NULL_TREE, linenumber, NULL_TREE))))))))));
+  return current_label_value;
+}
+
+static tree
+build_receive_signal_case_label (sigdecl, loclist)
+     tree sigdecl, loclist;
+{
+  struct rc_state_type *rc_state = current_rc_state;
+  tree signame = DECL_NAME (sigdecl);
+  tree expr;
+
+  if (rc_state->bufseen != 0)
+    {
+      error ("SIGNAL in RECEIVE CASE alternative follows");
+      error (" a BUFFER name on line %d", rc_state->bufseen);
+      return error_mark_node;
+    }
+  rc_state->sigseen = lineno;
+  rc_state->bufseen = 0;
+
+  if (!IDENTIFIER_SIGNAL_DATA (signame) && loclist != NULL_TREE)
+    {
+      error ("SIGNAL `%s' has no data fields", IDENTIFIER_POINTER (signame));
+      return error_mark_node;
+    }
+  if (IDENTIFIER_SIGNAL_DATA (signame) && loclist == NULL_TREE)
+    {
+      error ("SIGNAL `%s' requires data fields", IDENTIFIER_POINTER (signame));
+      return error_mark_node;
+    }
+
+  if (!rc_state->call_generated)
+    {
+      tree wait_call;
+
+      TREE_VALUE (rc_state->actuallist) = force_addr_of (rc_state->received_signal);
+      wait_call = build_chill_function_call (lookup_name
+		    (get_identifier ("__wait_signal_timed")),
+		       rc_state->actuallist);
+#if 0
+      chill_expand_assignment (rc_state->received_signal,
+			       NOP_EXPR, wait_call);
+#endif
+      build_timesupervised_call (wait_call, rc_state->to_loc);
+      
+      rc_state->call_generated = 1;
+    }
+
+  /* build the conditional expression */
+  expr = build (EQ_EXPR, boolean_type_node,
+		rc_state->received_signal,
+		(tree)DECL_TASKING_CODE_DECL (sigdecl));
+
+  if (!rc_state->if_generated)
+    {
+      expand_start_cond (expr, 0);
+      rc_state->if_generated = 1;
+    }
+  else
+    expand_start_elseif (expr);
+
+  if (IDENTIFIER_SIGNAL_DATA (signame))
+    {
+      /* copy data from signal buffer to user's variables */
+      tree typelist = TYPE_FIELDS (TREE_TYPE (sigdecl));
+      tree valtail, typetail;
+      int  parmno = 1;
+      tree pointer_type = build_chill_pointer_type (TREE_TYPE (sigdecl));
+      tree pointer = convert (pointer_type, rc_state->databufp);
+	  
+      for (valtail = nreverse (loclist), typetail = typelist;
+	   valtail != NULL_TREE && typetail != NULL_TREE;  
+	   parmno++, valtail = TREE_CHAIN (valtail),
+	   typetail = TREE_CHAIN (typetail))
+	{
+	  register tree actual  = valtail  ? TREE_VALUE (valtail)  : 0;
+	  register tree type    = typetail ? TREE_TYPE (typetail) : 0;
+	  register tree assgn;
+	  char place[30];
+	  sprintf (place, "signal field %d", parmno);
+
+	  assgn = build_component_ref (build1 (INDIRECT_REF,
+					       TREE_TYPE (sigdecl),
+					       pointer),
+				       DECL_NAME (typetail));
+	  if (!CH_TYPE_NONVALUE_P (type))
+	    /* don't assign to non-value type. Error printed at signal definition */
+	    chill_expand_assignment (actual, NOP_EXPR, assgn);
+	}
+
+      if (valtail == NULL_TREE && typetail != NULL_TREE)
+	error ("too few data fields provided for `%s'",
+	       IDENTIFIER_POINTER (signame));
+      if (valtail != NULL_TREE && typetail == NULL_TREE)
+	error ("too many data fields provided for `%s'",
+	       IDENTIFIER_POINTER (signame));
+    }
+
+  /* last action here */
+  emit_line_note (input_filename, lineno);
+
+  return build_tree_list (loclist, signame);
+}
+
+static tree
+build_receive_buffer_case_label (buffer, loclist)
+     tree buffer, loclist;
+{
+  struct rc_state_type *rc_state = current_rc_state;
+  tree buftype = buffer_element_mode (TREE_TYPE (buffer));
+  tree expr, var;
+  tree pointer_type, pointer, assgn;
+  int  had_errors = 0;
+  tree x, y, z, bufaddr;
+
+  if (rc_state->sigseen != 0)
+    {
+      error ("BUFFER in RECEIVE CASE alternative follows");
+      error (" a SIGNAL name on line %d", rc_state->sigseen);
+      return error_mark_node;
+    }
+  rc_state->bufseen = lineno;
+  rc_state->sigseen = 0;
+
+  if (! CH_REFERABLE (buffer))
+    {
+      error ("BUFFER in RECEIVE CASE alternative must be a location.");
+      return error_mark_node;
+    }
+
+  if (TREE_CHAIN (loclist) != NULL_TREE)
+    {
+      error ("buffer receive alternative requires only 1 defining occurence.");
+      return error_mark_node;
+    }
+
+  if (!rc_state->call_generated)
+    {
+      tree wait_call;
+
+      /* here we change the mode of rc_state->sig_code to
+	 REF ARRAY (0:65535) REF __tmp_DESCR_type.
+	 This is neccesary, cause we cannot evaluate the buffer twice
+	 (once here where we compare against the address of the buffer
+	 and second in build_receive_buffer_case_end, where we use the
+	 address build the descriptor, which gets passed to __wait_buffer).
+	 So we change the comparison from
+	 if (rc_state->received_buffer == &buffer)
+	 to
+	 if (rc_state->received_buffer ==
+	 rc_state->sig_codep->[rc_state->bufcnt]->datap).
+	 
+	 This will evaluate the buffer location only once
+	 (in build_receive_buffer_case_end) and therefore doesn't confuse
+	 our machinery. */
+      
+      tree reftmpdescr = build_chill_pointer_type (
+		            TREE_TYPE (lookup_name (
+				get_identifier ("__tmp_DESCR_type"))));
+      tree idxtype = build_chill_range_type (NULL_TREE,
+			integer_zero_node,
+			   build_int_2 (65535, 0)); /* should be enough, probably use ULONG */
+      tree arrtype = build_chill_array_type (reftmpdescr,
+			tree_cons (NULL_TREE, idxtype, NULL_TREE),
+			   0, NULL_TREE);
+      tree refarrtype = build_chill_pointer_type (arrtype);
+
+      TREE_VALUE (rc_state->actuallist) = force_addr_of (rc_state->received_buffer);
+      wait_call = build_chill_function_call (
+		    lookup_name (get_identifier ("__wait_buffer")),
+		      rc_state->actuallist);
+#if 0
+      chill_expand_assignment (rc_state->received_buffer,
+				 NOP_EXPR, wait_call);
+#endif
+      build_timesupervised_call (wait_call, rc_state->to_loc);
+      
+      /* do this after the call, otherwise there will be a mode mismatch */
+      TREE_TYPE (rc_state->sig_code) = refarrtype;
+      
+      /* now we are ready to generate the call */
+      rc_state->call_generated = 1;
+    }
+
+  x = build_chill_indirect_ref (rc_state->sig_code, NULL_TREE, 0);
+  y = build_chill_array_ref (x,
+        tree_cons (NULL_TREE, build_int_2 (rc_state->bufcnt, 0), NULL_TREE));
+  z = build_chill_indirect_ref (y, NULL_TREE, 0);
+  bufaddr = build_chill_component_ref (z, get_identifier ("datap"));
+
+  /* build the conditional expression */
+  expr = build (EQ_EXPR, boolean_type_node,
+		rc_state->received_buffer,
+		bufaddr);
+
+  /* next buffer in list */
+  rc_state->bufcnt++;
+
+  if (!rc_state->if_generated)
+    {
+      expand_start_cond (expr, 0);
+      rc_state->if_generated = 1;
+    }
+  else
+    expand_start_elseif (expr);
+
+  /* copy buffer's data to destination */
+  var = TREE_VALUE (loclist);
+
+  if (buftype != NULL_TREE && TREE_CODE (buftype) == ERROR_MARK)
+    had_errors = 1;
+  else if (! CH_COMPATIBLE (var, buftype))
+    {
+      error ("incompatible modes in receive buffer alternative.");
+      had_errors = 1;
+    }
+
+  if (! CH_LOCATION_P (var))
+    {
+      error ("defining occurence in receive buffer alternative must be a location.");
+      had_errors = 1;
+    }
+
+  if (! had_errors)
+    {
+      pointer_type = build_chill_pointer_type (TREE_TYPE (var));
+      pointer = convert (pointer_type,
+			 rc_state->databufp);
+      /* no need to check this pointer being NULL */
+      assgn = build_chill_indirect_ref (pointer, NULL_TREE, 0);
+      
+      chill_expand_assignment (var, NOP_EXPR, assgn);
+    }
+
+  /* last action here */
+  emit_line_note (input_filename, lineno);
+
+  return build_tree_list (loclist, buffer);
+}
+/*
+ *  SIGNAME is the signal name or buffer location,
+ *  LOCLIST is a list of possible locations to store data in
+ */
+tree
+build_receive_case_label (signame, loclist)
+     tree signame, loclist;
+{
+  /* now see what we have got and do some checks */
+  if (TREE_CODE (signame) == TYPE_DECL && CH_DECL_SIGNAL (signame))
+    return build_receive_signal_case_label (signame, loclist);
+
+  if (TREE_TYPE (signame) != NULL_TREE
+      && CH_IS_BUFFER_MODE (TREE_TYPE (signame)))
+    {
+      if (loclist == NULL_TREE)
+	{
+	  error ("buffer receive alternative without `IN location'.");
+	  return error_mark_node;
+	}
+      return build_receive_buffer_case_label (signame, loclist);
+    }
+
+  error ("RECEIVE CASE alternative must specify a SIGNAL name or BUFFER location.");
+  return error_mark_node;
+}
+
+/*
+ * LABEL_CNT is the case-label counter passed from build_receive_case_start.
+ * ELSE_CLAUSE defines if the RECEIVE CASE action had an ELSE(1) or not(0).
+ * BUF_LIST is a tree-list of tree-lists, where TREE_VALUE defines the 
+ * BUFFER location and TREE_PURPOSE defines the defining occurence.
+ */
+static void
+build_receive_buffer_case_end (label_cnt, buf_list, else_clause)
+     tree label_cnt, buf_list, else_clause;
+{
+  struct rc_state_type *rc_state = current_rc_state;
+  tree alist;
+  tree field_decls = NULL_TREE; /* list of all buffer types, for the union */
+  int  buffer_cnt = 0;
+  tree descr_type = lookup_name (get_identifier ("__tmp_DESCR_type"));
+  tree tuple = NULL_TREE;       /* constructors for array of ptrs */
+  tree union_type_node = NULL_TREE;
+
+  /* walk thru all the buffers */
+  for (alist = buf_list; alist != NULL_TREE;
+       buffer_cnt++, alist = TREE_CHAIN (alist))
+    {
+      tree value      = TREE_VALUE (alist);
+      tree buffer     = TREE_VALUE (value);                 /* this is the buffer */
+      tree data       = TREE_VALUE (TREE_PURPOSE (value));  /* the location to receive in */
+      tree buffer_descr;
+      tree buffer_descr_init;
+      tree buffer_length;
+      tree buffer_ptr;
+      tree field;
+      char fldname[20];
+
+      /* build descriptor for buffer */
+      buffer_length = max_queue_size (TREE_TYPE (buffer));
+      if (buffer_length == NULL_TREE)
+	buffer_length = infinite_buffer_event_length_node;
+      buffer_descr_init = build_nt (CONSTRUCTOR, NULL_TREE,
+                            tree_cons (NULL_TREE, force_addr_of (buffer),
+                              tree_cons (NULL_TREE, buffer_length, NULL_TREE)));
+      buffer_descr = decl_temp1 (get_unique_identifier ("RCbuffer"),
+				 TREE_TYPE (descr_type), 0,
+				 buffer_descr_init, 0, 0);
+      tuple = tree_cons (NULL_TREE,
+			 force_addr_of (buffer_descr),
+			 tuple);
+
+      /* make a field for the union */
+      sprintf (fldname, "fld%03d", buffer_cnt);
+      field = grok_chill_fixedfields (
+                 tree_cons (NULL_TREE, get_identifier (fldname), NULL_TREE),
+                   TREE_TYPE (data), NULL_TREE);
+      if (field_decls == NULL_TREE)
+	field_decls = field;
+      else
+	chainon (field_decls, field);
+    }
+
+  /* generate the union */
+  if (field_decls != NULL_TREE)
+    {
+      tree data_id = get_identifier ("databuffer");
+      tree data_decl;
+
+      union_type_node = finish_struct (
+			  start_struct (UNION_TYPE, NULL_TREE),
+			    field_decls);
+      data_decl = decl_temp1 (data_id, union_type_node, 0, NULL_TREE, 0, 0);
+
+      chill_expand_assignment (rc_state->databufp, NOP_EXPR,
+			       force_addr_of (data_decl));
+
+      chill_expand_assignment (rc_state->datalen, NOP_EXPR,
+			       size_in_bytes (TREE_TYPE (data_decl)));
+    }
+
+  /* tell runtime system if we had an else or not */
+  chill_expand_assignment (rc_state->else_clause, NOP_EXPR, else_clause);
+
+  /* generate the array of pointers to all buffers */
+  {
+    tree array_id = get_identifier ("buf_ptr_array");
+    tree array_type_node =
+           build_chill_array_type (ptr_type_node,
+             tree_cons (NULL_TREE,
+               build_chill_range_type (NULL_TREE,
+				       integer_one_node,
+				       build_int_2 (buffer_cnt, 0)),
+			NULL_TREE),
+			  0, NULL_TREE);
+    tree constr = build_nt (CONSTRUCTOR, NULL_TREE, nreverse (tuple));
+    tree array_decl = decl_temp1 (array_id, array_type_node, 0,
+				  constr, 0, 0);
+    
+    chill_expand_assignment (build_chill_cast (ptr_type_node, rc_state->sig_code),
+			     NOP_EXPR,
+			     force_addr_of (array_decl));
+    chill_expand_assignment (rc_state->n_sigs, NOP_EXPR,
+			     build_int_2 (buffer_cnt, 0));
+  }
+}
+
+/*
+ * SIG_LIST is a tree list.  The TREE_VALUEs are VAR_DECLs of 
+ * __tmp_%s_code variables, and the TREE_PURPOSEs are the
+ * TYPE_DECLs of the __tmp_%s_struct types.  LABEL_CNT is the
+ * case-label counter passed from build_receive_case_start.
+ */
+static void
+build_receive_signal_case_end (label_cnt, sig_list, else_clause)
+     tree label_cnt, sig_list, else_clause;
+{
+  struct rc_state_type *rc_state = current_rc_state;
+  tree alist, temp1;
+  tree union_type_node = NULL_TREE;
+  tree field_decls = NULL_TREE;  /* list of signal
+				   structure, for the union */
+  tree tuple = NULL_TREE;    /* constructor for array of ptrs */
+  int  signal_cnt = 0;
+  int  fldcnt = 0;
+
+  /* for each list of locations, validate it against the
+     corresponding signal's list of fields. */
+  {
+    for (alist = sig_list; alist != NULL_TREE;
+	 signal_cnt++, alist = TREE_CHAIN (alist))
+      {
+	tree value    = TREE_VALUE (alist);
+	tree signame  = TREE_VALUE (value);  /* signal's ID node */
+	tree sigdecl  = lookup_name (signame);
+	tree sigtype  = TREE_TYPE (sigdecl);
+	tree field;
+	char fldname[20];
+
+	if (IDENTIFIER_SIGNAL_DATA (signame))
+	  {
+	    sprintf (fldname, "fld%03d", fldcnt++);
+	    field = grok_chill_fixedfields (
+		      tree_cons (NULL_TREE, 
+				 get_identifier (fldname),
+				 NULL_TREE),
+			sigtype, NULL_TREE); 
+	    if (field_decls == NULL_TREE)
+	      field_decls = field;
+	    else
+	      chainon (field_decls, field);
+
+	  }
+
+	temp1 = (tree)DECL_TASKING_CODE_DECL (sigdecl);
+	mark_addressable (temp1);
+	tuple = tree_cons (NULL_TREE,
+		  build1 (ADDR_EXPR, 
+		    build_chill_pointer_type (chill_integer_type_node),
+			  temp1),
+		    tuple);
+      }
+  }
+
+  /* generate the union of all of the signal data types */
+  if (field_decls != NULL_TREE)
+    {
+      tree data_id = get_identifier ("databuffer");
+      tree data_decl;
+      union_type_node = finish_struct (start_struct (UNION_TYPE, 
+					       NULL_TREE),
+				 field_decls); 
+      data_decl =
+	decl_temp1 (data_id, union_type_node, 0, NULL_TREE, 0, 0);
+
+      chill_expand_assignment (rc_state->databufp, NOP_EXPR,
+			       force_addr_of (data_decl));
+
+      chill_expand_assignment (rc_state->datalen, NOP_EXPR, 
+			       size_in_bytes (TREE_TYPE (data_decl)));
+    }
+
+  /* tell runtime system if we had an else or not */
+  chill_expand_assignment (rc_state->else_clause, NOP_EXPR, else_clause);
+
+  /* generate the array of all signal codes */
+  {
+    tree array_id = get_identifier ("sig_code_array");
+    tree array_type_node
+      = build_chill_array_type (
+          build_chill_pointer_type (chill_integer_type_node),
+	    tree_cons (NULL_TREE,
+	      build_chill_range_type (NULL_TREE,
+				      integer_one_node,
+				      build_int_2 (signal_cnt, 0)),
+		       NULL_TREE),
+	 0, NULL_TREE);
+    tree constr = build_nt (CONSTRUCTOR, NULL_TREE,
+			    nreverse (tuple));
+    tree array_decl = 
+      decl_temp1 (array_id, array_type_node, 0, constr, 0, 0);
+
+    chill_expand_assignment (rc_state->sig_code, NOP_EXPR, 
+			     force_addr_of (array_decl));
+
+    /* give number of signals to runtime system */
+    chill_expand_assignment (rc_state->n_sigs, NOP_EXPR, 
+			     build_int_2 (signal_cnt, 0));
+  }
+}
+
+/* General function for the end of a RECEIVE CASE action */
+
+void
+build_receive_case_end (label_cnt, alist, else_clause)
+     tree label_cnt, alist, else_clause;
+{
+  rtx rcdone = gen_label_rtx ();
+  struct rc_state_type *rc_state = current_rc_state;
+  tree tmp;
+  int had_errors = 0;
+
+  /* finish the if's, if generated */
+  if (rc_state->if_generated)
+    expand_end_cond ();
+
+  /* check alist for errors */
+  for (tmp = alist; tmp != NULL_TREE; tmp = TREE_CHAIN (tmp))
+    {
+      if (TREE_CODE (TREE_VALUE (tmp)) == ERROR_MARK)
+	had_errors++;
+    }
+
+  /* jump to the end of RECEIVE CASE processing */
+  emit_jump (rcdone);
+
+  /* define the __rcsetup label. We come here to initialize
+     all variables */
+  emit_label (rc_state->rcsetup);
+
+  if (alist == NULL_TREE && !had_errors)
+    {
+      error ("RECEIVE CASE without alternatives");
+      goto gen_rcdoit;
+    }
+
+  if (TREE_CODE (alist) == ERROR_MARK || had_errors)
+    goto gen_rcdoit;
+
+  /* now call the actual end function */
+  if (rc_state->bufseen)
+    build_receive_buffer_case_end (label_cnt, alist, else_clause);
+  else
+    build_receive_signal_case_end (label_cnt, alist, else_clause);
+
+  /* now jump to the beginning of RECEIVE CASE processing */
+gen_rcdoit: ;
+  emit_jump (rc_state->rcdoit);
+
+  /* define the __rcdone label. We come here when the whole
+     receive case is done. */
+  emit_label (rcdone);
+
+  current_rc_state = rc_state->enclosing;
+  free(rc_state);
+}
+
+/* build a CONTINUE action */
+
+void expand_continue_event (evloc)
+     tree evloc;
+{
+  tree filename, linenumber, evaddr;
+
+  /* do some checks */
+  if (evloc == NULL_TREE || TREE_CODE (evloc) == ERROR_MARK)
+    return;
+
+  if (! CH_REFERABLE (evloc) || ! CH_IS_EVENT_MODE (TREE_TYPE (evloc)))
+    {
+      error ("CONTINUE requires an event location.");
+      return;
+    }
+
+  evaddr = force_addr_of (evloc);
+  filename = force_addr_of (get_chill_filename ());
+  linenumber = get_chill_linenumber ();
+
+  expand_expr_stmt (
+    build_chill_function_call (lookup_name (get_identifier ("__continue")),
+      tree_cons (NULL_TREE, evaddr,
+        tree_cons (NULL_TREE, filename,
+          tree_cons (NULL_TREE, linenumber, NULL_TREE)))));
+}
+
+#if 0
+ * The following code builds a DELAY CASE statement,
+ * which looks like this in CHILL:
+ *
+ *    DCL ev1, ev2 EVENT, ins INSTANCE;
+ *    DCL ev3 EVENT (10);
+ *    DCL count1 INT := 0, count2 INT := 0;
+ *
+ *    DELAY CASE SET ins;
+ *      (ev1): count1 +:= 1;
+ *      (ev2, ev3): count2 +:= 1;
+ *    ESAC; 
+ *
+ * Because we don''t know until we get to the ESAC how
+ * many events need processing, we generate the following
+ * C-equivalent code:
+ *
+ *
+ * {               /* start a new symbol context */
+ *   typedef struct
+ *   {
+ *      void           *p;
+ *      unsigned long  len;
+ *   } Descr;
+ *   int     number_of_events;
+ *   Descr  *event_codes;
+ *
+ *   goto __dlsetup;
+ *
+ *  __dldoit: 
+ *   void *whatevent = __delay_event (number_of_events,
+ *                                    event_codes,
+ *                                    priority,
+ *                                    &instance_loc,
+ *                                    filename,
+ *                                    linenumber);
+ *   if (whatevent == &ev1)
+ *     {
+ *       /* code for ev1 alternative's action_statement_list */
+ *       count1 += 1;
+ *     }
+ *   else if (whatevent == &ev2 || whatevent == &ev3)
+ *     {
+ *       /* code for ev2 and ev3 alternative's action_statement_list */
+ *       count2 += 1;
+ *     }
+ *   goto __dl_done;
+ *
+ * __dlsetup:
+ *   Descr event_code_ptr [3] = {
+ *              { &ev1, -1 },
+ *              { &ev2, -1 },
+ *              { &ev3, 10 } };
+ *   event_codes = &event_code_ptr[0];
+ *   number_of_events = 3;
+ *   goto __dldoit;
+ *
+ * __dl_done: 
+ *   ;
+ * }               /* end the new symbol context */
+ *
+#endif
+
+struct dl_state_type
+{
+  struct dl_state_type *enclosing;
+  rtx  dldoit;
+  rtx  dlsetup;
+  tree n_events;
+  tree event_codes;
+  tree received_event;
+};
+
+struct dl_state_type *current_dl_state = NULL;
+
+/* build_receive_case_start returns an INTEGER_CST node
+   containing the case-label number to be used by
+   build_receive_case_end to generate correct labels */
+tree
+build_delay_case_start (optset, optpriority)
+     tree optset, optpriority;
+{
+  /* counter to generate unique delay case labels */
+  static int dl_lbl_count = 0;
+  tree current_label_value = 
+    build_int_2 ((HOST_WIDE_INT)dl_lbl_count, 0);
+  tree wait_call;
+  tree actuallist = NULL_TREE;
+  tree filename, linenumber;
+  tree to_loc;
+  
+  struct dl_state_type *dl_state
+    = (struct dl_state_type*) xmalloc (sizeof (struct dl_state_type));
+  dl_state->enclosing = current_dl_state;
+  current_dl_state = dl_state;
+  dl_state->dldoit = gen_label_rtx ();
+  dl_state->dlsetup = gen_label_rtx ();
+
+  dl_lbl_count++;
+
+  /* check the optional SET location */
+  if (optset == NULL_TREE
+      || TREE_CODE (optset) == ERROR_MARK)
+    optset = null_pointer_node;
+  else if (CH_IS_INSTANCE_MODE (TREE_TYPE (optset)) && CH_LOCATION_P (optset))
+    optset = force_addr_of (optset);
+  else
+    {
+      error ("SET requires INSTANCE location");
+      optset = null_pointer_node;
+    }			 
+
+  /* check the presence of the PRIORITY expression */
+  if (optpriority == NULL_TREE)
+    optpriority = integer_zero_node;
+  else if (TREE_CODE (optpriority) == ERROR_MARK)
+    optpriority = integer_zero_node;
+  else if (TREE_CODE (TREE_TYPE (optpriority)) != INTEGER_TYPE)
+    {
+      error ("PRIORITY must be of integer type.");
+      optpriority = integer_zero_node;
+    }
+
+  /* check for time supervised */
+  to_loc = build_timeout_preface ();
+  
+  dl_state->n_events =
+    decl_temp1 (get_identifier ("number_of_events"),
+		integer_type_node, 0, integer_zero_node, 0, 0);
+
+  dl_state->event_codes =
+    decl_temp1 (get_identifier ("event_codes"),
+		ptr_type_node, 0, null_pointer_node, 0, 0);
+
+  /* wait_event will store the signal number in here */
+  dl_state->received_event =
+    decl_temp1 (get_identifier ("received_event"),
+		ptr_type_node, 0, NULL_TREE, 0, 0);
+
+  /* now jump to the end of RECEIVE CASE actions, to
+     set up variables for them. */
+  emit_jump (dl_state->dlsetup);
+
+  /* define the __rcdoit label. We come here after
+     initialization of all variables, to execute the
+     actions. */
+  emit_label (dl_state->dldoit);
+
+  filename = force_addr_of (get_chill_filename ());
+  linenumber = get_chill_linenumber ();
+  
+  /* here we go, call the runtime routine */
+  actuallist = tree_cons (NULL_TREE, force_addr_of (dl_state->received_event),
+                 tree_cons (NULL_TREE, dl_state->n_events,
+                   tree_cons (NULL_TREE, dl_state->event_codes,
+                     tree_cons (NULL_TREE, optpriority, 
+                       tree_cons (NULL_TREE, to_loc,
+                         tree_cons (NULL_TREE, optset, 
+		           tree_cons (NULL_TREE, filename,
+		             tree_cons (NULL_TREE, linenumber, NULL_TREE))))))));
+
+  wait_call = build_chill_function_call (
+                lookup_name (get_identifier ("__delay_event")),
+					 actuallist);
+
+#if 0
+  chill_expand_assignment (dl_state->received_event, NOP_EXPR, wait_call);
+#endif
+  build_timesupervised_call (wait_call, to_loc);
+  return current_label_value;
+}
+
+/*
+   EVENTLIST is the list of this alternative's events
+   and IF_OR_ELSEIF indicates what action (1 for if and 
+   0 for else if) should be generated.
+*/
+void
+build_delay_case_label (eventlist, if_or_elseif)
+     tree eventlist;
+     int  if_or_elseif;
+{
+  tree eventp, expr = NULL_TREE;
+
+  if (eventlist == NULL_TREE || TREE_CODE (eventlist) == ERROR_MARK)
+    return;
+
+  for (eventp = eventlist; eventp != NULL_TREE; 
+       eventp = TREE_CHAIN (eventp))
+    {
+      tree event = TREE_VALUE (eventp);
+      tree temp1;
+
+      if (event == NULL_TREE || TREE_CODE (event) == ERROR_MARK)
+	temp1 = null_pointer_node;
+      else if (! CH_IS_EVENT_MODE (TREE_TYPE (event)) || ! CH_REFERABLE (event))
+	{
+	  error ("delay alternative must be an EVENT location.");
+	  temp1 = null_pointer_node;
+	}
+      else
+	temp1 = force_addr_of (event);
+      
+      /* build the conditional expression */
+      if (expr == NULL_TREE)
+	expr = build (EQ_EXPR, boolean_type_node,
+		      current_dl_state->received_event, temp1);
+      else
+	expr = 
+	  build (TRUTH_ORIF_EXPR, boolean_type_node, expr,
+		 build (EQ_EXPR, boolean_type_node,
+			current_dl_state->received_event, temp1));
+    }
+  if (if_or_elseif)
+    expand_start_cond (expr, 0);
+  else
+    expand_start_elseif (expr);
+
+  /* last action here */
+  emit_line_note (input_filename, lineno);
+}
+
+/*
+ * EVENT_LIST is a tree list.  The TREE_VALUEs are VAR_DECLs of 
+ * EVENT variables.  LABEL_CNT is the case-label counter
+ * passed from build_delay_case_start.
+ */
+void
+build_delay_case_end (label_cnt, event_list)
+     tree label_cnt, event_list;
+{
+  struct dl_state_type *dl_state = current_dl_state;
+  rtx    dldone          = gen_label_rtx ();
+  tree tuple = NULL_TREE;    /* constructor for array of descrs */
+  tree acode;
+  int  event_cnt = 0;
+
+  /* if we have an empty event_list, there was no alternatives and we
+     havn't started an if therefor don't run expand_end_cond */
+  if (event_list != NULL_TREE)
+    /* finish the if's */
+    expand_end_cond ();
+
+  /* jump to the end of RECEIVE CASE processing */
+  emit_jump (dldone);
+
+  /* define the __dlsetup label. We come here to initialize
+     all variables */
+  emit_label (dl_state->dlsetup);
+
+  if (event_list == NULL_TREE)
+    {
+      error ("DELAY CASE without alternatives");
+      goto gen_dldoit;
+    }
+
+  if (event_list == NULL_TREE 
+      || TREE_CODE (event_list) == ERROR_MARK)
+    goto gen_dldoit;
+
+  /* make a list of pointers (in reverse order)
+     to the event code variables */
+  for (acode = event_list; acode != NULL_TREE; 
+       acode = TREE_CHAIN (acode))
+    {
+      tree event = TREE_VALUE (acode);
+      tree event_length;
+      tree descr_init;
+
+      if (event == NULL_TREE || TREE_CODE (event) == ERROR_MARK)
+	{
+	  descr_init = 
+	    tree_cons (NULL_TREE, null_pointer_node,
+	      tree_cons (NULL_TREE, integer_zero_node, NULL_TREE));
+	}
+      else
+	{
+	  event_length = max_queue_size (TREE_TYPE (event));
+	  if (event_length == NULL_TREE)
+	    event_length = infinite_buffer_event_length_node;
+	  descr_init =
+	    tree_cons (NULL_TREE, force_addr_of (event),
+              tree_cons (NULL_TREE, event_length, NULL_TREE));
+	}
+      tuple = tree_cons (NULL_TREE,
+		build_nt (CONSTRUCTOR, NULL_TREE, descr_init),
+		  tuple);
+      event_cnt++;
+    }
+    
+  /* generate the array of all event code pointers */
+  {
+    tree descr_type = TREE_TYPE (lookup_name (get_identifier ("__tmp_DESCR_type")));
+    tree array_id = get_identifier ("event_code_array");
+    tree array_type_node
+      = build_chill_array_type (descr_type,
+	 tree_cons (NULL_TREE,
+           build_chill_range_type (NULL_TREE,
+				   integer_one_node,
+				   build_int_2 (event_cnt, 0)),
+		    NULL_TREE),
+	 0, NULL_TREE);
+    tree constr = build_nt (CONSTRUCTOR, NULL_TREE,
+			    nreverse (tuple));
+    tree array_decl = 
+      decl_temp1 (array_id, array_type_node, 0, constr, 0, 0);
+
+    chill_expand_assignment (dl_state->event_codes, NOP_EXPR, 
+			     force_addr_of (array_decl));
+
+    /* give number of signals to runtime system */
+    chill_expand_assignment (dl_state->n_events, NOP_EXPR, 
+			     build_int_2 (event_cnt, 0));
+  }
+
+  /* now jump to the beginning of DELAY CASE processing */
+gen_dldoit: 
+  emit_jump (dl_state->dldoit);
+
+  /* define the __dldone label. We come here when the whole
+     DELAY CASE is done. */
+  emit_label (dldone);
+
+  current_dl_state = dl_state->enclosing;
+  free(dl_state);
+}
+
+#if 0
+ * The following code builds a simple delay statement,
+ * which looks like this in CHILL:
+ *
+ *    DCL ev1 EVENT(5), ins INSTANCE;
+ *
+ *    DELAY ev1 PRIORITY 7;
+ *
+ * This statement unconditionally delays the current 
+ * PROCESS, until some other process CONTINUEs it.
+ *
+ * Here is the generated C code:
+ *
+ * typedef struct
+ * {
+ *   void          *p;
+ *   unsigned long len;
+ * } Descr;
+ *
+ * static short __tmp_ev1_code;
+ * 
+ * {  /* start a new symbol context */
+ *
+ *   Descr __delay_array[1] = { { ev1, 5 } };
+ *
+ *   __delay_event (1, &__delay_array, 7, NULL,
+ *		    filename, linenumber);
+ *
+ * } /* end of symbol scope */
+ */
+#endif
+void
+build_delay_action (event, optpriority)
+	tree event, optpriority;
+{
+  int had_errors = 0;
+  tree to_loc = NULL_TREE;
+  /* we discard the return value of __delay_event, cause in
+     a normal DELAY action no selections have to be made */
+  tree ev_got = null_pointer_node;
+  
+  /* check the event */
+  if (event == NULL_TREE || TREE_CODE (event) == ERROR_MARK)
+    had_errors = 1;
+  else if (! CH_IS_EVENT_MODE (TREE_TYPE (event)) || ! CH_REFERABLE (event))
+    {
+      error ("DELAY action requires an event location.");
+      had_errors = 1;
+    }
+
+  /* check the presence of priority */
+  if (optpriority != NULL_TREE)
+    {
+      if (TREE_CODE (optpriority) == ERROR_MARK)
+	return;
+      if (TREE_CODE (TREE_TYPE (optpriority)) != INTEGER_TYPE)
+	{
+	  error ("PRIORITY in DELAY action must be of integer type.");
+	  return;
+	}
+    }
+  else
+    {
+      /* issue a warning in case of -Wall */
+      if (extra_warnings)
+	{
+	  warning ("DELAY action without priority.");
+	  warning (" PRIORITY defaulted to 0.");
+	}
+      optpriority = integer_zero_node;
+    }
+  if (had_errors)
+    return;
+
+  {
+    tree descr_type;
+    tree array_type_node;
+    tree array_decl;
+    tree descr_init;
+    tree array_init;
+    tree event_length = max_queue_size (TREE_TYPE (event));
+    tree event_codes;
+    tree filename = force_addr_of (get_chill_filename ());
+    tree linenumber = get_chill_linenumber ();
+    tree actuallist;
+
+    to_loc = build_timeout_preface ();
+    
+    descr_type = TREE_TYPE (lookup_name (get_identifier ("__tmp_DESCR_type")));
+
+    array_type_node =
+        build_chill_array_type (descr_type,
+	  tree_cons (NULL_TREE,
+	    build_chill_range_type (NULL_TREE, integer_one_node,
+				    integer_one_node),
+		     NULL_TREE),
+		       0, NULL_TREE);
+    if (event_length == NULL_TREE)
+      event_length = infinite_buffer_event_length_node;
+
+    descr_init = 
+      tree_cons (NULL_TREE, force_addr_of (event),
+        tree_cons (NULL_TREE, event_length, NULL_TREE));
+    array_init = 
+      tree_cons (NULL_TREE,
+		 build_nt (CONSTRUCTOR, NULL_TREE, descr_init),
+		 NULL_TREE);
+    array_decl = 
+      decl_temp1 (get_unique_identifier ("event_codes_array"),
+		  array_type_node, 0, 
+		  build_nt (CONSTRUCTOR, NULL_TREE, array_init),
+		  0, 0);
+
+    event_codes =
+      decl_temp1 (get_unique_identifier ("event_ptr"), 
+		  ptr_type_node, 0, 
+		  force_addr_of (array_decl),
+		  0, 0);
+
+    actuallist = 
+      tree_cons (NULL_TREE, ev_got,
+        tree_cons (NULL_TREE, integer_one_node,
+	  tree_cons (NULL_TREE, event_codes,
+            tree_cons (NULL_TREE, optpriority,
+              tree_cons (NULL_TREE, to_loc,
+	        tree_cons (NULL_TREE, null_pointer_node,
+	          tree_cons (NULL_TREE, filename,
+		    tree_cons (NULL_TREE, linenumber, NULL_TREE))))))));
+
+		   
+    build_timesupervised_call (
+      build_chill_function_call (
+	lookup_name (get_identifier ("__delay_event")),
+	  actuallist), to_loc);
+  }
+}
+
+void
+expand_send_buffer (buffer, value, optpriority, optwith, optto)
+     tree buffer, value, optpriority, optwith, optto;
+{
+  tree filename, linenumber;
+  tree buffer_mode_decl = NULL_TREE;
+  tree buffer_ptr, value_ptr;
+  int  had_errors = 0;
+  tree timeout_value, fcall;
+  
+  /* check buffer location */
+  if (buffer == NULL_TREE || TREE_CODE (buffer) == ERROR_MARK)
+    {
+      buffer = NULL_TREE;
+      had_errors = 1;
+    }
+  if (buffer != NULL_TREE)
+    {
+      if (! CH_IS_BUFFER_MODE (TREE_TYPE (buffer)) || ! CH_REFERABLE (buffer))
+	{
+	  error ("send buffer action requires a BUFFER location.");
+	  had_errors = 1;
+	}
+      else
+	buffer_mode_decl = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (buffer)));
+    }
+
+  /* check value and type */
+  if (value == NULL_TREE || TREE_CODE (value) == ERROR_MARK)
+    {
+      had_errors = 1;
+      value = NULL_TREE;
+    }
+  if (value != NULL_TREE)
+    {
+      if (TREE_CHAIN (value) != NULL_TREE)
+	{
+	  error ("there must be only 1 value for send buffer action.");
+	  had_errors = 1;
+	}
+      else
+	{
+	  value = TREE_VALUE (value);
+	  if (value == NULL_TREE || TREE_CODE (value) == ERROR_MARK)
+	    {
+	      had_errors = 1;
+	      value = NULL_TREE;
+	    }
+	  if (value != NULL_TREE && buffer_mode_decl != NULL_TREE)
+	    {
+	      if (TREE_TYPE (buffer_mode_decl) != NULL_TREE &&
+		  TREE_CODE (TREE_TYPE (buffer_mode_decl)) == ERROR_MARK)
+		had_errors = 1;
+	      else if (CH_COMPATIBLE (value, TREE_TYPE (buffer_mode_decl)))
+		{
+		  value = convert (TREE_TYPE (buffer_mode_decl), value);
+		  if (value == NULL_TREE || TREE_CODE (value) == ERROR_MARK)
+		    {
+		      error ("convert failed for send buffer action.");
+		      had_errors = 1;
+		    }
+		}
+	      else
+		{
+		  error ("incompatible modes in send buffer action.");
+		  had_errors = 1;
+		}
+	    }
+	}
+    }
+
+  /* check the presence of priority */
+  if (optpriority == NULL_TREE)
+    {
+      if (send_buffer_prio == NULL_TREE)
+	{
+	  /* issue a warning in case of -Wall */
+	  if (extra_warnings)
+	    {
+	      warning ("Buffer sent without priority");
+	      warning (" and no default priority was set.");
+	      warning (" PRIORITY defaulted to 0.");
+	    }
+	  optpriority = integer_zero_node;
+	}
+      else
+	optpriority = send_buffer_prio;
+    }
+  else if (TREE_CODE (optpriority) == ERROR_MARK)
+    had_errors = 1;
+  else if (TREE_CODE (TREE_TYPE (optpriority)) != INTEGER_TYPE)
+    {
+      error ("PRIORITY must be of integer type.");
+      had_errors = 1;
+    }
+
+  if (optwith != NULL_TREE)
+    {
+      error ("WITH not allowed for send buffer action.");
+      had_errors = 1;
+    }
+  if (optto != NULL_TREE)
+    {
+      error ("TO not allowed for send buffer action.");
+      had_errors = 1;
+    }
+  if (had_errors)
+    return;
+
+  {
+    tree descr_type;
+    tree buffer_descr, buffer_init, buffer_length;
+    tree val;
+
+    /* process timeout */
+    timeout_value = build_timeout_preface ();
+
+    descr_type = lookup_name (get_identifier ("__tmp_DESCR_type"));
+
+    /* build descr for buffer */
+    buffer_length = max_queue_size (TREE_TYPE (buffer));
+    if (buffer_length == NULL_TREE)
+      buffer_length = infinite_buffer_event_length_node;
+    buffer_init = build_nt (CONSTRUCTOR, NULL_TREE,
+		    tree_cons (NULL_TREE, force_addr_of (buffer),
+                      tree_cons (NULL_TREE, buffer_length, NULL_TREE)));
+    buffer_descr = decl_temp1 (get_unique_identifier ("buffer_descr"),
+			       TREE_TYPE (descr_type), 0, buffer_init,
+			       0, 0);
+    buffer_ptr = decl_temp1 (get_unique_identifier ("buffer_ptr"),
+			     ptr_type_node, 0,
+			     force_addr_of (buffer_descr),
+			     0, 0);
+
+    /* build descr for value */
+    if (! CH_REFERABLE (value))
+      val = decl_temp1 (get_identifier ("buffer_value"),
+			TREE_TYPE (value), 0,
+			value, 0, 0);
+    else
+      val = value;
+
+    value_ptr = build_chill_descr (val);
+
+  }
+
+  /* get filename and linenumber */
+  filename = force_addr_of (get_chill_filename ());
+  linenumber = get_chill_linenumber ();
+  
+  /* Now, we can call the runtime */
+  fcall = build_chill_function_call (
+    lookup_name (get_identifier ("__send_buffer")),
+      tree_cons (NULL_TREE, buffer_ptr,
+	tree_cons (NULL_TREE, value_ptr,
+	  tree_cons (NULL_TREE, optpriority,
+            tree_cons (NULL_TREE, timeout_value,
+              tree_cons (NULL_TREE, filename,
+                tree_cons (NULL_TREE, linenumber, NULL_TREE)))))));
+  build_timesupervised_call (fcall, timeout_value);
+}
+# if 0
+
+void
+process_buffer_decls (namelist, mode, optstatic)
+  tree namelist, mode;
+  int  optstatic;
+{
+  tree names;
+  int quasi_flag = current_module->is_spec_module;
+
+  if (pass < 2)
+    return;
+
+  for (names = namelist; names != NULL_TREE; names = TREE_CHAIN (names))
+    { 
+      tree name = TREE_VALUE (names);
+      tree bufdecl = lookup_name (name);
+      tree code_decl = 
+	decl_tasking_code_variable (name, &buffer_code, quasi_flag);
+
+      /* remember the code variable in the buffer decl */
+      DECL_TASKING_CODE_DECL (bufdecl) = (struct lang_decl *)code_decl;
+
+      add_taskstuff_to_list (code_decl, "_TT_Buffer", 
+			     quasi_flag ? NULL_TREE : buffer_code,
+			     bufdecl);
+    }
+}
+#endif
+
+/*
+ * if no queue size was specified, QUEUESIZE is integer_zero_node.
+ */
+tree
+build_buffer_type (element_type, queuesize)
+     tree element_type, queuesize;
+{
+  tree type, field;
+  if (element_type == NULL_TREE || TREE_CODE (element_type) == ERROR_MARK)
+    return error_mark_node;
+  if (queuesize != NULL_TREE && TREE_CODE (queuesize) == ERROR_MARK)
+    return error_mark_node;
+
+  type = make_node (RECORD_TYPE);
+  field = build_decl (FIELD_DECL, get_identifier("__buffer_data"),
+		      ptr_type_node);
+  TYPE_FIELDS (type) = field;
+  TREE_CHAIN (field)
+    = build_lang_decl (TYPE_DECL, get_identifier ("__element_mode"),
+		       element_type);
+  field = TREE_CHAIN (field);
+  if (queuesize)
+    {
+      tree size_field = build_decl (CONST_DECL, get_identifier("__queue_max"),
+				    integer_type_node);
+      DECL_INITIAL (size_field) = queuesize;
+      TREE_CHAIN (field) = size_field;
+    }
+  CH_IS_BUFFER_MODE (type) = 1;
+  CH_TYPE_NONVALUE_P (type) = 1;
+  if (pass == 2)
+    type = layout_chill_struct_type (type);
+  return type;
+}
+
+#if 0
+tree
+build_buffer_descriptor (bufname, expr, optpriority)
+     tree bufname, expr, optpriority;
+{
+  tree bufdecl;
+
+  if (bufname == NULL_TREE
+      || TREE_CODE (bufname) == ERROR_MARK)
+    return error_mark_node;
+
+  if (expr != NULL_TREE
+      && TREE_CODE (expr) == ERROR_MARK)
+    return error_mark_node;
+#if 0
+/* FIXME: is this what we really want to test? */
+  bufdecl = lookup_name (bufname);
+  if (TREE_CODE (bufdecl) != TYPE_DECL
+      || ! CH_IS_BUFFER_MODE (TREE_TYPE (bufdecl)))
+    {
+      error ("SEND requires a BUFFER; `%s' is not a BUFFER name", 
+	     bufname);
+      return error_mark_node;
+    }
+#endif
+  {
+    /* build buffer/signal data structure */
+    tree bufdataname = get_unique_identifier (IDENTIFIER_POINTER (bufname));
+    tree dataptr;
+
+    if (expr == NULL_TREE)
+      dataptr = null_pointer_node;
+    else
+      {
+	tree decl = 
+	  decl_temp1 (bufdataname, TREE_TYPE (bufdecl), 0, 
+		      expr, 0, 0);
+	/* prevent granting of this variable */
+	DECL_SOURCE_LINE (decl) = 0;
+
+	dataptr = force_addr_of (decl);
+      }
+    
+    /* build descriptor pointing to buffer data */
+    {
+      tree tasking_message_var = get_unique_identifier (IDENTIFIER_POINTER (bufname));
+      tree data_len = (expr == NULL_TREE) ? integer_zero_node :
+	                     size_in_bytes (TREE_TYPE (bufdecl));
+      tree tasking_code = (tree)DECL_TASKING_CODE_DECL (bufdecl);
+      tree tuple = build_nt (CONSTRUCTOR, NULL_TREE,
+		     tree_cons (NULL_TREE, 
+		       build1 (ADDR_EXPR, 
+			       build_chill_pointer_type (chill_integer_type_node), 
+			       tasking_code),
+			   tree_cons (NULL_TREE, data_len,
+			     tree_cons (NULL_TREE, dataptr, NULL_TREE))));
+			      
+      tree decl = decl_temp1 (tasking_message_var,
+			      TREE_TYPE (tasking_message_type), 0,
+			      tuple, 0, 0);
+      mark_addressable (tasking_code);
+      /* prevent granting of this variable */
+      DECL_SOURCE_LINE (decl) = 0;
+
+      tuple = force_addr_of (decl);
+      return tuple;
+    }
+  }
+}
+#endif
+
+#if 0
+void
+process_event_decls (namelist, mode, optstatic)
+  tree namelist, mode;
+  int  optstatic;
+{
+  tree names;
+  int quasi_flag = current_module->is_spec_module;
+
+  if (pass < 2)
+    return;
+
+  for (names = namelist; names != NULL_TREE; names = TREE_CHAIN (names))
+    { 
+      tree name = TREE_VALUE (names);
+      tree eventdecl = lookup_name (name);
+      tree code_decl = 
+	decl_tasking_code_variable (name, &event_code, quasi_flag);
+
+      /* remember the code variable in the event decl */
+      DECL_TASKING_CODE_DECL (eventdecl) = (struct lang_decl *)code_decl;
+
+      add_taskstuff_to_list (code_decl, "_TT_Event", 
+			     quasi_flag ? NULL_TREE : event_code,
+			     eventdecl);
+    }
+}
+#endif
+
+/* Return the buffer or event length of a buffer or event mode.
+   (NULL_TREE means unlimited.) */
+
+tree
+max_queue_size (mode)
+     tree mode;
+{
+  tree field = TYPE_FIELDS (mode);
+  for ( ; field != NULL_TREE ; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (field) == CONST_DECL)
+	return DECL_INITIAL (field);
+    }
+  return NULL_TREE;
+}
+
+/* Return the buffer element mode of a buffer mode. */
+
+tree
+buffer_element_mode (bufmode)
+     tree bufmode;
+{
+  tree field = TYPE_FIELDS (bufmode);
+  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (field) == TYPE_DECL)
+	return TREE_TYPE (field);
+    }
+  return NULL_TREE;
+}
+
+/* invalidate buffer element mode in case we detect, that the
+   elelment mode has the non-value property */
+
+void
+invalidate_buffer_element_mode (bufmode)
+     tree bufmode;
+{
+  tree field = TYPE_FIELDS (bufmode);
+  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (field) == TYPE_DECL)
+	{
+	  TREE_TYPE (field) = error_mark_node;
+	  return;
+	}
+    }
+}
+
+/* For an EVENT or BUFFER mode TYPE, with a give maximum queue size QSIZE,
+   perform various error checks.  Return a new queue size. */
+
+tree
+check_queue_size (type, qsize)
+     tree type, qsize;
+{
+  if (qsize == NULL_TREE || TREE_CODE (qsize) == ERROR_MARK)
+    return qsize;
+  if (TREE_TYPE (qsize) == NULL_TREE
+      || !CH_SIMILAR (TREE_TYPE (qsize), integer_type_node))
+    {
+      error ("non-integral max queue size for EVENT/BUFFER mode");
+      return integer_one_node;
+    }
+  if (TREE_CODE (qsize) != INTEGER_CST)
+    {
+      error ("non-constant max queue size for EVENT/BUFFER mode");
+      return integer_one_node;
+    }
+  if (compare_int_csts (pedantic ? LE_EXPR : LT_EXPR,
+			qsize,
+			integer_zero_node))
+    {
+      error ("max queue_size for EVENT/BUFFER is not positive");
+      return integer_one_node;
+    }
+  return qsize;
+}
+
+/*
+ * An EVENT type is modelled as a boolean type, which should
+ * allocate the minimum amount of space.
+ */
+tree
+build_event_type (queuesize)
+     tree queuesize;
+{
+  tree type = make_node (RECORD_TYPE);
+  tree field = build_decl (FIELD_DECL, get_identifier("__event_data"),
+		      ptr_type_node);
+  TYPE_FIELDS (type) = field;
+  if (queuesize)
+    {
+      tree size_field = build_decl (CONST_DECL, get_identifier("__queue_max"),
+				    integer_type_node);
+      DECL_INITIAL (size_field) = queuesize;
+      TREE_CHAIN (field) = size_field;
+    }
+  CH_IS_EVENT_MODE (type) = 1;
+  CH_TYPE_NONVALUE_P (type) = 1;
+  if (pass == 2)
+    type = layout_chill_struct_type (type);
+  return type;
+}
+
+/*
+ * Initialize the various types of tasking data.
+ */
+void
+tasking_init ()
+{
+  extern int  ignore_case;
+  extern int  special_UC;
+  extern tree chill_predefined_function_type;
+  tree temp, ins_ftype_void;
+  tree endlink = void_list_node;
+  tree int_ftype_ptr_int_ptr_ptr_int_ptr_int_ptr_ptr_int;
+  tree void_ftype_ptr;
+  tree void_ftype_ptr_ins_int_int_ptr_ptr_int;
+  tree int_ftype_ptr_ptr_int_ptr_ptr_int;
+  tree void_ftype_int_int_int_ptr_ptr_ptr_int;
+  tree int_ftype_ptr_int_ptr_int_ptr_ptr_ptr_int;
+  tree int_ftype_ptr_int;
+
+  /* type of tasking code variables */
+  chill_taskingcode_type_node = short_unsigned_type_node;
+
+  void_ftype_void =
+       build_function_type (void_type_node,
+	 tree_cons (NULL_TREE, void_type_node, NULL_TREE));
+
+  build_instance_type ();
+  ins_ftype_void
+    = build_function_type (instance_type_node,
+        tree_cons (NULL_TREE, void_type_node,
+	  build_tree_list (NULL_TREE, void_type_node)));
+
+  builtin_function ("__whoami", ins_ftype_void,
+		    NOT_BUILT_IN, NULL_PTR);
+
+  build_tasking_message_type ();
+   
+  temp = build_decl (TYPE_DECL,
+	   get_identifier ("__tmp_TaskingStruct"),
+	     build_tasking_struct ());
+  pushdecl (temp);
+  DECL_SOURCE_LINE (temp) = 0;
+
+  /* any SIGNAL will be compatible with this one */
+  generic_signal_type_node = copy_node (boolean_type_node);
+
+  builtin_function ((ignore_case || ! special_UC) ? "copy_number" : "COPY_NUMBER",
+		    chill_predefined_function_type,
+		    BUILT_IN_COPY_NUMBER, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "gen_code" : "GEN_CODE",
+		    chill_predefined_function_type,
+		    BUILT_IN_GEN_CODE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "gen_inst" : "GEN_INST",
+		    chill_predefined_function_type,
+		    BUILT_IN_GEN_INST, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "gen_ptype" : "GEN_PTYPE",
+		    chill_predefined_function_type,
+		    BUILT_IN_GEN_PTYPE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "proc_type" : "PROC_TYPE",
+		    chill_predefined_function_type,
+		    BUILT_IN_PROC_TYPE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "queue_length" : "QUEUE_LENGTH",
+		    chill_predefined_function_type,
+		    BUILT_IN_QUEUE_LENGTH, NULL_PTR);
+
+  int_ftype_ptr_int_ptr_ptr_int_ptr_int_ptr_ptr_int
+     = build_function_type (integer_type_node,
+         tree_cons (NULL_TREE, ptr_type_node,
+	   tree_cons (NULL_TREE, integer_type_node,
+	     tree_cons (NULL_TREE, ptr_type_node,
+	       tree_cons (NULL_TREE, ptr_type_node,
+		 tree_cons (NULL_TREE, integer_type_node,
+		   tree_cons (NULL_TREE, ptr_type_node,
+		     tree_cons (NULL_TREE, integer_type_node,
+                       tree_cons (NULL_TREE, ptr_type_node,
+                         tree_cons (NULL_TREE, ptr_type_node,
+                           tree_cons (NULL_TREE, integer_type_node,
+			     endlink)))))))))));
+  void_ftype_ptr
+     = build_function_type (void_type_node,
+           tree_cons (NULL_TREE, ptr_type_node, endlink));
+
+  int_ftype_ptr_int_ptr_int_ptr_ptr_ptr_int
+     = build_function_type (integer_type_node,
+         tree_cons (NULL_TREE, ptr_type_node,
+	   tree_cons (NULL_TREE, integer_type_node,
+	     tree_cons (NULL_TREE, ptr_type_node,
+               tree_cons (NULL_TREE, integer_type_node,
+		 tree_cons (NULL_TREE, ptr_type_node,
+		   tree_cons (NULL_TREE, ptr_type_node,
+		     tree_cons (NULL_TREE, ptr_type_node,
+		       tree_cons (NULL_TREE, integer_type_node,
+		         endlink)))))))));
+
+  void_ftype_ptr_ins_int_int_ptr_ptr_int
+    = build_function_type (void_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	      tree_cons (NULL_TREE, instance_type_node,
+		  tree_cons (NULL_TREE, integer_type_node,
+		      tree_cons (NULL_TREE, integer_type_node,
+		        tree_cons (NULL_TREE, ptr_type_node,
+			    tree_cons (NULL_TREE, ptr_type_node,
+				tree_cons (NULL_TREE, integer_type_node,
+		                    endlink))))))));
+  int_ftype_ptr_ptr_int_ptr_ptr_int
+    = build_function_type (integer_type_node,
+	  tree_cons (NULL_TREE, ptr_type_node,
+	    tree_cons (NULL_TREE, ptr_type_node,
+	        tree_cons (NULL_TREE, integer_type_node,
+		    tree_cons (NULL_TREE, ptr_type_node,
+		        tree_cons (NULL_TREE, ptr_type_node,
+		            tree_cons (NULL_TREE, integer_type_node,
+		                endlink)))))));
+
+  void_ftype_int_int_int_ptr_ptr_ptr_int
+     = build_function_type (void_type_node,
+	   tree_cons (NULL_TREE, integer_type_node,
+	       tree_cons (NULL_TREE, integer_type_node,
+		   tree_cons (NULL_TREE, integer_type_node,
+		       tree_cons (NULL_TREE, ptr_type_node,
+			   tree_cons (NULL_TREE, ptr_type_node,
+		               tree_cons (NULL_TREE, ptr_type_node,
+				   tree_cons (NULL_TREE, integer_type_node,
+			               endlink))))))));
+
+  int_ftype_ptr_int
+     = build_function_type (integer_type_node,
+	   tree_cons (NULL_TREE, ptr_type_node,
+               tree_cons (NULL_TREE, integer_type_node,
+                   endlink)));
+
+  builtin_function ("__delay_event", int_ftype_ptr_int_ptr_int_ptr_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__queue_length", int_ftype_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__register_tasking", void_ftype_ptr,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__send_signal", void_ftype_ptr_ins_int_int_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__send_buffer", int_ftype_ptr_ptr_int_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__start_process", void_ftype_int_int_int_ptr_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__stop_process", void_ftype_void, NOT_BUILT_IN,
+		    NULL_PTR);
+  builtin_function ("__wait_buffer", int_ftype_ptr_int_ptr_ptr_int_ptr_int_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__wait_signal_timed", int_ftype_ptr_int_ptr_ptr_int_ptr_int_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+
+  infinite_buffer_event_length_node = build_int_2 (-1, 0);
+  TREE_TYPE (infinite_buffer_event_length_node) = long_integer_type_node;
+  TREE_UNSIGNED (infinite_buffer_event_length_node) = 1;
+}
diff --git a/gcc/ch/timing.c b/gcc/ch/timing.c
new file mode 100644
index 0000000..f96b715
--- /dev/null
+++ b/gcc/ch/timing.c
@@ -0,0 +1,494 @@
+/* Implement timing-related actions for CHILL.
+   Copyright (C) 1992, 93, 1994 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.  */
+
+#include <stdio.h>
+#include <limits.h>
+#include <string.h>
+#include "config.h"
+#include "tree.h"
+#include "rtl.h"
+#include "ch-tree.h"
+#include "flags.h"
+#include "input.h"
+#include "obstack.h"
+#include "lex.h"
+
+#ifndef LONG_TYPE_SIZE
+#define LONG_TYPE_SIZE BITS_PER_WORD
+#endif
+
+/* set non-zero if input text is forced to lowercase */
+extern int ignore_case;
+
+/* set non-zero if special words are to be entered in uppercase */
+extern int special_UC;
+
+/* timing modes */
+tree abs_timing_type_node;
+tree duration_timing_type_node;
+
+/* rts time type */
+static tree rtstime_type_node = NULL_TREE;
+
+/* the stack for AFTER primval [ DELAY ] IN 
+   and has following layout
+
+   TREE_VALUE (TREE_VALUE (after_stack)) = current time or NULL_TREE (if DELAY specified)
+   TREE_PURPOSE (TREE_VALUE (after_stack)) = the duration location
+   TREE_VALUE (TREE_PURPOSE (after_stack)) = label at TIMEOUT
+   TREE_PURPOSE (TREE_PURPOSE (after_stack)) = label at the end of AFTER action
+*/
+tree after_stack = NULL_TREE;
+
+/* in pass 1 we need a seperate list for the labels */
+static tree after_stack_pass_1 = NULL_TREE;
+static tree after_help;
+
+void
+timing_init ()
+{
+  tree ptr_ftype_durt_ptr_int;
+  tree int_ftype_abst_ptr_int;
+  tree void_ftype_ptr;
+  tree long_ftype_int_int_int_int_int_int_int_ptr_int;
+  tree void_ftype_abstime_ptr;
+  tree int_ftype_ptr_durt_ptr;
+  tree void_ftype_durt_ptr;
+  tree void_ftype_ptr_durt_ptr_int;
+  tree temp;
+  tree endlink;
+  tree ulong_type;
+  
+  ulong_type = TREE_TYPE (lookup_name (
+		          get_identifier ((ignore_case || ! special_UC ) ?
+					  "ulong" : "ULONG")));
+
+  /* build modes for TIME and DURATION */
+  duration_timing_type_node = make_unsigned_type (LONG_TYPE_SIZE);
+  temp = pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_DURATION],
+			       duration_timing_type_node));
+  SET_CH_NOVELTY_NONNIL (duration_timing_type_node, temp);
+  abs_timing_type_node = make_unsigned_type (LONG_TYPE_SIZE);
+  temp = pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_TIME],
+			       abs_timing_type_node));
+  SET_CH_NOVELTY_NONNIL (abs_timing_type_node, temp);
+
+  /* the mode of time the runtimesystem returns */
+  if (rtstime_type_node == NULL_TREE)
+  {
+      tree decl1, decl2, result;
+
+      decl1 = build_decl (FIELD_DECL,
+			  get_identifier ("secs"),
+			  ulong_type);
+      DECL_INITIAL (decl1) = NULL_TREE;
+      decl2 = build_decl (FIELD_DECL,
+			  get_identifier ("nsecs"),
+			  ulong_type);
+      DECL_INITIAL (decl2) = NULL_TREE;
+      TREE_CHAIN (decl2) = NULL_TREE;
+      TREE_CHAIN (decl1) = decl2;
+      
+      result = build_chill_struct_type (decl1);
+      pushdecl (temp = build_decl (TYPE_DECL,
+	get_identifier ("__tmp_rtstime"), result));
+      DECL_SOURCE_LINE (temp) = 0;
+      satisfy_decl (temp, 0);
+      rtstime_type_node = TREE_TYPE (temp);
+  }
+  
+  endlink = void_list_node;
+  
+  ptr_ftype_durt_ptr_int
+    = build_function_type (ptr_type_node,
+         tree_cons (NULL_TREE, duration_timing_type_node,
+             tree_cons (NULL_TREE, ptr_type_node,
+                 tree_cons (NULL_TREE, integer_type_node,
+                     endlink))));
+
+  int_ftype_abst_ptr_int
+    = build_function_type (integer_type_node,
+         tree_cons (NULL_TREE, abs_timing_type_node,
+             tree_cons (NULL_TREE, ptr_type_node,
+                 tree_cons (NULL_TREE, integer_type_node,
+                     endlink))));
+
+  void_ftype_ptr
+     = build_function_type (void_type_node,
+	   tree_cons (NULL_TREE, ptr_type_node,
+	       endlink));
+
+  long_ftype_int_int_int_int_int_int_int_ptr_int
+    = build_function_type (abs_timing_type_node,
+	 tree_cons (NULL_TREE, integer_type_node,
+	    tree_cons (NULL_TREE, integer_type_node,
+	       tree_cons (NULL_TREE, integer_type_node,
+	          tree_cons (NULL_TREE, integer_type_node,
+	             tree_cons (NULL_TREE, integer_type_node,
+	                tree_cons (NULL_TREE, integer_type_node,
+	                   tree_cons (NULL_TREE, integer_type_node,
+	                      tree_cons (NULL_TREE, ptr_type_node,
+	                         tree_cons (NULL_TREE, integer_type_node,
+			            endlink))))))))));
+
+  void_ftype_abstime_ptr
+    = build_function_type (void_type_node,
+          tree_cons (NULL_TREE, abs_timing_type_node,
+              tree_cons (NULL_TREE, ptr_type_node,
+                  endlink)));
+
+  int_ftype_ptr_durt_ptr
+    = build_function_type (integer_type_node,
+          tree_cons (NULL_TREE, ptr_type_node,
+              tree_cons (NULL_TREE, duration_timing_type_node,
+                  tree_cons (NULL_TREE, ptr_type_node,
+                      endlink))));
+
+  void_ftype_durt_ptr
+    = build_function_type (void_type_node,
+          tree_cons (NULL_TREE, duration_timing_type_node,
+              tree_cons (NULL_TREE, ptr_type_node,
+                  endlink)));
+
+  void_ftype_ptr_durt_ptr_int
+    = build_function_type (void_type_node,
+        tree_cons (NULL_TREE, ptr_type_node,
+          tree_cons (NULL_TREE, duration_timing_type_node,
+            tree_cons (NULL_TREE, ptr_type_node,
+              tree_cons (NULL_TREE, integer_type_node,
+                endlink)))));
+
+  builtin_function ("_abstime", long_ftype_int_int_int_int_int_int_int_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__check_cycle", void_ftype_ptr_durt_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__convert_duration_rtstime", void_ftype_durt_ptr,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__define_timeout", ptr_ftype_durt_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("_inttime", void_ftype_abstime_ptr,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__remaintime", int_ftype_ptr_durt_ptr,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__rtstime", void_ftype_ptr,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__wait_until", int_ftype_abst_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+}
+
+#if 0
+ *
+ * build AT action
+ *
+ * AT primval IN
+ *  ok-actionlist
+ * TIMEOUT
+ *  to-actionlist
+ * END;
+ *
+ * gets translated to
+ *
+ * if (__wait_until (primval) == 0)
+ *   ok-actionlist
+ * else
+ *   to-action-list
+ *
+#endif
+
+void
+build_at_action (t)
+     tree t;
+{
+  tree abstime, expr, filename, fcall;
+  
+  if (t == NULL_TREE || TREE_CODE (t) == ERROR_MARK)
+    abstime = convert (abs_timing_type_node, build_int_2 (0, 0));
+  else
+    abstime = t;
+  
+  if (TREE_TYPE (abstime) != abs_timing_type_node)
+    {
+      error ("absolute time value must be of mode TIME.");
+      abstime = convert (abs_timing_type_node, build_int_2 (0, 0));
+    }
+  filename = force_addr_of (get_chill_filename ());
+  fcall = build_chill_function_call (
+	    lookup_name (get_identifier ("__wait_until")),
+	      tree_cons (NULL_TREE, abstime,
+		tree_cons (NULL_TREE, filename,
+		  tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
+  expr = build (EQ_EXPR, integer_type_node, fcall, integer_zero_node);
+  expand_start_cond (expr, 0);
+  emit_line_note (input_filename, lineno);
+}
+
+#if 0
+ *
+ * build CYCLE action
+ *
+ * CYCLE primval IN
+ *  actionlist
+ * END;
+ *
+ * gets translated to
+ *
+ * {
+ *    RtsTime  now; 
+ *  label:
+ *    __rtstime (&now); 
+ *     actionlist
+ *    __check_cycle (&now, primval, filename, lineno); 
+ *    goto label;
+ *  }
+ *
+#endif
+
+tree
+build_cycle_start (t)
+    tree t;
+{
+  tree purpose = build_tree_list (NULL_TREE, NULL_TREE);
+  tree toid = build_tree_list (purpose, NULL_TREE);
+
+  /* define the label. Note: define_label needs to be called in
+     pass 1 and pass 2. */
+  TREE_VALUE (toid) = define_label (input_filename, lineno,
+				    get_unique_identifier ("CYCLE_label"));
+  if (! ignoring)
+    {
+      tree duration_value, now_location;
+      
+      if (t == NULL_TREE || TREE_CODE (t) == ERROR_MARK)
+	duration_value = convert (duration_timing_type_node, build_int_2 (0,0));
+      else
+	duration_value = t;
+      
+      if (TREE_TYPE (duration_value) != duration_timing_type_node)
+	{
+	  error ("duration primitive value must be of mode DURATION.");
+	  duration_value = convert (duration_timing_type_node, build_int_2 (0,0));
+	}
+      TREE_PURPOSE (TREE_PURPOSE (toid)) = duration_value;
+      /* define the variable */
+      now_location = decl_temp1 (get_unique_identifier ("CYCLE_var"),
+				 rtstime_type_node, 0,
+				 NULL_TREE, 0, 0);
+      TREE_VALUE (TREE_PURPOSE (toid)) = force_addr_of (now_location);
+      
+      /* build the call to __rtstime */
+      expand_expr_stmt (
+        build_chill_function_call (lookup_name (get_identifier ("__rtstime")),
+          build_tree_list (NULL_TREE, TREE_VALUE (TREE_PURPOSE (toid)))));
+    }
+
+  return toid;
+}
+
+void
+build_cycle_end (toid)
+     tree toid;
+{
+  tree filename, linenumber;
+  
+  /* here we call __check_cycle and then jump to beginning of this
+     action */
+  filename = force_addr_of (get_chill_filename ());
+  linenumber = get_chill_linenumber ();
+  expand_expr_stmt (
+    build_chill_function_call (
+      lookup_name (get_identifier ("__check_cycle")),
+	tree_cons (NULL_TREE, TREE_VALUE (TREE_PURPOSE (toid)),
+          tree_cons (NULL_TREE, TREE_PURPOSE (TREE_PURPOSE (toid)),
+	    tree_cons (NULL_TREE, filename,
+	      tree_cons (NULL_TREE, linenumber, NULL_TREE))))));
+  expand_goto (TREE_VALUE (toid));
+}
+
+#if 0
+ *
+ * build AFTER ACTION
+ *
+ * AFTER primval [ DELAY ] IN
+ *  action-list
+ * TIMEOUT
+ *  to-action-list
+ * END
+ *
+ * gets translated to
+ *
+ * {
+ *   struct chill_time __now; 
+ *   duration dur = primval; 
+ *   if (! delay_spceified)
+ *     __rts_time (&__now); 
+ *     .
+ *     .
+ *    goto end-label;
+ *   to-label:
+ *     .
+ *     .
+ *   end-label:
+ * }
+ *
+#endif
+
+void
+build_after_start (duration, delay_flag)
+    tree duration;
+    int  delay_flag;
+{
+  tree value, purpose;
+  
+  if (! ignoring)
+    {
+      value = tree_cons (NULL_TREE, NULL_TREE, NULL_TREE);
+      purpose = after_stack_pass_1;
+      after_stack_pass_1 = TREE_CHAIN (after_stack_pass_1);
+      after_stack = tree_cons (purpose, value, after_stack);
+      
+      if (TREE_TYPE (duration) != duration_timing_type_node)
+        {
+	  error ("duration primitive value must be of mode DURATION.");
+	  duration = convert (duration_timing_type_node, build_int_2 (0,0));
+        }
+      TREE_PURPOSE (value) = decl_temp1 (get_identifier ("AFTER_duration"),
+					 duration_timing_type_node, 0,
+					 duration, 0, 0);
+      
+      if (! delay_flag)
+        {
+	  /* in this case we have to get the current time */
+	  TREE_VALUE (value) = decl_temp1 (get_unique_identifier ("AFTER_now"),
+					   rtstime_type_node, 0,
+					   NULL_TREE, 0, 0);
+	  /* build the function call to initialize the variable */
+	  expand_expr_stmt (
+            build_chill_function_call (lookup_name (get_identifier ("__rtstime")),
+              build_tree_list (NULL_TREE, force_addr_of (TREE_VALUE (value)))));
+        }
+    }
+  else
+    {
+      /* in pass 1 we just save the labels */
+      after_help = tree_cons (NULL_TREE, NULL_TREE, after_help);
+      after_stack_pass_1 = chainon (after_stack_pass_1, after_help);
+    }
+}
+
+void
+build_after_timeout_start ()
+{
+  tree label_name, goto_where;
+  
+  if (! ignoring)
+    {
+      /* jump to the end of AFTER action */
+      lookup_and_expand_goto (TREE_PURPOSE (TREE_PURPOSE (after_stack)));
+      label_name = TREE_VALUE (TREE_PURPOSE (after_stack));
+      /* mark we are in TIMEOUT part of AFTER action */
+      TREE_VALUE (TREE_PURPOSE (after_stack)) = NULL_TREE;
+    }
+  else
+    {
+      label_name = get_unique_identifier ("AFTER_tolabel");
+      TREE_VALUE (after_help) = label_name;
+    }
+  define_label (input_filename, lineno, label_name);
+}
+
+void
+build_after_end ()
+{
+  tree label_name;
+    
+  /* define the end label */
+  if (! ignoring)
+    {
+      label_name = TREE_PURPOSE (TREE_PURPOSE (after_stack));
+      after_stack = TREE_CHAIN (after_stack);
+    }
+  else
+    {
+      label_name = get_unique_identifier ("AFTER_endlabel");
+      TREE_PURPOSE (after_help) = label_name;
+      after_help = TREE_CHAIN (after_help);
+    }
+  define_label (input_filename, lineno, label_name);
+}
+
+tree
+build_timeout_preface ()
+{
+  tree timeout_value = null_pointer_node;
+  
+  if (after_stack != NULL_TREE &&
+      TREE_VALUE (TREE_PURPOSE (after_stack)) != NULL_TREE)
+    {
+      tree to_loc;
+      
+      to_loc = decl_temp1 (get_unique_identifier ("TOloc"),
+			   rtstime_type_node, 0, NULL_TREE, 0, 0);
+      timeout_value = force_addr_of (to_loc);
+
+      if (TREE_VALUE (TREE_VALUE (after_stack)) == NULL_TREE)
+        {
+	  /* DELAY specified -- just call __convert_duration_rtstime for
+	     given duration value */
+	  expand_expr_stmt (
+            build_chill_function_call (
+              lookup_name (get_identifier ("__convert_duration_rtstime")),
+                tree_cons (NULL_TREE, TREE_PURPOSE (TREE_VALUE (after_stack)),
+                  tree_cons (NULL_TREE, timeout_value, NULL_TREE))));
+        }
+      else
+        {
+	  /* delay not specified -- call __remaintime which returns the 
+	     remaining time of duration in rtstime format and check the 
+	     result */
+	  tree fcall = 
+            build_chill_function_call (
+              lookup_name (get_identifier ("__remaintime")),
+                tree_cons (NULL_TREE, force_addr_of (TREE_VALUE (TREE_VALUE (after_stack))),
+		  tree_cons (NULL_TREE, TREE_PURPOSE (TREE_VALUE (after_stack)),
+                    tree_cons (NULL_TREE, timeout_value, NULL_TREE))));
+	  tree expr = build (NE_EXPR, integer_type_node,
+			     fcall, integer_zero_node);
+	  expand_start_cond (expr, 0);
+	  lookup_and_expand_goto (TREE_VALUE (TREE_PURPOSE (after_stack)));
+	  expand_end_cond ();
+        }
+    }
+  return timeout_value;
+}
+
+void
+build_timesupervised_call (fcall, to_loc)
+    tree fcall;
+    tree to_loc;
+{
+  if (to_loc == null_pointer_node)
+    expand_expr_stmt (fcall);
+  else
+    {
+      tree expr = build (NE_EXPR, integer_type_node, fcall, integer_zero_node);
+      expand_start_cond (expr, 0);
+      lookup_and_expand_goto (TREE_VALUE (TREE_PURPOSE (after_stack)));
+      expand_end_cond ();
+    }
+}
diff --git a/gcc/ch/typeck.c b/gcc/ch/typeck.c
new file mode 100644
index 0000000..5f97494
--- /dev/null
+++ b/gcc/ch/typeck.c
@@ -0,0 +1,3905 @@
+/* Build expressions with type checking for CHILL compiler.
+   Copyright (C) 1992, 93, 1994 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 file is part of the CHILL front end.
+   It contains routines to build C expressions given their operands,
+   including computing the modes of the result, C-specific error checks,
+   and some optimization.
+
+   There are also routines to build RETURN_STMT nodes and CASE_STMT nodes,
+   and to process initializations in declarations (since they work
+   like a strange sort of assignment).  */
+
+#include "config.h"
+#include <stdio.h>
+#include "tree.h"
+#include "ch-tree.h"
+#include "flags.h"
+#include "rtl.h"
+#include "expr.h"
+#include "lex.h"
+
+extern tree build_chill_compound_expr PROTO((tree));
+extern tree build_component_ref       PROTO((tree, tree));
+extern void c_expand_return           PROTO((tree));
+extern int  ch_singleton_set          PROTO((tree));
+extern void error                     PROTO((char *, ...));
+extern void error_with_decl           PROTO((tree, char *, ...));
+extern int  mark_addressable          PROTO((tree));
+extern void pedwarn                   PROTO((char *, ...));
+extern void pedwarn_with_decl         PROTO((tree, char *, ...));
+extern tree require_complete_type     PROTO((tree));
+extern void sorry                     PROTO((char *, ...));
+extern void warning                   PROTO((char *, ...));
+extern int  get_type_precision        PROTO((tree, tree));
+
+extern tree intQI_type_node;
+extern tree intHI_type_node;
+extern tree intSI_type_node;
+extern tree intDI_type_node;
+extern tree intTI_type_node;
+
+extern tree unsigned_intQI_type_node;
+extern tree unsigned_intHI_type_node;
+extern tree unsigned_intSI_type_node;
+extern tree unsigned_intDI_type_node;
+extern tree unsigned_intTI_type_node;
+
+/* forward declarations */
+tree chill_expand_tuple PROTO((tree, tree));
+static int chill_l_equivalent PROTO((tree, tree, struct mode_chain*));
+extern tree extract_constant_from_buffer();
+
+/*
+ * This function checks an array access.
+ * It calls error (ERROR_MESSAGE) if the condition (index <= domain max value
+ *                                     index >= domain min value)
+ *                   is not met at compile time,
+ *         If a runtime test is required and permitted,
+ *         check_expression is used to do so.
+ * the global RANGE_CHECKING flags controls the
+ * generation of runtime checking code.
+ */
+tree
+valid_array_index_p (array, idx, error_message, is_varying_lhs)
+     tree array, idx;
+     char *error_message;
+     int is_varying_lhs;
+{
+  tree cond, low_limit, high_cond, atype, domain;
+  tree orig_index = idx;
+  enum chill_tree_code condition;
+
+  if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK
+      || idx == NULL_TREE || TREE_CODE (idx) == ERROR_MARK)
+    return error_mark_node;
+  
+  if (TREE_CODE (idx) == TYPE_DECL
+      || TREE_CODE_CLASS (TREE_CODE (idx)) == 't')
+    {
+      error ("array or string index is a mode (instead of a value)");
+      return error_mark_node;
+    }
+
+  atype = TREE_TYPE (array);
+
+  if (chill_varying_type_p (atype))
+    {
+      domain = TYPE_DOMAIN (CH_VARYING_ARRAY_TYPE (atype));
+      high_cond = build_component_ref (array, var_length_id);
+      if (chill_varying_string_type_p (atype))
+	{
+	  if (is_varying_lhs)
+	    condition = GT_EXPR;
+	  else
+	    condition = GE_EXPR;
+	}
+      else
+	condition = GT_EXPR;
+    }
+  else
+    {
+      domain = TYPE_DOMAIN (atype);
+      high_cond = TYPE_MAX_VALUE (domain);
+      condition = GT_EXPR;
+    }
+
+  if (CH_STRING_TYPE_P (atype))
+    {
+      if (! CH_SIMILAR (TREE_TYPE (orig_index), integer_type_node))
+	{
+	  error ("index is not an integer expression");
+	  return error_mark_node;
+	}
+    }
+  else
+    {
+      if (! CH_COMPATIBLE (orig_index, domain))
+	{
+	  error ("index not compatible with index mode");
+	  return error_mark_node;
+	}
+    }
+
+  /* Convert BOOLS(1) to BOOL and CHARS(1) to CHAR. */
+  if (flag_old_strings)
+    {
+      idx = convert_to_discrete (idx);
+      if (idx == NULL) /* should never happen */
+	error ("index is not discrete");
+    }
+
+  /* we know we'll refer to this value twice */
+  if (range_checking)
+    idx = save_expr (idx);
+
+  low_limit = TYPE_MIN_VALUE (domain);
+  high_cond = build_compare_discrete_expr (condition, idx, high_cond);
+
+  /* an invalid index expression meets this condition */
+  cond = fold (build (TRUTH_ORIF_EXPR, boolean_type_node,
+	   build_compare_discrete_expr (LT_EXPR, idx, low_limit),
+	     high_cond));
+
+  /* strip a redundant NOP_EXPR */
+  if (TREE_CODE (cond) == NOP_EXPR
+      && TREE_TYPE (cond) == boolean_type_node
+      && TREE_CODE (TREE_OPERAND (cond, 0)) == INTEGER_CST)
+    cond = TREE_OPERAND (cond, 0);
+      
+  idx = convert (CH_STRING_TYPE_P (atype) ? integer_type_node : domain,
+		 idx);
+
+  if (TREE_CODE (cond) == INTEGER_CST)
+    {
+      if (tree_int_cst_equal (cond, boolean_false_node))
+	return idx;       /* condition met at compile time */
+      error (error_message); /* condition failed at compile time */
+      return error_mark_node;
+    }
+  else if (range_checking)
+    {
+      /* FIXME: often, several of these conditions will
+	 be generated for the same source file and line number.
+	 A great optimization would be to share the
+	 cause_exception function call among them rather
+	 than generating a cause_exception call for each. */
+      return check_expression (idx, cond,
+			       ridpointers[(int) RID_RANGEFAIL]);
+    }
+  else
+    return idx;           /* don't know at compile time */
+}
+
+/*
+ * Extract a slice from an array, which could look like a
+ * SET_TYPE if it's a bitstring.  The array could also be VARYING
+ * if the element type is CHAR.  The min_value and length values 
+ * must have already been checked with valid_array_index_p.  No 
+ * checking is done here.
+ */
+tree
+build_chill_slice (array, min_value, length)
+     tree array, min_value, length;
+{
+  tree result;
+  tree array_type = TREE_TYPE (array);
+
+  if (!CH_REFERABLE (array) && TREE_CODE (array) != SAVE_EXPR
+      && (TREE_CODE (array) != COMPONENT_REF
+	   || TREE_CODE (TREE_OPERAND (array, 0)) != SAVE_EXPR))
+    {
+      if (!TREE_CONSTANT (array))
+	warning ("possible internal error - slice argument is neither referable nor constant");
+      else
+	{
+	  /* Force to storage.
+	     NOTE:  This could mean multiple identical copies of
+	     the same constant.  FIXME. */
+	  tree mydecl = decl_temp1 (get_unique_identifier("SLICEE"),
+				    array_type, 1, array, 0, 0);
+	  TREE_READONLY (mydecl) = 1;
+	  /* mark_addressable (mydecl); FIXME: necessary? */
+	  array = mydecl;
+	}
+    }
+
+  /*
+     The code-generation which uses a slice tree needs not only to
+     know the dynamic upper and lower limits of that slice, but the
+     original static allocation, to use to build temps where one or both
+     of the dynamic limits must be calculated at runtime..  We pass the
+     dynamic size by building a new array_type whose limits are the
+     min_value and min_value + length values passed to us.  
+     
+     The static allocation info is passed by using the parent array's
+     limits to compute a temp_size, which is passed in the lang_specific
+     field of the slice_type.
+   */
+     
+  if (TREE_CODE (array_type) == ARRAY_TYPE)
+    {
+      tree domain_type = TYPE_DOMAIN (array_type);
+      tree index_domain
+	= TREE_CODE (length) != INTEGER_CST || integer_zerop (length)
+	? sizetype
+	: domain_type;
+      tree domain_min = convert (index_domain, TYPE_MIN_VALUE (domain_type));
+      tree domain_max = fold (build (PLUS_EXPR, index_domain,
+				     domain_min,
+				     convert (index_domain,
+					      size_binop (MINUS_EXPR,
+							  length,
+							  integer_one_node))));
+      tree index_type = build_chill_range_type (domain_type,
+						domain_min,
+						domain_max);
+
+      tree element_type = TREE_TYPE (array_type);
+      tree slice_type = build_simple_array_type (element_type, index_type, NULL_TREE);
+      tree slice_pointer_type;
+      int is_static;
+      tree max_size;
+
+      if (CH_CHARS_TYPE_P (array_type))
+	MARK_AS_STRING_TYPE (slice_type);
+      else
+	TYPE_PACKED (slice_type) = TYPE_PACKED (array_type);
+
+      SET_CH_NOVELTY (slice_type, CH_NOVELTY (array_type));
+
+      if (TREE_CONSTANT (array) && TREE_CODE (min_value) == INTEGER_CST
+	  && TREE_CODE (length) == INTEGER_CST)
+	{
+	  int type_size = int_size_in_bytes (array_type);
+	  unsigned char *buffer = (unsigned char*) alloca (type_size);
+	  int delta = int_size_in_bytes (element_type)
+	    * (TREE_INT_CST_LOW (min_value) - TREE_INT_CST_LOW (domain_min));
+	  bzero (buffer, type_size);
+	  if (expand_constant_to_buffer (array, buffer, type_size))
+	    {
+	      result = extract_constant_from_buffer (slice_type,
+						     buffer + delta,
+						     type_size - delta);
+	      if (result)
+		return result;
+	    }
+	}
+
+      /* Kludge used by case CONCAT_EXPR in chill_expand_expr.
+	 Set TYPE_ARRAY_MAX_SIZE to a constant upper bound on the
+	 bytes needed. */
+      max_size = size_in_bytes (slice_type);
+      if (TREE_CODE (max_size) != INTEGER_CST)
+	{
+	  max_size = TYPE_ARRAY_MAX_SIZE (array_type);
+	  if (max_size == NULL_TREE)
+	    max_size = size_in_bytes (array_type);
+	}
+      TYPE_ARRAY_MAX_SIZE (slice_type) = max_size;
+
+      mark_addressable (array);
+      /* Contruct a SLICE_EXPR to represent a slice of a packed array of bits. */
+      if (TYPE_PACKED (array_type))
+	{
+	  if (pass == 2 && TREE_CODE (length) != INTEGER_CST)
+	    {
+	      sorry ("bit array slice with non-constant length");
+	      return error_mark_node;
+	    }
+	  if (domain_min && ! integer_zerop (domain_min))
+	    min_value = size_binop (MINUS_EXPR, min_value,
+				    convert (sizetype, domain_min));
+	  result = build (SLICE_EXPR, slice_type, array, min_value, length);
+	  TREE_READONLY (result)
+	    = TREE_READONLY (array) | TYPE_READONLY (TREE_TYPE (array_type));
+	  return result;
+	}
+
+      slice_pointer_type = build_chill_pointer_type (slice_type);
+      if (TREE_CODE (min_value) == INTEGER_CST
+	  && domain_min && TREE_CODE (domain_min) == INTEGER_CST
+	  && compare_int_csts (EQ_EXPR, min_value, domain_min))
+	result = fold (build1 (ADDR_EXPR, slice_pointer_type, array));
+      else
+	{
+	  min_value = convert (sizetype, min_value);
+	  if (domain_min && ! integer_zerop (domain_min))
+	    min_value = size_binop (MINUS_EXPR, min_value,
+				    convert (sizetype, domain_min));
+	  min_value = size_binop (MULT_EXPR, min_value,
+				  size_in_bytes (element_type));
+	  result = fold (build (PLUS_EXPR, slice_pointer_type,
+				build1 (ADDR_EXPR, slice_pointer_type,
+					array),
+				convert (slice_pointer_type, min_value)));
+	}
+      /* Return the final array value. */
+      result = fold (build1 (INDIRECT_REF, slice_type, result));
+      TREE_READONLY (result)
+	= TREE_READONLY (array) | TYPE_READONLY (element_type);
+      return result;
+    }
+  else if (TREE_CODE (array_type) == SET_TYPE)  /* actually a bitstring */
+    {
+      if (pass == 2 && TREE_CODE (length) != INTEGER_CST)
+	{
+	  sorry ("bitstring slice with non-constant length");
+	  return error_mark_node;
+	}
+      result = build (SLICE_EXPR, build_bitstring_type (length),
+		      array, min_value, length);
+      TREE_READONLY (result)
+	= TREE_READONLY (array) | TYPE_READONLY (TREE_TYPE (array_type));
+      return result;
+    }
+  else if (chill_varying_type_p (array_type))
+      return build_chill_slice (varying_to_slice (array), min_value, length);
+  else
+    {
+      error ("slice operation on non-array, non-bitstring value not supported");
+      return error_mark_node;
+    }
+}
+
+static tree
+build_empty_string (type)
+     tree type;
+{
+  int orig_pass = pass;
+  tree range, result;
+
+  range = build_chill_range_type (type, integer_zero_node,
+				  integer_minus_one_node);
+  result = build_chill_array_type (type,
+	     tree_cons (NULL_TREE, range, NULL_TREE), 0, NULL_TREE);
+  pass = 2;
+  range = build_chill_range_type (type, integer_zero_node,
+				  integer_minus_one_node);
+  result = build_chill_array_type (type,
+	     tree_cons (NULL_TREE, range, NULL_TREE), 0, NULL_TREE);
+  pass = orig_pass;
+
+  return decl_temp1 (get_unique_identifier ("EMPTY_STRING"),
+		     result, 0, NULL_TREE, 0, 0);
+}
+
+/* We build the runtime range-checking as a separate list
+ * rather than making a compound_expr with min_value
+ * (for example), to control when that comparison gets 
+ * generated.  We cannot allow it in a TYPE_MAX_VALUE or
+ * TYPE_MIN_VALUE expression, for instance, because that code 
+ * will get generated when the slice is laid out, which would 
+ * put it outside the scope of an exception handler for the 
+ * statement we're generating.  I.e. we would be generating
+ * cause_exception calls which might execute before the
+ * necessary ch_link_handler call.
+ */
+tree
+build_chill_slice_with_range (array, min_value, max_value)
+     tree array, min_value, max_value;
+{
+  if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK
+      || min_value == NULL_TREE || TREE_CODE(min_value) == ERROR_MARK
+      || max_value == NULL_TREE || TREE_CODE(max_value) == ERROR_MARK)
+    return error_mark_node;
+
+  if (TREE_TYPE (array) == NULL_TREE
+      || (TREE_CODE (TREE_TYPE (array)) != ARRAY_TYPE
+	  && TREE_CODE (TREE_TYPE (array)) != SET_TYPE
+	  && !chill_varying_type_p (TREE_TYPE (array))))
+    {
+      error ("can only take slice of array or string");
+      return error_mark_node;
+    }
+
+  array = save_if_needed (array);
+
+  /* FIXME: test here for max_value >= min_value, except
+     for max_value == -1, min_value == 0 (empty string) */
+  min_value = valid_array_index_p (array, min_value,
+				   "slice lower limit out-of-range", 0);
+  if (TREE_CODE (min_value) == ERROR_MARK)
+    return min_value;
+
+  /* FIXME: suppress this test if max_value is the LENGTH of a 
+     varying array, which has presumably already been checked. */
+  max_value = valid_array_index_p (array, max_value,
+				   "slice upper limit out-of-range", 0);
+  if (TREE_CODE (max_value) == ERROR_MARK)
+    return error_mark_node;
+
+  if (TREE_CODE (min_value) == INTEGER_CST
+      && TREE_CODE (max_value) == INTEGER_CST
+      && tree_int_cst_lt (max_value, min_value))
+    return build_empty_string (TREE_TYPE (TREE_TYPE (array)));
+
+  return build_chill_slice (array, min_value,
+	     save_expr (size_binop (PLUS_EXPR,
+	       size_binop (MINUS_EXPR, max_value, min_value),
+				    integer_one_node)));
+}
+
+
+tree
+build_chill_slice_with_length (array, min_value, length)
+     tree array, min_value, length;
+{
+  tree max_index;
+  tree cond, high_cond, atype;
+
+  if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK
+      || min_value == NULL_TREE || TREE_CODE(min_value) == ERROR_MARK
+      || length == NULL_TREE || TREE_CODE(length) == ERROR_MARK)
+    return error_mark_node;
+
+  if (TREE_TYPE (array) == NULL_TREE
+      || (TREE_CODE (TREE_TYPE (array)) != ARRAY_TYPE
+	  && TREE_CODE (TREE_TYPE (array)) != SET_TYPE
+	  && !chill_varying_type_p (TREE_TYPE (array))))
+    {
+      error ("can only take slice of array or string");
+      return error_mark_node;
+    }
+
+  if (TREE_CONSTANT (length) 
+      && tree_int_cst_lt (length, integer_zero_node))
+    return build_empty_string (TREE_TYPE (TREE_TYPE (array)));
+
+  array = save_if_needed (array);
+  min_value = save_expr (min_value);
+  length = save_expr (length);
+
+  if (! CH_SIMILAR (TREE_TYPE (length), integer_type_node))
+    {
+      error ("slice length is not an integer");
+      length = integer_one_node;
+    }
+
+  max_index = size_binop (MINUS_EXPR, 
+	        size_binop (PLUS_EXPR, length, min_value),
+			  integer_one_node);
+  max_index = convert_to_class (chill_expr_class (min_value), max_index);
+
+  min_value = valid_array_index_p (array, min_value,
+				   "slice start index out-of-range", 0);
+  if (TREE_CODE (min_value) == ERROR_MARK)
+    return error_mark_node;
+
+  atype = TREE_TYPE (array);
+
+  if (chill_varying_type_p (atype))
+    high_cond = build_component_ref (array, var_length_id);
+  else
+    high_cond = TYPE_MAX_VALUE (TYPE_DOMAIN (atype));
+
+  /* an invalid index expression meets this condition */
+  cond = fold (build (TRUTH_ORIF_EXPR, boolean_type_node,
+		      build_compare_discrete_expr (LT_EXPR,
+						   length, integer_zero_node),
+		      build_compare_discrete_expr (GT_EXPR,
+						   max_index, high_cond)));
+
+  if (TREE_CODE (cond) == INTEGER_CST)
+    {
+      if (! tree_int_cst_equal (cond, boolean_false_node))
+	{
+	  error ("slice length out-of-range");
+	  return error_mark_node;
+	}
+	  
+    }
+  else if (range_checking)
+    {
+      min_value = check_expression (min_value, cond,
+				    ridpointers[(int) RID_RANGEFAIL]);
+    }
+
+  return build_chill_slice (array, min_value, length);
+}
+
+tree
+build_chill_array_ref (array, indexlist)
+     tree array, indexlist;
+{
+  tree idx;
+
+  if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK)
+    return error_mark_node;
+  if (indexlist == NULL_TREE || TREE_CODE (indexlist) == ERROR_MARK)
+    return error_mark_node;
+
+  idx = TREE_VALUE (indexlist);   /* handle first index */
+
+  idx = valid_array_index_p (array, idx,
+			     "array index out-of-range", 0);
+  if (TREE_CODE (idx) == ERROR_MARK)
+    return error_mark_node;
+
+  array = build_chill_array_ref_1 (array, idx);
+
+  if (array && TREE_CODE (array) != ERROR_MARK 
+      && TREE_CHAIN (indexlist))
+    {
+      /* Z.200 (1988) section 4.2.8 says that:
+	 <array> '(' <expression {',' <expression> }* ')'
+	 is derived syntax (i.e. syntactic sugar) for:
+	 <array> '(' <expression ')' { '(' <expression> ')' }*
+	 The intent is clear if <array> has mode: ARRAY (...) ARRAY (...) XXX.
+	 But what if <array> has mode: ARRAY (...) CHARS (N)
+	 or: ARRAY (...) BOOLS (N).
+	 Z.200 doesn't explicitly prohibit it, but the intent is unclear.
+	 We'll allow it, since it seems reasonable and useful.
+	 However, we won't allow it if <array> is:
+	 ARRAY (...) PROC (...).
+	 (The latter would make sense if we allowed general
+	 Currying, which Chill doesn't.)  */
+      if (TREE_CODE (TREE_TYPE (array)) == ARRAY_TYPE
+	  || chill_varying_type_p (TREE_TYPE (array))
+	  || CH_BOOLS_TYPE_P (TREE_TYPE (array)))
+	array = build_generalized_call (array, TREE_CHAIN (indexlist));
+      else
+	error ("too many index expressions");
+    }
+  return array;
+}
+
+/*
+ * Don't error check the index in here.  It's supposed to be 
+ * checked by the caller.
+ */
+tree
+build_chill_array_ref_1 (array, idx)
+     tree array, idx;
+{
+  tree type;
+  tree domain;
+  tree rval;
+
+  if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK
+      || idx == NULL_TREE || TREE_CODE (idx) == ERROR_MARK)
+    return error_mark_node;
+
+  if (chill_varying_type_p (TREE_TYPE (array)))
+    array = varying_to_slice (array);
+
+  domain = TYPE_DOMAIN (TREE_TYPE (array));
+
+#if 0
+  if (! integer_zerop (TYPE_MIN_VALUE (domain)))
+    {
+      /* The C part of the compiler doesn't understand how to do
+	 arithmetic with dissimilar enum types.  So we check compatability
+	 here, and perform the math in INTEGER_TYPE.  */
+      if (TREE_CODE (TREE_TYPE (idx)) == ENUMERAL_TYPE
+	  && chill_comptypes (TREE_TYPE (idx), domain, 0))
+	idx = convert (TREE_TYPE (TYPE_MIN_VALUE (domain)), idx);
+      idx = build_binary_op (MINUS_EXPR, idx, TYPE_MIN_VALUE (domain), 0);
+    }
+#endif
+
+  if (CH_STRING_TYPE_P (TREE_TYPE (array)))
+    {
+      /* Could be bitstring or char string.  */
+      if (TREE_TYPE (TREE_TYPE (array)) == boolean_type_node)
+	{
+	  rval = build (SET_IN_EXPR, boolean_type_node, idx, array);
+	  TREE_READONLY (rval) = TREE_READONLY (array);
+	  return rval;
+	}
+    }
+
+  if (!discrete_type_p (TREE_TYPE (idx)))
+    {
+      error ("array index is not discrete");
+      return error_mark_node;
+    }
+
+  /* An array that is indexed by a non-constant
+     cannot be stored in a register; we must be able to do
+     address arithmetic on its address.
+     Likewise an array of elements of variable size.  */
+  if (TREE_CODE (idx) != INTEGER_CST
+      || (TYPE_SIZE (TREE_TYPE (TREE_TYPE (array))) != 0
+	  && TREE_CODE (TYPE_SIZE (TREE_TYPE (TREE_TYPE (array)))) != INTEGER_CST))
+    {
+      if (mark_addressable (array) == 0)
+	return error_mark_node;
+    }
+
+  type = TREE_TYPE (TREE_TYPE (array));
+
+  /* Do constant folding */
+  if (TREE_CODE (idx) == INTEGER_CST && TREE_CONSTANT (array))
+    {
+      struct ch_class class;
+      class.kind = CH_VALUE_CLASS;
+      class.mode = type;
+
+      if (TREE_CODE (array) == CONSTRUCTOR)
+	{
+	  tree list = CONSTRUCTOR_ELTS (array);
+	  for ( ; list != NULL_TREE; list = TREE_CHAIN (list))
+	    {
+	      if (tree_int_cst_equal (TREE_PURPOSE (list), idx))
+		return convert_to_class (class, TREE_VALUE (list));
+	    }
+	}
+      else if (TREE_CODE (array) == STRING_CST
+	       && CH_CHARS_TYPE_P (TREE_TYPE (array)))
+	{
+	  HOST_WIDE_INT i = TREE_INT_CST_LOW (idx);
+	  if (i >= 0 && i < TREE_STRING_LENGTH (array))
+	    {
+	      char ch = TREE_STRING_POINTER (array) [i];
+	      return convert_to_class (class,
+				       build_int_2 ((unsigned char)ch, 0));
+	    }
+	}
+    }
+
+  if (TYPE_PACKED (TREE_TYPE (array)))
+    rval = build (PACKED_ARRAY_REF, type, array, idx);
+  else
+    rval = build (ARRAY_REF, type, array, idx);
+
+  /* Array ref is const/volatile if the array elements are
+     or if the array is.  */
+  TREE_READONLY (rval) = TREE_READONLY (array) | TYPE_READONLY (type);
+  TREE_SIDE_EFFECTS (rval)
+    |= (TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (array)))
+	| TREE_SIDE_EFFECTS (array));
+  TREE_THIS_VOLATILE (rval)
+    |= (TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (array)))
+	/* This was added by rms on 16 Nov 91.
+	   It fixes  vol struct foo *a;  a->elts[1] 
+	   in an inline function.
+	   Hope it doesn't break something else.  */
+	| TREE_THIS_VOLATILE (array));
+  return fold (rval);
+}
+
+tree
+build_chill_bitref (bitstring, indexlist)
+     tree bitstring, indexlist;
+{
+  if (TREE_CODE (bitstring) == ERROR_MARK)
+    return bitstring;
+  if (TREE_CODE (indexlist) == ERROR_MARK)
+    return indexlist;
+
+  if (TREE_CHAIN (indexlist) != NULL_TREE)
+    {
+      error ("invalid compound index for bitstring mode");
+      return error_mark_node;
+    }
+
+  if (TREE_CODE (indexlist) == TREE_LIST)
+    {
+      tree result = build (SET_IN_EXPR, boolean_type_node,
+			   TREE_VALUE (indexlist), bitstring);
+      TREE_READONLY (result) = TREE_READONLY (bitstring);
+      return result;
+    }
+  else abort ();
+}
+
+
+int
+discrete_type_p (type)
+     tree type;
+{
+  return INTEGRAL_TYPE_P (type);
+}
+
+/* Checks that EXP has discrete type, or can be converted to discrete.
+   Otherwise, returns NULL_TREE.
+   Normally returns the (possibly-converted) EXP. */
+
+tree
+convert_to_discrete (exp)
+     tree exp;
+{
+  if (! discrete_type_p (TREE_TYPE (exp)))
+    {
+      if (flag_old_strings)
+	{
+	  if (CH_CHARS_ONE_P (TREE_TYPE (exp)))
+	    return convert (char_type_node, exp);
+	  if (CH_BOOLS_ONE_P (TREE_TYPE (exp)))
+	    return convert (boolean_type_node, exp);
+	}
+      return NULL_TREE;
+    }
+  return exp;
+}
+
+/* Write into BUFFER the target-machine representation of VALUE.
+   Returns 1 on success, or 0 on failure. (Either the VALUE was
+   not constant, or we don't know how to do the conversion.) */
+
+int
+expand_constant_to_buffer (value, buffer, buf_size)
+     tree value;
+     unsigned char *buffer; 
+     int buf_size;
+{
+  tree type = TREE_TYPE (value);
+  int size = int_size_in_bytes (type);
+  int i;
+  if (size < 0 || size > buf_size)
+    return 0;
+  switch (TREE_CODE (value))
+    {
+    case INTEGER_CST:
+      {
+	HOST_WIDE_INT lo = TREE_INT_CST_LOW (value);
+	HOST_WIDE_INT hi = TREE_INT_CST_HIGH (value);
+	for (i = 0; i < size; i++)
+	  {
+	    /* Doesn't work if host and target BITS_PER_UNIT differ. */
+	    unsigned char byte = lo & ((1 << BITS_PER_UNIT) - 1);
+	    if (BYTES_BIG_ENDIAN)
+	      buffer[size - i - 1] = byte;
+	    else
+	      buffer[i] = byte;
+	    rshift_double (lo, hi, BITS_PER_UNIT, BITS_PER_UNIT * size,
+			   &lo, &hi, 0);
+	  }
+      }
+      break;
+    case STRING_CST:
+      {
+	size = TREE_STRING_LENGTH (value);
+	if (size > buf_size)
+	  return 0;
+	bcopy (TREE_STRING_POINTER (value), buffer, size);
+	break;
+      }
+    case CONSTRUCTOR:
+      if (TREE_CODE (type) == ARRAY_TYPE)
+	{
+	  tree element_type = TREE_TYPE (type);
+	  int element_size = int_size_in_bytes (element_type);
+	  tree list = CONSTRUCTOR_ELTS (value);
+	  HOST_WIDE_INT next_index;
+	  HOST_WIDE_INT min_index = 0;
+	  if (element_size < 0)
+	    return 0;
+
+	  if (TYPE_DOMAIN (type) != 0)
+	    {
+	      tree min_val = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
+	      if (min_val)
+		if (TREE_CODE (min_val) != INTEGER_CST)
+		  return 0;
+		else
+		  min_index = TREE_INT_CST_LOW (min_val);
+	    }
+
+	  next_index = min_index;
+
+	  for (; list != NULL_TREE; list = TREE_CHAIN (list))
+	    {
+	      HOST_WIDE_INT offset;
+	      HOST_WIDE_INT last_index;
+	      tree purpose = TREE_PURPOSE (list);
+	      if (purpose)
+		{
+		  if (TREE_CODE (purpose) == INTEGER_CST)
+		    last_index = next_index = TREE_INT_CST_LOW (purpose);
+		  else if (TREE_CODE (purpose) == RANGE_EXPR)
+		    {
+		      next_index = TREE_INT_CST_LOW (TREE_OPERAND(purpose, 0));
+		      last_index = TREE_INT_CST_LOW (TREE_OPERAND(purpose, 1));
+		    }
+		  else
+		    return 0;
+		}
+	      else
+		last_index = next_index;
+	      for ( ; next_index <= last_index; next_index++)
+		{
+		  offset = (next_index - min_index) * element_size;
+		  if (!expand_constant_to_buffer (TREE_VALUE (list),
+						  buffer + offset,
+						  buf_size - offset))
+		    return 0;
+		}
+	    }
+	  break;
+	}
+      else if (TREE_CODE (type) == RECORD_TYPE)
+	{
+	  tree list = CONSTRUCTOR_ELTS (value);
+	  for (; list != NULL_TREE; list = TREE_CHAIN (list))
+	    {
+	      tree field = TREE_PURPOSE (list);
+	      HOST_WIDE_INT offset;
+	      if (field == NULL_TREE || TREE_CODE (field) != FIELD_DECL)
+		return 0;
+	      if (DECL_BIT_FIELD (field))
+		return 0;
+	      offset = TREE_INT_CST_LOW (DECL_FIELD_BITPOS (field))
+		/ BITS_PER_UNIT;
+	      if (!expand_constant_to_buffer (TREE_VALUE (list),
+					      buffer + offset,
+					      buf_size - offset))
+		return 0;
+	    }
+	  break;
+	}
+      else if (TREE_CODE (type) == SET_TYPE)
+	{
+	  if (get_set_constructor_bytes (value, buffer, buf_size)
+	      != NULL_TREE)
+	    return 0;
+	}
+      break;
+    default:
+      return 0;
+    }
+  return 1;
+}
+
+/* Given that BUFFER contains a target-machine representation of
+   a value of type TYPE, return that value as a tree.
+   Returns NULL_TREE on failure. (E.g. the TYPE might be variable size,
+   or perhaps we don't know how to do the conversion.) */
+
+tree
+extract_constant_from_buffer (type, buffer, buf_size)
+     tree type;
+     unsigned char *buffer;
+     int buf_size;
+{
+  tree value;
+  int size = int_size_in_bytes (type);
+  int i;
+  if (size < 0 || size > buf_size)
+    return 0;
+  switch (TREE_CODE (type))
+    {
+    case INTEGER_TYPE:
+    case CHAR_TYPE:
+    case BOOLEAN_TYPE:
+    case ENUMERAL_TYPE:
+    case POINTER_TYPE:
+      {
+	HOST_WIDE_INT lo = 0, hi = 0;
+	/* Accumulate (into (lo,hi) the bytes (from buffer). */
+	for (i = size; --i >= 0; )
+	  {
+	    unsigned char byte;
+	    /* Get next byte (in big-endian order). */
+	    if (BYTES_BIG_ENDIAN)
+	      byte = buffer[size - i - 1];
+	    else
+	      byte = buffer[i];
+	    lshift_double (lo, hi, BITS_PER_UNIT, TYPE_PRECISION (type),
+			   &lo, &hi, 0);
+	    add_double (lo, hi, byte, 0, &lo, &hi);
+	  }
+	value = build_int_2 (lo, hi);
+	TREE_TYPE (value) = type;
+	return value;
+      }
+    case ARRAY_TYPE:
+      {
+	tree element_type = TREE_TYPE (type);
+	int element_size = int_size_in_bytes (element_type);
+	tree list = NULL_TREE;
+	HOST_WIDE_INT min_index = 0, max_index, cur_index;
+	if (element_size == 1 && CH_CHARS_TYPE_P (type))
+	  {
+	    value = build_string (size, buffer);
+	    CH_DERIVED_FLAG (value) = 1;
+	    TREE_TYPE (value) = type;
+	    return value;
+	  }
+	if (TYPE_DOMAIN (type) == 0)
+	  return 0;
+	value = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
+	if (value)
+	  if (TREE_CODE (value) != INTEGER_CST)
+	    return 0;
+	  else
+	    min_index = TREE_INT_CST_LOW (value);
+	value = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
+	if (value == NULL_TREE || TREE_CODE (value) != INTEGER_CST)
+	  return 0;
+	else
+	  max_index = TREE_INT_CST_LOW (value);
+	for (cur_index = max_index; cur_index >= min_index; cur_index--)
+	  {
+	    HOST_WIDE_INT offset = (cur_index - min_index) * element_size;
+	    value = extract_constant_from_buffer (element_type,
+						  buffer + offset,
+						  buf_size - offset);
+	    if (value == NULL_TREE)
+	      return NULL_TREE;
+	    list = tree_cons (build_int_2 (cur_index, 0), value, list);
+	  }
+	value = build (CONSTRUCTOR, type, NULL_TREE, list);
+	TREE_CONSTANT (value) = 1;
+	TREE_STATIC (value) = 1;
+	return value;
+      }
+    case RECORD_TYPE:
+      {
+	tree list = NULL_TREE;
+	tree field = TYPE_FIELDS (type);
+	for (; field != NULL_TREE; field = TREE_CHAIN (field))
+	  {
+	    HOST_WIDE_INT offset
+	      = TREE_INT_CST_LOW (DECL_FIELD_BITPOS (field)) / BITS_PER_UNIT;
+	    if (DECL_BIT_FIELD (field))
+	      return 0;
+	    value = extract_constant_from_buffer (TREE_TYPE (field),
+						  buffer + offset,
+						  buf_size - offset);
+	    if (value == NULL_TREE)
+	      return NULL_TREE;
+	    list = tree_cons (field, value, list);
+	  }
+	value = build (CONSTRUCTOR, type, NULL_TREE, nreverse (list));
+	TREE_CONSTANT (value) = 1;
+	TREE_STATIC (value) = 1;
+	return value;
+      }
+
+    case UNION_TYPE:
+      {
+	tree longest_variant = NULL_TREE;
+	int longest_size = 0;
+	tree field = TYPE_FIELDS (type);
+	
+	/* This is a kludge.  We assume that converting the data to te
+	   longest variant will provide valid data for the "correct"
+	   variant.  This is usually the case, but is not guaranteed.
+	   For example, the longest variant may include holes.
+	   Also incorrect interpreting the given value as the longest
+	   variant may confuse the compiler if that should happen
+	   to yield invalid values.  ??? */
+
+	for (; field != NULL_TREE; field = TREE_CHAIN (field))
+	  {
+	    int size = TREE_INT_CST_LOW (size_in_bytes (TREE_TYPE (field)));
+	    
+	    if (size > longest_size)
+	      {
+		longest_size = size;
+		longest_variant = field;
+	      }
+	  }
+	if (longest_variant == NULL_TREE)
+	  return NULL_TREE;
+	return extract_constant_from_buffer (TREE_TYPE (longest_variant), buffer, buf_size);
+      }
+
+    case SET_TYPE:
+      {
+	tree list = NULL_TREE;
+	int i;
+	HOST_WIDE_INT min_index, max_index;
+	if (TYPE_DOMAIN (type) == 0)
+	  return 0;
+	value = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
+	if (value == NULL_TREE)
+	  min_index = 0;
+	else if (TREE_CODE (value) != INTEGER_CST)
+	  return 0;
+	else
+	  min_index = TREE_INT_CST_LOW (value);
+	value = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
+	if (value == NULL_TREE)
+	  max_index = 0;
+	else if (TREE_CODE (value) != INTEGER_CST)
+	  return 0;
+	else
+	  max_index = TREE_INT_CST_LOW (value);
+	for (i = max_index + 1 - min_index; --i >= 0; )
+	  {
+	    unsigned char byte = (unsigned char)buffer[i / BITS_PER_UNIT];
+	    unsigned bit_pos = (unsigned)i % (unsigned)BITS_PER_UNIT;
+	    if (BYTES_BIG_ENDIAN
+		? (byte & (1 << (BITS_PER_UNIT - 1 - bit_pos)))
+		: (byte & (1 << bit_pos)))
+	      list = tree_cons (NULL_TREE,
+				build_int_2 (i + min_index, 0), list);
+	  }
+	value = build (CONSTRUCTOR, type, NULL_TREE, list);
+	TREE_CONSTANT (value) = 1;
+	TREE_STATIC (value) = 1;
+	return value;
+      }
+
+    default:
+      return NULL_TREE;
+    }
+}
+
+tree
+build_chill_cast (type, expr)
+     tree type, expr;
+{
+  tree expr_type;
+  int  expr_type_size;
+  int  type_size;
+  int  type_is_discrete;
+  int  expr_type_is_discrete;
+
+  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+    return error_mark_node;
+  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+    return error_mark_node;
+
+  /* if expression was untyped because of its context (an
+     if_expr or case_expr in a tuple, perhaps) just apply
+     the type */
+  expr_type = TREE_TYPE (expr);
+  if (expr_type == NULL_TREE
+      || TREE_CODE (expr_type) == ERROR_MARK)
+    return convert (type, expr);
+
+  if (expr_type == type)
+    return expr;
+
+  expr_type_size = int_size_in_bytes (expr_type);
+  type_size      = int_size_in_bytes (type);
+
+  if (expr_type_size == -1)
+    {
+      error ("conversions from variable_size value");
+      return error_mark_node;
+    }
+  if (type_size == -1)
+    {
+      error ("conversions to variable_size mode");
+      return error_mark_node;
+    }
+
+  /* FIXME: process REAL ==> INT && INT ==> REAL && REAL ==> REAL. I hope this is correct. */
+  if ((TREE_CODE (expr_type) == INTEGER_TYPE && TREE_CODE (type) == REAL_TYPE) ||
+      (TREE_CODE (expr_type) == REAL_TYPE && TREE_CODE (type) == INTEGER_TYPE) ||
+      (TREE_CODE (expr_type) == REAL_TYPE && TREE_CODE (type) == REAL_TYPE))
+    return convert (type, expr);
+
+  /* FIXME: Don't know if this is correct */
+  /* Don't allow conversions to or from REAL with others then integer */
+  if (TREE_CODE (type) == REAL_TYPE)
+    {
+      error ("cannot convert to float");
+      return error_mark_node;
+    }
+  else if (TREE_CODE (expr_type) == REAL_TYPE)
+    {
+      error ("cannot convert float to this mode");
+      return error_mark_node;
+    }
+
+  if (expr_type_size == type_size && CH_REFERABLE (expr))
+    goto do_location_conversion;
+
+  type_is_discrete
+    = discrete_type_p (type) || TREE_CODE (type) == POINTER_TYPE;
+  expr_type_is_discrete
+    = discrete_type_p (expr_type) || TREE_CODE (expr_type) == POINTER_TYPE;
+  if (expr_type_is_discrete && type_is_discrete)
+    {
+      /* do an overflow check
+	 FIXME: is this always neccessary ??? */
+      /* FIXME: don't do range chacking when target type is PTR.
+	 PTR doesn't have MIN and MAXVALUE. result is sigsegv. */
+      if (range_checking && type != ptr_type_node)
+	{
+	  tree tmp = expr;
+
+	  STRIP_NOPS (tmp);
+	  if (TREE_CONSTANT (tmp) && TREE_CODE (tmp) != ADDR_EXPR)
+	    {
+	      if (compare_int_csts (LT_EXPR, tmp, TYPE_MIN_VALUE (type)) ||
+		  compare_int_csts (GT_EXPR, tmp, TYPE_MAX_VALUE (type)))
+		{
+		  error ("OVERFLOW in expression conversion");
+		  return error_mark_node;
+		}
+	    }
+	  else
+	    {
+	      int cond1 = tree_int_cst_lt (TYPE_SIZE (type),
+					   TYPE_SIZE (expr_type));
+	      int cond2 = TREE_UNSIGNED (type) && (! TREE_UNSIGNED (expr_type));
+	      int cond3 = (! TREE_UNSIGNED (type))
+		&& TREE_UNSIGNED (expr_type)
+		&& tree_int_cst_equal (TYPE_SIZE (type),
+				       TYPE_SIZE (expr_type));
+	      int cond4 = TREE_TYPE (type) && type_is_discrete;
+
+	      if (cond1 || cond2 || cond3 || cond4)
+		{
+		  tree type_min = TYPE_MIN_VALUE (type);
+		  tree type_max = TYPE_MAX_VALUE (type);
+  
+		  expr = save_if_needed (expr);
+		  if (expr && type_min && type_max)
+		    {
+		      tree check = test_range (expr, type_min, type_max);
+		      if (!integer_zerop (check))
+			{
+			  if (current_function_decl == NULL_TREE)
+			    {
+			      if (TREE_CODE (check) == INTEGER_CST)
+				error ("overflow (not inside function)");
+			      else
+				warning ("possible overflow (not inside function)");
+			    }
+			  else
+			    {
+			      if (TREE_CODE (check) == INTEGER_CST)
+				warning ("expression will always cause OVERFLOW");
+			      expr = check_expression (expr, check,
+						       ridpointers[(int) RID_OVERFLOW]);
+			    }
+			}
+		    }
+		}
+	    }
+	}
+      return convert (type, expr);
+    }
+
+  if (TREE_CODE (expr) == INTEGER_CST && expr_type_size != type_size)
+    {
+      /* There should probably be a pedwarn here ... */
+      tree itype = type_for_size (type_size * BITS_PER_UNIT, 1);
+      if (itype)
+	{
+	  expr = convert (itype, expr);
+	  expr_type = TREE_TYPE (expr);
+	  expr_type_size= type_size;
+	}
+    }
+
+  /* If expr is a constant of the right size, use it to to
+     initialize a static variable. */
+  if (expr_type_size == type_size && TREE_CONSTANT (expr) && !pedantic)
+    {
+      unsigned char *buffer = (unsigned char*) alloca (type_size);
+      tree value;
+      bzero (buffer, type_size);
+      if (!expand_constant_to_buffer (expr, buffer, type_size))
+	{
+	  error ("not implemented: constant conversion from that kind of expression");
+	  return error_mark_node;
+	}
+      value = extract_constant_from_buffer (type, buffer, type_size);
+      if (value == NULL_TREE)
+	{
+	  error ("not implemented: constant conversion to that kind of mode");
+	  return error_mark_node;
+	}
+      return value;
+    }
+
+  if (!CH_REFERABLE (expr) && expr_type_size == type_size)
+    {
+      tree temp = decl_temp1 (get_unique_identifier ("CAST"),
+			      TREE_TYPE (expr), 0, 0, 0, 0);
+      tree convert1 = build_chill_modify_expr (temp, expr);
+      pedwarn ("non-standard, non-portable value conversion");
+      return build (COMPOUND_EXPR, type, convert1,
+		    build_chill_cast (type, temp));
+    }
+
+  if (CH_REFERABLE (expr) && expr_type_size != type_size)
+    error ("location conversion between differently-sized modes");
+  else
+    error ("unsupported value conversion");
+  return error_mark_node;
+
+ do_location_conversion:
+  /* To avoid confusing other parts of gcc,
+     represent this as the C expression: *(TYPE*)EXPR. */
+  mark_addressable (expr);
+  expr = build1 (INDIRECT_REF, type,
+		 build1 (NOP_EXPR, build_pointer_type (type),
+			 build1 (ADDR_EXPR, build_pointer_type (expr_type),
+				 expr)));
+  TREE_READONLY (expr) == TYPE_READONLY (type);
+  return expr;
+}
+
+/*
+ * given a set_type, build an integer array from it that C will grok.
+ */
+tree
+build_array_from_set (type)
+     tree type;
+{
+  tree bytespint, bit_array_size, int_array_count;
+ 
+  if (type == NULL_TREE || type == error_mark_node || TREE_CODE (type) != SET_TYPE)
+    return error_mark_node;
+
+  bytespint = build_int_2 (HOST_BITS_PER_INT / HOST_BITS_PER_CHAR, 0);
+  bit_array_size = size_in_bytes (type);
+  int_array_count = fold (size_binop (TRUNC_DIV_EXPR, bit_array_size,
+						 bytespint));
+  if (integer_zerop (int_array_count))
+    int_array_count = size_one_node;
+  type = build_array_type (integer_type_node, 
+			   build_index_type (int_array_count));
+  return type;
+}
+
+
+tree
+build_chill_bin_type (size)
+     tree size;
+{
+#if 0
+  int isize;
+
+  if (TREE_CODE (size) != INTEGER_CST
+      || (isize = TREE_INT_CST_LOW (size), isize <= 0))
+    {
+      error ("operand to bin must be a non-negative integer literal");
+      return error_mark_node;
+    }
+  if (isize <= TYPE_PRECISION (unsigned_char_type_node))
+    return unsigned_char_type_node;
+  if (isize <= TYPE_PRECISION (short_unsigned_type_node))
+    return short_unsigned_type_node;
+  if (isize <= TYPE_PRECISION (unsigned_type_node))
+    return unsigned_type_node;
+  if (isize <= TYPE_PRECISION (long_unsigned_type_node))
+    return long_unsigned_type_node;
+  if (isize <= TYPE_PRECISION (long_long_unsigned_type_node))
+    return long_long_unsigned_type_node;
+  error ("size %d of BIN too big - no such integer mode", isize);
+  return error_mark_node;
+#endif
+  tree bintype;
+ 
+  if (pass == 1)
+    {
+      bintype = make_node (INTEGER_TYPE);
+      TREE_TYPE (bintype) = ridpointers[(int) RID_BIN];
+      TYPE_MIN_VALUE (bintype) = size;
+      TYPE_MAX_VALUE (bintype) = size;
+    }
+  else
+    {
+      error ("BIN in pass 2");
+      return error_mark_node;
+    }
+  return bintype;
+}
+
+tree
+chill_expand_tuple (type, constructor)
+     tree type, constructor;
+{
+  char *name;
+  tree nonreft = type;
+
+  if (TYPE_NAME (type) != NULL_TREE)
+    {
+      if (TREE_CODE (TYPE_NAME (type)) == IDENTIFIER_NODE)
+	name = IDENTIFIER_POINTER (TYPE_NAME (type));
+      else
+	name = IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (type)));
+    }
+  else
+    name = "";
+
+  /* get to actual underlying type for digest_init */
+  while (nonreft && TREE_CODE (nonreft) == REFERENCE_TYPE)
+    nonreft = TREE_TYPE (nonreft);
+
+  if (TREE_CODE (nonreft) == ARRAY_TYPE
+      || TREE_CODE (nonreft) == RECORD_TYPE
+      || TREE_CODE (nonreft) == SET_TYPE)
+    return convert (nonreft, constructor);
+  else
+    {
+      error ("mode of tuple is neither ARRAY, STRUCT, nor POWERSET");
+      return error_mark_node;
+    }
+}
+
+/* This function classifies an expr into the Null class,
+   the All class, the M-Value, the M-derived, or the M-reference class.
+   It probably has some inaccuracies. */
+
+struct ch_class
+chill_expr_class (expr)
+     tree expr;
+{
+  struct ch_class class;
+  /* The Null class contains the NULL pointer constant (only). */
+  if (expr == null_pointer_node)
+    {
+      class.kind = CH_NULL_CLASS;
+      class.mode = NULL_TREE;
+      return class;
+    }
+
+  /* The All class contains the <undefined value> "*". */
+  if (TREE_CODE (expr) == UNDEFINED_EXPR)
+    {
+      class.kind = CH_ALL_CLASS;
+      class.mode = NULL_TREE;
+      return class;
+    }
+
+  if (CH_DERIVED_FLAG (expr))
+    {
+      class.kind = CH_DERIVED_CLASS;
+      class.mode = TREE_TYPE (expr);
+      return class;
+    }
+
+  /* The M-Reference contains <references location> (address-of) expressions.
+     Note that something that's been converted to a reference doesn't count. */
+  if (TREE_CODE (expr) == ADDR_EXPR
+      && TREE_CODE (TREE_TYPE (expr)) != REFERENCE_TYPE)
+    {
+      class.kind = CH_REFERENCE_CLASS;
+      class.mode = TREE_TYPE (TREE_TYPE (expr));
+      return class;
+    }
+
+  /* The M-Value class contains expressions with a known, specific mode M. */
+  class.kind = CH_VALUE_CLASS;
+  class.mode = TREE_TYPE (expr);
+  return class;
+}
+
+/* Returns >= 1 iff REF is a location. Return 2 if it is referable. */
+
+int chill_location (ref)
+     tree ref;
+{
+  register enum tree_code code = TREE_CODE (ref);
+
+  switch (code)
+    {
+    case REALPART_EXPR:
+    case IMAGPART_EXPR:
+    case ARRAY_REF:
+    case PACKED_ARRAY_REF:
+    case COMPONENT_REF:
+    case NOP_EXPR: /* RETYPE_EXPR */
+      return chill_location (TREE_OPERAND (ref, 0));
+    case COMPOUND_EXPR:
+      return chill_location (TREE_OPERAND (ref, 1));
+
+    case BIT_FIELD_REF:
+    case SLICE_EXPR:
+      /* A bit-string slice is nor referable. */
+      return chill_location (TREE_OPERAND (ref, 0)) == 0 ? 0 : 1;
+
+    case CONSTRUCTOR:
+    case STRING_CST:
+      return 0;
+
+    case INDIRECT_REF:
+    case VAR_DECL:
+    case PARM_DECL:
+    case RESULT_DECL:
+    case ERROR_MARK:
+      if (TREE_CODE (TREE_TYPE (ref)) != FUNCTION_TYPE
+	  && TREE_CODE (TREE_TYPE (ref)) != METHOD_TYPE)
+	return 2;
+      break;
+
+    default:
+      break;
+    }
+  return 0;
+}
+
+int
+chill_referable (val)
+     tree val;
+{
+  return chill_location (val) > 1;
+}
+
+/* Make a copy of MODE, but with the given NOVELTY. */
+
+tree
+copy_novelty (novelty, mode)
+     tree novelty, mode;
+{
+  if (CH_NOVELTY (mode) != novelty)
+    {
+      mode = copy_node (mode);
+      TYPE_MAIN_VARIANT (mode) = mode;
+      TYPE_NEXT_VARIANT (mode) = 0;
+      TYPE_POINTER_TO (mode) = 0;
+      TYPE_REFERENCE_TO (mode) = 0;
+      SET_CH_NOVELTY (mode, novelty);
+    }
+  return mode;
+}
+
+
+struct mode_chain
+{
+  struct mode_chain *prev;
+  tree mode1, mode2;
+};
+
+/* Tests if MODE1 and MODE2 are SIMILAR.
+   This is more or less as defined in the Blue Book, though
+   see FIXME for parts that are unfinished.
+   CHAIN is used to catch infinite recursion:  It is a list of pairs
+   of mode arguments to calls to chill_similar "outer" to this call. */   
+
+int
+chill_similar (mode1, mode2, chain)
+     tree mode1, mode2;
+     struct mode_chain *chain;
+{
+  int varying1, varying2;
+  tree t1, t2;
+  struct mode_chain *link, node;
+  if (mode1 == NULL_TREE || mode2 == NULL_TREE)
+    return 0;
+
+  while (TREE_CODE (mode1) == REFERENCE_TYPE)
+    mode1 = TREE_TYPE (mode1);
+  while (TREE_CODE (mode2) == REFERENCE_TYPE)
+    mode2 = TREE_TYPE (mode2);
+
+  /* Range modes are similar to their parent types. */
+  while (TREE_CODE (mode1) == INTEGER_TYPE && TREE_TYPE (mode1) != NULL_TREE)
+    mode1 = TREE_TYPE (mode1);
+  while (TREE_CODE (mode2) == INTEGER_TYPE && TREE_TYPE (mode2) != NULL_TREE)
+    mode2 = TREE_TYPE (mode2);
+
+   
+  /* see Z.200 sections 12.1.2.2 and 13.2 - all integer precisions 
+     are similar to INT and to each other */
+  if (mode1 == mode2 ||
+      (TREE_CODE (mode1) == INTEGER_TYPE && TREE_CODE (mode2) == INTEGER_TYPE))
+    return 1;
+
+  /* This guards against certain kinds of recursion.
+     For example:
+     SYNMODE a = STRUCT ( next REF a );
+     SYNMODE b = STRUCT ( next REF b );
+     These moes are similar, but will get an infite recursion trying
+     to prove that.  So, if we are recursing, assume the moes are similar.
+     If they are not, we'll find some other discrepancy.  */
+  for (link = chain; link != NULL; link = link->prev)
+    {
+      if (link->mode1 == mode1 && link->mode2 == mode2)
+	return 1;
+    }
+
+  node.mode1 = mode1;
+  node.mode2 = mode2;
+  node.prev = chain;
+
+  varying1 = chill_varying_type_p (mode1);
+  varying2 = chill_varying_type_p (mode2);
+  /* FIXME:  This isn't quite strict enough. */
+  if ((varying1 && varying2)
+      || (varying1 && TREE_CODE (mode2) == ARRAY_TYPE)
+      || (varying2 && TREE_CODE (mode1) == ARRAY_TYPE))
+    return 1;
+
+  if (TREE_CODE(mode1) != TREE_CODE(mode2))
+    {
+      if (flag_old_strings)
+	{
+	  /* The recursion is to handle varying strings. */
+	  if ((TREE_CODE (mode1) == CHAR_TYPE
+	       && CH_SIMILAR (mode2, string_one_type_node))
+	      || (TREE_CODE (mode2) == CHAR_TYPE
+	       && CH_SIMILAR (mode1, string_one_type_node)))
+	    return 1;
+	  if ((TREE_CODE (mode1) == BOOLEAN_TYPE
+	       && CH_SIMILAR (mode2, bitstring_one_type_node))
+	      || (TREE_CODE (mode2) == BOOLEAN_TYPE
+	       && CH_SIMILAR (mode1, bitstring_one_type_node)))
+	    return 1;
+	}
+      if (TREE_CODE (mode1) == FUNCTION_TYPE
+	  && TREE_CODE (mode2) == POINTER_TYPE
+	  && TREE_CODE (TREE_TYPE (mode2)) == FUNCTION_TYPE)
+	mode2 = TREE_TYPE (mode2);
+      else if (TREE_CODE (mode2) == FUNCTION_TYPE
+	  && TREE_CODE (mode1) == POINTER_TYPE
+	  && TREE_CODE (TREE_TYPE (mode1)) == FUNCTION_TYPE)
+	mode1 = TREE_TYPE (mode1);
+      else
+	return 0;
+    }
+
+  if (CH_IS_BUFFER_MODE (mode1) && CH_IS_BUFFER_MODE (mode2))
+    {
+      tree len1 = max_queue_size (mode1);
+      tree len2 = max_queue_size (mode2);
+      return tree_int_cst_equal (len1, len2);
+    }
+  else if (CH_IS_EVENT_MODE (mode1) && CH_IS_EVENT_MODE (mode2))
+    {
+      tree len1 = max_queue_size (mode1);
+      tree len2 = max_queue_size (mode2);
+      return tree_int_cst_equal (len1, len2);
+    }
+  else if (CH_IS_ACCESS_MODE (mode1) && CH_IS_ACCESS_MODE (mode2))
+    {
+      tree index1 = access_indexmode (mode1);
+      tree index2 = access_indexmode (mode2);
+      tree record1 = access_recordmode (mode1);
+      tree record2 = access_recordmode (mode2);
+      if (! chill_read_compatible (index1, index2))
+	return 0;
+      return chill_read_compatible (record1, record2);
+    }
+  switch ((enum chill_tree_code)TREE_CODE (mode1))
+    {
+    case INTEGER_TYPE:
+    case BOOLEAN_TYPE:
+    case CHAR_TYPE:
+      return 1;
+    case ENUMERAL_TYPE:
+      if (TYPE_VALUES (mode1) == TYPE_VALUES (mode2))
+	return 1;
+      else
+	{
+	  /* FIXME: This is more strict than z.200, which seems to
+	     allow the elements to be reordered, as long as they
+	     have the same values. */
+
+	  tree field1 = TYPE_VALUES (mode1);
+	  tree field2 = TYPE_VALUES (mode2);
+
+	  while (field1 != NULL_TREE && field2 != NULL_TREE)
+	    {
+	      tree value1, value2;
+	      /* Check that the names are equal.  */
+	      if (TREE_PURPOSE (field1) != TREE_PURPOSE (field2))
+		break;
+
+	      value1 = TREE_VALUE (field1);
+	      value2 = TREE_VALUE (field2);
+	      /* This isn't quite sufficient in general, but will do ... */
+	      /* Note that proclaim_decl can cause the SET modes to be
+		 compared BEFORE they are satisfied, but otherwise
+		 chill_similar is mostly called after satisfaction. */
+	      if (TREE_CODE (value1) == CONST_DECL)
+		value1 = DECL_INITIAL (value1);
+	      if (TREE_CODE (value2) == CONST_DECL)
+		value2 = DECL_INITIAL (value2);
+	      /* Check that the values are equal or both NULL.  */
+	      if (!(value1 == NULL_TREE && value2 == NULL_TREE)
+		  && (value1 == NULL_TREE || value2 == NULL_TREE
+		      || ! tree_int_cst_equal (value1, value2)))
+		break;
+	      field1 = TREE_CHAIN (field1);
+	      field2 = TREE_CHAIN (field2);
+	    }
+	  return field1 == NULL_TREE && field2 == NULL_TREE;
+	}
+    case SET_TYPE:
+      /* check for bit strings */
+      if (CH_BOOLS_TYPE_P (mode1))
+	return CH_BOOLS_TYPE_P (mode2);
+      if (CH_BOOLS_TYPE_P (mode2))
+	return CH_BOOLS_TYPE_P (mode1);
+      /* both are powerset modes */
+      return CH_EQUIVALENT (TYPE_DOMAIN (mode1), TYPE_DOMAIN (mode2));
+
+    case POINTER_TYPE:
+      /* Are the referenced modes equivalent? */
+      return !integer_zerop (chill_equivalent (TREE_TYPE (mode1),
+					       TREE_TYPE (mode2),
+					       &node));
+
+    case ARRAY_TYPE:
+      /* char for char strings */
+      if (CH_CHARS_TYPE_P (mode1))
+	return CH_CHARS_TYPE_P (mode2);
+      if (CH_CHARS_TYPE_P (mode2))
+	return CH_CHARS_TYPE_P (mode1);
+      /* array modes */
+      if (CH_V_EQUIVALENT (TYPE_DOMAIN (mode1), TYPE_DOMAIN (mode2))
+	  /* Are the elements modes equivalent? */
+	  && !integer_zerop (chill_equivalent (TREE_TYPE (mode1),
+					       TREE_TYPE (mode2),
+					       &node)))
+	{
+	  /* FIXME:  Check that element layouts are equivalent */
+
+	  tree count1 = fold (build (MINUS_EXPR, sizetype,
+				     TYPE_MAX_VALUE (TYPE_DOMAIN (mode1)),
+				     TYPE_MIN_VALUE (TYPE_DOMAIN (mode1))));
+	  tree count2 = fold (build (MINUS_EXPR, sizetype,
+				     TYPE_MAX_VALUE (TYPE_DOMAIN (mode2)),
+				     TYPE_MIN_VALUE (TYPE_DOMAIN (mode2))));
+	  tree cond = build_compare_discrete_expr (EQ_EXPR, count1, count2);
+	  if (TREE_CODE (cond) == INTEGER_CST)
+	    return !integer_zerop (cond);
+	  else
+	    {
+#if 0
+	      extern int ignoring;
+	      if (!ignoring 
+		  && range_checking
+		  && current_function_decl)
+		return cond;
+#endif
+	      return 1;
+	    }
+	}
+      return 0;
+
+    case RECORD_TYPE:
+    case UNION_TYPE:
+      for (t1 = TYPE_FIELDS (mode1), t2 = TYPE_FIELDS (mode2);
+	   t1 && t2;  t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2))
+	   {
+	     if (TREE_CODE (t1) != TREE_CODE (t2))
+	       return 0;
+	     /* Are the field modes equivalent? */
+	     if (integer_zerop (chill_equivalent (TREE_TYPE (t1),
+						   TREE_TYPE (t2),
+						   &node)))
+	       return 0;
+	   }
+      return t1 == t2;
+
+    case FUNCTION_TYPE:
+      if (!chill_l_equivalent (TREE_TYPE (mode1), TREE_TYPE (mode2), &node))
+	return 0;
+      for (t1 = TYPE_ARG_TYPES (mode1), t2 = TYPE_ARG_TYPES (mode2);
+	   t1 != NULL_TREE && t2 != NULL_TREE;
+	   t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2))
+	{
+	  tree attr1 = TREE_PURPOSE (t1)
+	    ? TREE_PURPOSE (t1) : ridpointers[(int) RID_IN];
+	  tree attr2 = TREE_PURPOSE (t2)
+	    ? TREE_PURPOSE (t2) : ridpointers[(int) RID_IN];
+	  if (attr1 != attr2)
+	    return 0;
+	  if (!chill_l_equivalent (TREE_VALUE (t1), TREE_VALUE (t2), &node))
+	    return 0;
+	}
+      if (t1 != t2) /* Both NULL_TREE */
+	return 0;
+      /* check list of exception names */
+      t1 = TYPE_RAISES_EXCEPTIONS (mode1);
+      t2 = TYPE_RAISES_EXCEPTIONS (mode2);
+      if (t1 == NULL_TREE && t2 != NULL_TREE)
+	return 0;
+      if (t1 != NULL_TREE && t2 == NULL_TREE)
+	return 0;
+      if (list_length (t1) != list_length (t2))
+	return 0;
+      while (t1 != NULL_TREE)
+        {
+	  if (value_member (TREE_VALUE (t1), t2) == NULL_TREE)
+	    return 0;
+	  t1 = TREE_CHAIN (t1);
+        }
+      /* FIXME:  Should also check they have the same RECURSIVITY */
+      return 1;
+
+    default:
+      ;
+#if 0
+      /* Need to handle row modes, instance modes,
+	 association modes, access modes, text modes,
+	 duration modes, absolute time modes, structure modes,
+	 parameterized structure modes */
+#endif
+    }
+  return 1;
+}
+
+/* Return a node that is true iff MODE1 and MODE2 are equivalent.
+   This is normally boolean_true_node or boolean_false_node,
+   but can be dynamic for dynamic types.
+   CHAIN is as for chill_similar.  */
+
+tree
+chill_equivalent (mode1, mode2, chain)
+     tree mode1, mode2;
+     struct mode_chain *chain;
+{
+  int varying1, varying2;
+  int is_string1, is_string2;
+  tree base_mode1, base_mode2;
+
+  /* Are the modes v-equivalent? */
+#if 0
+  if (!chill_similar (mode1, mode2, chain)
+      || CH_NOVELTY(mode1) != CH_NOVELTY(mode2))
+    return boolean_false_node;
+#endif
+  if (!chill_similar (mode1, mode2, chain))
+    return boolean_false_node;
+  else if (TREE_CODE (mode2) == FUNCTION_TYPE
+	   && TREE_CODE (mode1) == POINTER_TYPE
+	   && TREE_CODE (TREE_TYPE (mode1)) == FUNCTION_TYPE)
+    /* don't check novelty in this case to avoid error in case of
+       NEWMODE'd proceduremode gets assigned a function */
+    return boolean_true_node;
+  else if (CH_NOVELTY(mode1) != CH_NOVELTY(mode2))
+    return boolean_false_node;
+
+  varying1 = chill_varying_type_p (mode1);
+  varying2 = chill_varying_type_p (mode2);
+
+  if (varying1 != varying2)
+    return boolean_false_node;
+  base_mode1 = varying1 ? CH_VARYING_ARRAY_TYPE (mode1) : mode1;
+  base_mode2 = varying2 ? CH_VARYING_ARRAY_TYPE (mode2) : mode2;
+  is_string1 = CH_STRING_TYPE_P (base_mode1);
+  is_string2 = CH_STRING_TYPE_P (base_mode2);
+  if (is_string1 || is_string2)
+    {
+      if (is_string1 != is_string2)
+	return boolean_false_node;
+      return fold (build (EQ_EXPR, boolean_type_node,
+			  TYPE_SIZE (base_mode1),
+			  TYPE_SIZE (base_mode2)));
+    }
+
+  /* && some more stuff FIXME! */
+  if (TREE_CODE(mode1) == INTEGER_TYPE || TREE_CODE(mode2) == INTEGER_TYPE)
+    {
+      if (TREE_CODE(mode1) != INTEGER_TYPE || TREE_CODE(mode2) != INTEGER_TYPE)
+	return boolean_false_node;
+      /* If one is a range, the other has to be a range. */
+      if ((TREE_TYPE (mode1) != NULL_TREE) != (TREE_TYPE (mode2) != NULL_TREE))
+	return boolean_false_node;
+      if (TYPE_PRECISION (mode1) != TYPE_PRECISION (mode2))
+	return boolean_false_node;
+      if (!tree_int_cst_equal (TYPE_MIN_VALUE (mode1), TYPE_MIN_VALUE (mode2)))
+	return boolean_false_node;
+      if (!tree_int_cst_equal (TYPE_MAX_VALUE (mode1), TYPE_MAX_VALUE (mode2)))
+	return boolean_false_node;
+    }
+  return boolean_true_node;
+}
+
+static int
+chill_l_equivalent (mode1, mode2, chain)
+     tree mode1, mode2;
+     struct mode_chain *chain;
+{
+  /* Are the modes equivalent? */
+  if (integer_zerop (chill_equivalent (mode1, mode2, chain)))
+    return 0;
+  if (TYPE_READONLY (mode1) != TYPE_READONLY (mode2))
+    return 0;
+#if 0
+  ... other conditions ...;
+#endif
+  return 1;
+}
+
+/* See Z200 12.1.2.12 */
+
+int
+chill_read_compatible (modeM, modeN)
+     tree modeM, modeN;
+{
+  while (TREE_CODE (modeM) == REFERENCE_TYPE)
+    modeM = TREE_TYPE (modeM);
+  while (TREE_CODE (modeN) == REFERENCE_TYPE)
+    modeN = TREE_TYPE (modeN);
+
+  if (!CH_EQUIVALENT (modeM, modeN))
+    return 0;
+  if (TYPE_READONLY (modeN))
+    {
+      if (!TYPE_READONLY (modeM))
+	return 0;
+      if (CH_IS_BOUND_REFERENCE_MODE (modeM)
+	  && CH_IS_BOUND_REFERENCE_MODE (modeN))
+	{
+	  return chill_l_equivalent (TREE_TYPE (modeM), TREE_TYPE (modeN), 0);
+	}
+#if 0
+      ...;
+#endif
+    }
+  return 1;
+}
+
+/* Tests if MODE is compatible with the class of EXPR.
+   Cfr. Chill Blue Book 12.1.2.15. */
+
+int
+chill_compatible (expr, mode)
+     tree expr, mode;
+{
+  struct ch_class class;
+
+  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+    return 0;
+  if (mode == NULL_TREE || TREE_CODE (mode) == ERROR_MARK)
+    return 0;
+
+  while (TREE_CODE (mode) == REFERENCE_TYPE)
+    mode = TREE_TYPE (mode);
+
+  if (TREE_TYPE (expr) == NULL_TREE)
+    if (TREE_CODE (expr) == CONSTRUCTOR)
+      return TREE_CODE (mode) == RECORD_TYPE
+	|| ((TREE_CODE (mode) == SET_TYPE || TREE_CODE (mode) == ARRAY_TYPE)
+	    && ! TYPE_STRING_FLAG (mode));
+    else
+      return TREE_CODE (expr) == CASE_EXPR || TREE_CODE (expr) == COND_EXPR;
+
+  class = chill_expr_class (expr);
+  switch (class.kind)
+    {
+    case CH_ALL_CLASS:
+      return 1;
+    case CH_NULL_CLASS:
+      return CH_IS_REFERENCE_MODE (mode) || CH_IS_PROCEDURE_MODE (mode)
+	|| CH_IS_INSTANCE_MODE (mode);
+    case CH_VALUE_CLASS:
+      if (CH_HAS_REFERENCING_PROPERTY (mode))
+	return CH_RESTRICTABLE_TO(mode, class.mode);
+      else
+	return CH_V_EQUIVALENT(mode, class.mode);
+    case CH_DERIVED_CLASS:
+      return CH_SIMILAR (class.mode, mode);
+    case CH_REFERENCE_CLASS:
+      if (!CH_IS_REFERENCE_MODE (mode))
+	return 0;
+#if 0
+      /* FIXME! */
+      if (class.mode is a row mode)
+	...;
+      else if (class.mode is not a static mode)
+	return 0; /* is this possible? FIXME */
+#endif
+      return !CH_IS_BOUND_REFERENCE_MODE(mode)
+	|| CH_READ_COMPATIBLE (TREE_TYPE (mode), class.mode);
+    }
+  return 0; /* ERROR! */
+}
+
+/* Tests if the class of of EXPR1 and EXPR2 are compatible.
+   Cfr. Chill Blue Book 12.1.2.16. */
+
+int
+chill_compatible_classes (expr1, expr2)
+     tree expr1, expr2;
+{
+  struct ch_class temp;
+  struct ch_class class1, class2;
+  class1 = chill_expr_class (expr1);
+  class2 = chill_expr_class (expr2);
+
+  switch (class1.kind)
+    {
+    case CH_ALL_CLASS:
+      return 1;
+    case CH_NULL_CLASS:
+      switch (class2.kind)
+	{
+	case CH_ALL_CLASS:
+	case CH_NULL_CLASS:
+	case CH_REFERENCE_CLASS:
+	  return 1;
+	case CH_VALUE_CLASS:
+	case CH_DERIVED_CLASS:
+	  goto rule4;
+	}
+    case CH_REFERENCE_CLASS:
+      switch (class2.kind)
+	{
+	case CH_ALL_CLASS:
+	case CH_NULL_CLASS:
+	  return 1;
+	case CH_REFERENCE_CLASS:
+	  return CH_EQUIVALENT (class1.mode, class2.mode);
+	case CH_VALUE_CLASS:
+	  goto rule6;
+	case CH_DERIVED_CLASS:
+	  return 0;
+	}
+    case CH_DERIVED_CLASS:
+      switch (class2.kind)
+	{
+	case CH_ALL_CLASS:
+	  return 1;
+	case CH_VALUE_CLASS:
+	case CH_DERIVED_CLASS:
+	  return CH_SIMILAR (class1.mode, class2.mode);
+	case CH_NULL_CLASS:
+	  class2 = class1;
+	  goto rule4;
+	case CH_REFERENCE_CLASS:
+	  return 0;
+	}
+    case CH_VALUE_CLASS:
+      switch (class2.kind)
+	{
+	case CH_ALL_CLASS:
+	  return 1;
+	case CH_DERIVED_CLASS:
+	  return CH_SIMILAR (class1.mode, class2.mode);
+	case CH_VALUE_CLASS:
+	  return CH_V_EQUIVALENT (class1.mode, class2.mode);
+	case CH_NULL_CLASS:
+	  class2 = class1;
+	  goto rule4;
+	case CH_REFERENCE_CLASS:
+	  temp = class1;  class1 = class2;  class2 = temp;
+	  goto rule6;
+	}
+    }
+ rule4:
+  /* The Null class is Compatible with the M-derived class or M-value class
+     if and only if M is a reference mdoe, procedure mode or instance mode.*/
+  return CH_IS_REFERENCE_MODE (class2.mode)
+    || CH_IS_PROCEDURE_MODE (class2.mode)
+    || CH_IS_INSTANCE_MODE (class2.mode);
+
+ rule6:
+  /* The M-reference class is compatible with the N-value class if and
+     only if N is a reference mode and ... */
+  if (!CH_IS_REFERENCE_MODE (class2.mode))
+    return 0;
+  if (1) /* If M is a static mode - FIXME */
+    {
+      if (!CH_IS_BOUND_REFERENCE_MODE (class2.mode))
+	return 1;
+      if (CH_EQUIVALENT (TREE_TYPE (class2.mode), class1.mode))
+	return 1;
+    }
+  /* If N is a row mode whose .... FIXME */
+  return 0;
+}
+
+/* Cfr.  Blue Book 12.1.1.6, with some "extensions." */
+
+tree
+chill_root_mode (mode)
+     tree mode;
+{
+  /* Reference types are not user-visible types.
+     This seems like a good place to get rid of them. */
+  if (TREE_CODE (mode) == REFERENCE_TYPE)
+    mode = TREE_TYPE (mode);
+
+  while (TREE_CODE (mode) == INTEGER_TYPE && TREE_TYPE (mode) != NULL_TREE)
+    mode = TREE_TYPE (mode);  /* a sub-range */
+
+  /* This extension in not in the Blue Book - which only has a
+     single Integer type.
+     We should probably use chill_integer_type_node rather
+     than integer_type_node, but that is likely to bomb.
+     At some point, these will become the same, I hope. FIXME */
+  if (TREE_CODE (mode) == INTEGER_TYPE
+      && TYPE_PRECISION (mode) < TYPE_PRECISION (integer_type_node)
+      && CH_NOVELTY (mode) == NULL_TREE)
+    mode = integer_type_node;
+ 
+  if (TREE_CODE (mode) == FUNCTION_TYPE)
+    return build_pointer_type (mode);
+
+  return mode;
+}
+
+/* Cfr.  Blue Book 12.1.1.7. */
+
+tree
+chill_resulting_mode (mode1, mode2)
+     tree mode1, mode2;
+{
+  mode1 = CH_ROOT_MODE (mode1);
+  mode2 = CH_ROOT_MODE (mode2);
+  if (chill_varying_type_p (mode1))
+    return mode1;
+  if (chill_varying_type_p (mode2))
+    return mode2;
+  return mode1;
+}
+
+/* Cfr.  Blue Book (z200, 1988) 12.1.1.7 Resulting class. */
+
+struct ch_class
+chill_resulting_class (class1, class2)
+     struct ch_class class1, class2;
+{
+  struct ch_class class;
+  switch (class1.kind)
+    {
+    case CH_VALUE_CLASS:
+      switch (class2.kind)
+	{
+	case CH_DERIVED_CLASS:
+	case CH_ALL_CLASS:
+	  class.kind = CH_VALUE_CLASS;
+	  class.mode = CH_ROOT_MODE (class1.mode);
+	  return class;
+	case CH_VALUE_CLASS:
+	  class.kind = CH_VALUE_CLASS;
+	  class.mode
+	    = CH_ROOT_MODE (CH_RESULTING_MODE (class1.mode, class2.mode));
+	  return class;
+	}
+    case CH_DERIVED_CLASS:
+      switch (class2.kind)
+	{
+	case CH_VALUE_CLASS:
+	  class.kind = CH_VALUE_CLASS;
+	  class.mode = CH_ROOT_MODE (class2.mode);
+	  return class;
+	case CH_DERIVED_CLASS:
+	  class.kind = CH_DERIVED_CLASS;
+	  class.mode = CH_RESULTING_MODE (class1.mode, class2.mode);
+	  return class;
+	case CH_ALL_CLASS:
+	  class.kind = CH_DERIVED_CLASS;
+	  class.mode = CH_ROOT_MODE (class1.mode);
+	  return class;
+	}
+    case CH_ALL_CLASS:
+      switch (class2.kind)
+	{
+	case CH_VALUE_CLASS:
+	  class.kind = CH_VALUE_CLASS;
+	  class.mode = CH_ROOT_MODE (class2.mode);
+	  return class;
+	case CH_ALL_CLASS:
+	  class.kind = CH_ALL_CLASS;
+	  class.mode = NULL_TREE;
+	  return class;
+	case CH_DERIVED_CLASS:
+	  class.kind = CH_DERIVED_CLASS;
+	  class.mode = CH_ROOT_MODE (class2.mode);
+	  return class;
+	}
+    }
+  error ("internal error in chill_root_resulting_mode");
+  class.kind = CH_VALUE_CLASS;
+  class.mode = CH_ROOT_MODE (class1.mode);
+  return class;
+}
+
+
+/*
+ * See Z.200, section 6.3, static conditions. This function
+ * returns bool_false_node if the condition is not met at compile time,
+ *         bool_true_node if the condition is detectably met at compile time
+ *         an expression if a runtime check would be required or was generated.
+ * It should only be called with string modes and values.
+ */
+tree
+string_assignment_condition (lhs_mode, rhs_value)
+     tree lhs_mode, rhs_value;
+{
+  tree lhs_size, rhs_size, cond;
+  tree rhs_mode = TREE_TYPE (rhs_value);
+  int lhs_varying = chill_varying_type_p (lhs_mode);
+
+  if (lhs_varying)
+    lhs_size = size_in_bytes (CH_VARYING_ARRAY_TYPE (lhs_mode));
+  else if (CH_BOOLS_TYPE_P (lhs_mode))
+    lhs_size = TYPE_MAX_VALUE (TYPE_DOMAIN (lhs_mode));
+  else
+    lhs_size = size_in_bytes (lhs_mode);
+  lhs_size = convert (chill_unsigned_type_node, lhs_size);
+
+  if (rhs_mode && TREE_CODE (rhs_mode) == REFERENCE_TYPE)
+    rhs_mode = TREE_TYPE (rhs_mode);
+  if (rhs_mode == NULL_TREE)
+    {
+      /* actually, count constructor's length */
+      abort ();
+    }
+  else if (chill_varying_type_p (rhs_mode))
+    rhs_size = build_component_ref (rhs_value, var_length_id);
+  else if (CH_BOOLS_TYPE_P (rhs_mode))
+    rhs_size = TYPE_MAX_VALUE (TYPE_DOMAIN (rhs_mode));
+  else
+    rhs_size = size_in_bytes (rhs_mode);
+  rhs_size = convert (chill_unsigned_type_node, rhs_size);
+
+  /* validity condition */
+  cond = fold (build (lhs_varying ? GE_EXPR : EQ_EXPR, 
+	   boolean_type_node, lhs_size, rhs_size));
+  return cond;
+}
+
+/*
+ * take a basic CHILL type and wrap it in a VARYING structure.
+ * Be sure the length field is initialized.  Return the wrapper.
+ */
+tree
+build_varying_struct (type)
+     tree type;
+{  
+  tree decl1, decl2, result;
+
+  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+    return error_mark_node;
+
+  decl1 = build_decl (FIELD_DECL, var_length_id, chill_integer_type_node);
+  decl2 = build_decl (FIELD_DECL, var_data_id, type);
+  TREE_CHAIN (decl1) = decl2;      
+  TREE_CHAIN (decl2) = NULL_TREE;
+  result = build_chill_struct_type (decl1);
+
+  /* mark this so we don't complain about missing initializers.
+     It's fine for a VARYING array to be partially initialized.. */
+  C_TYPE_VARIABLE_SIZE(type) = 1;
+  return result;
+}
+
+
+/*
+ * This is the struct type that forms the runtime initializer
+ * list.  There's at least one of these generated per module.
+ * It's attached to the global initializer list by the module's
+ * 'constructor' code.  Should only be called in pass 2.
+ */
+tree
+build_init_struct ()
+{
+  tree decl1, decl2, result;
+  /* We temporarily reset the maximum_field_alignment to zero so the
+     compiler's init data structures can be compatible with the
+     run-time system, even when we're compiling with -fpack. */
+  extern int maximum_field_alignment;
+  int save_maximum_field_alignment = maximum_field_alignment;
+  maximum_field_alignment = 0;
+
+  decl1 = build_decl (FIELD_DECL, get_identifier ("__INIT_ENTRY"),
+	    build_chill_pointer_type (
+              build_function_type (void_type_node, NULL_TREE)));
+
+  decl2 = build_decl (FIELD_DECL, get_identifier ("__INIT_NEXT"),
+		      build_chill_pointer_type (void_type_node));
+
+  TREE_CHAIN (decl1) = decl2;      
+  TREE_CHAIN (decl2) = NULL_TREE;
+  result = build_chill_struct_type (decl1);
+  maximum_field_alignment = save_maximum_field_alignment;
+  return result;
+}
+
+
+/*
+ * Return 1 if the given type is a single-bit boolean set,
+ *          in which the domain's min and max values 
+ *          are both zero,
+ *        0 if not.  This can become a macro later..
+ */
+int
+ch_singleton_set (type)
+     tree type;
+{
+  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+    return 0;
+  if (TREE_CODE (type) != SET_TYPE)
+    return 0;
+  if (TREE_TYPE (type) == NULL_TREE 
+      || TREE_CODE (TREE_TYPE (type)) != BOOLEAN_TYPE)
+    return 0;
+  if (TYPE_DOMAIN (type) == NULL_TREE)
+    return 0;
+  if (! tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (type)),
+			    integer_zero_node))
+    return 0;
+  if (! tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (type)),
+			    integer_zero_node))
+    return 0;
+  return 1;
+}
+
+/* return non-zero if TYPE is a compiler-generated VARYING
+   array of some base type */
+int
+chill_varying_type_p (type)
+     tree type;
+{
+  if (type == NULL_TREE)
+    return 0;
+  if (TREE_CODE (type) != RECORD_TYPE)
+    return 0;
+  if (TYPE_FIELDS (type) == NULL_TREE 
+      || TREE_CHAIN (TYPE_FIELDS (type)) == NULL_TREE)
+    return 0;
+  if (DECL_NAME (TYPE_FIELDS (type)) != var_length_id)
+    return 0;
+  if (DECL_NAME (TREE_CHAIN (TYPE_FIELDS (type))) != var_data_id)
+    return 0;
+  if (TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (type))) != NULL_TREE)
+    return 0;
+  return 1;
+}
+
+/* return non-zero if TYPE is a compiler-generated VARYING
+   string record */
+int
+chill_varying_string_type_p (type)
+     tree type;
+{
+  tree var_data_type;
+    
+  if (!chill_varying_type_p (type))
+      return 0;
+  
+  var_data_type = CH_VARYING_ARRAY_TYPE (type);
+  return CH_CHARS_TYPE_P (var_data_type);
+}
+
+/* swiped from c-typeck.c */
+/* Build an assignment expression of lvalue LHS from value RHS. */
+
+tree
+build_chill_modify_expr (lhs, rhs)
+     tree lhs, rhs;
+{
+  register tree result;
+
+
+  tree lhstype = TREE_TYPE (lhs);
+
+  /* Avoid duplicate error messages from operands that had errors.  */
+  if (lhs == NULL_TREE || TREE_CODE (lhs) == ERROR_MARK || rhs == NULL_TREE || TREE_CODE (rhs) == ERROR_MARK)
+    return error_mark_node;
+
+  /* Strip NON_LVALUE_EXPRs since we aren't using as an lvalue.  */
+  /* Do not use STRIP_NOPS here.  We do not want an enumerator
+     whose value is 0 to count as a null pointer constant.  */
+  if (TREE_CODE (rhs) == NON_LVALUE_EXPR)
+    rhs = TREE_OPERAND (rhs, 0);
+
+#if 0
+  /* Handle a cast used as an "lvalue".
+     We have already performed any binary operator using the value as cast.
+     Now convert the result to the cast type of the lhs,
+     and then true type of the lhs and store it there;
+     then convert result back to the cast type to be the value
+     of the assignment.  */
+
+  switch (TREE_CODE (lhs))
+    {
+    case NOP_EXPR:
+    case CONVERT_EXPR:
+    case FLOAT_EXPR:
+    case FIX_TRUNC_EXPR:
+    case FIX_FLOOR_EXPR:
+    case FIX_ROUND_EXPR:
+    case FIX_CEIL_EXPR:
+      {
+	tree inner_lhs = TREE_OPERAND (lhs, 0);
+	tree result;
+	result = build_chill_modify_expr (inner_lhs,
+		   convert (TREE_TYPE (inner_lhs),
+		     convert (lhstype, rhs)));
+	pedantic_lvalue_warning (CONVERT_EXPR);
+	return convert (TREE_TYPE (lhs), result);
+      }
+    }
+
+  /* Now we have handled acceptable kinds of LHS that are not truly lvalues.
+     Reject anything strange now.  */
+
+  if (!lvalue_or_else (lhs, "assignment"))
+    return error_mark_node;
+#endif
+  /* FIXME: need to generate a RANGEFAIL if the RHS won't
+     fit into the LHS. */
+
+  if (TREE_CODE (lhs) != VAR_DECL
+      && ((TREE_CODE (TREE_TYPE (lhs)) == ARRAY_TYPE &&
+	   (TREE_TYPE (rhs) && TREE_CODE (TREE_TYPE (rhs)) == ARRAY_TYPE)) ||
+	  chill_varying_type_p (TREE_TYPE (lhs)) || 
+	  chill_varying_type_p (TREE_TYPE (rhs))))
+    {
+      int lhs_varying = chill_varying_type_p (TREE_TYPE (lhs));
+      int rhs_varying = chill_varying_type_p (TREE_TYPE (rhs));
+
+      /* point at actual RHS data's type */
+      tree rhs_data_type = rhs_varying ? 
+	CH_VARYING_ARRAY_TYPE (TREE_TYPE (rhs)) :
+	  TREE_TYPE (rhs);
+      {
+	/* point at actual LHS data's type */
+	tree lhs_data_type = lhs_varying ? 
+	  CH_VARYING_ARRAY_TYPE (TREE_TYPE (lhs)) :
+	    TREE_TYPE (lhs);
+
+	int lhs_bytes = int_size_in_bytes (lhs_data_type);
+	int rhs_bytes = int_size_in_bytes (rhs_data_type);
+
+	/* if both sides not varying, and sizes not dynamically 
+	   computed, sizes must *match* */
+	if (! lhs_varying && ! rhs_varying && lhs_bytes != rhs_bytes
+	    && lhs_bytes > 0 && rhs_bytes > 0)
+	  {
+	    error ("string lengths not equal");
+	    return error_mark_node;
+	  }
+	/* Must have enough space on LHS for static size of RHS */
+    
+	if (lhs_bytes > 0 && rhs_bytes > 0 
+	    && lhs_bytes < rhs_bytes)
+	  {
+	    if (rhs_varying)
+	      {
+		/* FIXME: generate runtime test for room */
+		;
+	      }
+	    else
+	      {
+		error ("can't do ARRAY assignment - too large");
+		return error_mark_node;
+	      }
+	  }
+      }
+
+      /* now we know the RHS will fit in LHS, build trees for the
+	 emit_block_move parameters */
+
+      if (lhs_varying)
+	rhs = convert (TREE_TYPE (lhs), rhs);
+      else
+	{
+	  if (rhs_varying)
+	    rhs = build_component_ref (rhs, var_data_id);
+
+	  if (! mark_addressable (rhs))
+	    {
+	      error ("rhs of array assignment is not addressable");
+	      return error_mark_node;
+	    }
+
+	  lhs = force_addr_of (lhs);
+	  rhs = build1 (ADDR_EXPR, const_ptr_type_node, rhs);
+	  return
+	  build_chill_function_call (lookup_name (get_identifier ("memmove")),
+	    tree_cons (NULL_TREE, lhs,
+              tree_cons (NULL_TREE, rhs,
+                tree_cons (NULL_TREE, size_in_bytes (rhs_data_type), 
+		   NULL_TREE))));
+	}
+    }
+
+  result = build (MODIFY_EXPR, lhstype, lhs, rhs);
+  TREE_SIDE_EFFECTS (result) = 1;
+
+  return result;
+}
+
+/* Constructors for pointer, array and function types.
+   (RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE nodes are
+   constructed by language-dependent code, not here.)  */
+
+/* Construct, lay out and return the type of pointers to TO_TYPE.
+   If such a type has already been constructed, reuse it.  */
+
+tree
+make_chill_pointer_type (to_type, code)
+     tree to_type;
+     enum tree_code code;  /* POINTER_TYPE or REFERENCE_TYPE */
+{
+  extern struct obstack *current_obstack;
+  extern struct obstack *saveable_obstack;
+  extern struct obstack  permanent_obstack;
+  tree t;
+  register struct obstack *ambient_obstack = current_obstack;
+  register struct obstack *ambient_saveable_obstack = saveable_obstack;
+
+  /* If TO_TYPE is permanent, make this permanent too.  */
+  if (TREE_PERMANENT (to_type))
+    {
+      current_obstack = &permanent_obstack;
+      saveable_obstack = &permanent_obstack;
+    }
+
+  t = make_node (code);
+  TREE_TYPE (t) = to_type;
+
+  current_obstack = ambient_obstack;
+  saveable_obstack = ambient_saveable_obstack;
+  return t;
+}
+
+
+tree
+build_chill_pointer_type (to_type)
+     tree to_type;
+{
+  int is_type_node = TREE_CODE_CLASS (TREE_CODE (to_type)) == 't';
+  register tree t = is_type_node ? TYPE_POINTER_TO (to_type) : NULL_TREE;
+
+  /* First, if we already have a type for pointers to TO_TYPE, use it.  */
+
+  if (t)
+    return t;
+
+  /* We need a new one. */
+  t = make_chill_pointer_type (to_type, POINTER_TYPE);
+
+  /* Lay out the type.  This function has many callers that are concerned
+     with expression-construction, and this simplifies them all.
+     Also, it guarantees the TYPE_SIZE is permanent if the type is.  */
+  if ((is_type_node && (TYPE_SIZE (to_type) != NULL_TREE))
+      || pass == 2)
+    {
+      /* Record this type as the pointer to TO_TYPE.  */
+      TYPE_POINTER_TO (to_type) = t;
+      layout_type (t);
+    }
+
+  return t;
+}
+
+tree
+build_chill_reference_type (to_type)
+     tree to_type;
+{
+  int is_type_node = TREE_CODE_CLASS (TREE_CODE (to_type)) == 't';
+  register tree t = is_type_node ? TYPE_REFERENCE_TO (to_type) : NULL_TREE;
+
+  /* First, if we already have a type for references to TO_TYPE, use it.  */
+
+  if (t)
+    return t;
+
+  /* We need a new one. */
+  t = make_chill_pointer_type (to_type, REFERENCE_TYPE);
+
+  /* Lay out the type.  This function has many callers that are concerned
+     with expression-construction, and this simplifies them all.
+     Also, it guarantees the TYPE_SIZE is permanent if the type is.  */
+  if ((is_type_node && (TYPE_SIZE (to_type) != NULL_TREE))
+      || pass == 2)
+    {
+      /* Record this type as the reference to TO_TYPE.  */
+      TYPE_REFERENCE_TO (to_type) = t;
+      layout_type (t);
+      CH_NOVELTY (t) = CH_NOVELTY (to_type);
+    }
+
+  return t;
+}
+
+tree
+make_chill_range_type (type, lowval, highval)
+     tree type, lowval, highval;
+{
+  register tree itype = make_node (INTEGER_TYPE);
+  TREE_TYPE (itype) = type;
+  TYPE_MIN_VALUE (itype) = lowval;
+  TYPE_MAX_VALUE (itype) = highval;
+  return itype;
+}
+
+tree
+layout_chill_range_type (rangetype, must_be_const)
+     tree rangetype;
+     int must_be_const;
+{
+  tree type = TREE_TYPE (rangetype);
+  tree lowval = TYPE_MIN_VALUE (rangetype);
+  tree highval = TYPE_MAX_VALUE (rangetype);
+  int bad_limits = 0;
+
+  if (TYPE_SIZE (rangetype) != NULL_TREE)
+    return rangetype;
+
+  /* process BIN */
+  if (type == ridpointers[(int) RID_BIN])
+    {
+      int binsize;
+      
+      /* make a range out of it */
+      if (TREE_CODE (highval) != INTEGER_CST)
+	{
+	  error ("non-constant expression for BIN");
+	  return error_mark_node;
+	}
+      binsize = TREE_INT_CST_LOW (highval);
+      if (binsize < 0)
+	{
+	  error ("expression for BIN must not be negative");
+	  return error_mark_node;
+	}
+      if (binsize > 32)
+	{
+	  error ("cannot process BIN (>32)");
+	  return error_mark_node;
+	}
+      type = ridpointers [(int) RID_RANGE];
+      lowval = integer_zero_node;
+      highval = build_int_2 ((1 << binsize) - 1, 0);
+    }
+ 
+  if (TREE_CODE (lowval) == ERROR_MARK ||
+      TREE_CODE (highval) == ERROR_MARK)
+    return error_mark_node;
+
+  if (!CH_COMPATIBLE_CLASSES (lowval, highval))
+    {
+      error ("bounds of range are not compatible");
+      return error_mark_node;
+    }
+
+  if (type == string_index_type_dummy)
+    {
+      if (TREE_CODE (highval) == INTEGER_CST
+	  && compare_int_csts (LT_EXPR, highval, integer_minus_one_node))
+	{
+	  error ("negative string length");
+	  highval = integer_minus_one_node;
+	}
+      if (compare_int_csts (EQ_EXPR, highval, integer_minus_one_node))
+	type = integer_type_node;
+      else
+	type = sizetype;
+      TREE_TYPE (rangetype) = type;
+    }
+  else if (type == ridpointers[(int) RID_RANGE])
+    {
+      /* This isn't 100% right, since the Blue Book definition
+	 uses Resulting Class, rather than Resulting Mode,
+	 but it's close enough. */
+      type = CH_ROOT_RESULTING_CLASS (lowval, highval).mode;
+
+      /* The default TYPE is the type of the constants -
+	 except if the constants are integers, we choose an
+	 integer type that fits. */
+      if (TREE_CODE (type) == INTEGER_TYPE
+	  && TREE_CODE (lowval) == INTEGER_CST
+	  && TREE_CODE (highval) == INTEGER_CST)
+	{
+	  /* The logic of this code has been copied from finish_enum
+	     in c-decl.c.  FIXME duplication! */
+	  int precision = 0;
+	  HOST_WIDE_INT maxvalue = TREE_INT_CST_LOW (highval);
+	  HOST_WIDE_INT minvalue = TREE_INT_CST_LOW (lowval);
+	  if (TREE_INT_CST_HIGH (lowval) >= 0
+	      ? tree_int_cst_lt (TYPE_MAX_VALUE (unsigned_type_node), highval)
+	      : (tree_int_cst_lt (lowval, TYPE_MIN_VALUE (integer_type_node))
+		 || tree_int_cst_lt (TYPE_MAX_VALUE (integer_type_node), highval)))
+	    precision = TYPE_PRECISION (long_long_integer_type_node);
+	  else
+	    {
+	      if (maxvalue > 0)
+		precision = floor_log2 (maxvalue) + 1;
+	      if (minvalue < 0)
+		{
+		  /* Compute number of bits to represent magnitude of a
+		     negative value.  Add one to MINVALUE since range of
+		     negative numbers includes the power of two.  */
+		  unsigned negprecision = floor_log2 (-minvalue - 1) + 1;
+		  if (negprecision > precision)
+		    precision = negprecision;
+		  precision += 1;	/* room for sign bit */
+		}
+
+	      if (!precision)
+		precision = 1;
+	    }
+	  type = type_for_size (precision, minvalue >= 0);
+
+	}
+      TREE_TYPE (rangetype) = type;
+    }
+  else
+    {
+      if (!CH_COMPATIBLE (lowval, type))
+	{
+	  error ("range's lower bound and parent mode don't match");
+	  return integer_type_node;    /* an innocuous fake */
+	}
+      if (!CH_COMPATIBLE (highval, type))
+	{
+	  error ("range's upper bound and parent mode don't match");
+	  return integer_type_node;    /* an innocuous fake */
+	}
+    }
+
+  if (TREE_CODE (type) == ERROR_MARK)
+    return type;
+  else if (TREE_CODE_CLASS (TREE_CODE (type)) != 't')
+    {
+      error ("making range from non-mode");
+      return error_mark_node;
+    }
+
+  if (TREE_CODE (lowval) == REAL_CST || TREE_CODE (highval) == REAL_CST)
+    {
+      sorry ("floating point ranges");
+      return integer_type_node; /* another fake */
+    }
+
+  if (TREE_CODE (lowval) != INTEGER_CST || TREE_CODE (highval) != INTEGER_CST)
+    {
+      if (must_be_const)
+	{
+	  error ("range mode has non-constant limits");
+	  bad_limits = 1;
+	}
+    }
+  else if (tree_int_cst_equal (lowval, integer_zero_node)
+	   && tree_int_cst_equal (highval, integer_minus_one_node))
+    ; /* do nothing - this is the index type for an empty string */
+  else if (compare_int_csts (LT_EXPR, highval, TYPE_MIN_VALUE (type)))
+    {
+      error ("range's high bound < mode's low bound");
+      bad_limits = 1;
+    }
+  else if (compare_int_csts (GT_EXPR, highval, TYPE_MAX_VALUE (type)))
+    {
+      error ("range's high bound > mode's high bound");
+      bad_limits = 1;
+    }
+  else if (compare_int_csts (LT_EXPR, highval, lowval))
+    {
+      error ("range mode high bound < range mode low bound");
+      bad_limits = 1;
+    }
+  else if (compare_int_csts (LT_EXPR, lowval, TYPE_MIN_VALUE (type)))
+    {
+      error ("range's low bound < mode's low bound");
+      bad_limits = 1;
+    }
+  else if (compare_int_csts (GT_EXPR, lowval, TYPE_MAX_VALUE (type)))
+    {
+      error ("range's low bound > mode's high bound");
+      bad_limits = 1;
+    }
+
+  if (bad_limits)
+    {
+      lowval = TYPE_MIN_VALUE (type);
+      highval = lowval;
+    }
+
+  highval = convert (type, highval);
+  lowval =  convert (type, lowval);
+  TYPE_MIN_VALUE (rangetype) = lowval;
+  TYPE_MAX_VALUE (rangetype) = highval;
+  TYPE_PRECISION (rangetype) = TYPE_PRECISION (type);
+  TYPE_MODE (rangetype) = TYPE_MODE (type);
+  TYPE_SIZE (rangetype) = TYPE_SIZE (type);
+  TYPE_ALIGN (rangetype) = TYPE_ALIGN (type);
+  TREE_UNSIGNED (rangetype) = TREE_UNSIGNED (type);
+  CH_NOVELTY (rangetype) = CH_NOVELTY (type);
+  return rangetype;
+}
+
+/* Build a _TYPE node that has range bounds associated with its values.
+   TYPE is the base type for the range type. */
+tree
+build_chill_range_type (type, lowval, highval)
+     tree type, lowval, highval;
+{
+  tree rangetype;
+
+  if (type == NULL_TREE)
+    type = ridpointers[(int) RID_RANGE];
+  else if (TREE_CODE (type) == ERROR_MARK)
+    return error_mark_node;
+
+  rangetype = make_chill_range_type (type, lowval, highval);
+  if (pass != 1)
+    rangetype = layout_chill_range_type (rangetype, 0);
+
+  return rangetype;
+}
+
+/* Build a CHILL array type, but with minimal checking etc. */
+
+tree
+build_simple_array_type (type, idx, layout)
+     tree type, idx, layout;
+{
+  tree array_type = make_node (ARRAY_TYPE);
+  TREE_TYPE (array_type) = type;
+  TYPE_DOMAIN (array_type) = idx;
+  TYPE_ATTRIBUTES (array_type) = layout;
+  if (pass != 1)
+    array_type = layout_chill_array_type (array_type);
+  return array_type;
+}
+
+static void
+apply_chill_array_layout (array_type)
+     tree array_type;
+{
+  tree layout, temp, what, element_type;
+  int stepsize, word, start_bit, offset, length, natural_length;
+  int stepsize_specified;
+  int start_bit_error = 0;
+  int length_error = 0;
+
+  layout = TYPE_ATTRIBUTES (array_type);
+  if (layout == NULL_TREE)
+    return;
+
+  if (layout == integer_zero_node) /* NOPACK */
+    {
+      TYPE_PACKED (array_type) = 0;
+      return;
+    }
+
+  /* Allow for the packing of 1 bit discrete modes at the bit level. */
+  element_type = TREE_TYPE (array_type);
+  if (discrete_type_p (element_type)
+      && get_type_precision (TYPE_MIN_VALUE (element_type),
+			     TYPE_MAX_VALUE (element_type)) == 1)
+    natural_length = 1;
+  else
+    natural_length = TREE_INT_CST_LOW (TYPE_SIZE (element_type));
+
+  if (layout == integer_one_node) /* PACK */
+    {
+      if (natural_length == 1)
+	TYPE_PACKED (array_type) = 1;
+      return;
+    }
+
+  /* The layout is a STEP (...).
+     The current implementation restricts STEP specifications to be of the form
+     STEP(POS(0,0,n),n) where n is the natural size of the element mode. */
+  stepsize_specified = 0;
+  temp = TREE_VALUE (layout);
+  if (TREE_VALUE (temp) != NULL_TREE)
+    {
+      if (TREE_CODE (TREE_VALUE (temp)) != INTEGER_CST)
+	error ("Stepsize in STEP must be an integer constant");
+      else
+	{
+	  stepsize = TREE_INT_CST_LOW (TREE_VALUE (temp));
+	  if (stepsize <= 0)
+	    error ("Stepsize in STEP must be > 0");
+	  else
+	    stepsize_specified = 1;
+
+	  if (stepsize != natural_length)
+	    sorry ("Stepsize in STEP must be the natural width of "
+		   "the array element mode");
+	}
+    }
+
+  temp = TREE_PURPOSE (temp);
+  if (TREE_CODE (TREE_PURPOSE (temp)) != INTEGER_CST)
+    error ("Starting word in POS must be an integer constant");
+  else
+    {
+      word = TREE_INT_CST_LOW (TREE_PURPOSE (temp));
+      if (word < 0)
+	error ("Starting word in POS must be >= 0");
+      if (word != 0)
+	sorry ("Starting word in POS within STEP must be 0");
+    }
+
+  length = natural_length;
+  temp = TREE_VALUE (temp);
+  if (temp != NULL_TREE)
+    {
+      int wordsize = TYPE_PRECISION (chill_integer_type_node);
+      if (TREE_CODE (TREE_PURPOSE (temp)) != INTEGER_CST)
+	{
+	  error ("Starting bit in POS must be an integer constant");
+	  start_bit_error = 1;
+	}
+      else
+	{
+	  start_bit = TREE_INT_CST_LOW (TREE_PURPOSE (temp));
+	  if (start_bit != 0)
+	    sorry ("Starting bit in POS within STEP must be 0");
+	  if (start_bit < 0)
+	    {
+	      error ("Starting bit in POS must be >= 0");
+	      start_bit = 0;
+	      start_bit_error = 1;
+	    }
+	  else if (start_bit >= wordsize)
+	    {
+	      error ("Starting bit in POS must be < the width of a word");
+	      start_bit = 0;
+	      start_bit_error = 1;
+	    }
+	}
+
+      temp = TREE_VALUE (temp);
+      if (temp != NULL_TREE)
+	{
+	  what = TREE_PURPOSE (temp);
+	  if (what == integer_zero_node)
+	    {
+	      if (TREE_CODE (TREE_VALUE (temp)) != INTEGER_CST)
+		{
+		  error ("Length in POS must be an integer constant");
+		  length_error = 1;
+		}
+	      else
+		{
+		  length = TREE_INT_CST_LOW (TREE_VALUE (temp));
+		  if (length <= 0)
+		    error ("Length in POS must be > 0");
+		}
+	    }
+	  else
+	    {
+	      if (TREE_CODE (TREE_VALUE (temp)) != INTEGER_CST)
+		{
+		  error ("End bit in POS must be an integer constant");
+		  length_error = 1;
+		}
+	      else
+		{
+		  int end_bit = TREE_INT_CST_LOW (TREE_VALUE (temp));
+		  if (end_bit < start_bit)
+		    {
+		      error ("End bit in POS must be >= the start bit");
+		      end_bit = wordsize - 1;
+		      length_error = 1;
+		    }
+		  else if (end_bit >= wordsize)
+		    {
+		      error ("End bit in POS must be < the width of a word");
+		      end_bit = wordsize - 1;
+		      length_error = 1;
+		    }
+		  else if (start_bit_error)
+		    length_error = 1;
+		  else
+		    length = end_bit - start_bit + 1;
+		}
+	    }
+	  if (! length_error && length != natural_length)
+	    {
+	      sorry ("The length specified on POS within STEP must be "
+		     "the natural length of the array element type");
+	    }
+	}
+    }
+
+  if (! length_error && stepsize_specified && stepsize < length)
+    error ("Step size in STEP must be >= the length in POS");
+
+  if (length == 1)
+    TYPE_PACKED (array_type) = 1;
+}
+
+tree
+layout_chill_array_type (array_type)
+     tree array_type;
+{
+  tree itype;
+  tree element_type = TREE_TYPE (array_type);
+
+  if (TREE_CODE (element_type) == ARRAY_TYPE
+      && TYPE_SIZE (element_type) == 0)
+    layout_chill_array_type (element_type);
+
+  itype = TYPE_DOMAIN (array_type);
+
+  if (TREE_CODE (itype) == ERROR_MARK
+      || TREE_CODE (element_type) == ERROR_MARK)
+    return error_mark_node;
+
+  /* do a lower/upper bound check. */
+  if (TREE_CODE (itype) == INTEGER_CST)
+    {
+      error ("array index must be a range, not a single integer");
+      return error_mark_node;
+    }
+  if (TREE_CODE_CLASS (TREE_CODE (itype)) != 't'
+      || !discrete_type_p (itype))
+    {
+      error ("array index is not a discrete mode");
+      return error_mark_node;
+    }
+
+  /* apply the array layout, if specified. */
+  apply_chill_array_layout (array_type);
+  TYPE_ATTRIBUTES (array_type) = NULL_TREE;
+
+  /* Make sure TYPE_POINTER_TO (element_type) is filled in.  */
+  build_pointer_type (element_type);
+
+  if (TYPE_SIZE (array_type) == 0)
+    layout_type (array_type);
+
+  if (TYPE_READONLY_PROPERTY (element_type))
+    TYPE_FIELDS_READONLY (array_type) = 1;
+
+  TYPE_ARRAY_MAX_SIZE (array_type) = size_in_bytes (array_type);
+  return array_type;
+}
+
+/* Build a CHILL array type.
+
+   TYPE is the element type of the array.
+   IDXLIST is the list of dimensions of the array.
+   VARYING_P is non-zero if the array is a varying array.
+   LAYOUT is (NULL_TREE, integer_one_node, integer_zero_node, tree_list),
+   meaning (default, pack, nopack, STEP (...) ).  */
+tree
+build_chill_array_type (type, idxlist, varying_p, layouts)
+     tree type, idxlist;
+     int varying_p;
+     tree layouts;
+{
+  tree array_type = type;
+
+  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+    return error_mark_node;
+  if (idxlist == NULL_TREE || TREE_CODE (idxlist) == ERROR_MARK)
+    return error_mark_node;
+
+  /* We have to walk down the list of index decls, building inner
+     array types as we go. We need to reverse the list of layouts so that the
+     first layout applies to the last index etc. */
+  layouts = nreverse (layouts);
+  for ( ; idxlist; idxlist = TREE_CHAIN (idxlist))
+    {
+      if (layouts != NULL_TREE)
+	{
+	  type = build_simple_array_type (
+		   type, TREE_VALUE (idxlist), TREE_VALUE (layouts));
+	  layouts = TREE_CHAIN (layouts);
+	}
+      else
+        type = build_simple_array_type (type, TREE_VALUE (idxlist), NULL_TREE);
+    }
+  array_type = type;
+  if (varying_p)
+    array_type = build_varying_struct (array_type);
+  return array_type;
+}
+
+/* Function to help qsort sort FIELD_DECLs by name order.  */
+
+static int
+field_decl_cmp (x, y)
+     tree *x, *y;
+{
+  return (long)DECL_NAME (*x) - (long)DECL_NAME (*y);
+}
+
+tree
+make_chill_struct_type (fieldlist)
+     tree fieldlist;
+{
+  tree t, x;
+  if (TREE_UNION_ELEM (fieldlist))
+    t = make_node (UNION_TYPE);
+  else
+    t = make_node (RECORD_TYPE);
+  /* Install struct as DECL_CONTEXT of each field decl. */
+  for (x = fieldlist; x; x = TREE_CHAIN (x))
+    {
+      DECL_CONTEXT (x) = t;
+      DECL_FIELD_SIZE (x) = 0;
+    }
+
+  /* Delete all duplicate fields from the fieldlist */
+  for (x = fieldlist; x && TREE_CHAIN (x);)
+    /* Anonymous fields aren't duplicates.  */
+    if (DECL_NAME (TREE_CHAIN (x)) == 0)
+      x = TREE_CHAIN (x);
+    else
+      {
+	register tree y = fieldlist;
+	  
+	while (1)
+	  {
+	    if (DECL_NAME (y) == DECL_NAME (TREE_CHAIN (x)))
+	      break;
+	    if (y == x)
+	      break;
+	    y = TREE_CHAIN (y);
+	  }
+	if (DECL_NAME (y) == DECL_NAME (TREE_CHAIN (x)))
+	  {
+	    error_with_decl (TREE_CHAIN (x), "duplicate member `%s'");
+	    TREE_CHAIN (x) = TREE_CHAIN (TREE_CHAIN (x));
+	  }
+	else x = TREE_CHAIN (x);
+      }
+
+  TYPE_FIELDS (t) = fieldlist;
+
+  return t;
+}
+
+/* decl is a FIELD_DECL.
+   DECL_INIT (decl) is (NULL_TREE, integer_one_node, integer_zero_node, tree_list),
+   meaning (default, pack, nopack, POS (...) ).
+   The return value is a boolean: 1 if POS specified, 0 if not */
+static int
+apply_chill_field_layout (decl, next_struct_offset)
+     tree decl;
+     int* next_struct_offset;
+{
+  tree layout, type, temp, what;
+  int word, wordsize, start_bit, offset, length, natural_length;
+  int pos_error = 0;
+  int is_discrete;
+
+  type = TREE_TYPE (decl);
+  is_discrete = discrete_type_p (type);
+  if (is_discrete)
+    natural_length = get_type_precision (TYPE_MIN_VALUE (type), TYPE_MAX_VALUE (type));
+  else
+    natural_length = TREE_INT_CST_LOW (TYPE_SIZE (type));
+
+  layout = DECL_INITIAL (decl);
+  if (layout == integer_zero_node) /* NOPACK */
+    {
+      DECL_PACKED (decl) = 0;
+      *next_struct_offset += natural_length;
+      return 0; /* not POS */
+    }
+
+  if (layout == integer_one_node) /* PACK */
+    {
+      if (is_discrete)
+	DECL_BIT_FIELD (decl) = 1;
+      else
+	{
+	  DECL_BIT_FIELD (decl) = 0;
+	  DECL_ALIGN (decl) = BITS_PER_UNIT;
+	}
+      DECL_PACKED (decl) = 1;
+      DECL_FIELD_SIZE (decl) = natural_length;
+      *next_struct_offset += natural_length;
+      return 0; /* not POS */
+    }
+
+  /* The layout is a POS (...). The current implementation restricts the use
+     of POS to monotonically increasing fields whose width must be the
+     natural width of the underlying type. */
+  temp = TREE_PURPOSE (layout);
+
+  if (TREE_CODE (TREE_PURPOSE (temp)) != INTEGER_CST)
+    {
+      error ("Starting word in POS must be an integer constant");
+      pos_error = 1;
+    }
+  else
+    {
+      word = TREE_INT_CST_LOW (TREE_PURPOSE (temp));
+      if (word < 0)
+	{
+	  error ("Starting word in POS must be >= 0");
+	  word = 0;
+	  pos_error = 1;
+	}
+    }
+
+  wordsize = TYPE_PRECISION (chill_integer_type_node);
+  offset = word * wordsize;
+  length = natural_length;
+
+  temp = TREE_VALUE (temp);
+  if (temp != NULL_TREE)
+    {
+      if (TREE_CODE (TREE_PURPOSE (temp)) != INTEGER_CST)
+	{
+	  error ("Starting bit in POS must be an integer constant");
+	  start_bit = *next_struct_offset - offset;
+	  pos_error = 1;
+	}
+      else
+	{
+	  start_bit = TREE_INT_CST_LOW (TREE_PURPOSE (temp));
+	  if (start_bit < 0)
+	    {
+	      error ("Starting bit in POS must be >= 0");
+	      start_bit = *next_struct_offset - offset;
+	      pos_error = 1;
+	    }
+	  else if (start_bit >= wordsize)
+	    {
+	      error ("Starting bit in POS must be < the width of a word");
+	      start_bit = *next_struct_offset - offset;
+	      pos_error = 1;
+	    }
+	}
+
+      temp = TREE_VALUE (temp);
+      if (temp != NULL_TREE)
+	{
+	  what = TREE_PURPOSE (temp);
+	  if (what == integer_zero_node)
+	    {
+	      if (TREE_CODE (TREE_VALUE (temp)) != INTEGER_CST)
+		{
+		  error ("Length in POS must be an integer constant");
+		  pos_error = 1;
+		}
+	      else
+		{
+		  length = TREE_INT_CST_LOW (TREE_VALUE (temp));
+		  if (length <= 0)
+		    {
+		      error ("Length in POS must be > 0");
+		      length = natural_length;
+		      pos_error = 1;
+		    }
+		}
+	    }
+	  else
+	    {
+	      if (TREE_CODE (TREE_VALUE (temp)) != INTEGER_CST)
+		{
+		  error ("End bit in POS must be an integer constant");
+		  pos_error = 1;
+		}
+	      else
+		{
+		  int end_bit = TREE_INT_CST_LOW (TREE_VALUE (temp));
+		  if (end_bit < start_bit)
+		    {
+		      error ("End bit in POS must be >= the start bit");
+		      pos_error = 1;
+		    }
+		  else if (end_bit >= wordsize)
+		    {
+		      error ("End bit in POS must be < the width of a word");
+		      pos_error = 1;
+		    }
+		  else
+		    length = end_bit - start_bit + 1;
+		}
+	    }
+	  if (length != natural_length && ! pos_error)
+	    {
+	      sorry ("The length specified on POS must be the natural length "
+		     "of the field type");
+	      length = natural_length;
+	    }
+	}
+
+      offset += start_bit;
+    }
+
+  if (offset != *next_struct_offset && ! pos_error)
+    sorry ("STRUCT fields must be layed out in monotonically increasing order");
+
+  DECL_PACKED (decl) = 1;
+  DECL_BIT_FIELD (decl) = is_discrete;
+  DECL_FIELD_SIZE (decl) = length;
+  *next_struct_offset += natural_length;
+
+  return 1; /* was POS */
+}
+
+tree
+layout_chill_struct_type (t)
+     tree t;
+{
+  tree fieldlist = TYPE_FIELDS (t);
+  tree x;
+  int old_momentary;
+  int was_pos;
+  int pos_seen = 0;
+  int pos_error = 0;
+  int next_struct_offset;
+
+  old_momentary = suspend_momentary ();
+
+  /* Process specified field sizes.
+     Set DECL_FIELD_SIZE to the specified size, or 0 if none specified.
+     The specified size is found in the DECL_INITIAL.
+     Store 0 there, except for ": 0" fields (so we can find them
+     and delete them, below).  */
+
+  next_struct_offset = 0;
+  for (x = fieldlist; x; x = TREE_CHAIN (x))
+    {
+      /* An EVENT or BUFFER mode is implemented as a RECORD_TYPE
+	 which may contain a CONST_DECL for the maximum queue size. */
+      if (TREE_CODE (x) == CONST_DECL)
+	continue;
+
+      /* If any field is const, the structure type is pseudo-const.  */
+      /* A field that is pseudo-const makes the structure likewise.  */
+      if (TREE_READONLY (x) || TYPE_READONLY_PROPERTY (TREE_TYPE (x)))
+	TYPE_FIELDS_READONLY (t) = 1;
+
+      /* Any field that is volatile means variables of this type must be
+	 treated in some ways as volatile.  */
+      if (TREE_THIS_VOLATILE (x))
+	C_TYPE_FIELDS_VOLATILE (t) = 1;
+
+      if (DECL_INITIAL (x) != NULL_TREE)
+	{
+	  was_pos = apply_chill_field_layout (x, &next_struct_offset);
+	  DECL_INITIAL (x) = NULL_TREE;
+	}
+      else
+	{
+	  int min_align = TYPE_ALIGN (TREE_TYPE (x));
+	  DECL_ALIGN (x) = MAX (DECL_ALIGN (x), min_align);
+	  was_pos = 0;
+	}
+      if ((! was_pos && pos_seen) || (was_pos && ! pos_seen && x != fieldlist))
+	pos_error = 1;
+      pos_seen |= was_pos;
+    }
+
+  if (pos_error)
+    error ("If one field has a POS layout, then all fields must have a POS layout");
+
+  /* Now DECL_INITIAL is null on all fields.  */
+
+  layout_type (t);
+
+  /*  Now we have the truly final field list.
+      Store it in this type and in the variants.  */
+
+  TYPE_FIELDS (t) = fieldlist;
+
+  /* If there are lots of fields, sort so we can look through them fast.
+     We arbitrarily consider 16 or more elts to be "a lot".  */
+  {
+    int len = 0;
+
+    for (x = fieldlist; x; x = TREE_CHAIN (x))
+      {
+	if (len > 15)
+	  break;
+	len += 1;
+      }
+    if (len > 15)
+      {
+	tree *field_array;
+	char *space;
+
+	len += list_length (x);
+	/* Use the same allocation policy here that make_node uses, to
+	   ensure that this lives as long as the rest of the struct decl.
+	   All decls in an inline function need to be saved.  */
+	if (allocation_temporary_p ())
+	  space = savealloc (sizeof (struct lang_type) + len * sizeof (tree));
+	else
+	  space = oballoc (sizeof (struct lang_type) + len * sizeof (tree));
+
+	TYPE_LANG_SPECIFIC (t) = (struct lang_type *) space;
+	TYPE_LANG_SPECIFIC (t)->foo.rec.len = len;
+
+	field_array = &TYPE_LANG_SPECIFIC (t)->foo.rec.elts[0];
+	len = 0;
+	for (x = fieldlist; x; x = TREE_CHAIN (x))
+	  field_array[len++] = x;
+
+	qsort (field_array, len, sizeof (tree), field_decl_cmp);
+      }
+  }
+
+  for (x = TYPE_MAIN_VARIANT (t); x; x = TYPE_NEXT_VARIANT (x))
+    {
+      TYPE_FIELDS (x) = TYPE_FIELDS (t);
+      TYPE_LANG_SPECIFIC (x) = TYPE_LANG_SPECIFIC (t);
+      TYPE_ALIGN (x) = TYPE_ALIGN (t);
+    }
+
+  resume_momentary (old_momentary);
+
+  return t;
+}
+
+/* Given a list of fields, FIELDLIST, return a structure 
+   type that contains these fields.  The returned type is 
+   always a new type.  */
+tree
+build_chill_struct_type (fieldlist)
+     tree fieldlist;
+{
+  register tree t;
+
+  if (fieldlist == NULL_TREE || TREE_CODE (fieldlist) == ERROR_MARK)
+    return error_mark_node;
+
+  t = make_chill_struct_type (fieldlist);
+  if (pass != 1)
+    t = layout_chill_struct_type (t);
+
+/*   pushtag (NULL_TREE, t); */
+
+  return t;
+}
+
+/* Fix a LANG_TYPE.  These are used for three different uses:
+   - representing a 'READ M' (in which case TYPE_READONLY is set);
+   - for a  NEWMODE or SYNMODE (CH_NOVELTY is set for a NEWMODE); and
+   - for a parameterised type (TREE_TYPE points to base type,
+     while TYPE_DOMAIN is the parameter or parameter list).
+   Called from satisfy. */
+tree
+smash_dummy_type (type)
+     tree type;
+{
+  /* Save fields that we don't want to copy from ORIGIN. */ 
+  tree origin = TREE_TYPE (type);
+  tree main = TYPE_MAIN_VARIANT (origin);
+  int  save_uid = TYPE_UID (type);
+  struct obstack *save_obstack = TYPE_OBSTACK (type);
+  tree save_name = TYPE_NAME (type);
+  int  save_permanent = TREE_PERMANENT (type);
+  int  save_readonly = TYPE_READONLY (type);
+  tree  save_novelty = CH_NOVELTY (type);
+  tree save_domain = TYPE_DOMAIN (type);
+  struct lang_type *save_lang_specific = TYPE_LANG_SPECIFIC (type);
+
+  if (origin == NULL_TREE)
+    abort ();
+
+  if (save_domain)
+    {
+      if (TREE_CODE (save_domain) == ERROR_MARK)
+	return error_mark_node;
+      if (origin == char_type_node)
+	{ /* Old-fashioned CHAR(N) declaration. */
+	  origin = build_string_type (origin, save_domain);
+	}
+      else
+	{ /* Handle parameterised modes. */
+	  int is_varying = chill_varying_type_p (origin);
+	  tree new_max = save_domain;
+	  tree origin_novelty = CH_NOVELTY (origin);
+	  if (is_varying)
+	    origin = CH_VARYING_ARRAY_TYPE (origin);
+	  if (CH_STRING_TYPE_P (origin))
+	    {
+	      tree oldindex = TYPE_DOMAIN (origin);
+	      new_max = check_range (new_max, new_max, NULL_TREE,
+				     size_binop (PLUS_EXPR,
+						 TYPE_MAX_VALUE (oldindex),
+						 integer_one_node));
+	      origin = build_string_type (TREE_TYPE (origin), new_max);
+	    }
+	  else if (TREE_CODE (origin) == ARRAY_TYPE)
+	    {
+	      tree oldindex = TYPE_DOMAIN (origin);
+	      tree upper = check_range (new_max, new_max, NULL_TREE,
+					TYPE_MAX_VALUE (oldindex));
+	      tree newindex
+		= build_chill_range_type (TREE_TYPE (oldindex),
+					  TYPE_MIN_VALUE (oldindex), upper);
+	      origin = build_simple_array_type (TREE_TYPE (origin), newindex, NULL_TREE);
+	    }
+	  else if (TREE_CODE (origin) == RECORD_TYPE)
+	    {
+	      error ("parameterised structures not implemented");
+	      return error_mark_node;
+	    }
+	  else
+	    {
+	      error ("invalid parameterised type");
+	      return error_mark_node;
+	    }
+	    
+	  SET_CH_NOVELTY (origin, origin_novelty);
+	  if (is_varying)
+	    {
+	      origin = build_varying_struct (origin);
+	      SET_CH_NOVELTY (origin, origin_novelty);
+	    }
+	}
+      save_domain = NULL_TREE;
+    }
+
+  if (TREE_CODE (origin) == ERROR_MARK)
+    return error_mark_node;
+
+  *(struct tree_type*)type = *(struct tree_type*)origin;
+  /* The following is so that the debug code for
+     the copy is different from the original type.
+     The two statements usually duplicate each other
+     (because they clear fields of the same union),
+     but the optimizer should catch that. */
+  TYPE_SYMTAB_POINTER (type) = 0;
+  TYPE_SYMTAB_ADDRESS (type) = 0;
+
+  /* Restore fields that we didn't want copied from ORIGIN. */
+  TYPE_UID (type) = save_uid;
+  TYPE_OBSTACK (type) = save_obstack;
+  TREE_PERMANENT (type) = save_permanent;
+  TYPE_NAME (type) = save_name;
+
+  TREE_CHAIN (type) = NULL_TREE;
+  TYPE_VOLATILE (type) = 0;
+  TYPE_POINTER_TO (type) = 0;
+  TYPE_REFERENCE_TO (type) = 0;
+
+  if (save_readonly)
+    { /* TYPE is READ ORIGIN.
+	 Add this type to the chain of variants of TYPE.  */
+      TYPE_NEXT_VARIANT (type) = TYPE_NEXT_VARIANT (main);
+      TYPE_NEXT_VARIANT (main) = type;
+      TYPE_READONLY (type) = save_readonly;
+    }
+  else
+    {
+      /* TYPE is the copy of the RHS in a NEWMODE or SYNMODE.
+       We also get here after old-fashioned CHAR(N) declaration (see above). */
+      TYPE_MAIN_VARIANT (type) = type;
+      TYPE_NEXT_VARIANT (type) = NULL_TREE;
+      if (save_name)
+	DECL_ORIGINAL_TYPE (save_name) = origin;
+
+      if (save_novelty != NULL_TREE)  /* A NEWMODE declaration. */
+	{
+	  CH_NOVELTY (type) = save_novelty;
+
+	  /* Z.200: "If the DEFINING mode of the NEWMODE name is a range mode,
+	     then the virtual mode &name is introduced as the PARENT mode
+	     of the NEWMODE name. The DEFINING mode of &name is the PARENT
+	     mode of the range mode, and the NOVELTY of &name is that of
+	     the NEWMODE name." */
+
+	  if (TREE_CODE (type) == INTEGER_TYPE && TREE_TYPE (type))
+	    {
+	      tree parent;
+	      /* PARENT is the virtual mode &name mentioned above. */
+	      push_obstacks_nochange ();
+	      end_temporary_allocation ();
+	      parent = copy_novelty (save_novelty,TREE_TYPE (type));
+	      pop_obstacks ();
+	      
+	      TREE_TYPE (type) = parent;
+	      TYPE_MIN_VALUE (type) = convert (parent, TYPE_MIN_VALUE (type));
+	      TYPE_MAX_VALUE (type) = convert (parent, TYPE_MAX_VALUE (type));
+	    }
+	}
+    }
+  return type;
+}
+
+/* This generates a LANG_TYPE node that represents 'READ TYPE'. */
+
+tree
+build_readonly_type (type)
+     tree type;
+{
+  tree node = make_node (LANG_TYPE);
+  TREE_TYPE (node) = type;
+  TYPE_READONLY (node) = 1;
+  if (pass != 1)
+    node = smash_dummy_type (node);
+  return node;
+}
+
+
+/* Return an unsigned type the same as TYPE in other respects.  */
+
+tree
+unsigned_type (type)
+     tree type;
+{
+  tree type1 = TYPE_MAIN_VARIANT (type);
+  if (type1 == signed_char_type_node || type1 == char_type_node)
+    return unsigned_char_type_node;
+  if (type1 == integer_type_node)
+    return unsigned_type_node;
+  if (type1 == short_integer_type_node)
+    return short_unsigned_type_node;
+  if (type1 == long_integer_type_node)
+    return long_unsigned_type_node;
+  if (type1 == long_long_integer_type_node)
+    return long_long_unsigned_type_node;
+
+  return signed_or_unsigned_type (1, type);
+}
+
+/* Return a signed type the same as TYPE in other respects.  */
+
+tree
+signed_type (type)
+     tree type;
+{
+  tree type1 = TYPE_MAIN_VARIANT (type);
+  while (TREE_CODE (type1) == INTEGER_TYPE && TREE_TYPE (type1) != NULL_TREE)
+    type1 = TREE_TYPE (type1);
+  if (type1 == unsigned_char_type_node || type1 == char_type_node)
+    return signed_char_type_node;
+  if (type1 == unsigned_type_node)
+    return integer_type_node;
+  if (type1 == short_unsigned_type_node)
+    return short_integer_type_node;
+  if (type1 == long_unsigned_type_node)
+    return long_integer_type_node;
+  if (type1 == long_long_unsigned_type_node)
+    return long_long_integer_type_node;
+  if (TYPE_PRECISION (type1) == 1)
+    return signed_boolean_type_node;
+
+  return signed_or_unsigned_type (0, type);
+}
+
+/* Return a type the same as TYPE except unsigned or
+   signed according to UNSIGNEDP.  */
+
+tree
+signed_or_unsigned_type (unsignedp, type)
+     int unsignedp;
+     tree type;
+{
+  if (! INTEGRAL_TYPE_P (type)
+      || TREE_UNSIGNED (type) == unsignedp)
+    return type;
+
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (signed_char_type_node))
+    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (integer_type_node)) 
+    return unsignedp ? unsigned_type_node : integer_type_node;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (short_integer_type_node)) 
+    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (long_integer_type_node)) 
+    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (long_long_integer_type_node)) 
+    return (unsignedp ? long_long_unsigned_type_node
+	    : long_long_integer_type_node);
+  return type;
+}
+
+/* Mark EXP saying that we need to be able to take the
+   address of it; it should not be allocated in a register.
+   Value is 1 if successful.  */
+
+int
+mark_addressable (exp)
+     tree exp;
+{
+  register tree x = exp;
+  while (1)
+    switch (TREE_CODE (x))
+      {
+      case ADDR_EXPR:
+      case COMPONENT_REF:
+      case ARRAY_REF:
+      case REALPART_EXPR:
+      case IMAGPART_EXPR:
+	x = TREE_OPERAND (x, 0);
+	break;
+
+      case TRUTH_ANDIF_EXPR:
+      case TRUTH_ORIF_EXPR:
+      case COMPOUND_EXPR:
+	x = TREE_OPERAND (x, 1);
+	break;
+
+      case COND_EXPR:
+	return mark_addressable (TREE_OPERAND (x, 1))
+	  & mark_addressable (TREE_OPERAND (x, 2));
+
+      case CONSTRUCTOR:
+	TREE_ADDRESSABLE (x) = 1;
+	return 1;
+
+      case INDIRECT_REF:
+	/* We sometimes add a cast *(TYPE*)&FOO to handle type and mode
+	   incompatibility problems.  Handle this case by marking FOO.  */
+	if (TREE_CODE (TREE_OPERAND (x, 0)) == NOP_EXPR
+	    && TREE_CODE (TREE_OPERAND (TREE_OPERAND (x, 0), 0)) == ADDR_EXPR)
+	  {
+	    x = TREE_OPERAND (TREE_OPERAND (x, 0), 0);
+	    break;
+	  }
+	if (TREE_CODE (TREE_OPERAND (x, 0)) == ADDR_EXPR)
+	  {
+	    x = TREE_OPERAND (x, 0);
+	    break;
+	  }
+	return 1;
+
+      case VAR_DECL:
+      case CONST_DECL:
+      case PARM_DECL:
+      case RESULT_DECL:
+	if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x)
+	    && DECL_NONLOCAL (x))
+	  {
+	    if (TREE_PUBLIC (x))
+	      {
+		error ("global register variable `%s' used in nested function",
+		       IDENTIFIER_POINTER (DECL_NAME (x)));
+		return 0;
+	      }
+	    pedwarn ("register variable `%s' used in nested function",
+		     IDENTIFIER_POINTER (DECL_NAME (x)));
+	  }
+	else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x))
+	  {
+	    if (TREE_PUBLIC (x))
+	      {
+		error ("address of global register variable `%s' requested",
+		       IDENTIFIER_POINTER (DECL_NAME (x)));
+		return 0;
+	      }
+
+	    /* If we are making this addressable due to its having
+	       volatile components, give a different error message.  Also
+	       handle the case of an unnamed parameter by not trying
+	       to give the name.  */
+
+	    else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x)))
+	      {
+		error ("cannot put object with volatile field into register");
+		return 0;
+	      }
+
+	    pedwarn ("address of register variable `%s' requested",
+		     IDENTIFIER_POINTER (DECL_NAME (x)));
+	  }
+	put_var_into_stack (x);
+
+	/* drops through */
+      case FUNCTION_DECL:
+	TREE_ADDRESSABLE (x) = 1;
+#if 0  /* poplevel deals with this now.  */
+	if (DECL_CONTEXT (x) == 0)
+	  TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (x)) = 1;
+#endif
+	/* drops through */
+      default:
+	return 1;
+    }
+}
+
+/* Return nonzero if VALUE is a valid constant-valued expression
+   for use in initializing a static variable; one that can be an
+   element of a "constant" initializer.
+
+   Return null_pointer_node if the value is absolute;
+   if it is relocatable, return the variable that determines the relocation.
+   We assume that VALUE has been folded as much as possible;
+   therefore, we do not need to check for such things as
+   arithmetic-combinations of integers.  */
+
+tree
+initializer_constant_valid_p (value, endtype)
+     tree value;
+     tree endtype;
+{
+  switch (TREE_CODE (value))
+    {
+    case CONSTRUCTOR:
+      if (TREE_CODE (TREE_TYPE (value)) == UNION_TYPE
+	  && TREE_CONSTANT (value))
+	return
+	  initializer_constant_valid_p (TREE_VALUE (CONSTRUCTOR_ELTS (value)),
+					endtype);
+	
+      return TREE_STATIC (value) ? null_pointer_node : 0;
+
+    case INTEGER_CST:
+    case REAL_CST:
+    case STRING_CST:
+    case COMPLEX_CST:
+      return null_pointer_node;
+
+    case ADDR_EXPR:
+      return TREE_OPERAND (value, 0);
+
+    case NON_LVALUE_EXPR:
+      return initializer_constant_valid_p (TREE_OPERAND (value, 0), endtype);
+
+    case CONVERT_EXPR:
+    case NOP_EXPR:
+      /* Allow conversions between pointer types.  */
+      if (TREE_CODE (TREE_TYPE (value)) == POINTER_TYPE
+	  && TREE_CODE (TREE_TYPE (TREE_OPERAND (value, 0))) == POINTER_TYPE)
+	return initializer_constant_valid_p (TREE_OPERAND (value, 0), endtype);
+
+      /* Allow conversions between real types.  */
+      if (TREE_CODE (TREE_TYPE (value)) == REAL_TYPE
+	  && TREE_CODE (TREE_TYPE (TREE_OPERAND (value, 0))) == REAL_TYPE)
+	return initializer_constant_valid_p (TREE_OPERAND (value, 0), endtype);
+
+      /* Allow length-preserving conversions between integer types.  */
+      if (TREE_CODE (TREE_TYPE (value)) == INTEGER_TYPE
+	  && TREE_CODE (TREE_TYPE (TREE_OPERAND (value, 0))) == INTEGER_TYPE
+	  && (TYPE_PRECISION (TREE_TYPE (value))
+	      == TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (value, 0)))))
+	return initializer_constant_valid_p (TREE_OPERAND (value, 0), endtype);
+
+      /* Allow conversions between other integer types only if
+	 explicit value.  */
+      if (TREE_CODE (TREE_TYPE (value)) == INTEGER_TYPE
+	  && TREE_CODE (TREE_TYPE (TREE_OPERAND (value, 0))) == INTEGER_TYPE)
+	{
+	  tree inner = initializer_constant_valid_p (TREE_OPERAND (value, 0),
+						     endtype);
+	  if (inner == null_pointer_node)
+	    return null_pointer_node;
+	  return 0;
+	}
+
+      /* Allow (int) &foo provided int is as wide as a pointer.  */
+      if (TREE_CODE (TREE_TYPE (value)) == INTEGER_TYPE
+	  && TREE_CODE (TREE_TYPE (TREE_OPERAND (value, 0))) == POINTER_TYPE
+	  && (TYPE_PRECISION (TREE_TYPE (value))
+	      >= TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (value, 0)))))
+	return initializer_constant_valid_p (TREE_OPERAND (value, 0),
+					     endtype);
+
+      /* Likewise conversions from int to pointers.  */
+      if (TREE_CODE (TREE_TYPE (value)) == POINTER_TYPE
+	  && TREE_CODE (TREE_TYPE (TREE_OPERAND (value, 0))) == INTEGER_TYPE
+	  && (TYPE_PRECISION (TREE_TYPE (value))
+	      <= TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (value, 0)))))
+	return initializer_constant_valid_p (TREE_OPERAND (value, 0),
+					     endtype);
+
+      /* Allow conversions to union types if the value inside is okay.  */
+      if (TREE_CODE (TREE_TYPE (value)) == UNION_TYPE)
+	return initializer_constant_valid_p (TREE_OPERAND (value, 0),
+					     endtype);
+      return 0;
+
+    case PLUS_EXPR:
+      if (TREE_CODE (endtype) == INTEGER_TYPE
+	  && TYPE_PRECISION (endtype) < POINTER_SIZE)
+	return 0;
+      {
+	tree valid0 = initializer_constant_valid_p (TREE_OPERAND (value, 0),
+						    endtype);
+	tree valid1 = initializer_constant_valid_p (TREE_OPERAND (value, 1),
+						    endtype);
+	/* If either term is absolute, use the other terms relocation.  */
+	if (valid0 == null_pointer_node)
+	  return valid1;
+	if (valid1 == null_pointer_node)
+	  return valid0;
+	return 0;
+      }
+
+    case MINUS_EXPR:
+      if (TREE_CODE (endtype) == INTEGER_TYPE
+	  && TYPE_PRECISION (endtype) < POINTER_SIZE)
+	return 0;
+      {
+	tree valid0 = initializer_constant_valid_p (TREE_OPERAND (value, 0),
+						    endtype);
+	tree valid1 = initializer_constant_valid_p (TREE_OPERAND (value, 1),
+						    endtype);
+	/* Win if second argument is absolute.  */
+	if (valid1 == null_pointer_node)
+	  return valid0;
+	/* Win if both arguments have the same relocation.
+	   Then the value is absolute.  */
+	if (valid0 == valid1)
+	  return null_pointer_node;
+	return 0;
+      }
+    }
+
+  return 0;
+}
+
+/* Return an integer type with BITS bits of precision,
+   that is unsigned if UNSIGNEDP is nonzero, otherwise signed.  */
+
+tree
+type_for_size (bits, unsignedp)
+     unsigned bits;
+     int unsignedp;
+{
+  if (bits == TYPE_PRECISION (integer_type_node))
+    return unsignedp ? unsigned_type_node : integer_type_node;
+
+  if (bits == TYPE_PRECISION (signed_char_type_node))
+    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+
+  if (bits == TYPE_PRECISION (short_integer_type_node))
+    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+
+  if (bits == TYPE_PRECISION (long_integer_type_node))
+    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+
+  if (bits == TYPE_PRECISION (long_long_integer_type_node))
+    return (unsignedp ? long_long_unsigned_type_node
+	    : long_long_integer_type_node);
+
+  if (bits <= TYPE_PRECISION (intQI_type_node))
+    return unsignedp ? unsigned_intQI_type_node : intQI_type_node;
+
+  if (bits <= TYPE_PRECISION (intHI_type_node))
+    return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
+
+  if (bits <= TYPE_PRECISION (intSI_type_node))
+    return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
+
+  if (bits <= TYPE_PRECISION (intDI_type_node))
+    return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
+
+  if (bits <= TYPE_PRECISION (intTI_type_node))
+    return unsignedp ? unsigned_intTI_type_node : intTI_type_node;
+
+  return 0;
+}
+
+/* Return a data type that has machine mode MODE.
+   If the mode is an integer,
+   then UNSIGNEDP selects between signed and unsigned types.  */
+
+tree
+type_for_mode (mode, unsignedp)
+     enum machine_mode mode;
+     int unsignedp;
+{
+  if (mode == TYPE_MODE (integer_type_node))
+    return unsignedp ? unsigned_type_node : integer_type_node;
+
+  if (mode == TYPE_MODE (signed_char_type_node))
+    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+
+  if (mode == TYPE_MODE (short_integer_type_node))
+    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+
+  if (mode == TYPE_MODE (long_integer_type_node))
+    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+
+  if (mode == TYPE_MODE (long_long_integer_type_node))
+    return unsignedp ? long_long_unsigned_type_node : long_long_integer_type_node;
+
+  if (mode == TYPE_MODE (intQI_type_node))
+    return unsignedp ? unsigned_intQI_type_node : intQI_type_node;
+
+  if (mode == TYPE_MODE (intHI_type_node))
+    return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
+
+  if (mode == TYPE_MODE (intSI_type_node))
+    return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
+
+  if (mode == TYPE_MODE (intDI_type_node))
+    return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
+
+  if (mode == TYPE_MODE (intTI_type_node))
+    return unsignedp ? unsigned_intTI_type_node : intTI_type_node;
+
+  if (mode == TYPE_MODE (float_type_node))
+    return float_type_node;
+
+  if (mode == TYPE_MODE (double_type_node))
+    return double_type_node;
+
+  if (mode == TYPE_MODE (long_double_type_node))
+    return long_double_type_node;
+
+  if (mode == TYPE_MODE (build_pointer_type (char_type_node)))
+    return build_pointer_type (char_type_node);
+
+  if (mode == TYPE_MODE (build_pointer_type (integer_type_node)))
+    return build_pointer_type (integer_type_node);
+
+  return 0;
+}