�

Migrate from devo/gcc/ch.

From-SVN: r22034

25 files changed, 13517 insertions, 0 deletions

diff --git a/gcc/ch/actions.h b/gcc/ch/actions.h
new file mode 100644
index 0000000..d1eceb3
--- /dev/null
+++ b/gcc/ch/actions.h
@@ -0,0 +1,33 @@
+/* Declarations for ch-actions.c.
+   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.  */
+
+/* used by compile_file */
+
+void init_chill PROTO((void));
+
+extern int grant_count;
+
+extern void push_handler PROTO((void));
+extern void pop_handler PROTO((int));
+extern void push_action PROTO((void));
+
+extern int  chill_handle_single_dimension_case_label PROTO((tree, tree, int *, int *));
+extern tree build_chill_multi_dimension_case_expr    PROTO((tree, tree, tree));
+extern tree build_multi_case_selector_expression     PROTO((tree, tree));
+extern void compute_else_ranges                      PROTO((tree, tree));
diff --git a/gcc/ch/except.c b/gcc/ch/except.c
new file mode 100644
index 0000000..d3b3c70
--- /dev/null
+++ b/gcc/ch/except.c
@@ -0,0 +1,703 @@
+/* Exception support for GNU CHILL.
+   WARNING:  Only works for native (needs setjmp.h)!  FIXME!
+   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 "rtl.h"
+
+/* On Suns this can get you to the right definition if you
+   set the right value for TARGET.  */
+#include <setjmp.h>
+#ifdef sequent
+/* Can you believe they forgot this?  */
+#ifndef _JBLEN
+#define _JBLEN 11
+#endif
+#endif
+
+#ifndef _JBLEN
+#define _JBLEN (sizeof(jmp_buf)/sizeof(int))
+#define _JBLEN_2 _JBLEN+20
+#else
+/* if we use i.e. posix threads, this buffer must be longer */
+#define _JBLEN_2 _JBLEN+20
+#endif
+
+/* On Linux setjmp is __setjmp FIXME: what is for CROSS */
+#ifndef SETJMP_LIBRARY_NAME
+#ifdef __linux__
+#define SETJMP_LIBRARY_NAME "__setjmp"
+#else
+#define SETJMP_LIBRARY_NAME "setjmp"
+#endif
+#endif
+
+extern int  expand_exit_needed;
+extern tree build_chill_exception_decl PROTO((char *));
+extern void chill_handle_case_default  PROTO((void));
+extern void emit_jump                  PROTO((rtx));
+extern void expand_decl                PROTO((tree));
+extern void fatal                      PROTO((char *, ...));
+extern void make_decl_rtl              PROTO((tree, char *, int));
+extern void rest_of_decl_compilation   PROTO((tree, char *, int, int));
+
+static tree link_handler_decl;
+static tree handler_link_pointer_type;
+static tree unlink_handler_decl;
+static int exceptions_initialized = 0;
+static void emit_setup_handler PROTO((void));
+static void initialize_exceptions PROTO((void));
+static tree char_pointer_type_for_handler;
+
+/* If this is 1, operations to push and pop on the __exceptionStack
+   are inline.  The default is is to use a function call, to
+   allow for a per-thread exception stack. */
+static int inline_exception_stack_ops = 0;
+
+struct handler_state
+{
+  struct handler_state *next;
+
+  /* Starts at 0, then incremented for every <on-alternative>. */
+  int prev_on_alternative;
+
+  /* If > 0: handler number for ELSE handler. */
+  int else_handler;
+
+  int action_number;
+
+  char do_pushlevel;
+
+  tree on_alt_list;
+  tree setjmp_expr;
+
+  /* A decl for the static handler array (used to map exception name to int).*/
+  tree handler_array_decl;
+
+  rtx end_label;
+
+  /* Used to pass a tree from emit_setup_handler to chill_start_on. */
+  tree handler_ref;
+
+  tree unlink_cleanup;
+
+  tree function;
+
+  /* flag to indicate that we are currently compiling this handler.
+     is_handled will need this to determine an unhandled exception */
+  int compiling;
+};
+
+/* This is incremented by one each time we start an action which
+   might have an ON-handler.  It is reset between passes. */
+static int action_number = 0;
+
+int action_nesting_level = 0;
+
+/* The global_handler_list is constructed in pass 1.  It is not sorted.
+   It contains one element for each action that actually had an ON-handler.
+   An element's ACTION_NUMBER matches the action_number
+   of that action.  The global_handler_list is eaten up during pass 2. */
+#define ACTION_NUMBER(HANDLER) ((HANDLER)->action_number)
+struct handler_state *global_handler_list = NULL;
+
+/* This is a stack of handlers, one for each nested ON-handler. */
+static struct handler_state *current_handler = NULL;
+
+static struct handler_state *free_handlers = NULL; /* freelist */
+
+static tree handler_element_type;
+static tree handler_link_type;
+static tree BISJ;
+static tree jbuf_ident, prev_ident, handlers_ident;
+static tree exception_stack_decl = 0;
+
+/* Chain of cleanups assocated with exception handlers.
+   The TREE_PURPOSE is an INTEGER_CST whose value is the
+   DECL_ACTION_NESTING_LEVEL (when the handled actions was entered).
+   The TREE_VALUE is an expression to expand when we exit that action. */
+
+static tree cleanup_chain = NULL_TREE;
+
+#if 0
+/* Merge the current sequence onto the tail of the previous one. */
+
+void
+pop_sequence ()
+{
+  rtx sequence_first = get_insns ();
+
+  end_sequence ();
+  emit_insns (sequence_first);
+  
+}
+#endif
+
+/* Things we need to do at the beginning of pass 2. */
+
+void
+except_init_pass_2 ()
+{
+  /* First sort the global_handler_list on ACTION_NUMBER.
+     This will already be in close to reverse order (the exception being
+     nested ON-handlers), so insertion sort should essentially linear. */
+
+  register struct handler_state *old_list = global_handler_list;
+
+  /* First add a dummy final element. */
+  if (free_handlers)
+    global_handler_list = free_handlers;
+  else
+    global_handler_list
+      = (struct handler_state*) permalloc (sizeof (struct handler_state));
+  /* Make the final dummy "larger" than any other element. */
+  ACTION_NUMBER (global_handler_list) = action_number + 1;
+  /* Now move all the elements in old_list over to global_handler_list. */
+  while (old_list != NULL)
+    {
+      register struct handler_state **ptr = &global_handler_list;
+      /* Unlink from old_list. */
+      register struct handler_state *current = old_list;
+      old_list = old_list->next;
+
+      while (ACTION_NUMBER (current) > ACTION_NUMBER (*ptr))
+	ptr = &(*ptr)->next;
+      /* Link into proper place in global_handler_list (new list). */
+      current->next = *ptr;
+      *ptr = current;
+    }
+     
+  /* Don't forget to reset action_number. */
+  action_number = 0;
+}
+
+/* This function is called at the beginning of an action that might be
+   followed by an ON-handler.  Chill syntax doesn't let us know if
+   we actually have an ON-handler until we see the ON, so we save
+   away during pass 1 that information for use during pass 2. */
+
+void
+push_handler ()
+{
+  register struct handler_state *hstate;
+
+  action_number++;
+  action_nesting_level++;
+
+  if (pass == 1)
+    {
+      if (free_handlers)
+	{
+	  hstate = free_handlers;
+	  free_handlers = hstate->next;
+	}
+      else
+	{
+	  hstate =
+	    (struct handler_state*) permalloc (sizeof (struct handler_state));
+	}
+
+      hstate->next = current_handler;
+      current_handler = hstate;
+      hstate->prev_on_alternative = 0;
+      hstate->else_handler = 0;
+      hstate->on_alt_list = NULL_TREE;
+      hstate->compiling = 0;
+
+      ACTION_NUMBER (hstate) = action_number;
+      return;
+    }
+
+  if (ACTION_NUMBER (global_handler_list) != action_number)
+    return;
+
+  /* OK.  This action actually has an ON-handler.
+     Pop it from global_handler_list, and use it. */
+
+  hstate = global_handler_list;
+  global_handler_list = hstate->next;
+
+  /* Since this is pass 2, let's generate prologue code for that. */
+
+  hstate->next = current_handler;
+  current_handler = hstate;
+
+  hstate->prev_on_alternative = 0;
+  hstate->function = current_function_decl;
+
+  emit_setup_handler ();
+}
+
+static tree
+start_handler_array ()
+{
+  tree handler_array_type, decl;
+
+  push_obstacks_nochange ();
+  end_temporary_allocation ();
+  handler_array_type = build_array_type (handler_element_type, NULL_TREE);
+  decl = build_lang_decl (VAR_DECL,
+			  get_unique_identifier ("handler_table"),
+			  handler_array_type);
+
+/*  TREE_TYPE (decl) = handler_array_type;*/
+  TREE_READONLY (decl) = 1;
+  TREE_STATIC (decl) = 1;
+  DECL_INITIAL (decl) = error_mark_node;
+  
+  pushdecl (decl);
+  make_decl_rtl (decl, NULL_PTR, 0);
+  current_handler->handler_array_decl = decl;
+  return decl;
+}
+
+static void
+finish_handler_array ()
+{
+  tree decl = current_handler->handler_array_decl;
+  tree t;
+  tree handler_array_init = NULL_TREE;
+  int handlers_count = 1;
+  int nelts;
+
+  /* Build the table mapping exceptions to handler(-number)s.
+     This is done in reverse order. */
+  
+  /* First push the end of the list.  This is either the ELSE
+     handler (current_handler->else_handler>0) or NULL handler to indicate
+     the end of the list (if current_handler->else-handler == 0).
+     The following works either way. */
+  handler_array_init = build_tree_list
+    (NULL_TREE, chill_expand_tuple
+     (handler_element_type,
+      build_nt (CONSTRUCTOR, NULL_TREE,
+		tree_cons (NULL_TREE,
+			   null_pointer_node,
+			   build_tree_list (NULL_TREE,
+					    build_int_2 (current_handler->else_handler,
+							     0))))));
+  
+  for (t = current_handler->on_alt_list; t != NULL_TREE; t = TREE_CHAIN (t))
+    { tree handler_number = TREE_PURPOSE(t);
+      tree elist = TREE_VALUE (t);
+      for ( ; elist != NULL_TREE; elist = TREE_CHAIN (elist))
+	{
+	  tree ex_decl =
+	    build_chill_exception_decl (IDENTIFIER_POINTER(TREE_VALUE(elist)));
+	  tree ex_addr = build1 (ADDR_EXPR,
+				 char_pointer_type_for_handler,
+				 ex_decl);
+	  tree el = build_nt (CONSTRUCTOR, NULL_TREE,
+			      tree_cons (NULL_TREE,
+					 ex_addr,
+					 build_tree_list (NULL_TREE,
+							  handler_number)));
+	  mark_addressable (ex_decl);
+	  TREE_CONSTANT (ex_addr) = 1;
+	  handler_array_init =
+	    tree_cons (NULL_TREE,
+		       chill_expand_tuple (handler_element_type, el),
+		       handler_array_init);
+	  handlers_count++;
+	}
+    }
+
+#if 1
+  nelts = list_length (handler_array_init);
+  TYPE_DOMAIN (TREE_TYPE (decl))
+    = build_index_type (build_int_2 (nelts - 1, - (nelts == 0)));
+  layout_type (TREE_TYPE (decl));
+  DECL_INITIAL (decl)
+    = convert (TREE_TYPE (decl),
+	       build_nt (CONSTRUCTOR, NULL_TREE, handler_array_init));
+
+  /* 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 ();
+  layout_decl (decl, 0);
+  /* To prevent make_decl_rtl (called indiectly by rest_of_decl_compilation)
+     throwing the existing RTL (which has already been used). */
+  PUT_MODE (DECL_RTL (decl), DECL_MODE (decl));
+  rest_of_decl_compilation (decl, (char*)0, 0, 0);
+  expand_decl_init (decl);
+#else
+  /* To prevent make_decl_rtl (called indirectly by finish_decl)
+     altering the existing RTL. */
+  GET_MODE (DECL_RTL (current_handler->handler_array_decl)) =
+    DECL_MODE (current_handler->handler_array_decl);
+
+  finish_decl (current_handler->handler_array_decl,
+	       build_nt (CONSTRUCTOR, NULL_TREE, handler_array_init),
+	       NULL_TREE);
+#endif
+}
+
+
+void
+pop_handler (used)
+     int used;
+{
+  action_nesting_level--;
+  if (pass == 1)
+    {
+      struct handler_state *old = current_handler;
+      if (old == NULL)
+	fatal ("internal error: on stack out of sync");
+      current_handler = old->next;
+
+      if (used)
+	{ /* Push unto global_handler_list. */
+	  old->next = global_handler_list;
+	  global_handler_list = old;
+	}
+      else
+	{
+	  /* Push onto free_handlers free list. */
+	  old->next = free_handlers;
+	  free_handlers = old;
+	}
+    }
+  else if (used)
+    {
+      current_handler = current_handler->next;
+    }
+}
+
+/* Emit code before an action that has an ON-handler. */
+
+static void
+emit_setup_handler ()
+{
+  tree handler_decl, handler_addr, t;
+
+  /* Field references. */
+  tree jbuf_ref, handlers_ref,prev_ref;
+  if (!exceptions_initialized)
+    {
+      /* We temporarily reset the maximum_field_alignment to zero so the
+	 compiler's exception 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;
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+      initialize_exceptions ();
+      pop_obstacks ();
+      maximum_field_alignment = save_maximum_field_alignment;
+    }
+
+  push_momentary ();
+
+  handler_decl = build_lang_decl (VAR_DECL,
+				  get_unique_identifier ("handler"),
+				  handler_link_type);
+  push_obstacks_nochange ();
+  pushdecl(handler_decl);
+  expand_decl (handler_decl);
+  finish_decl (handler_decl);
+
+  jbuf_ref = build_component_ref (handler_decl, jbuf_ident);
+  jbuf_ref = build_chill_arrow_expr (jbuf_ref, 1);
+  handlers_ref = build_component_ref (handler_decl, handlers_ident);
+  prev_ref = build_component_ref (handler_decl, prev_ident);
+
+  /* Emit code to link in handler in __exceptionStack chain. */
+  mark_addressable (handler_decl);
+  handler_addr = build1 (ADDR_EXPR, handler_link_pointer_type, handler_decl);
+  if (inline_exception_stack_ops)
+    {
+      expand_expr_stmt (build_chill_modify_expr (prev_ref,
+						 exception_stack_decl));
+      expand_expr_stmt (build_chill_modify_expr (exception_stack_decl,
+						 handler_addr));
+      current_handler->handler_ref = prev_ref;
+    }
+  else
+    {
+      expand_expr_stmt (build_chill_function_call (link_handler_decl,
+					     build_tree_list (NULL_TREE,
+							      handler_addr)));
+      current_handler->handler_ref = handler_addr;
+    }
+
+  /* Expand:  handler->__handlers = { <<array mapping names to ints } */
+  t =  build1 (NOP_EXPR, build_pointer_type (handler_element_type),
+	       build_chill_arrow_expr (start_handler_array (), 1));
+  expand_expr_stmt (build_chill_modify_expr (handlers_ref, t));
+
+  /* Emit code to unlink handler. */
+  if (inline_exception_stack_ops)
+    current_handler->unlink_cleanup
+      = build_chill_modify_expr (exception_stack_decl,
+				 current_handler->handler_ref);
+  else
+    current_handler->unlink_cleanup
+      = build_chill_function_call (unlink_handler_decl,
+				   build_tree_list(NULL_TREE,
+					       current_handler->handler_ref));
+  cleanup_chain = tree_cons (build_int_2 (action_nesting_level, 0),
+			     current_handler->unlink_cleanup,
+			     cleanup_chain);
+
+  /* Emit code for setjmp. */
+  
+  current_handler->setjmp_expr =
+    build_chill_function_call (BISJ, build_tree_list (NULL_TREE, jbuf_ref));
+  expand_start_case (1, current_handler->setjmp_expr,
+		     integer_type_node, "on handler");
+
+  chill_handle_case_label (integer_zero_node, current_handler->setjmp_expr);
+}
+
+/* Start emitting code for: <actions> ON <handlers> END.
+   Assume we've parsed <actions>, and the setup needed for it. */
+
+void
+chill_start_on ()
+{
+  expand_expr_stmt (current_handler->unlink_cleanup);
+
+  /* Emit code to jump past the handlers. */
+  current_handler->end_label = gen_label_rtx ();
+  current_handler->compiling = 1;
+  emit_jump (current_handler->end_label);
+}
+
+void
+chill_finish_on ()
+{
+  expand_end_case (current_handler->setjmp_expr);
+  
+  finish_handler_array ();
+
+  emit_label (current_handler->end_label);
+
+  pop_momentary ();
+
+  cleanup_chain = TREE_CHAIN (cleanup_chain);
+}
+
+void
+chill_handle_on_labels (labels)
+     tree labels;
+{
+  int alternative = ++current_handler->prev_on_alternative;
+  if (pass == 1)
+    {
+      tree handler_number = build_int_2 (alternative, 0);
+      current_handler->on_alt_list =
+	tree_cons (handler_number, labels, current_handler->on_alt_list);
+    }
+  else
+    {
+      /* Find handler_number saved in pass 1. */
+      tree tmp = current_handler->on_alt_list;
+      while (TREE_INT_CST_LOW (TREE_PURPOSE (tmp)) != alternative)
+	tmp = TREE_CHAIN (tmp);
+      if (expand_exit_needed)
+	expand_exit_something (), expand_exit_needed = 0;
+      chill_handle_case_label (TREE_PURPOSE (tmp),
+			       current_handler->setjmp_expr);
+    }
+}
+
+void
+chill_start_default_handler ()
+{
+  current_handler->else_handler = ++current_handler->prev_on_alternative;
+  if (!ignoring)
+    {
+      chill_handle_case_default ();
+    }
+}
+
+void
+chill_check_no_handlers ()
+{
+  if (current_handler != NULL)
+    fatal ("internal error: on stack not empty when done");
+}
+
+static void
+initialize_exceptions ()
+{
+  tree jmp_buf_type = build_array_type (integer_type_node,
+					build_index_type (build_int_2 (_JBLEN_2-1, 0)));
+  tree setjmp_fndecl, link_ftype;
+  tree parmtypes
+    = tree_cons (NULL_TREE, build_pointer_type (jmp_buf_type), void_list_node);
+
+  setjmp_fndecl = builtin_function ("setjmp",
+				    build_function_type (integer_type_node,
+							 parmtypes),
+				    NOT_BUILT_IN,
+				    SETJMP_LIBRARY_NAME);
+  BISJ = build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (setjmp_fndecl)),
+		 setjmp_fndecl);
+ 
+  char_pointer_type_for_handler
+    = build_pointer_type (build_type_variant (char_type_node, 1, 0));
+  handler_element_type =
+    build_chill_struct_type (chainon
+			     (build_decl (FIELD_DECL,
+					  get_identifier("__exceptid"),
+					  char_pointer_type_for_handler),
+			      build_decl (FIELD_DECL,
+					  get_identifier("__handlerno"),
+					  integer_type_node)));
+
+  jbuf_ident = get_identifier("__jbuf");
+  prev_ident = get_identifier("__prev");
+  handlers_ident = get_identifier("__handlers");
+
+  handler_link_type =
+    build_chill_struct_type
+      (chainon
+       (build_decl (FIELD_DECL, prev_ident, ptr_type_node),
+	chainon
+	(build_decl (FIELD_DECL, handlers_ident,
+		     build_pointer_type (handler_element_type)),
+	 build_decl (FIELD_DECL, jbuf_ident, jmp_buf_type))));
+
+  handler_link_pointer_type = build_pointer_type (handler_link_type);
+
+  if (inline_exception_stack_ops)
+    {
+      exception_stack_decl =
+	build_lang_decl (VAR_DECL,
+			 get_identifier("__exceptionStack"),
+			 handler_link_pointer_type);
+      TREE_STATIC (exception_stack_decl) = 1;
+      TREE_PUBLIC (exception_stack_decl) = 1;
+      DECL_EXTERNAL (exception_stack_decl) = 1;
+      push_obstacks_nochange ();
+      pushdecl(exception_stack_decl);
+      make_decl_rtl (exception_stack_decl, NULL_PTR, 1);
+      finish_decl (exception_stack_decl);
+    }
+
+  link_ftype = build_function_type (void_type_node,
+				    tree_cons (NULL_TREE,
+					       handler_link_pointer_type,
+					       void_list_node));
+  link_handler_decl = builtin_function ("__ch_link_handler", link_ftype,
+					NOT_BUILT_IN, NULL_PTR);
+  unlink_handler_decl = builtin_function ("__ch_unlink_handler", link_ftype,
+					  NOT_BUILT_IN, NULL_PTR);
+
+  exceptions_initialized = 1;
+}
+
+/* Do the cleanup(s) needed for a GOTO label.
+   We only need to do the last of the cleanups. */
+
+void
+expand_goto_except_cleanup (label_level)
+     int label_level;
+{
+  tree list = cleanup_chain;
+  tree last = NULL_TREE;
+  for ( ; list != NULL_TREE; list = TREE_CHAIN (list))
+    {
+      if (TREE_INT_CST_LOW (TREE_PURPOSE (list)) > label_level)
+	last = list;
+      else
+	break;
+    }
+  if (last)
+    expand_expr_stmt (TREE_VALUE (last));
+}
+
+/* Returns true if there is a valid handler for EXCEPT_NAME
+   in the current static scope.
+   0 ... no handler found
+   1 ... local handler available
+   2 ... function may propagate this exception
+*/
+
+int
+is_handled (except_name)
+     tree except_name;
+{
+  tree t;
+  struct handler_state *h = current_handler;
+
+  /* if we are are currently compiling this handler
+     we have to start at the next level */
+  if (h && h->compiling)
+    h = h->next;
+  while (h != NULL)
+    {
+      if (h->function != current_function_decl)
+	break;
+      if (h->else_handler > 0)
+	return 1;
+      for (t = h->on_alt_list; t != NULL_TREE; t = TREE_CHAIN (t))
+	{
+	  if (value_member (except_name, TREE_VALUE (t)))
+	    return 1;
+	}
+      h = h->next;
+    }
+
+  t = TYPE_RAISES_EXCEPTIONS (TREE_TYPE (current_function_decl));
+
+  if (value_member (except_name, t))
+    return 2;
+  return 0;
+}
+
+/* function generates code to reraise exceptions
+   for PROC's propagating exceptions. */
+
+void
+chill_reraise_exceptions (exceptions)
+     tree exceptions;
+{
+  tree wrk;
+
+  if (exceptions == NULL_TREE)
+    return; /* just in case */
+
+  if (pass == 1)
+    {
+      for (wrk = exceptions; wrk != NULL_TREE; wrk = TREE_CHAIN (wrk))
+	chill_handle_on_labels (build_tree_list (NULL_TREE, TREE_VALUE (wrk)));
+    }
+  else /* pass == 2 */
+    {
+      chill_start_on ();
+      expand_exit_needed = 0;
+
+      for (wrk = exceptions; wrk != NULL_TREE; wrk = TREE_CHAIN (wrk))
+	{
+	  chill_handle_on_labels (TREE_VALUE (wrk));
+	  /* do a CAUSE exception */
+	  expand_expr_stmt (build_cause_exception (TREE_VALUE (wrk), 0));
+	  expand_exit_needed = 1;
+	}
+      chill_finish_on ();
+    }
+  pop_handler (1);
+}
diff --git a/gcc/ch/grant.c b/gcc/ch/grant.c
new file mode 100644
index 0000000..5dcf450
--- /dev/null
+++ b/gcc/ch/grant.c
@@ -0,0 +1,3053 @@
+/* Implement grant-file output & seize-file input for CHILL.
+   Copyright (C) 1992, 93, 94, 95, 1996 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 <string.h>
+#include <limits.h>
+#include "config.h"
+#include "tree.h"
+#include "ch-tree.h"
+#include "lex.h"
+#include "flags.h"
+#include "actions.h"
+#include "input.h"
+#include "errno.h"
+#include "rtl.h"
+#include "tasking.h"
+
+/* Disable possible macro over-rides, so the externs parse
+   portably. */
+#undef strchr
+#undef strrchr
+
+#define APPEND(X,Y) X = append (X, Y)
+#define PREPEND(X,Y) X = prepend (X, Y);
+#define FREE(x) strfree (x)
+#define ALLOCAMOUNT	10000
+/* may be we can handle this in a more exciting way,
+   but this also should work for the moment */
+#define MAYBE_NEWLINE(X)                       \
+do                                             \
+{                                              \
+  if (X->len && X->str[X->len - 1] != '\n')    \
+    APPEND (X, ";\n");                         \
+} while (0)
+
+extern void assemble_constructor PROTO((char *));
+extern void assemble_name PROTO((FILE *, char *));
+extern void error PROTO((char *, ...));
+extern tree tasking_list;
+extern void tasking_registry PROTO((void));
+extern void tasking_setup PROTO((void));
+extern void build_enum_tables PROTO((void));
+extern tree process_type;
+extern void warning PROTO((char *, ...));
+extern tree get_file_function_name PROTO((int));
+extern char *asm_file_name;
+extern char *dump_base_name;
+
+/* forward declarations */
+
+/* variable indicates compilation at module level */
+int chill_at_module_level = 0;
+
+
+/* mark that a SPEC MODULE was generated */
+static int spec_module_generated = 0;
+
+/* define version strings */
+extern char *gnuchill_version;
+extern char *version_string;
+
+/* define a faster string handling */
+typedef struct
+{
+  char	*str;
+  int		len;
+  int		allocated;
+} MYSTRING;
+
+/* structure used for handling multiple grant files */
+char	*grant_file_name;
+MYSTRING	*gstring = NULL;
+MYSTRING        *selective_gstring = NULL;
+
+static MYSTRING *decode_decl                PROTO((tree));
+static MYSTRING *decode_constant            PROTO((tree));
+static void      grant_one_decl             PROTO((tree));
+static MYSTRING *get_type                   PROTO((tree));
+static MYSTRING *decode_mode                PROTO((tree));
+static MYSTRING *decode_prefix_rename       PROTO((tree));
+static MYSTRING *decode_constant_selective  PROTO((tree, tree));
+static MYSTRING *decode_mode_selective      PROTO((tree, tree));
+static MYSTRING *get_type_selective         PROTO((tree, tree));
+static MYSTRING *decode_decl_selective      PROTO((tree, tree));
+
+/* list of the VAR_DECLs of the module initializer entries */
+tree      module_init_list = NULL_TREE;
+
+/* handle different USE_SEIZE_FILE's in case of selective granting */
+typedef struct SEIZEFILELIST
+{
+  struct SEIZEFILELIST *next;
+  tree filename;
+  MYSTRING *seizes;
+} seizefile_list;
+
+static seizefile_list *selective_seizes = 0;
+
+
+static MYSTRING *
+newstring (str)
+    char	*str;
+{
+    MYSTRING	*tmp = (MYSTRING *) xmalloc (sizeof (MYSTRING));
+    unsigned	len = strlen (str);
+    
+    tmp->allocated = len + ALLOCAMOUNT;
+    tmp->str = xmalloc ((unsigned)tmp->allocated);
+    strcpy (tmp->str, str);
+    tmp->len = len;
+    return (tmp);
+}
+
+static void
+strfree (str)
+    MYSTRING	*str;
+{
+    free (str->str);
+    free (str);
+}
+
+static MYSTRING *
+append (inout, in)
+    MYSTRING	*inout;
+    char	*in;
+{
+    int	inlen = strlen (in);
+    int amount = ALLOCAMOUNT;
+
+    if (inlen >= amount)
+      amount += inlen;
+    if ((inout->len + inlen) >= inout->allocated)
+	inout->str = xrealloc (inout->str, inout->allocated += amount);
+    strcpy (inout->str + inout->len, in);
+    inout->len += inlen;
+    return (inout);
+}
+
+static MYSTRING *
+prepend (inout, in)
+    MYSTRING	*inout;
+    char	*in;
+{
+  MYSTRING *res = inout;
+  if (strlen (in))
+    {
+      res = newstring (in);
+      res = APPEND (res, inout->str);
+      FREE (inout);
+    }
+  return res;
+}
+
+void
+grant_use_seizefile (seize_filename)
+     char *seize_filename;
+{
+  APPEND (gstring, "<> USE_SEIZE_FILE \"");
+  APPEND (gstring, seize_filename);
+  APPEND (gstring, "\" <>\n");
+}
+
+static MYSTRING *
+decode_layout (layout)
+    tree layout;
+{
+  tree temp;
+  tree stepsize = NULL_TREE;
+  int  was_step = 0;
+  MYSTRING *result = newstring ("");
+  MYSTRING *work;
+
+  if (layout == integer_zero_node) /* NOPACK */
+    {
+      APPEND (result, " NOPACK");
+      return result;
+    }
+
+  if (layout == integer_one_node) /* PACK */
+    {
+      APPEND (result, " PACK");
+      return result;
+    }
+
+  APPEND (result, " ");
+  temp = layout;
+  if (TREE_PURPOSE (temp) == NULL_TREE)
+    {
+      APPEND (result, "STEP(");
+      was_step = 1;
+      temp = TREE_VALUE (temp);
+      stepsize = TREE_VALUE (temp);
+    }
+  APPEND (result, "POS(");
+
+  /* Get the starting word */
+  temp = TREE_PURPOSE (temp);
+  work = decode_constant (TREE_PURPOSE (temp));
+  APPEND (result, work->str);
+  FREE (work);
+
+  temp = TREE_VALUE (temp);
+  if (temp != NULL_TREE)
+    {
+      /* Get the starting bit */
+      APPEND (result, ", ");
+      work = decode_constant (TREE_PURPOSE (temp));
+      APPEND (result, work->str);
+      FREE (work);
+
+      temp = TREE_VALUE (temp);
+      if (temp != NULL_TREE)
+	{
+	  /* Get the length or the ending bit */
+	  tree what = TREE_PURPOSE (temp);
+	  if (what == integer_zero_node) /* length */
+	    {
+	      APPEND (result, ", ");
+	    }
+	  else
+	    {
+	      APPEND (result, ":");
+	    }
+	  work = decode_constant (TREE_VALUE (temp));
+	  APPEND (result, work->str);
+	  FREE (work);
+	}
+    }
+  APPEND (result, ")");
+
+  if (was_step)
+    {
+      if (stepsize != NULL_TREE)
+	{
+	  APPEND (result, ", ");
+	  work = decode_constant (stepsize);
+	  APPEND (result, work->str);
+	  FREE (work);
+	}
+      APPEND (result, ")");
+    }
+
+  return result;
+}
+
+static MYSTRING *
+grant_array_type (type)
+     tree type;
+{
+  MYSTRING	*result = newstring ("");
+  MYSTRING	*mode_string;
+  tree           layout;
+  int            varying = 0;
+
+  if (chill_varying_type_p (type))
+    {
+      varying = 1;
+      type = CH_VARYING_ARRAY_TYPE (type);
+    }
+  if (CH_STRING_TYPE_P (type))
+    {
+      tree fields = TYPE_DOMAIN (type);
+      tree maxval = TYPE_MAX_VALUE (fields);
+
+      if (TREE_CODE (TREE_TYPE (type)) == CHAR_TYPE)
+	APPEND (result, "CHARS (");
+      else
+	APPEND (result, "BOOLS (");
+      if (TREE_CODE (maxval) == INTEGER_CST)
+	{
+	  char	wrk[20];
+	  sprintf (wrk, "%d", TREE_INT_CST_LOW (maxval) + 1);
+	  APPEND (result, wrk);
+	}
+      else if (TREE_CODE (maxval) == MINUS_EXPR
+	       && TREE_OPERAND (maxval, 1) == integer_one_node)
+	{
+	  mode_string = decode_constant (TREE_OPERAND (maxval, 0));
+	  APPEND (result, mode_string->str);
+	  FREE (mode_string);
+	}
+      else
+	{
+	  mode_string = decode_constant (maxval);
+	  APPEND (result, mode_string->str);
+	  FREE (mode_string);
+	  APPEND (result, "+1");
+	}
+      APPEND (result, ")");
+      if (varying)
+	APPEND (result, " VARYING");
+      return result;
+    }
+
+  APPEND (result, "ARRAY (");
+  if (TREE_CODE (TYPE_DOMAIN (type)) == INTEGER_TYPE
+     && TREE_TYPE (TYPE_DOMAIN (type)) == ridpointers[(int) RID_RANGE])
+    {
+      mode_string = decode_constant (TYPE_MIN_VALUE (TYPE_DOMAIN (type)));
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      
+      APPEND (result, ":");
+      mode_string = decode_constant (TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+    }
+  else
+    {
+      mode_string = decode_mode (TYPE_DOMAIN (type));
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+    }
+  APPEND (result, ") ");
+  if (varying)
+    APPEND (result, "VARYING ");
+
+  mode_string = get_type (TREE_TYPE (type));
+  APPEND (result, mode_string->str);
+  FREE (mode_string);
+
+  layout = TYPE_ATTRIBUTES (type);
+  if (layout != NULL_TREE)
+    {
+      mode_string = decode_layout (layout);
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+    }
+    
+  return result;
+}
+
+static MYSTRING *
+grant_array_type_selective (type, all_decls)
+     tree type;
+     tree all_decls;
+{
+  MYSTRING	*result = newstring ("");
+  MYSTRING	*mode_string;
+  int            varying = 0;
+
+  if (chill_varying_type_p (type))
+    {
+      varying = 1;
+      type = CH_VARYING_ARRAY_TYPE (type);
+    }
+  if (CH_STRING_TYPE_P (type))
+    {
+      tree fields = TYPE_DOMAIN (type);
+      tree maxval = TYPE_MAX_VALUE (fields);
+
+      if (TREE_CODE (maxval) != INTEGER_CST)
+	{
+	  if (TREE_CODE (maxval) == MINUS_EXPR
+	      && TREE_OPERAND (maxval, 1) == integer_one_node)
+	    {
+	      mode_string = decode_constant_selective (TREE_OPERAND (maxval, 0), all_decls);
+	      if (mode_string->len)
+		APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	  else
+	    {
+	      mode_string = decode_constant_selective (maxval, all_decls);
+	      if (mode_string->len)
+		APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	}
+      return result;
+    }
+
+  if (TREE_CODE (TYPE_DOMAIN (type)) == INTEGER_TYPE
+     && TREE_TYPE (TYPE_DOMAIN (type)) == ridpointers[(int) RID_RANGE])
+    {
+      mode_string = decode_constant_selective (TYPE_MIN_VALUE (TYPE_DOMAIN (type)), all_decls);
+      if (mode_string->len)
+	APPEND (result, mode_string->str);
+      FREE (mode_string);
+      
+      mode_string = decode_constant_selective (TYPE_MAX_VALUE (TYPE_DOMAIN (type)), all_decls);
+      if (mode_string->len)
+	{
+	  MAYBE_NEWLINE (result);
+	  APPEND (result, mode_string->str);
+	}
+      FREE (mode_string);
+    }
+  else
+    {
+      mode_string = decode_mode_selective (TYPE_DOMAIN (type), all_decls);
+      if (mode_string->len)
+	APPEND (result, mode_string->str);
+      FREE (mode_string);
+    }
+
+  mode_string = get_type_selective (TREE_TYPE (type),  all_decls);
+  if (mode_string->len)
+    {
+      MAYBE_NEWLINE (result);
+      APPEND (result, mode_string->str);
+    }
+  FREE (mode_string);
+
+  return result;
+}
+
+static MYSTRING *
+get_tag_value (val)
+    tree	val;
+{
+  MYSTRING	*result;
+    
+  if (TREE_CODE (val) == CONST_DECL && DECL_NAME (val))
+    {
+      result = newstring (IDENTIFIER_POINTER (DECL_NAME (val)));
+    }
+  else if (TREE_CODE (val) == CONST_DECL)
+    {
+      /* it's a synonym -- get the value */
+      result = decode_constant (DECL_INITIAL (val));
+    }
+  else
+    {
+      result = decode_constant (val);
+    }
+  return (result);
+}
+
+static MYSTRING *
+get_tag_value_selective (val, all_decls)
+    tree	val;
+    tree        all_decls;
+{
+  MYSTRING	*result;
+    
+  if (TREE_CODE (val) == CONST_DECL && DECL_NAME (val))
+      result = newstring ("");
+  else if (TREE_CODE (val) == CONST_DECL)
+    {
+      /* it's a synonym -- get the value */
+      result = decode_constant_selective (DECL_INITIAL (val), all_decls);
+    }
+  else
+    {
+      result = decode_constant_selective (val, all_decls);
+    }
+  return (result);
+}
+
+static MYSTRING *
+print_enumeral (type)
+     tree type;
+{
+  MYSTRING	*result = newstring ("");
+  tree	fields;
+
+#if 0
+  if (TYPE_LANG_SPECIFIC (type) == NULL)
+#endif
+    {
+      
+      APPEND (result, "SET (");
+      for (fields = TYPE_VALUES (type);
+	   fields != NULL_TREE;
+	   fields = TREE_CHAIN (fields))
+	{
+	  if (TREE_PURPOSE (fields) == NULL_TREE)
+	    APPEND (result, "*");
+	  else
+	    {
+	      tree decl = TREE_VALUE (fields);
+	      APPEND (result, IDENTIFIER_POINTER (TREE_PURPOSE (fields)));
+	      if (TREE_CODE (decl) == CONST_DECL && DECL_INITIAL (decl))
+		{
+		  MYSTRING *val_string = decode_constant (DECL_INITIAL (decl));
+		  APPEND (result, " = ");
+		  APPEND (result, val_string->str);
+		  FREE (val_string);
+		}
+	    }
+	  if (TREE_CHAIN (fields) != NULL_TREE)
+	    APPEND (result, ",\n     ");
+	}
+      APPEND (result, ")");
+    }
+  return result;
+}
+
+static MYSTRING *
+print_enumeral_selective (type, all_decls)
+     tree type;
+     tree all_decls;
+{
+  MYSTRING	*result = newstring ("");
+  tree	fields;
+
+  for (fields = TYPE_VALUES (type);
+       fields != NULL_TREE;
+       fields = TREE_CHAIN (fields))
+    {
+      if (TREE_PURPOSE (fields) != NULL_TREE)
+	{
+	  tree decl = TREE_VALUE (fields);
+	  if (TREE_CODE (decl) == CONST_DECL && DECL_INITIAL (decl))
+	    {
+	      MYSTRING *val_string = decode_constant_selective (DECL_INITIAL (decl), all_decls);
+	      if (val_string->len)
+		APPEND (result, val_string->str);
+	      FREE (val_string);
+	    }
+	}
+    }
+  return result;
+}
+
+static MYSTRING *
+print_integer_type (type)
+     tree type;
+{
+  MYSTRING *result = newstring ("");
+  MYSTRING *mode_string;
+  char     *name_ptr;
+  tree	    base_type;
+
+  if (TREE_TYPE (type))
+    {
+      mode_string = decode_mode (TREE_TYPE (type));
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      
+      APPEND (result, "(");
+      mode_string = decode_constant (TYPE_MIN_VALUE (type));
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+
+      if (TREE_TYPE (type) != ridpointers[(int) RID_BIN])
+	{
+	  APPEND (result, ":");
+	  mode_string = decode_constant (TYPE_MAX_VALUE (type));
+	  APPEND (result, mode_string->str);
+	  FREE (mode_string);
+	}
+
+      APPEND (result, ")");
+      return result;
+    }
+  /* We test TYPE_MAIN_VARIANT because pushdecl often builds
+     a copy of a built-in type node, which is logically id-
+     entical but has a different address, and the same
+     TYPE_MAIN_VARIANT. */
+  /* FIXME this should not be needed! */
+
+  base_type = TREE_TYPE (type) ? TREE_TYPE (type) : type;
+
+  if (TREE_UNSIGNED (base_type))
+    {
+      if (base_type == chill_unsigned_type_node
+	  || TYPE_MAIN_VARIANT(base_type) ==
+	     TYPE_MAIN_VARIANT (chill_unsigned_type_node))
+	name_ptr = "UINT";
+      else if (base_type == long_integer_type_node
+	       || TYPE_MAIN_VARIANT(base_type) ==
+	          TYPE_MAIN_VARIANT (long_unsigned_type_node))
+	name_ptr = "ULONG";
+      else if (type == unsigned_char_type_node
+	       || TYPE_MAIN_VARIANT(base_type) ==
+	          TYPE_MAIN_VARIANT (unsigned_char_type_node))
+	name_ptr = "UBYTE";
+      else if (type == duration_timing_type_node
+	       || TYPE_MAIN_VARIANT (base_type) ==
+	          TYPE_MAIN_VARIANT (duration_timing_type_node))
+	name_ptr = "DURATION";
+      else if (type == abs_timing_type_node
+	       || TYPE_MAIN_VARIANT (base_type) ==
+	          TYPE_MAIN_VARIANT (abs_timing_type_node))
+	name_ptr = "TIME";
+      else
+	name_ptr = "UINT";
+    }
+  else
+    {
+      if (base_type == chill_integer_type_node
+	  || TYPE_MAIN_VARIANT (base_type) ==
+	     TYPE_MAIN_VARIANT (chill_integer_type_node))
+	name_ptr = "INT";
+      else if (base_type == long_integer_type_node
+	       || TYPE_MAIN_VARIANT (base_type) ==
+	          TYPE_MAIN_VARIANT (long_integer_type_node))
+	name_ptr = "LONG";
+      else if (type == signed_char_type_node
+	       || TYPE_MAIN_VARIANT (base_type) ==
+	          TYPE_MAIN_VARIANT (signed_char_type_node))
+	name_ptr = "BYTE";
+      else
+	name_ptr = "INT";
+    }
+  
+  APPEND (result, name_ptr);
+  
+  /* see if we have a range */
+  if (TREE_TYPE (type) != NULL)
+    {
+      mode_string = decode_constant (TYPE_MIN_VALUE (type));
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      APPEND (result, ":");
+      mode_string = decode_constant (TYPE_MAX_VALUE (type));
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+    }
+
+  return result;
+}
+
+static tree
+find_enum_parent (enumname, all_decls)
+     tree enumname;
+     tree all_decls;
+{
+  tree wrk;
+
+  for (wrk = all_decls; wrk != NULL_TREE; wrk = TREE_CHAIN (wrk))
+    {
+      if (TREE_TYPE (wrk) != NULL_TREE && TREE_CODE (wrk) != CONST_DECL &&
+	  TREE_CODE (TREE_TYPE (wrk)) == ENUMERAL_TYPE)
+	{
+	  tree list;
+	  for (list = TYPE_VALUES (TREE_TYPE (wrk)); list != NULL_TREE; list = TREE_CHAIN (list))
+	    {
+	      if (DECL_NAME (TREE_VALUE (list)) == enumname)
+		return wrk;
+	    }
+	}
+    }
+  return NULL_TREE;
+}
+
+static MYSTRING *
+print_integer_selective (type, all_decls)
+     tree type;
+     tree all_decls;
+{
+  MYSTRING *result = newstring ("");
+  MYSTRING *mode_string;
+
+  if (TREE_TYPE (type))
+    {
+      mode_string = decode_mode_selective (TREE_TYPE (type), all_decls);
+      if (mode_string->len)
+	APPEND (result, mode_string->str);
+      FREE (mode_string);
+
+      if (TREE_TYPE (type) == ridpointers[(int)RID_RANGE] &&
+	  TREE_CODE (TYPE_MIN_VALUE (type)) == IDENTIFIER_NODE &&
+	  TREE_CODE (TYPE_MAX_VALUE (type)) == IDENTIFIER_NODE)
+	{
+	  /* we have a range of a set. Find parant mode and write it
+	     to SPEC MODULE. This will loose if the parent mode was SEIZED from
+	     another file.*/
+	  tree minparent = find_enum_parent (TYPE_MIN_VALUE (type), all_decls);
+	  tree maxparent = find_enum_parent (TYPE_MAX_VALUE (type), all_decls);
+
+	  if (minparent != NULL_TREE)
+	    {
+	      if (! CH_ALREADY_GRANTED (minparent))
+		{
+		  mode_string = decode_decl (minparent);
+		  if (mode_string->len)
+		    APPEND (result, mode_string->str);
+		  FREE (mode_string);
+		  CH_ALREADY_GRANTED (minparent) = 1;
+		}
+	    }
+	  if (minparent != maxparent && maxparent != NULL_TREE)
+	    {
+	      if (!CH_ALREADY_GRANTED (maxparent))
+		{
+		  mode_string = decode_decl (maxparent);
+		  if (mode_string->len)
+		    {
+		      MAYBE_NEWLINE (result);
+		      APPEND (result, mode_string->str);
+		    }
+		  FREE (mode_string);
+		  CH_ALREADY_GRANTED (maxparent) = 1;
+		}
+	    }
+	}
+      else
+	{
+	  mode_string = decode_constant_selective (TYPE_MIN_VALUE (type), all_decls);
+	  if (mode_string->len)
+	    {
+	      MAYBE_NEWLINE (result);
+	      APPEND (result, mode_string->str);
+	    }
+	  FREE (mode_string);
+	  
+	  mode_string = decode_constant_selective (TYPE_MAX_VALUE (type), all_decls);
+	  if (mode_string->len)
+	    {
+	      MAYBE_NEWLINE (result);
+	      APPEND (result, mode_string->str);
+	    }
+	  FREE (mode_string);
+	}
+      return result;
+    }
+
+  /* see if we have a range */
+  if (TREE_TYPE (type) != NULL)
+    {
+      mode_string = decode_constant_selective (TYPE_MIN_VALUE (type), all_decls);
+      if (mode_string->len)
+	APPEND (result, mode_string->str);
+      FREE (mode_string);
+
+      mode_string = decode_constant_selective (TYPE_MAX_VALUE (type), all_decls);
+      if (mode_string->len)
+	{
+	  MAYBE_NEWLINE (result);
+	  APPEND (result, mode_string->str);
+	}
+      FREE (mode_string);
+    }
+
+  return result;
+}
+
+static MYSTRING *
+print_struct (type)
+     tree type;
+{
+  MYSTRING	*result = newstring ("");
+  MYSTRING	*mode_string;
+  tree	fields;
+
+  if (chill_varying_type_p (type))
+    {
+      mode_string = grant_array_type (type);
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+    }
+  else
+    {
+      fields = TYPE_FIELDS (type);
+      
+      APPEND (result, "STRUCT (");
+      while (fields != NULL_TREE)
+	{
+	  if (TREE_CODE (TREE_TYPE (fields)) == UNION_TYPE)
+	    {
+	      tree variants;
+	      /* Format a tagged variant record type.  */
+	      APPEND (result, " CASE ");
+	      if (TYPE_TAGFIELDS (TREE_TYPE (fields)) != NULL_TREE)
+		{
+		  tree tag_list = TYPE_TAGFIELDS (TREE_TYPE (fields));
+		  for (;;)
+		    {
+		      tree tag_name = DECL_NAME (TREE_VALUE (tag_list));
+		      APPEND (result, IDENTIFIER_POINTER (tag_name));
+		      tag_list = TREE_CHAIN (tag_list);
+		      if (tag_list == NULL_TREE)
+			break;
+		      APPEND (result, ", ");
+		    }
+		}
+	      APPEND (result, " OF\n");
+	      variants = TYPE_FIELDS (TREE_TYPE (fields));
+	      
+	      /* Each variant is a FIELD_DECL whose type is an anonymous
+		 struct within the anonymous union.  */
+	      while (variants != NULL_TREE)
+		{
+		  tree tag_list = TYPE_TAG_VALUES (TREE_TYPE (variants));
+		  tree struct_elts = TYPE_FIELDS (TREE_TYPE (variants));
+		  
+		  while (tag_list != NULL_TREE)
+		    {
+		      tree tag_values = TREE_VALUE (tag_list);
+		      APPEND (result, "   (");
+		      while (tag_values != NULL_TREE)
+			{
+			  mode_string = get_tag_value (TREE_VALUE (tag_values));
+			  APPEND (result, mode_string->str);
+			  FREE (mode_string);
+			  if (TREE_CHAIN (tag_values) != NULL_TREE)
+			    {
+			      APPEND (result, ",\n    ");
+			      tag_values = TREE_CHAIN (tag_values);
+			    }
+			  else break;
+			}
+		      APPEND (result, ")");
+		      tag_list = TREE_CHAIN (tag_list);
+		      if (tag_list)
+			APPEND (result, ",");
+		      else
+			break;
+		    }
+		  APPEND (result, " : ");
+		  
+		  while (struct_elts != NULL_TREE)
+		    {
+		      mode_string = decode_decl (struct_elts);
+		      APPEND (result, mode_string->str);
+		      FREE (mode_string);
+		      
+		      if (TREE_CHAIN (struct_elts) != NULL_TREE)
+			APPEND (result, ",\n     ");
+		      struct_elts = TREE_CHAIN (struct_elts);
+		    }
+		  
+		  variants = TREE_CHAIN (variants);
+		  if (variants != NULL_TREE
+		      && TREE_CHAIN (variants) == NULL_TREE
+		      && DECL_NAME (variants) == ELSE_VARIANT_NAME)
+		    {
+		      tree else_elts = TYPE_FIELDS (TREE_TYPE (variants));
+		      APPEND (result, "\n   ELSE ");
+		      while (else_elts != NULL_TREE)
+			{
+			  mode_string = decode_decl (else_elts);
+			  APPEND (result, mode_string->str);
+			  FREE (mode_string);
+			  if (TREE_CHAIN (else_elts) != NULL_TREE)
+			    APPEND (result, ",\n     ");
+			  else_elts = TREE_CHAIN (else_elts);
+			}
+		      break;
+		    }
+		  if (variants != NULL_TREE)
+		    APPEND (result, ",\n");
+		}
+	      
+	      APPEND (result, "\n   ESAC");
+	    }
+	  else
+	    {
+	      mode_string = decode_decl (fields);
+	      APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	  
+	  fields = TREE_CHAIN (fields);
+	  if (fields != NULL_TREE)
+	    APPEND (result, ",\n    ");
+	}
+      APPEND (result, ")");
+    }
+  return result;
+}
+
+static MYSTRING *
+print_struct_selective (type, all_decls)
+     tree type;
+     tree all_decls;
+{
+  MYSTRING	*result = newstring ("");
+  MYSTRING	*mode_string;
+  tree	fields;
+
+  if (chill_varying_type_p (type))
+    {
+      mode_string = grant_array_type_selective (type, all_decls);
+      if (mode_string->len)
+	APPEND (result, mode_string->str);
+      FREE (mode_string);
+    }
+  else
+    {
+      fields = TYPE_FIELDS (type);
+      
+      while (fields != NULL_TREE)
+	{
+	  if (TREE_CODE (TREE_TYPE (fields)) == UNION_TYPE)
+	    {
+	      tree variants;
+	      /* Format a tagged variant record type.  */
+
+	      variants = TYPE_FIELDS (TREE_TYPE (fields));
+	      
+	      /* Each variant is a FIELD_DECL whose type is an anonymous
+		 struct within the anonymous union.  */
+	      while (variants != NULL_TREE)
+		{
+		  tree tag_list = TYPE_TAG_VALUES (TREE_TYPE (variants));
+		  tree struct_elts = TYPE_FIELDS (TREE_TYPE (variants));
+		  
+		  while (tag_list != NULL_TREE)
+		    {
+		      tree tag_values = TREE_VALUE (tag_list);
+		      while (tag_values != NULL_TREE)
+			{
+			  mode_string = get_tag_value_selective (TREE_VALUE (tag_values),
+								 all_decls);
+			  if (mode_string->len)
+			    {
+			      MAYBE_NEWLINE (result);
+			      APPEND (result, mode_string->str);
+			    }
+			  FREE (mode_string);
+			  if (TREE_CHAIN (tag_values) != NULL_TREE)
+			      tag_values = TREE_CHAIN (tag_values);
+			  else break;
+			}
+		      tag_list = TREE_CHAIN (tag_list);
+		      if (!tag_list)
+			break;
+		    }
+		  
+		  while (struct_elts != NULL_TREE)
+		    {
+		      mode_string = decode_decl_selective (struct_elts, all_decls);
+		      if (mode_string->len)
+			{
+			  MAYBE_NEWLINE (result);
+			  APPEND (result, mode_string->str);
+			}
+		      FREE (mode_string);
+		      
+		      struct_elts = TREE_CHAIN (struct_elts);
+		    }
+		  
+		  variants = TREE_CHAIN (variants);
+		  if (variants != NULL_TREE
+		      && TREE_CHAIN (variants) == NULL_TREE
+		      && DECL_NAME (variants) == ELSE_VARIANT_NAME)
+		    {
+		      tree else_elts = TYPE_FIELDS (TREE_TYPE (variants));
+		      while (else_elts != NULL_TREE)
+			{
+			  mode_string = decode_decl_selective (else_elts, all_decls);
+			  if (mode_string->len)
+			    {
+			      MAYBE_NEWLINE (result);
+			      APPEND (result, mode_string->str);
+			    }
+			  FREE (mode_string);
+			  else_elts = TREE_CHAIN (else_elts);
+			}
+		      break;
+		    }
+		}
+	    }
+	  else
+	    {
+	      mode_string = decode_decl_selective (fields, all_decls);
+	      APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	  
+	  fields = TREE_CHAIN (fields);
+	}
+    }
+  return result;
+}
+
+static MYSTRING *
+print_proc_exceptions (ex)
+     tree ex;
+{
+  MYSTRING	*result = newstring ("");
+
+  if (ex != NULL_TREE)
+    {
+      APPEND (result, "\n  EXCEPTIONS (");
+      for ( ; ex != NULL_TREE; ex = TREE_CHAIN (ex))
+	{
+	  APPEND (result, IDENTIFIER_POINTER (TREE_VALUE (ex)));
+	  if (TREE_CHAIN (ex) != NULL_TREE)
+	    APPEND (result, ",\n    ");
+	}
+      APPEND (result, ")");
+    }
+  return result;
+}
+
+static MYSTRING *
+print_proc_tail (type, args, print_argnames)
+     tree type;
+     tree args;
+     int print_argnames;
+{
+  MYSTRING	*result = newstring ("");
+  MYSTRING	*mode_string;
+  int count = 0;
+  int stopat = list_length (args) - 3;
+
+  /* do the argument modes */
+  for ( ; args != NULL_TREE; 
+       args = TREE_CHAIN (args), count++)
+    {
+      char buf[20];
+      tree argmode = TREE_VALUE (args);
+      tree attribute = TREE_PURPOSE (args);
+
+      if (argmode == void_type_node)
+	continue;
+
+      /* if we have exceptions don't print last 2 arguments */
+      if (TYPE_RAISES_EXCEPTIONS (type) && count == stopat)
+	break;
+      
+      if (count)
+	APPEND (result, ",\n       ");
+      if (print_argnames)
+	{
+	  sprintf(buf, "arg%d ", count);
+	  APPEND (result, buf);
+	}
+
+      if (attribute == ridpointers[(int) RID_LOC])
+	argmode = TREE_TYPE (argmode);
+      mode_string = get_type (argmode);
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+
+      if (attribute != NULL_TREE)
+	{
+	  sprintf (buf, " %s", IDENTIFIER_POINTER (attribute));
+	  APPEND (result, buf);
+	}
+    }
+  APPEND (result, ")");
+  
+  /* return type */
+  {
+    tree retn_type = TREE_TYPE (type);
+
+    if (retn_type != NULL_TREE
+	&& TREE_CODE (retn_type) != VOID_TYPE)
+      {
+	mode_string = get_type (retn_type);
+	APPEND (result, "\n  RETURNS (");
+	APPEND (result, mode_string->str);
+	FREE (mode_string);
+	if (TREE_CODE (retn_type) == REFERENCE_TYPE)
+	  APPEND (result, " LOC");
+	APPEND (result, ")");
+      }
+  }
+
+  mode_string = print_proc_exceptions (TYPE_RAISES_EXCEPTIONS (type));
+  APPEND (result, mode_string->str);
+  FREE (mode_string);
+	
+  return result;
+}
+
+static MYSTRING *
+print_proc_tail_selective (type, args, all_decls)
+     tree type;
+     tree args;
+     tree all_decls;
+{
+  MYSTRING	*result = newstring ("");
+  MYSTRING	*mode_string;
+  int count = 0;
+  int stopat = list_length (args) - 3;
+
+  /* do the argument modes */
+  for ( ; args != NULL_TREE; 
+       args = TREE_CHAIN (args), count++)
+    {
+      tree argmode = TREE_VALUE (args);
+      tree attribute = TREE_PURPOSE (args);
+
+      if (argmode == void_type_node)
+	continue;
+
+      /* if we have exceptions don't process last 2 arguments */
+      if (TYPE_RAISES_EXCEPTIONS (type) && count == stopat)
+	break;
+      
+      if (attribute == ridpointers[(int) RID_LOC])
+	argmode = TREE_TYPE (argmode);
+      mode_string = get_type_selective (argmode, all_decls);
+      if (mode_string->len)
+	{
+	  MAYBE_NEWLINE (result);
+	  APPEND (result, mode_string->str);
+	}
+      FREE (mode_string);
+    }
+  
+  /* return type */
+  {
+    tree retn_type = TREE_TYPE (type);
+
+    if (retn_type != NULL_TREE
+	&& TREE_CODE (retn_type) != VOID_TYPE)
+      {
+	mode_string = get_type_selective (retn_type, all_decls);
+	if (mode_string->len)
+	  {
+	    MAYBE_NEWLINE (result);
+	    APPEND (result, mode_string->str);
+	  }
+	FREE (mode_string);
+      }
+  }
+	
+  return result;
+}
+
+/* output a mode (or type). */
+
+static MYSTRING *
+decode_mode (type)
+    tree type;
+{
+  MYSTRING	*result = newstring ("");
+  MYSTRING	*mode_string;
+
+  switch ((enum chill_tree_code)TREE_CODE (type))
+    {
+    case TYPE_DECL:
+      if (DECL_NAME (type))
+	{
+	  APPEND (result, IDENTIFIER_POINTER (DECL_NAME (type)));
+	  return result;
+	}
+      type = TREE_TYPE (type);
+      break;
+
+    case IDENTIFIER_NODE:
+      APPEND (result, IDENTIFIER_POINTER (type));
+      return result;
+
+    case LANG_TYPE:
+      /* LANG_TYPE are only used until satisfy is done,
+	 as place-holders for 'READ T', NEWMODE/SYNMODE modes,
+	 parameterised modes, and old-fashioned CHAR(N). */
+      if (TYPE_READONLY (type))
+	APPEND (result, "READ ");
+
+      mode_string = get_type (TREE_TYPE (type));
+      APPEND (result, mode_string->str);
+      if (TYPE_DOMAIN (type) != NULL_TREE)
+	{
+	  /* Parameterized mode,
+	     or old-fashioned CHAR(N) string declaration.. */
+	  APPEND (result, "(");
+	  mode_string = decode_constant (TYPE_DOMAIN (type));
+	  APPEND (result, mode_string->str);
+	  APPEND (result, ")");
+	}
+      FREE (mode_string);
+      break;
+
+    case ARRAY_TYPE:
+      mode_string = grant_array_type (type);
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+
+    case BOOLEAN_TYPE:
+      APPEND (result, "BOOL");
+      break;
+
+    case CHAR_TYPE:
+      APPEND (result, "CHAR");
+      break;
+
+    case ENUMERAL_TYPE:
+      mode_string = print_enumeral (type); 
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+	
+    case FUNCTION_TYPE:
+      {
+	tree args = TYPE_ARG_TYPES (type);
+
+	APPEND (result, "PROC (");
+
+	mode_string = print_proc_tail (type, args, 0);
+	APPEND (result, mode_string->str);
+	FREE (mode_string);
+      }
+      break;
+
+    case INTEGER_TYPE:
+      mode_string = print_integer_type (type);
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+	
+    case RECORD_TYPE:
+      if (CH_IS_INSTANCE_MODE (type))
+	{
+	  APPEND (result, "INSTANCE");
+	  return result;
+	}
+      else if (CH_IS_BUFFER_MODE (type) || CH_IS_EVENT_MODE (type))
+	{ tree bufsize = max_queue_size (type);
+	  APPEND (result, CH_IS_BUFFER_MODE (type) ? "BUFFER " : "EVENT ");
+	  if (bufsize != NULL_TREE)
+	    {
+	      APPEND (result, "(");
+	      mode_string = decode_constant (bufsize);
+	      APPEND (result, mode_string->str);
+	      APPEND (result, ") ");
+	      FREE (mode_string);
+	    }
+	  if (CH_IS_BUFFER_MODE (type))
+	    {
+	      mode_string = decode_mode (buffer_element_mode (type));
+	      APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	  break;
+	}
+      else if (CH_IS_ACCESS_MODE (type))
+	{
+	  tree indexmode, recordmode, dynamic;
+
+	  APPEND (result, "ACCESS");
+	  recordmode = access_recordmode (type);
+	  indexmode = access_indexmode (type);
+	  dynamic = access_dynamic (type);
+
+	  if (indexmode != void_type_node)
+	    {
+	      mode_string = decode_mode (indexmode);
+	      APPEND (result, " (");
+	      APPEND (result, mode_string->str);
+	      APPEND (result, ")");
+	      FREE (mode_string);
+	    }
+	  if (recordmode != void_type_node)
+	    {
+	      mode_string = decode_mode (recordmode);
+	      APPEND (result, " ");
+	      APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	  if (dynamic != integer_zero_node)
+	    APPEND (result, " DYNAMIC");
+	  break;
+	}
+      else if (CH_IS_TEXT_MODE (type))
+	{
+	  tree indexmode, dynamic, length;
+
+	  APPEND (result, "TEXT (");
+	  length = text_length (type);
+	  indexmode = text_indexmode (type);
+	  dynamic = text_dynamic (type);
+
+	  mode_string = decode_constant (length);
+	  APPEND (result, mode_string->str);
+	  FREE (mode_string);
+	  APPEND (result, ")");
+	  if (indexmode != void_type_node)
+	    {
+	      APPEND (result, " ");
+	      mode_string = decode_mode (indexmode);
+	      APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	  if (dynamic != integer_zero_node)
+	    APPEND (result, " DYNAMIC");
+	  return result;
+	}
+      mode_string = print_struct (type);
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+
+    case POINTER_TYPE:
+      if (TREE_CODE (TREE_TYPE (type)) == VOID_TYPE)
+	APPEND (result, "PTR");
+      else
+	{
+	  if (TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE)
+	    {
+	      mode_string = get_type (TREE_TYPE (type));
+	      APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	  else
+	    {
+	      APPEND (result, "REF ");
+	      mode_string = get_type (TREE_TYPE (type));
+	      APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	}
+      break;
+
+    case REAL_TYPE:
+      if (TREE_INT_CST_LOW (TYPE_SIZE (type)) == 32)
+	APPEND (result, "REAL");
+      else
+	APPEND (result, "LONG_REAL");
+      break;
+
+    case SET_TYPE:
+      if (CH_BOOLS_TYPE_P (type))
+	mode_string = grant_array_type (type);
+      else
+	{
+	  APPEND (result, "POWERSET ");
+	  mode_string = get_type (TYPE_DOMAIN (type));
+	}
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+	
+    case REFERENCE_TYPE:
+      mode_string = get_type (TREE_TYPE (type));
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+      
+    default:
+      APPEND (result, "/* ---- not implemented ---- */");
+      break;
+    }
+
+  return (result);
+}
+
+static tree
+find_in_decls (id, all_decls)
+     tree id;
+     tree all_decls;
+{
+  tree wrk;
+
+  for (wrk = all_decls; wrk != NULL_TREE; wrk = TREE_CHAIN (wrk))
+    {
+      if (DECL_NAME (wrk) == id || DECL_POSTFIX (wrk) == id)
+	return wrk;
+    }
+  return NULL_TREE;
+}
+
+static int
+in_ridpointers (id)
+     tree id;
+{
+  int i;
+  for (i = RID_UNUSED; i < RID_MAX; i++)
+    {
+      if (id == ridpointers[i])
+	return 1;
+    }
+  return 0;
+}
+
+static void
+grant_seized_identifier (decl)
+     tree decl;
+{
+  seizefile_list *wrk = selective_seizes;
+  MYSTRING *mode_string;
+
+  CH_ALREADY_GRANTED (decl) = 1;
+
+  /* comes from a SPEC MODULE in the module */
+  if (DECL_SEIZEFILE (decl) == NULL_TREE)
+    return;
+
+  /* search file already in process */
+  while (wrk != 0)
+    {
+      if (wrk->filename == DECL_SEIZEFILE (decl))
+	break;
+      wrk = wrk->next;
+    }
+  if (!wrk)
+    {
+      wrk = (seizefile_list *)xmalloc (sizeof (seizefile_list));
+      wrk->next = selective_seizes;
+      selective_seizes = wrk;
+      wrk->filename = DECL_SEIZEFILE (decl);
+      wrk->seizes = newstring ("<> USE_SEIZE_FILE \"");
+      APPEND (wrk->seizes, IDENTIFIER_POINTER (DECL_SEIZEFILE (decl)));
+      APPEND (wrk->seizes, "\" <>\n");
+    }
+  APPEND (wrk->seizes, "SEIZE ");
+  mode_string = decode_prefix_rename (decl);
+  APPEND (wrk->seizes, mode_string->str);
+  FREE (mode_string);
+  APPEND (wrk->seizes, ";\n");
+}
+
+static MYSTRING *
+decode_mode_selective (type, all_decls)
+    tree type;
+    tree all_decls;
+{
+  MYSTRING	*result = newstring ("");
+  MYSTRING	*mode_string;
+  tree decl;
+
+  switch ((enum chill_tree_code)TREE_CODE (type))
+    {
+    case TYPE_DECL:
+      /* FIXME: could this ever happen ?? */
+      if (DECL_NAME (type))
+	{
+	  FREE (result);
+	  result = decode_mode_selective (DECL_NAME (type), all_decls);
+	  return result;
+	}
+      break;
+
+    case IDENTIFIER_NODE:
+      if (in_ridpointers (type))
+	/* it's a predefined, we must not search the whole list */
+	return result;
+
+      decl = find_in_decls (type, all_decls);
+      if (decl != NULL_TREE)
+	{
+	  if (CH_ALREADY_GRANTED (decl))
+	    /* already processed */
+	    return result;
+
+	  if (TREE_CODE (decl) == ALIAS_DECL && DECL_POSTFIX (decl) != NULL_TREE)
+	    {
+	      /* If CH_DECL_GRANTED, decl was granted into this scope, and
+		 so wasn't in the source code. */
+	      if (!CH_DECL_GRANTED (decl))
+		{
+		  grant_seized_identifier (decl);
+		}
+	    }
+	  else
+	    {
+	      result = decode_decl (decl);
+	      mode_string = decode_decl_selective (decl, all_decls);
+	      if (mode_string->len)
+		{
+		  PREPEND (result, mode_string->str);
+		}
+	      FREE (mode_string);
+	    }
+	}
+      return result;
+
+    case LANG_TYPE:
+      mode_string = get_type_selective (TREE_TYPE (type), all_decls);
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+
+    case ARRAY_TYPE:
+      mode_string = grant_array_type_selective (type, all_decls);
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+
+    case BOOLEAN_TYPE:
+      return result;
+      break;
+
+    case CHAR_TYPE:
+      return result;
+      break;
+
+    case ENUMERAL_TYPE:
+      mode_string = print_enumeral_selective (type, all_decls);
+      if (mode_string->len)
+	APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+	
+    case FUNCTION_TYPE:
+      {
+	tree args = TYPE_ARG_TYPES (type);
+
+	mode_string = print_proc_tail_selective (type, args, all_decls);
+	if (mode_string->len)
+	  APPEND (result, mode_string->str);
+	FREE (mode_string);
+      }
+      break;
+
+    case INTEGER_TYPE:
+      mode_string = print_integer_selective (type, all_decls);
+      if (mode_string->len)
+	APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+	
+    case RECORD_TYPE:
+      if (CH_IS_INSTANCE_MODE (type))
+	{
+	  return result;
+	}
+      else if (CH_IS_BUFFER_MODE (type) || CH_IS_EVENT_MODE (type))
+	{
+	  tree bufsize = max_queue_size (type);
+	  if (bufsize != NULL_TREE)
+	    {
+	      mode_string = decode_constant_selective (bufsize, all_decls);
+	      if (mode_string->len)
+		APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	  if (CH_IS_BUFFER_MODE (type))
+	    {
+	      mode_string = decode_mode_selective (buffer_element_mode (type), all_decls);
+	      if (mode_string->len)
+		{
+		  MAYBE_NEWLINE (result);
+		  APPEND (result, mode_string->str);
+		}
+	      FREE (mode_string);
+	    }
+	  break;
+	}      
+      else if (CH_IS_ACCESS_MODE (type))
+	{
+	  tree indexmode = access_indexmode (type);
+	  tree recordmode = access_recordmode (type);
+	      
+	  if (indexmode != void_type_node)
+	    {
+	      mode_string = decode_mode_selective (indexmode, all_decls);
+	      if (mode_string->len)
+		{
+		  if (result->len && result->str[result->len - 1] != '\n')
+		    APPEND (result, ";\n");
+		  APPEND (result, mode_string->str);
+		}
+	      FREE (mode_string);
+	    }
+	  if (recordmode != void_type_node)
+	    {
+	      mode_string = decode_mode_selective (recordmode, all_decls);
+	      if (mode_string->len)
+		{
+		  if (result->len && result->str[result->len - 1] != '\n')
+		    APPEND (result, ";\n");
+		  APPEND (result, mode_string->str);
+		}
+	      FREE (mode_string);
+	    }
+	  break;
+	}
+      else if (CH_IS_TEXT_MODE (type))
+	{
+	  tree indexmode = text_indexmode (type);
+	  tree length = text_length (type);
+
+	  mode_string = decode_constant_selective (length, all_decls);
+	  if (mode_string->len)
+	    APPEND (result, mode_string->str);
+	  FREE (mode_string);
+	  if (indexmode != void_type_node)
+	    {
+	      mode_string = decode_mode_selective (indexmode, all_decls);
+	      if (mode_string->len)
+		{
+		  if (result->len && result->str[result->len - 1] != '\n')
+		    APPEND (result, ";\n");
+		  APPEND (result, mode_string->str);
+		}
+	      FREE (mode_string);
+	    }
+	  break;
+	}
+      mode_string = print_struct_selective (type, all_decls);
+      if (mode_string->len)
+	{
+	  MAYBE_NEWLINE (result);
+	  APPEND (result, mode_string->str);
+	}
+      FREE (mode_string);
+      break;
+
+    case POINTER_TYPE:
+      if (TREE_CODE (TREE_TYPE (type)) == VOID_TYPE)
+	break;
+      else
+	{
+	  if (TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE)
+	    {
+	      mode_string = get_type_selective (TREE_TYPE (type), all_decls);
+	      if (mode_string->len)
+		APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	  else
+	    {
+	      mode_string = get_type_selective (TREE_TYPE (type), all_decls);
+	      if (mode_string->len)
+		APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	}
+      break;
+
+    case REAL_TYPE:
+      return result;
+      break;
+
+    case SET_TYPE:
+      if (CH_BOOLS_TYPE_P (type))
+	mode_string = grant_array_type_selective (type, all_decls);
+      else
+	mode_string = get_type_selective (TYPE_DOMAIN (type), all_decls);
+      if (mode_string->len)
+	APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+	
+    case REFERENCE_TYPE:
+      mode_string = get_type_selective (TREE_TYPE (type), all_decls);
+      if (mode_string->len)
+	APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+      
+    default:
+      APPEND (result, "/* ---- not implemented ---- */");
+      break;
+    }
+
+  return (result);
+}
+
+static MYSTRING *
+get_type (type)
+    tree	type;
+{
+  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+    return newstring ("");
+
+  return (decode_mode (type));
+}
+
+static MYSTRING *
+get_type_selective (type, all_decls)
+    tree	type;
+    tree        all_decls;
+{
+  if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+    return newstring ("");
+
+  return (decode_mode_selective (type, all_decls));
+}
+
+#if 0
+static int
+is_forbidden (str, forbid)
+    tree	str;
+    tree	forbid;
+{
+  if (forbid == NULL_TREE)
+    return (0);
+  
+  if (TREE_CODE (forbid) == INTEGER_CST)
+    return (1);
+  
+  while (forbid != NULL_TREE)
+    {
+      if (TREE_VALUE (forbid) == str)
+	return (1);
+      forbid = TREE_CHAIN (forbid);
+    }
+  /* nothing found */
+  return (0);
+}
+#endif
+
+static MYSTRING *
+decode_constant (init)
+     tree	init;
+{
+  MYSTRING *result = newstring ("");
+  MYSTRING *tmp_string;
+  tree	    type = TREE_TYPE (init);
+  tree	val = init;
+  char *op;
+  char	wrk[256];
+  MYSTRING *mode_string;
+    
+  switch ((enum chill_tree_code)TREE_CODE (val))
+    {
+    case CALL_EXPR:
+      tmp_string = decode_constant (TREE_OPERAND (val, 0));
+      APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      val = TREE_OPERAND (val, 1);  /* argument list */
+      if (val != NULL_TREE && TREE_CODE (val) != TREE_LIST)
+	{
+	  APPEND (result, " ");
+	  tmp_string = decode_constant (val);
+	  APPEND (result, tmp_string->str);
+	  FREE (tmp_string);
+	}
+      else
+	{
+	  APPEND (result, " (");
+	  if (val != NULL_TREE)
+	    {
+	      for (;;)
+		{
+		  tmp_string = decode_constant (TREE_VALUE (val));
+		  APPEND (result, tmp_string->str);
+		  FREE (tmp_string);
+		  val = TREE_CHAIN (val);
+		  if (val == NULL_TREE)
+		    break;
+		  APPEND (result, ", ");
+		}
+	    }
+	  APPEND (result, ")");
+	}
+      return result;
+
+    case NOP_EXPR:
+      /* Generate an "expression conversion" expression (a cast). */
+      tmp_string = decode_mode (type);
+
+      APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      APPEND (result, "(");
+      val = TREE_OPERAND (val, 0);
+      type = TREE_TYPE (val);
+
+      /* If the coercee is a tuple, make sure it is prefixed by its mode. */
+      if (TREE_CODE (val) == CONSTRUCTOR
+	&& !CH_BOOLS_TYPE_P (type) && !chill_varying_type_p (type))
+	{
+	  tmp_string = decode_mode (type);
+	  APPEND (result, tmp_string->str);
+	  FREE (tmp_string);
+	  APPEND (result, " ");
+	}
+
+      tmp_string = decode_constant (val);
+      APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      APPEND (result, ")");
+      return result;
+
+    case IDENTIFIER_NODE:
+      APPEND (result, IDENTIFIER_POINTER (val));
+      return result;
+
+    case PAREN_EXPR:
+      APPEND (result, "(");
+      tmp_string = decode_constant (TREE_OPERAND (val, 0));
+      APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      APPEND (result, ")");
+      return result;
+
+    case UNDEFINED_EXPR:
+      APPEND (result, "*");
+      return result;
+
+    case PLUS_EXPR:        op = "+";       goto binary;
+    case MINUS_EXPR:       op = "-";       goto binary;
+    case MULT_EXPR:        op = "*";       goto binary;
+    case TRUNC_DIV_EXPR:   op = "/";       goto binary;
+    case FLOOR_MOD_EXPR:   op = " MOD ";   goto binary;
+    case TRUNC_MOD_EXPR:   op = " REM ";   goto binary;
+    case CONCAT_EXPR:      op = "//";      goto binary;
+    case BIT_IOR_EXPR:     op = " OR ";    goto binary;
+    case BIT_XOR_EXPR:     op = " XOR ";   goto binary;
+    case TRUTH_ORIF_EXPR:  op = " ORIF ";  goto binary;
+    case BIT_AND_EXPR:     op = " AND ";   goto binary;
+    case TRUTH_ANDIF_EXPR: op = " ANDIF "; goto binary;
+    case GT_EXPR:          op = ">";       goto binary;
+    case GE_EXPR:          op = ">=";      goto binary;
+    case SET_IN_EXPR:      op = " IN ";    goto binary;
+    case LT_EXPR:          op = "<";       goto binary;
+    case LE_EXPR:          op = "<=";      goto binary;
+    case EQ_EXPR:          op = "=";       goto binary;
+    case NE_EXPR:          op = "/=";      goto binary;
+    case RANGE_EXPR:
+      if (TREE_OPERAND (val, 0) == NULL_TREE)
+	{
+	  APPEND (result, TREE_OPERAND (val, 1) == NULL_TREE ? "*" : "ELSE");
+	  return result;
+	}
+      op = ":";       goto binary;
+    binary:
+      tmp_string = decode_constant (TREE_OPERAND (val, 0));
+      APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      APPEND (result, op);
+      tmp_string = decode_constant (TREE_OPERAND (val, 1));
+      APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      return result;
+
+    case REPLICATE_EXPR:
+      APPEND (result, "(");
+      tmp_string = decode_constant (TREE_OPERAND (val, 0));
+      APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      APPEND (result, ")");
+      tmp_string = decode_constant (TREE_OPERAND (val, 1));
+      APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      return result;
+
+    case NEGATE_EXPR:     op = "-";     goto unary;
+    case BIT_NOT_EXPR:    op = " NOT "; goto unary;
+    case ADDR_EXPR:       op = "->"; goto unary;
+    unary:
+      APPEND (result, op);
+      tmp_string = decode_constant (TREE_OPERAND (val, 0));
+      APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      return result;
+
+    case INTEGER_CST:
+      APPEND (result, display_int_cst (val));
+      return result;
+
+    case REAL_CST:
+#ifndef REAL_IS_NOT_DOUBLE
+      sprintf (wrk, "%.20g", TREE_REAL_CST (val));
+#else
+      REAL_VALUE_TO_DECIMAL (TREE_REAL_CST (val), "%.20g", wrk);
+#endif
+      APPEND (result, wrk);
+      return result;
+
+    case STRING_CST:
+      {
+	char *ptr = TREE_STRING_POINTER (val);
+	int i = TREE_STRING_LENGTH (val);
+	APPEND (result, "\"");
+	while (--i >= 0)
+	  {
+	    char buf[10];
+	    unsigned char c = *ptr++;
+	    if (c == '^')
+	      APPEND (result, "^^");
+	    else if (c == '"')
+	      APPEND (result, "\"\"");
+	    else if (c == '\n')
+	      APPEND (result, "^J");
+	    else if (c < ' ' || c > '~')
+	      {
+		sprintf (buf, "^(%u)", c);
+		APPEND (result, buf);
+	      }
+	    else
+	      {
+		buf[0] = c;
+		buf[1] = 0;
+		APPEND (result, buf);
+	      }
+	  }
+	APPEND (result, "\"");
+	return result;
+      }
+
+    case CONSTRUCTOR:
+      val = TREE_OPERAND (val, 1);
+      if (type != NULL && TREE_CODE (type) == SET_TYPE
+	  && CH_BOOLS_TYPE_P (type))
+	{
+	  /* It's a bitstring. */
+	  tree domain = TYPE_DOMAIN (type);
+	  tree domain_max = TYPE_MAX_VALUE (domain);
+	  char *buf;
+	  register char *ptr;
+	  int len;
+	  if (TREE_CODE (domain_max) != INTEGER_CST
+	      || (val && TREE_CODE (val) != TREE_LIST))
+	    goto fail;
+
+	  len = TREE_INT_CST_LOW (domain_max) + 1;
+	  if (TREE_CODE (init) != CONSTRUCTOR)
+	    goto fail;
+	  buf = (char *) alloca (len + 10);
+	  ptr = buf;
+	  *ptr++ = ' ';	  
+	  *ptr++ = 'B';
+	  *ptr++ = '\'';
+	  if (get_set_constructor_bits (init, ptr, len))
+	    goto fail;
+	  for (; --len >= 0; ptr++)
+	    *ptr += '0';
+	  *ptr++ = '\'';
+	  *ptr = '\0';
+	  APPEND (result, buf);
+	  return result;
+	}
+      else
+	{ /* It's some kind of tuple */
+	  if (type != NULL_TREE)
+	    {
+	      mode_string = get_type (type);
+	      APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	      APPEND (result, " ");
+	    }
+	  if (val == NULL_TREE
+	      || TREE_CODE (val) == ERROR_MARK)
+	    APPEND (result, "[ ]");
+	  else if (TREE_CODE (val) != TREE_LIST)
+	    goto fail;
+	  else
+	    {
+	      APPEND (result, "[");
+	      for ( ; ; )
+		{
+		  tree lo_val = TREE_PURPOSE (val);
+		  tree hi_val = TREE_VALUE (val);
+		  MYSTRING *val_string;
+		  if (TUPLE_NAMED_FIELD (val))
+		    APPEND(result, ".");
+		  if (lo_val != NULL_TREE)
+		    {
+		      val_string = decode_constant (lo_val);
+		      APPEND (result, val_string->str);
+		      FREE (val_string);
+		      APPEND (result, ":");
+		    }
+		  val_string = decode_constant (hi_val);
+		  APPEND (result, val_string->str);
+		  FREE (val_string);
+		  val = TREE_CHAIN (val);
+		  if (val == NULL_TREE)
+		    break;
+		  APPEND (result, ", ");
+		}
+	      APPEND (result, "]");
+	    }
+	}
+      return result;
+    case COMPONENT_REF:
+      {
+	tree op1;
+
+	mode_string = decode_constant (TREE_OPERAND (init, 0));
+	APPEND (result, mode_string->str);
+	FREE (mode_string);
+	op1 = TREE_OPERAND (init, 1);
+	if (TREE_CODE (op1) != IDENTIFIER_NODE)
+	  {
+	    error ("decode_constant: invalid component_ref");
+	    break;
+	  }
+	APPEND (result, ".");
+	APPEND (result, IDENTIFIER_POINTER (op1));
+	return result;
+      }
+    fail:
+      error ("decode_constant: mode and value mismatch");
+      break;
+    default:
+      error ("decode_constant: cannot decode this mode");
+      break;
+    }
+  return result;
+}
+
+static MYSTRING *
+decode_constant_selective (init, all_decls)
+     tree	init;
+     tree       all_decls;
+{
+  MYSTRING *result = newstring ("");
+  MYSTRING *tmp_string;
+  tree	    type = TREE_TYPE (init);
+  tree	val = init;
+  char *op;
+  char	wrk[256];
+  MYSTRING *mode_string;
+    
+  switch ((enum chill_tree_code)TREE_CODE (val))
+    {
+    case CALL_EXPR:
+      tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
+      if (tmp_string->len)
+	APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      val = TREE_OPERAND (val, 1);  /* argument list */
+      if (val != NULL_TREE && TREE_CODE (val) != TREE_LIST)
+	{
+	  tmp_string = decode_constant_selective (val, all_decls);
+	  if (tmp_string->len)
+	    {
+	      MAYBE_NEWLINE (result);
+	      APPEND (result, tmp_string->str);
+	    }
+	  FREE (tmp_string);
+	}
+      else
+	{
+	  if (val != NULL_TREE)
+	    {
+	      for (;;)
+		{
+		  tmp_string = decode_constant_selective (TREE_VALUE (val), all_decls);
+		  if (tmp_string->len)
+		    {
+		      MAYBE_NEWLINE (result);
+		      APPEND (result, tmp_string->str);
+		    }
+		  FREE (tmp_string);
+		  val = TREE_CHAIN (val);
+		  if (val == NULL_TREE)
+		    break;
+		}
+	    }
+	}
+      return result;
+
+    case NOP_EXPR:
+      /* Generate an "expression conversion" expression (a cast). */
+      tmp_string = decode_mode_selective (type, all_decls);
+      if (tmp_string->len)
+	APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      val = TREE_OPERAND (val, 0);
+      type = TREE_TYPE (val);
+
+      /* If the coercee is a tuple, make sure it is prefixed by its mode. */
+      if (TREE_CODE (val) == CONSTRUCTOR
+	&& !CH_BOOLS_TYPE_P (type) && !chill_varying_type_p (type))
+	{
+	  tmp_string = decode_mode_selective (type, all_decls);
+	  if (tmp_string->len)
+	    APPEND (result, tmp_string->str);
+	  FREE (tmp_string);
+	}
+
+      tmp_string = decode_constant_selective (val, all_decls);
+      if (tmp_string->len)
+	APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      return result;
+
+    case IDENTIFIER_NODE:
+      tmp_string = decode_mode_selective (val, all_decls);
+      if (tmp_string->len)
+	APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      return result;
+
+    case PAREN_EXPR:
+      tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
+      if (tmp_string->len)
+	APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      return result;
+
+    case UNDEFINED_EXPR:
+      return result;
+
+    case PLUS_EXPR:
+    case MINUS_EXPR:
+    case MULT_EXPR:
+    case TRUNC_DIV_EXPR:
+    case FLOOR_MOD_EXPR:
+    case TRUNC_MOD_EXPR:
+    case CONCAT_EXPR:
+    case BIT_IOR_EXPR:
+    case BIT_XOR_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case BIT_AND_EXPR:
+    case TRUTH_ANDIF_EXPR:
+    case GT_EXPR:
+    case GE_EXPR:
+    case SET_IN_EXPR:
+    case LT_EXPR:
+    case LE_EXPR:
+    case EQ_EXPR:
+    case NE_EXPR:
+      goto binary;
+    case RANGE_EXPR:
+      if (TREE_OPERAND (val, 0) == NULL_TREE)
+	  return result;
+
+    binary:
+      tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
+      if (tmp_string->len)
+	APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      tmp_string = decode_constant_selective (TREE_OPERAND (val, 1), all_decls);
+      if (tmp_string->len)
+	{
+	  MAYBE_NEWLINE (result);
+	  APPEND (result, tmp_string->str);
+	}
+      FREE (tmp_string);
+      return result;
+
+    case REPLICATE_EXPR:
+      tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
+      if (tmp_string->len)
+	APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      tmp_string = decode_constant_selective (TREE_OPERAND (val, 1), all_decls);
+      if (tmp_string->len)
+	{
+	  MAYBE_NEWLINE (result);
+	  APPEND (result, tmp_string->str);
+	}
+      FREE (tmp_string);
+      return result;
+
+    case NEGATE_EXPR:
+    case BIT_NOT_EXPR:
+    case ADDR_EXPR:
+      tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
+      if (tmp_string->len)
+	APPEND (result, tmp_string->str);
+      FREE (tmp_string);
+      return result;
+
+    case INTEGER_CST:
+      return result;
+
+    case REAL_CST:
+      return result;
+
+    case STRING_CST:
+      return result;
+
+    case CONSTRUCTOR:
+      val = TREE_OPERAND (val, 1);
+      if (type != NULL && TREE_CODE (type) == SET_TYPE
+	  && CH_BOOLS_TYPE_P (type))
+	  /* It's a bitstring. */
+	  return result;
+      else
+	{ /* It's some kind of tuple */
+	  if (type != NULL_TREE)
+	    {
+	      mode_string = get_type_selective (type, all_decls);
+	      if (mode_string->len)
+		APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	  if (val == NULL_TREE
+	      || TREE_CODE (val) == ERROR_MARK)
+	    return result;
+	  else if (TREE_CODE (val) != TREE_LIST)
+	    goto fail;
+	  else
+	    {
+	      for ( ; ; )
+		{
+		  tree lo_val = TREE_PURPOSE (val);
+		  tree hi_val = TREE_VALUE (val);
+		  MYSTRING *val_string;
+		  if (lo_val != NULL_TREE)
+		    {
+		      val_string = decode_constant_selective (lo_val, all_decls);
+		      if (val_string->len)
+			APPEND (result, val_string->str);
+		      FREE (val_string);
+		    }
+		  val_string = decode_constant_selective (hi_val, all_decls);
+		  if (val_string->len)
+		    {
+		      MAYBE_NEWLINE (result);
+		      APPEND (result, val_string->str);
+		    }
+		  FREE (val_string);
+		  val = TREE_CHAIN (val);
+		  if (val == NULL_TREE)
+		    break;
+		}
+	    }
+	}
+      return result;
+    case COMPONENT_REF:
+      {
+	mode_string = decode_constant_selective (TREE_OPERAND (init, 0), all_decls);
+	if (mode_string->len)
+	  APPEND (result, mode_string->str);
+	FREE (mode_string);
+	return result;
+      }
+    fail:
+      error ("decode_constant_selective: mode and value mismatch");
+      break;
+    default:
+      error ("decode_constant_selective: cannot decode this mode");
+      break;
+    }
+  return result;
+}
+
+/* Assuming DECL is an ALIAS_DECL, return its prefix rename clause. */
+
+static MYSTRING *
+decode_prefix_rename (decl)
+    tree decl;
+{
+  MYSTRING *result = newstring ("");
+  if (DECL_OLD_PREFIX (decl) || DECL_NEW_PREFIX (decl))
+    {
+      APPEND (result, "(");
+      if (DECL_OLD_PREFIX (decl))
+	APPEND (result, IDENTIFIER_POINTER (DECL_OLD_PREFIX (decl)));
+      APPEND (result, "->");
+      if (DECL_NEW_PREFIX (decl))
+ 	APPEND (result, IDENTIFIER_POINTER (DECL_NEW_PREFIX (decl)));
+      APPEND (result, ")!");
+    }
+  if (DECL_POSTFIX_ALL (decl))
+    APPEND (result, "ALL");
+  else
+    APPEND (result, IDENTIFIER_POINTER  (DECL_POSTFIX (decl)));
+  return result;
+}
+
+static MYSTRING *
+decode_decl (decl)
+    tree decl;
+{
+  MYSTRING *result = newstring ("");
+  MYSTRING *mode_string;
+  tree      type;
+  
+  switch ((enum chill_tree_code)TREE_CODE (decl))
+    {
+    case VAR_DECL:
+    case BASED_DECL:
+      APPEND (result, "DCL ");
+      APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
+      APPEND (result, " ");
+      mode_string = get_type (TREE_TYPE (decl));
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      if ((enum chill_tree_code)TREE_CODE (decl) == BASED_DECL)
+        {
+          APPEND (result, " BASED (");
+          APPEND (result, IDENTIFIER_POINTER (DECL_ABSTRACT_ORIGIN (decl)));
+          APPEND (result, ")");
+        }
+      break;
+
+    case TYPE_DECL:
+      if (CH_DECL_SIGNAL (decl))
+	{
+	  /* this is really a signal */
+	  tree fields = TYPE_FIELDS (TREE_TYPE (decl));
+	  tree signame = DECL_NAME (decl);
+	  tree sigdest;
+	  
+	  APPEND (result, "SIGNAL ");
+	  APPEND (result, IDENTIFIER_POINTER (signame));
+	  if (IDENTIFIER_SIGNAL_DATA (signame))
+	    {
+	      APPEND (result, " = (");
+	      for ( ; fields != NULL_TREE;
+		   fields = TREE_CHAIN (fields))
+		{
+		  MYSTRING *mode_string;
+		  
+		  mode_string = get_type (TREE_TYPE (fields));
+		  APPEND (result, mode_string->str);
+		  FREE (mode_string);
+		  if (TREE_CHAIN (fields) != NULL_TREE)
+		    APPEND (result, ", ");
+		}
+	      APPEND (result, ")");
+	    }
+	  sigdest = IDENTIFIER_SIGNAL_DEST (signame);
+	  if (sigdest != NULL_TREE)
+	    {
+	      APPEND (result, " TO ");
+	      APPEND (result, IDENTIFIER_POINTER (DECL_NAME (sigdest)));
+	    }
+	}
+      else
+	{
+	  /* avoid defining a mode as itself */
+	  if (CH_NOVELTY (TREE_TYPE (decl)) == decl)
+	    APPEND (result, "NEWMODE ");
+	  else
+	    APPEND (result, "SYNMODE ");
+	  APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
+	  APPEND (result, " = ");
+	  mode_string = decode_mode (TREE_TYPE (decl));
+	  APPEND (result, mode_string->str);
+	  FREE (mode_string);
+	}
+      break;
+      
+    case FUNCTION_DECL:
+      {
+	tree	args;
+	
+	type = TREE_TYPE (decl);
+	args = TYPE_ARG_TYPES (type);
+	
+	APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
+	
+	if (CH_DECL_PROCESS (decl))
+	  APPEND (result, ": PROCESS (");
+	else
+	  APPEND (result, ": PROC (");
+
+	args = TYPE_ARG_TYPES (type);
+	
+	mode_string = print_proc_tail (type, args, 1);
+	APPEND (result, mode_string->str);
+	FREE (mode_string);
+	
+	/* generality */
+	if (CH_DECL_GENERAL (decl))
+	  APPEND (result, " GENERAL");
+	if (CH_DECL_SIMPLE (decl))
+	  APPEND (result, " SIMPLE");
+	if (DECL_INLINE (decl))
+	  APPEND (result, " INLINE");
+	if (CH_DECL_RECURSIVE (decl))
+	  APPEND (result, " RECURSIVE");
+	APPEND (result, " END");
+      }
+      break;
+      
+    case FIELD_DECL:
+      APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
+      APPEND (result, " ");
+      mode_string = get_type (TREE_TYPE (decl));
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      if (DECL_INITIAL (decl) != NULL_TREE)
+	{
+	  mode_string = decode_layout (DECL_INITIAL (decl));
+	  APPEND (result, mode_string->str);
+	  FREE (mode_string);
+	}
+#if 0
+      if (is_forbidden (DECL_NAME (decl), forbid))
+	APPEND (result, " FORBID");
+#endif
+      break;
+      
+    case CONST_DECL:
+      if (DECL_INITIAL (decl) == NULL_TREE 
+	  || TREE_CODE (DECL_INITIAL (decl)) == ERROR_MARK)
+	break;
+      APPEND (result, "SYN ");
+      APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
+      APPEND (result, " ");
+      mode_string = get_type (TREE_TYPE (decl));
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      APPEND (result, " = ");
+      mode_string = decode_constant (DECL_INITIAL (decl));
+      APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+      
+    case ALIAS_DECL:
+      /* If CH_DECL_GRANTED, decl was granted into this scope, and
+	 so wasn't in the source code. */
+      if (!CH_DECL_GRANTED (decl))
+	{
+	  static int restricted = 0;
+	    
+	  if (DECL_SEIZEFILE (decl) != use_seizefile_name
+	      && DECL_SEIZEFILE (decl))
+	    {
+	      use_seizefile_name = DECL_SEIZEFILE (decl);
+	      restricted = use_seizefile_name == NULL_TREE ? 0 : CH_USE_SEIZEFILE_RESTRICTED (use_seizefile_name);
+	      if (! restricted)
+	        grant_use_seizefile (IDENTIFIER_POINTER (use_seizefile_name));
+	      mark_use_seizefile_written (use_seizefile_name);
+	    }
+	  if (! restricted)
+	    {
+	      APPEND (result, "SEIZE ");
+	      mode_string = decode_prefix_rename (decl);
+	      APPEND (result, mode_string->str);
+	      FREE (mode_string);
+	    }
+	}
+      break;
+
+    default:
+      APPEND (result, "----- not implemented ------");
+      break;
+    }
+  return (result);
+}
+
+static MYSTRING *
+decode_decl_selective (decl, all_decls)
+    tree decl;
+    tree all_decls;
+{
+  MYSTRING *result = newstring ("");
+  MYSTRING *mode_string;
+  tree      type;
+
+  if (CH_ALREADY_GRANTED (decl))
+    /* do nothing */
+    return result;
+
+  CH_ALREADY_GRANTED (decl) = 1;
+
+  switch ((enum chill_tree_code)TREE_CODE (decl))
+    {
+    case VAR_DECL:
+    case BASED_DECL:
+      mode_string = get_type_selective (TREE_TYPE (decl), all_decls);
+      if (mode_string->len)
+	APPEND (result, mode_string->str);
+      FREE (mode_string);
+      if ((enum chill_tree_code)TREE_CODE (decl) == BASED_DECL)
+        {
+	  mode_string = decode_mode_selective (DECL_ABSTRACT_ORIGIN (decl), all_decls);
+	  if (mode_string->len)
+	    PREPEND (result, mode_string->str);
+	  FREE (mode_string);
+        }
+      break;
+
+    case TYPE_DECL:
+      if (CH_DECL_SIGNAL (decl))
+	{
+	  /* this is really a signal */
+	  tree fields = TYPE_FIELDS (TREE_TYPE (decl));
+	  tree signame = DECL_NAME (decl);
+	  tree sigdest;
+	  
+	  if (IDENTIFIER_SIGNAL_DATA (signame))
+	    {
+	      for ( ; fields != NULL_TREE;
+		   fields = TREE_CHAIN (fields))
+		{
+		  MYSTRING *mode_string;
+		  
+		  mode_string = get_type_selective (TREE_TYPE (fields),
+						    all_decls);
+		  if (mode_string->len)
+		    APPEND (result, mode_string->str);
+		  FREE (mode_string);
+		}
+	    }
+	  sigdest = IDENTIFIER_SIGNAL_DEST (signame);
+	  if (sigdest != NULL_TREE)
+	    {
+	      mode_string = decode_mode_selective (DECL_NAME (sigdest), all_decls);
+	      if (mode_string->len)
+		{
+		  MAYBE_NEWLINE (result);
+		  APPEND (result, mode_string->str);
+		}
+	      FREE (mode_string);
+	    }
+	}
+      else
+	{
+	  /* avoid defining a mode as itself */
+	  mode_string = decode_mode_selective (TREE_TYPE (decl), all_decls);
+	  APPEND (result, mode_string->str);
+	  FREE (mode_string);
+	}
+      break;
+      
+    case FUNCTION_DECL:
+      {
+	tree	args;
+	
+	type = TREE_TYPE (decl);
+	args = TYPE_ARG_TYPES (type);
+	
+	args = TYPE_ARG_TYPES (type);
+	
+	mode_string = print_proc_tail_selective (type, args, all_decls);
+	if (mode_string->len)
+	  APPEND (result, mode_string->str);
+	FREE (mode_string);
+      }
+      break;
+      
+    case FIELD_DECL:
+      mode_string = get_type_selective (TREE_TYPE (decl), all_decls);
+      if (mode_string->len)
+	APPEND (result, mode_string->str);
+      FREE (mode_string);
+      break;
+      
+    case CONST_DECL:
+      if (DECL_INITIAL (decl) == NULL_TREE 
+	  || TREE_CODE (DECL_INITIAL (decl)) == ERROR_MARK)
+	break;
+      mode_string = get_type_selective (TREE_TYPE (decl), all_decls);
+      if (mode_string->len)
+	APPEND (result, mode_string->str);
+      FREE (mode_string);
+      mode_string = decode_constant_selective (DECL_INITIAL (decl), all_decls);
+      if (mode_string->len)
+	{
+	  MAYBE_NEWLINE (result);
+	  APPEND (result, mode_string->str);
+	}
+      FREE (mode_string);
+      break;
+      
+    }
+  MAYBE_NEWLINE (result);
+  return (result);
+}
+
+static void
+globalize_decl (decl)
+    tree	decl;
+{
+  if (!TREE_PUBLIC (decl) && DECL_NAME (decl) &&
+      (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL))
+    {
+      extern	FILE	*asm_out_file;
+      extern	char	*first_global_object_name;
+      char		*name = XSTR (XEXP (DECL_RTL (decl), 0), 0);
+	
+      if (!first_global_object_name)
+	first_global_object_name = name + (name[0] == '*');
+      ASM_GLOBALIZE_LABEL (asm_out_file, name);
+    }
+}
+
+
+static void
+grant_one_decl (decl)
+    tree	decl;
+{
+  MYSTRING	*result;
+
+  if (DECL_SOURCE_LINE (decl) == 0)
+    return;
+  result = decode_decl (decl);
+  if (result->len)
+    {
+      APPEND (result, ";\n");
+      APPEND (gstring, result->str);
+    }
+  FREE (result);
+}
+
+static void
+grant_one_decl_selective (decl, all_decls)
+     tree decl;
+     tree all_decls;
+{
+  MYSTRING *result;
+  MYSTRING *fixups;
+
+  tree     d = DECL_ABSTRACT_ORIGIN (decl);
+
+  if (CH_ALREADY_GRANTED (d))
+    /* already done */
+    return;
+
+  result = decode_decl (d);
+  if (!result->len)
+    {
+      /* nothing to do */
+      FREE (result);
+      return;
+    }
+
+  APPEND (result, ";\n");
+
+  /* now process all undefined items in the decl */
+  fixups = decode_decl_selective (d, all_decls);
+  if (fixups->len)
+    {
+      PREPEND (result, fixups->str);
+    }
+  FREE (fixups);
+
+  /* we have finished a decl */
+  APPEND (selective_gstring, result->str);
+  FREE (result);
+}
+
+static int
+compare_memory_file (fname, buf)
+    char	*fname;
+    char	*buf;
+{
+  FILE	*fb;
+  int		c;
+
+  /* check if we have something to write */
+  if (!buf || !strlen (buf))
+    return (0);
+    
+  if ((fb = fopen (fname, "r")) == NULL)
+    return (1);
+    
+  while ((c = getc (fb)) != EOF)
+    {
+      if (c != *buf++)
+	{
+	  fclose (fb);
+	  return (1);
+	}
+    }
+  fclose (fb);
+  return (*buf ? 1 : 0);
+}
+
+void
+write_grant_file ()
+{
+  FILE	*fb;
+
+  /* We only write out the grant file if it has changed,
+     to avoid changing its time-stamp and triggering an
+     unnecessary 'make' action.  Return if no change. */
+  if (gstring == NULL || !spec_module_generated ||
+      !compare_memory_file (grant_file_name, gstring->str))
+    return;
+
+  fb = fopen (grant_file_name, "w");
+  if (fb == NULL)
+      pfatal_with_name (grant_file_name);
+    
+  /* write file. Due to problems with record sizes on VAX/VMS
+     write string to '\n' */
+#ifdef VMS
+  /* do it this way for VMS, cause of problems with
+     record sizes */
+  p = gstring->str;
+  while (*p)
+    {
+      extern char* strchr ();
+      p1 = strchr (p, '\n');
+      c = *++p1;
+      *p1 = '\0';
+      fprintf (fb, "%s", p);
+      *p1 = c;
+      p = p1;
+    }
+#else
+  /* faster way to write */
+  if (write (fileno (fb), gstring->str, gstring->len) < 0)
+    {
+      int save_errno = errno;
+      unlink (grant_file_name);
+      errno = save_errno;
+      pfatal_with_name (grant_file_name);
+    }
+#endif
+  fclose (fb);
+}
+
+
+/* handle grant statement */
+
+void
+set_default_grant_file ()
+{
+#undef strrchr
+    extern	char *strrchr ();
+    char	*p, *tmp, *fname;
+
+    if (dump_base_name)
+      fname = dump_base_name; /* Probably invoked via gcc */
+    else
+      { /* Probably invoked directly (not via gcc) */
+	fname = asm_file_name;
+	if (!fname)
+	  fname = main_input_filename ? main_input_filename : input_filename;
+	if (!fname)
+	  return;
+      }
+
+    p = strrchr (fname, '.');
+    if (!p)
+    {
+	tmp = (char *) alloca (strlen (fname) + 10);
+	strcpy (tmp, fname);
+    }
+    else
+    {
+	int	i = p - fname;
+	
+	tmp = (char *) alloca (i + 10);
+	strncpy (tmp, fname, i);
+	tmp[i] = '\0';
+    }
+    strcat (tmp, ".grt");
+    default_grant_file = build_string (strlen (tmp), tmp);
+
+    grant_file_name = TREE_STRING_POINTER (default_grant_file);
+
+    if (gstring == NULL)
+      gstring = newstring ("");
+    if (selective_gstring == NULL)
+      selective_gstring = newstring ("");
+}
+
+/* Make DECL visible under the name NAME in the (fake) outermost scope. */
+
+void
+push_granted (name, decl)
+     tree name, decl;
+{
+#if 0
+  IDENTIFIER_GRANTED_VALUE (name) = decl;
+  granted_decls = tree_cons (name, decl, granted_decls);
+#endif
+}
+
+void
+chill_grant (old_prefix, new_prefix, postfix, forbid)
+     tree old_prefix;
+     tree new_prefix;
+     tree postfix;
+     tree forbid;
+{
+  if (pass == 1)
+    {
+#if 0
+      tree old_name = old_prefix == NULL_TREE ? postfix
+	: get_identifier3 (IDENTIFIER_POINTER (old_prefix),
+			   "!", IDENTIFIER_POINTER (postfix));
+      tree new_name = new_prefix == NULL_TREE ? postfix
+	: get_identifier3 (IDENTIFIER_POINTER (new_prefix),
+			   "!", IDENTIFIER_POINTER (postfix));
+#endif
+      tree alias = build_alias_decl (old_prefix, new_prefix, postfix);
+      CH_DECL_GRANTED (alias) = 1;
+      DECL_SEIZEFILE (alias) = current_seizefile_name;
+      TREE_CHAIN (alias) = current_module->granted_decls;
+      current_module->granted_decls = alias;
+
+      if (forbid)
+	warning ("FORBID is not yet implemented");  /* FIXME */
+    }
+}
+
+/* flag GRANT ALL only once. Avoids search in case of GRANT ALL. */
+static int grant_all_seen = 0;
+
+/* check if a decl is in the list of granted decls. */
+static int
+search_in_list (name, granted_decls)
+    tree name;
+    tree granted_decls;
+{
+  tree vars;
+  
+  for (vars = granted_decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
+    if (DECL_SOURCE_LINE (vars))
+      {
+	if (DECL_POSTFIX_ALL (vars))
+	  {
+	    grant_all_seen = 1;
+	    return 1;
+	  }
+	else if (name == DECL_NAME (vars))
+	  return 1;
+      }
+  /* not found */
+  return 0;
+}
+
+static int
+really_grant_this (decl, granted_decls)
+    tree decl;
+    tree granted_decls;
+{
+  /* we never grant labels at module level */
+  if ((enum chill_tree_code)TREE_CODE (decl) == LABEL_DECL)
+    return 0;
+
+  if (grant_all_seen)
+    return 1;
+    
+  switch ((enum chill_tree_code)TREE_CODE (decl))
+    {
+    case VAR_DECL:
+    case BASED_DECL:
+    case FUNCTION_DECL:
+      return search_in_list (DECL_NAME (decl), granted_decls);
+    case ALIAS_DECL:
+    case CONST_DECL:
+      return 1;
+    case TYPE_DECL:
+      if (CH_DECL_SIGNAL (decl))
+	return search_in_list (DECL_NAME (decl), granted_decls);
+      else
+	return 1;
+    }
+
+  /* this nerver should happen */
+  error_with_decl (decl, "function \"really_grant_this\" called for `%s'.");
+  return 1;
+}
+
+/* Write a SPEC MODULE using the declarations in the list DECLS. */
+static int header_written = 0;
+static char *header_template =
+"--\n-- WARNING: this file was generated by\n\
+-- GNUCHILL version %s\n-- based on gcc version %s\n--\n";
+
+void
+write_spec_module (decls, granted_decls)
+     tree decls;
+     tree granted_decls;
+{
+  tree	 vars;
+  char   *hdr;
+
+  if (granted_decls == NULL_TREE)
+    return;
+  
+  use_seizefile_name = NULL_TREE;
+
+  if (!header_written)
+    {
+      hdr = (char*) alloca (strlen (gnuchill_version)
+			    + strlen (version_string)
+			    + strlen (header_template) + 1);
+      sprintf (hdr, header_template, gnuchill_version, version_string);
+      APPEND (gstring, hdr);
+      header_written = 1;
+    }      
+  APPEND (gstring, IDENTIFIER_POINTER (current_module->name));
+  APPEND (gstring, ": SPEC MODULE\n");
+
+  /* first of all we look for GRANT ALL specified */
+  search_in_list (NULL_TREE, granted_decls);
+
+  if (grant_all_seen != 0)
+    {
+      /* write all identifiers to grant file */
+      for (vars = decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
+	{
+	  if (DECL_SOURCE_LINE (vars))
+	    {
+	      if (DECL_NAME (vars))
+		{
+		  if ((TREE_CODE (vars) != CONST_DECL || !CH_DECL_ENUM (vars)) &&
+		      really_grant_this (vars, granted_decls))
+		    grant_one_decl (vars);
+		}
+	      else if (DECL_POSTFIX_ALL (vars))
+		{
+		  static int restricted = 0;
+		
+		  if (DECL_SEIZEFILE (vars) != use_seizefile_name
+		      && DECL_SEIZEFILE (vars))
+		    {
+		      use_seizefile_name = DECL_SEIZEFILE (vars);
+		      restricted = use_seizefile_name == NULL_TREE ? 0 : CH_USE_SEIZEFILE_RESTRICTED (use_seizefile_name);
+		      if (! restricted)
+			grant_use_seizefile (IDENTIFIER_POINTER (use_seizefile_name));
+		      mark_use_seizefile_written (use_seizefile_name);
+		    }
+		  if (! restricted)
+		    {
+		      APPEND (gstring, "SEIZE ALL;\n");
+		    }
+		}
+	    }
+	}
+    }
+  else
+    {
+      seizefile_list *wrk, *x;
+
+      /* do a selective write to the grantfile. This will reduce the
+	 size of a grantfile and speed up compilation of 
+	 modules depending on this grant file */
+
+      if (selective_gstring == 0)
+	selective_gstring = newstring ("");
+
+      /* first of all process all SEIZE ALL's */
+      for (vars = decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
+	{
+	  if (DECL_SOURCE_LINE (vars)
+	      && DECL_POSTFIX_ALL (vars))
+	    grant_seized_identifier (vars);
+	}
+
+      /* now walk through granted decls */
+      granted_decls = nreverse (granted_decls);
+      for (vars = granted_decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
+	{
+	  grant_one_decl_selective (vars, decls);
+	}
+      granted_decls = nreverse (granted_decls);
+
+      /* append all SEIZES */
+      wrk = selective_seizes;
+      while (wrk != 0)
+	{
+	  x = wrk->next;
+	  APPEND (gstring, wrk->seizes->str);
+	  FREE (wrk->seizes);
+	  free (wrk);
+	  wrk = x;
+	}
+      selective_seizes = 0;
+      
+      /* append generated string to grant file */
+      APPEND (gstring, selective_gstring->str);
+      FREE (selective_gstring);
+      selective_gstring = NULL;
+    }
+
+  for (vars = granted_decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
+    if (DECL_SOURCE_LINE (vars))
+      {
+	MYSTRING *mode_string = decode_prefix_rename (vars);
+	APPEND (gstring, "GRANT ");
+	APPEND (gstring, mode_string->str);
+	FREE (mode_string);
+	APPEND (gstring, ";\n");
+      }
+
+  APPEND (gstring, "END;\n");
+  spec_module_generated = 1;
+
+  /* initialize this for next spec module */
+  grant_all_seen = 0;
+}
+
+/*
+ * after the dark comes, after all of the modules are at rest,
+ * we tuck the compilation unit to bed...  A story in pass 1
+ * and a hug-and-a-kiss goodnight in pass 2.
+ */
+void
+chill_finish_compile ()
+{
+  tree global_list;
+  tree chill_init_function;
+
+  tasking_setup ();
+  build_enum_tables ();
+  
+  /* We only need an initializer function for the source file if
+     a) there's module-level code to be called, or
+     b) tasking-related stuff to be initialized. */
+  if (module_init_list != NULL_TREE || tasking_list != NULL_TREE)
+    {
+      extern tree initializer_type;
+      static tree chill_init_name;
+
+      /* declare the global initializer list */
+      global_list = do_decl (get_identifier ("_ch_init_list"),
+			     build_chill_pointer_type (initializer_type), 1, 0,
+			     NULL_TREE, 1);
+
+      /* Now, we're building the function which is the *real*
+	 constructor - if there's any module-level code in this
+	 source file, the compiler puts the file's initializer entry
+	 onto the global initializer list, so each module's body code
+	 will eventually get called, after all of the processes have
+	 been started up.  */
+      
+      /* This is better done in pass 2 (when first_global_object_name
+	 may have been set), but that is too late.
+	 Perhaps rewrite this so nothing is done in pass 1. */
+      if (pass == 1)
+	{
+	  extern char *first_global_object_name;
+	  /* If we don't do this spoof, we get the name of the first
+	     tasking_code variable, and not the file name. */
+	  char *tmp = first_global_object_name;
+
+	  first_global_object_name = NULL;
+	  chill_init_name = get_file_function_name ('I');
+	  first_global_object_name = tmp;
+	  /* strip off the file's extension, if any. */
+	  tmp = strrchr (IDENTIFIER_POINTER (chill_init_name), '.');
+	  if (tmp)
+	    *tmp = '\0';
+	}
+
+      start_chill_function (chill_init_name, void_type_node, NULL_TREE,
+			    NULL_TREE, NULL_TREE);
+      TREE_PUBLIC (current_function_decl) = 1;
+      chill_init_function = current_function_decl;
+      
+      /* For each module that we've compiled, that had module-level 
+	 code to be called, add its entry to the global initializer
+	 list. */
+	 
+      if (pass == 2)
+	{
+	  tree module_init;
+
+	  for (module_init = module_init_list;  
+	       module_init != NULL_TREE;
+	       module_init = TREE_CHAIN (module_init))
+	    {
+	      tree init_entry      = TREE_VALUE (module_init);
+
+	      /* assign module_entry.next := _ch_init_list; */
+	      expand_expr_stmt (
+		build_chill_modify_expr (
+		  build_component_ref (init_entry,
+		    get_identifier ("__INIT_NEXT")),
+		      global_list));
+
+	      /* assign _ch_init_list := &module_entry; */
+	      expand_expr_stmt (
+		build_chill_modify_expr (global_list,
+		  build1 (ADDR_EXPR, ptr_type_node, init_entry)));
+	    }
+	}
+
+      tasking_registry ();
+
+      make_decl_rtl (current_function_decl, NULL, 1);
+
+      finish_chill_function ();
+
+      if (pass == 2)
+	{
+	  assemble_constructor (IDENTIFIER_POINTER (chill_init_name));
+	  globalize_decl (chill_init_function);
+	}
+
+      /* ready now to link decls onto this list in pass 2. */
+      module_init_list = NULL_TREE;
+      tasking_list = NULL_TREE;
+    }
+}
+
+
diff --git a/gcc/ch/inout.c b/gcc/ch/inout.c
new file mode 100644
index 0000000..2d2293b
--- /dev/null
+++ b/gcc/ch/inout.c
@@ -0,0 +1,4675 @@
+/* Implement I/O-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 <string.h>
+#include <limits.h>
+#include "config.h"
+#include "tree.h"
+#include "ch-tree.h"
+#include "rtl.h"
+#include "lex.h"
+#include "flags.h"
+#include "input.h"
+#include "assert.h"
+
+/* 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;
+
+extern void error   PROTO((char *, ...));
+extern void sorry   PROTO((char *, ...));
+extern void warning PROTO((char *, ...));
+
+extern tree build_chill_compound_expr PROTO((tree));
+
+static int intsize_of_charsexpr PROTO((tree));
+
+/* association mode */
+tree association_type_node;
+/* initialzier for association mode */
+tree association_init_value;
+
+/* NOTE: should be same as in runtime/chillrt0.c */
+#define STDIO_TEXT_LENGTH    1024
+/* mode of stdout, stdin, stderr*/
+static tree stdio_type_node;
+
+/* usage- and where modes */
+tree usage_type_node;
+tree where_type_node;
+
+/* we have to distinguish between io-list-type for WRITETEXT
+   and for READTEXT. WRITETEXT does not process ranges and
+   READTEXT must get pointers to the variables.
+   */
+/* variable to hold the type of the io_list */
+static tree chill_io_list_type = NULL_TREE;
+
+/* the type for the enum tables */
+static tree enum_table_type = NULL_TREE;
+
+/* structure to save enums for later use in compilation */
+typedef struct save_enum_names
+{
+  struct save_enum_names  *forward;
+  tree			  name;
+  tree			  decl;
+} SAVE_ENUM_NAMES;
+
+static SAVE_ENUM_NAMES *used_enum_names = (SAVE_ENUM_NAMES *)0;
+
+typedef struct save_enum_values
+{
+  long		 	  val;
+  struct save_enum_names  *name;
+} SAVE_ENUM_VALUES;
+
+typedef struct save_enums
+{
+  struct save_enums       *forward;
+  tree		          context;
+  tree		          type;
+  tree		          ptrdecl;
+  long		          num_vals;
+  struct save_enum_values *vals;
+} SAVE_ENUMS;
+
+static SAVE_ENUMS	*used_enums = (SAVE_ENUMS *)0;
+
+
+/* Function collects all enums are necessary to collect, makes a copy of
+   the value and returns a VAR_DECL external to current function describing
+   the pointer to a name table, which will be generated at the end of
+   compilation
+   */
+
+static tree add_enum_to_list (type, context)
+     tree  type;
+     tree  context;
+{
+  tree		tmp;
+  SAVE_ENUMS		*wrk = used_enums;
+  SAVE_ENUM_VALUES	*vals;
+  SAVE_ENUM_NAMES	*names;
+    
+  while (wrk != (SAVE_ENUMS *)0)
+    {
+      /* search for this enum already in use */
+      if (wrk->context == context && wrk->type == type)
+	{
+	  /* yes, found. look if the ptrdecl is valid in this scope */
+	  char  *name = IDENTIFIER_POINTER (DECL_NAME (wrk->ptrdecl));
+	  tree   var  = get_identifier (name);
+	  tree   decl = lookup_name (var);
+	    
+	  if (decl == NULL_TREE)
+	    {
+	      /* no, not valid in this context, declare it */
+	      decl = decl_temp1 (var, build_pointer_type (TREE_TYPE (enum_table_type)),
+				 0, NULL_TREE, 1, 0);
+	    }
+	  return decl;
+	}
+	
+      /* next one */
+      wrk = wrk->forward;
+    }
+    
+  /* not yet found -- generate an entry */
+  wrk = (SAVE_ENUMS *)xmalloc (sizeof (SAVE_ENUMS));
+  wrk->forward = used_enums;
+  used_enums = wrk;
+    
+  /* generate the pointer decl */
+  wrk->ptrdecl = get_unique_identifier ("ENUMTABPTR");
+  wrk->ptrdecl = decl_temp1 (wrk->ptrdecl, build_pointer_type (TREE_TYPE (enum_table_type)),
+			     0, NULL_TREE, 1, 0);
+
+  /* save information for later use */
+  wrk->context = context;
+  wrk->type = type;
+
+  /* insert the names and values */
+  tmp = TYPE_FIELDS (type);
+  wrk->num_vals = list_length (tmp);
+  vals = (SAVE_ENUM_VALUES *)xmalloc (sizeof (SAVE_ENUM_VALUES) * wrk->num_vals);
+  wrk->vals = vals;
+    
+  while (tmp != NULL_TREE)
+    {
+      /* search if name is already in use */
+      names = used_enum_names;
+      while (names != (SAVE_ENUM_NAMES *)0)
+	{
+	  if (names->name == TREE_PURPOSE (tmp))
+	    break;
+	  names = names->forward;
+	}
+      if (names == (SAVE_ENUM_NAMES *)0)
+	{
+	  /* we have to insert one */
+	  names = (SAVE_ENUM_NAMES *)xmalloc (sizeof (SAVE_ENUM_NAMES));
+	  names->forward = used_enum_names;
+	  used_enum_names = names;
+	  names->decl = NULL_TREE;
+	  names->name = TREE_PURPOSE (tmp);
+	}
+      vals->name = names;
+      vals->val = TREE_INT_CST_LOW (TREE_VALUE (tmp));
+	
+      /* next entry in enum */
+      vals++;
+      tmp = TREE_CHAIN (tmp);
+    }
+    
+  /* return the generated decl */
+  return wrk->ptrdecl;
+}
+
+
+static void
+build_chill_io_list_type ()
+{
+  tree list = NULL_TREE;
+  tree result, enum1, listbase;
+  tree io_descriptor;
+  tree decl1, decl2;
+  tree forcharstring, forset_W, forset_R, forboolrange;
+
+  tree forintrange, intunion, forsetrange, forcharrange;
+  tree long_type, ulong_type, union_type;
+    
+  long_type = long_integer_type_node;
+  ulong_type = long_unsigned_type_node;
+
+  if (chill_io_list_type != NULL_TREE)
+    /* already done */
+    return;
+
+  /* first build the enum for the desriptor */
+  enum1 = start_enum (NULL_TREE);
+  result = build_enumerator (get_identifier ("__IO_UNUSED"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_ByteVal"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_UByteVal"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_IntVal"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_UIntVal"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_LongVal"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_ULongVal"),
+			     NULL_TREE);
+  list = chainon (result, list);
+
+  result = build_enumerator (get_identifier ("__IO_ByteLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_UByteLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_IntLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_UIntLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_LongLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_ULongLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+
+  result = build_enumerator (get_identifier ("__IO_ByteRangeLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_UByteRangeLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_IntRangeLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_UIntRangeLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_LongRangeLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_ULongRangeLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+
+  result = build_enumerator (get_identifier ("__IO_BoolVal"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_BoolLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_BoolRangeLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+
+  result = build_enumerator (get_identifier ("__IO_SetVal"),
+			     NULL_TREE);
+  list = chainon (result, list);
+
+  result = build_enumerator (get_identifier ("__IO_SetLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+
+  result = build_enumerator (get_identifier ("__IO_SetRangeLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+
+  result = build_enumerator (get_identifier ("__IO_CharVal"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_CharLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_CharRangeLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_CharStrLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_CharVaryingLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_BitStrLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+
+  result = build_enumerator (get_identifier ("__IO_RealVal"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_RealLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_LongRealVal"),
+			     NULL_TREE);
+  list = chainon (result, list);
+    
+  result = build_enumerator (get_identifier ("__IO_LongRealLoc"),
+			     NULL_TREE);
+  list = chainon (result, list);
+#if 0    
+  result = build_enumerator (get_identifier ("_IO_Pointer"),
+			     NULL_TREE);
+  list = chainon (result, list);
+#endif    
+
+  result = finish_enum (enum1, list);
+  pushdecl (io_descriptor = build_decl (TYPE_DECL,
+					get_identifier ("__tmp_IO_enum"),
+					result));
+  /* prevent seizing/granting of the decl */
+  DECL_SOURCE_LINE (io_descriptor) = 0;
+  satisfy_decl (io_descriptor, 0);
+
+  /* build type for enum_tables */
+  decl1 = build_decl (FIELD_DECL, get_identifier ("value"),
+		      long_type);
+  DECL_INITIAL (decl1) = NULL_TREE;
+  decl2 = build_decl (FIELD_DECL, get_identifier ("name"),
+		      build_pointer_type (char_type_node));
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+  result = build_chill_struct_type (decl1);
+  pushdecl (enum_table_type = build_decl (TYPE_DECL,
+					  get_identifier ("__tmp_IO_enum_table_type"),
+					  result));
+  DECL_SOURCE_LINE (enum_table_type) = 0;
+  satisfy_decl (enum_table_type, 0);
+
+  /* build type for writing a set mode */
+  decl1 = build_decl (FIELD_DECL, get_identifier ("value"),
+		      long_type);
+  DECL_INITIAL (decl1) = NULL_TREE;
+  listbase = decl1;
+    
+  decl2 = build_decl (FIELD_DECL, get_identifier ("name_table"),
+		      build_pointer_type (TREE_TYPE (enum_table_type)));
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+    
+  result = build_chill_struct_type (listbase);
+  pushdecl (forset_W = build_decl (TYPE_DECL,
+				   get_identifier ("__tmp_WIO_set"),
+				   result));
+  DECL_SOURCE_LINE (forset_W) = 0;
+  satisfy_decl (forset_W, 0);
+
+  /* build type for charrange */
+  decl1 = build_decl (FIELD_DECL, get_identifier ("ptr"),
+		      build_pointer_type (char_type_node));
+  DECL_INITIAL (decl1) = NULL_TREE;
+  listbase = decl1;
+    
+  decl2 = build_decl (FIELD_DECL, get_identifier ("lower"),
+		      long_type);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+    
+  decl2 = build_decl (FIELD_DECL, get_identifier ("upper"),
+		      long_type);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+    
+  result = build_chill_struct_type (listbase);
+  pushdecl (forcharrange = build_decl (TYPE_DECL,
+				       get_identifier ("__tmp_IO_charrange"),
+				       result));
+  DECL_SOURCE_LINE (forcharrange) = 0;
+  satisfy_decl (forcharrange, 0);
+    
+  /* type for integer range */
+  decl1 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("_slong"),
+				       long_type));
+  listbase = decl1;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("_ulong"),
+				       ulong_type));
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+
+  decl1 = grok_chill_variantdefs (NULL_TREE, listbase, NULL_TREE);
+  TREE_CHAIN (decl1) = NULL_TREE;
+  result = build_chill_struct_type (decl1);
+  pushdecl (intunion = build_decl (TYPE_DECL,
+				   get_identifier ("__tmp_IO_long"),
+				   result));
+  DECL_SOURCE_LINE (intunion) = 0;
+  satisfy_decl (intunion, 0);
+
+  decl1 = build_decl (FIELD_DECL,
+		      get_identifier ("ptr"),
+		      ptr_type_node);
+  listbase = decl1;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("lower"),
+		      TREE_TYPE (intunion));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("upper"),
+		      TREE_TYPE (intunion));
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+
+  result = build_chill_struct_type (listbase);
+  pushdecl (forintrange = build_decl (TYPE_DECL,
+				      get_identifier ("__tmp_IO_intrange"),
+				      result));
+  DECL_SOURCE_LINE (forintrange) = 0;
+  satisfy_decl (forintrange, 0);
+
+  /* build structure for bool range */
+  decl1 = build_decl (FIELD_DECL,
+		      get_identifier ("ptr"),
+		      ptr_type_node);
+  DECL_INITIAL (decl1) = NULL_TREE;
+  listbase = decl1;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("lower"),
+		      ulong_type);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("upper"),
+		      ulong_type);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+
+  result = build_chill_struct_type (listbase);
+  pushdecl (forboolrange = build_decl (TYPE_DECL,
+				       get_identifier ("__tmp_RIO_boolrange"),
+				       result));
+  DECL_SOURCE_LINE (forboolrange) = 0;
+  satisfy_decl (forboolrange, 0);
+
+  /* build type for reading a set */
+  decl1 = build_decl (FIELD_DECL, get_identifier ("ptr"),
+		      ptr_type_node);
+  DECL_INITIAL (decl1) = NULL_TREE;
+  listbase = decl1;
+    
+  decl2 = build_decl (FIELD_DECL, get_identifier ("length"),
+		      long_type);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL, get_identifier ("name_table"),
+		      build_pointer_type (TREE_TYPE (enum_table_type)));
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+    
+  result = build_chill_struct_type (listbase);
+  pushdecl (forset_R = build_decl (TYPE_DECL,
+				   get_identifier ("__tmp_RIO_set"),
+				   result));
+  DECL_SOURCE_LINE (forset_R) = 0;
+  satisfy_decl (forset_R, 0);
+    
+  /* build type for setrange */
+  decl1 = build_decl (FIELD_DECL, get_identifier ("ptr"),
+		      ptr_type_node);
+  DECL_INITIAL (decl1) = NULL_TREE;
+  listbase = decl1;
+    
+  decl2 = build_decl (FIELD_DECL, get_identifier ("length"),
+		      long_type);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+    
+  decl2 = build_decl (FIELD_DECL, get_identifier ("name_table"),
+		      build_pointer_type (TREE_TYPE (enum_table_type)));
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+    
+  decl2 = build_decl (FIELD_DECL, get_identifier ("lower"),
+		      long_type);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+    
+  decl2 = build_decl (FIELD_DECL, get_identifier ("upper"),
+		      long_type);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+    
+  result = build_chill_struct_type (listbase);
+  pushdecl (forsetrange = build_decl (TYPE_DECL,
+				      get_identifier ("__tmp_RIO_setrange"),
+				      result));
+  DECL_SOURCE_LINE (forsetrange) = 0;
+  satisfy_decl (forsetrange, 0);
+
+  /* build structure for character string */
+  decl1 = build_decl (FIELD_DECL, 
+		      get_identifier ("string"),
+		      build_pointer_type (char_type_node));
+  DECL_INITIAL (decl1) = NULL_TREE;
+  listbase = decl1;
+    
+  decl2 = build_decl (FIELD_DECL, 
+		      get_identifier ("string_length"),
+		      ulong_type);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+    
+  result = build_chill_struct_type (listbase);
+  pushdecl (forcharstring = build_decl (TYPE_DECL,
+					get_identifier ("__tmp_IO_forcharstring"), result));
+  DECL_SOURCE_LINE (forcharstring) = 0;
+  satisfy_decl (forcharstring, 0);
+
+  /* build the union */
+  decl1 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__valbyte"),
+				       signed_char_type_node));
+  listbase = decl1;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__valubyte"),
+				       unsigned_char_type_node));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+    
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__valint"),
+				       chill_integer_type_node)); 
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+    
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__valuint"),
+				       chill_unsigned_type_node));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__vallong"),
+				       long_type));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+    
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__valulong"),
+				       ulong_type));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+    
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__locint"),
+				       ptr_type_node));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__locintrange"),
+				       TREE_TYPE (forintrange)));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__valbool"),
+				       boolean_type_node));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__locbool"),
+				       build_pointer_type (boolean_type_node)));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__locboolrange"),
+				       TREE_TYPE (forboolrange)));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__valset"),
+				       TREE_TYPE (forset_W)));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__locset"),
+				       TREE_TYPE (forset_R)));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__locsetrange"),
+				       TREE_TYPE (forsetrange)));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__valchar"),
+				       char_type_node));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+    
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__locchar"),
+				       build_pointer_type (char_type_node)));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__loccharrange"),
+				       TREE_TYPE (forcharrange)));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__loccharstring"),
+				       TREE_TYPE (forcharstring)));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__valreal"),
+				       float_type_node));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+    
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__locreal"),
+				       build_pointer_type (float_type_node)));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+    
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__vallongreal"),
+				       double_type_node));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__loclongreal"),
+				       build_pointer_type (double_type_node)));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+#if 0    
+  decl2 = build_tree_list (NULL_TREE,
+			   build_decl (FIELD_DECL,
+				       get_identifier ("__forpointer"),
+				       ptr_type_node));
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+#endif
+
+  TREE_CHAIN (decl2) = NULL_TREE;
+    
+  decl1 = grok_chill_variantdefs (NULL_TREE, listbase, NULL_TREE);
+  TREE_CHAIN (decl1) = NULL_TREE;
+  result = build_chill_struct_type (decl1);
+  pushdecl (union_type = build_decl (TYPE_DECL,
+				     get_identifier ("__tmp_WIO_union"),
+				     result));
+  DECL_SOURCE_LINE (union_type) = 0;
+  satisfy_decl (union_type, 0);
+    
+  /* now build the final structure */
+  decl1 = build_decl (FIELD_DECL, get_identifier ("__t"),
+		      TREE_TYPE (union_type));
+  DECL_INITIAL (decl1) = NULL_TREE;
+  listbase = decl1;
+
+  decl2 = build_decl (FIELD_DECL, get_identifier ("__descr"),
+		      long_type);
+    
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+    
+  result = build_chill_struct_type (listbase);
+  pushdecl (chill_io_list_type = build_decl (TYPE_DECL,
+					     get_identifier ("__tmp_IO_list"),
+					     result));
+  DECL_SOURCE_LINE (chill_io_list_type) = 0;
+  satisfy_decl (chill_io_list_type, 0);
+}
+
+/* build the ASSOCIATION, ACCESS and TEXT mode types */
+static void
+build_io_types ()
+{
+  tree listbase, decl1, decl2, result, association;
+  tree acc, txt, tloc;
+  tree enum1, tmp;
+
+  /* the association mode */
+  listbase = build_decl (FIELD_DECL,
+			 get_identifier ("flags"),
+			 long_unsigned_type_node);
+  DECL_INITIAL (listbase) = NULL_TREE;
+  decl1 = listbase;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("pathname"),
+		      ptr_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("access"),
+		      ptr_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("handle"),
+		      integer_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("bufptr"),
+		      ptr_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("syserrno"),
+		      long_integer_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("usage"),
+		      char_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("ctl_pre"),
+		      char_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("ctl_post"),
+		      char_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+
+  result = build_chill_struct_type (listbase);
+  pushdecl (association = build_decl (TYPE_DECL,
+				      ridpointers[(int)RID_ASSOCIATION],
+				      result));
+  DECL_SOURCE_LINE (association) = 0;
+  satisfy_decl (association, 0);
+  association_type_node = TREE_TYPE (association);
+  TYPE_NAME (association_type_node) = association;
+  CH_NOVELTY (association_type_node) = association;
+  CH_TYPE_NONVALUE_P(association_type_node) = 1;
+  CH_TYPE_NONVALUE_P(association) = 1;
+
+  /* initialiser for association type */
+  tmp = convert (char_type_node, integer_zero_node);
+  association_init_value =
+    build_nt (CONSTRUCTOR, NULL_TREE,
+      tree_cons (NULL_TREE, integer_zero_node,            /* flags */
+        tree_cons (NULL_TREE, null_pointer_node,          /* pathname */
+          tree_cons (NULL_TREE, null_pointer_node,        /* access */
+            tree_cons (NULL_TREE, integer_minus_one_node, /* handle */
+              tree_cons (NULL_TREE, null_pointer_node,    /* bufptr */
+                tree_cons (NULL_TREE, integer_zero_node,  /* syserrno */
+                  tree_cons (NULL_TREE, tmp,              /* usage */
+                    tree_cons (NULL_TREE, tmp,            /* ctl_pre */
+                      tree_cons (NULL_TREE, tmp,          /* ctl_post */
+				 NULL_TREE))))))))));
+
+  /* the type for stdin, stdout, stderr */
+  /* text part */
+  decl1 = build_decl (FIELD_DECL,
+		      get_identifier ("flags"),
+		      long_unsigned_type_node);
+  DECL_INITIAL (decl1) = NULL_TREE;
+  listbase = decl1;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("text_record"),
+		      ptr_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("access_sub"),
+		      ptr_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("actual_index"),
+		      long_unsigned_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+  txt = build_chill_struct_type (listbase);
+
+  /* access part */
+  decl1 = build_decl (FIELD_DECL,
+		      get_identifier ("flags"),
+		      long_unsigned_type_node);
+  DECL_INITIAL (decl1) = NULL_TREE;
+  listbase = decl1;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("reclength"),
+		      long_unsigned_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+  
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("lowindex"),
+		      long_integer_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("highindex"),
+		      long_integer_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl2 = decl1;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("association"),
+		      ptr_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("base"),
+		      long_unsigned_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("storelocptr"),
+		      ptr_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL,
+		      get_identifier ("rectype"),
+		      long_integer_type_node);
+  DECL_INITIAL (decl2) = NULL_TREE;
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+  acc = build_chill_struct_type (listbase);
+
+  /* the location */
+  tmp = build_string_type (char_type_node, build_int_2 (STDIO_TEXT_LENGTH, 0));
+  tloc = build_varying_struct (tmp);
+
+  /* now the final mode */
+  decl1 = build_decl (FIELD_DECL, get_identifier ("txt"), txt);
+  listbase = decl1;
+
+  decl2 = build_decl (FIELD_DECL, get_identifier ("acc"), acc);
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (FIELD_DECL, get_identifier ("tloc"), tloc);
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_lang_decl (TYPE_DECL, get_identifier ("__indexmode"),
+			   void_type_node);
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (CONST_DECL, get_identifier ("__textlength"),
+		      integer_type_node);
+  DECL_INITIAL (decl2) = build_int_2 (STDIO_TEXT_LENGTH, 0);
+  TREE_CHAIN (decl1) = decl2;
+  decl1 = decl2;
+
+  decl2 = build_decl (CONST_DECL, get_identifier ("__dynamic"),
+		      integer_type_node);
+  DECL_INITIAL (decl2) = integer_zero_node;
+  TREE_CHAIN (decl1) = decl2;
+  TREE_CHAIN (decl2) = NULL_TREE;
+
+  result = build_chill_struct_type (listbase);
+  pushdecl (tmp = build_decl (TYPE_DECL,
+			      get_identifier ("__stdio_text"),
+			      result));
+  DECL_SOURCE_LINE (tmp) = 0;
+  satisfy_decl (tmp, 0);
+  stdio_type_node = TREE_TYPE (tmp);
+  CH_IS_TEXT_MODE (stdio_type_node) = 1;
+
+  /* predefined usage mode */
+  enum1 = start_enum (NULL_TREE);
+  listbase = NULL_TREE;
+  result = build_enumerator (
+            get_identifier ((ignore_case || ! special_UC) ? "readonly" : "READONLY"),
+			     NULL_TREE);
+  listbase = chainon (result, listbase);
+  result = build_enumerator (
+            get_identifier ((ignore_case || ! special_UC) ? "writeonly" : "WRITEONLY"),
+			     NULL_TREE);
+  listbase = chainon (result, listbase);
+  result = build_enumerator (
+            get_identifier ((ignore_case || ! special_UC) ? "readwrite" : "READWRITE"),
+			     NULL_TREE);
+  listbase = chainon (result, listbase);
+  result = finish_enum (enum1, listbase);
+  pushdecl (tmp = build_decl (TYPE_DECL,
+			      get_identifier ((ignore_case || ! special_UC) ? "usage" : "USAGE"),
+			      result));
+  DECL_SOURCE_LINE (tmp) = 0;
+  satisfy_decl (tmp, 0);
+  usage_type_node = TREE_TYPE (tmp);
+  TYPE_NAME (usage_type_node) = tmp;
+  CH_NOVELTY (usage_type_node) = tmp;
+
+  /* predefined where mode */
+  enum1 = start_enum (NULL_TREE);
+  listbase = NULL_TREE;
+  result = build_enumerator (
+            get_identifier ((ignore_case || ! special_UC) ? "first" : "FIRST"),
+			     NULL_TREE);
+  listbase = chainon (result, listbase);
+  result = build_enumerator (
+            get_identifier ((ignore_case || ! special_UC) ? "same" : "SAME"),
+			     NULL_TREE);
+  listbase = chainon (result, listbase);
+  result = build_enumerator (
+            get_identifier ((ignore_case || ! special_UC) ? "last" : "LAST"),
+			     NULL_TREE);
+  listbase = chainon (result, listbase);
+  result = finish_enum (enum1, listbase);
+  pushdecl (tmp = build_decl (TYPE_DECL,
+			      get_identifier ((ignore_case || ! special_UC) ? "where" : "WHERE"),
+			      result));
+  DECL_SOURCE_LINE (tmp) = 0;
+  satisfy_decl (tmp, 0);
+  where_type_node = TREE_TYPE (tmp);
+  TYPE_NAME (where_type_node) = tmp;
+  CH_NOVELTY (where_type_node) = tmp;
+}
+
+static void
+declare_predefined_file (name, assembler_name)
+     char *name;
+     char* assembler_name;
+{
+  tree decl = build_lang_decl (VAR_DECL, get_identifier (name),
+			       stdio_type_node);
+  DECL_ASSEMBLER_NAME (decl) = get_identifier(assembler_name);
+  TREE_STATIC (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  DECL_EXTERNAL (decl) = 1;
+  DECL_IN_SYSTEM_HEADER (decl) = 1;
+  make_decl_rtl (decl, 0, 1);
+  pushdecl (decl);
+}
+
+
+/* initialisation of all IO/related functions, types, etc. */
+void
+inout_init ()
+{
+  /* 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;
+
+  extern tree chill_predefined_function_type;
+  tree endlink = void_list_node;
+  tree bool_ftype_ptr_ptr_int;
+  tree ptr_ftype_ptr_ptr_int;
+  tree luns_ftype_ptr_ptr_int;
+  tree int_ftype_ptr_ptr_int;
+  tree ptr_ftype_ptr_ptr_int_ptr_int_ptr_int;
+  tree void_ftype_ptr_ptr_int_ptr_int_ptr_int;
+  tree void_ftype_ptr_ptr_int;
+  tree void_ftype_ptr_ptr_int_int_int_long_ptr_int;
+  tree ptr_ftype_ptr_int_ptr_ptr_int;
+  tree void_ftype_ptr_int_ptr_luns_ptr_int;
+  tree void_ftype_ptr_ptr_ptr_int;
+  tree void_ftype_ptr_int_ptr_int;
+  tree void_ftype_ptr_int_ptr_int_ptr_int_ptr_int;
+
+  maximum_field_alignment = 0;
+
+  builtin_function ((ignore_case || ! special_UC) ? "associate" : "ASSOCIATE",
+		    chill_predefined_function_type,
+		    BUILT_IN_ASSOCIATE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "connect" : "CONNECT",
+		    chill_predefined_function_type,
+		    BUILT_IN_CONNECT, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "create" : "CREATE",
+		    chill_predefined_function_type,
+		    BUILT_IN_CREATE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "delete" : "DELETE",
+		    chill_predefined_function_type,
+		    BUILT_IN_CH_DELETE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "disconnect" : "DISCONNECT",
+		    chill_predefined_function_type,
+		    BUILT_IN_DISCONNECT, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "dissociate" : "DISSOCIATE",
+		    chill_predefined_function_type,
+		    BUILT_IN_DISSOCIATE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "eoln" : "EOLN",
+		    chill_predefined_function_type,
+		    BUILT_IN_EOLN, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "existing" : "EXISTING",
+		    chill_predefined_function_type,
+		    BUILT_IN_EXISTING, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "getassociation" : "GETASSOCIATION",
+		    chill_predefined_function_type,
+		    BUILT_IN_GETASSOCIATION, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "gettextaccess" : "GETTEXTASSCESS",
+		    chill_predefined_function_type,
+		    BUILT_IN_GETTEXTACCESS, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "gettextindex" : "GETTEXTINDEX",
+		    chill_predefined_function_type,
+		    BUILT_IN_GETTEXTINDEX, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "gettextrecord" : "GETTEXTRECORD",
+		    chill_predefined_function_type,
+		    BUILT_IN_GETTEXTRECORD, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "getusage" : "GETUSAGE",
+		    chill_predefined_function_type,
+		    BUILT_IN_GETUSAGE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "indexable" : "INDEXABLE",
+		    chill_predefined_function_type,
+		    BUILT_IN_INDEXABLE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "isassociated" : "ISASSOCIATED",
+		    chill_predefined_function_type,
+		    BUILT_IN_ISASSOCIATED, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "modify" : "MODIFY",
+		    chill_predefined_function_type,
+		    BUILT_IN_MODIFY, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "outoffile" : "OUTOFFILE",
+		    chill_predefined_function_type,
+		    BUILT_IN_OUTOFFILE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "readable" : "READABLE",
+		    chill_predefined_function_type,
+		    BUILT_IN_READABLE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "readrecord" : "READRECORD",
+		    chill_predefined_function_type,
+		    BUILT_IN_READRECORD, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "readtext" : "READTEXT",
+		    chill_predefined_function_type,
+		    BUILT_IN_READTEXT, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "sequencible" : "SEQUENCIBLE",
+		    chill_predefined_function_type,
+		    BUILT_IN_SEQUENCIBLE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "settextaccess" : "SETTEXTACCESS",
+		    chill_predefined_function_type,
+		    BUILT_IN_SETTEXTACCESS, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "settextindex" : "SETTEXTINDEX",
+		    chill_predefined_function_type,
+		    BUILT_IN_SETTEXTINDEX, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "settextrecord" : "SETTEXTRECORD",
+		    chill_predefined_function_type,
+		    BUILT_IN_SETTEXTRECORD, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "variable" : "VARIABLE",
+		    chill_predefined_function_type,
+		    BUILT_IN_VARIABLE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "writeable" : "WRITEABLE",
+		    chill_predefined_function_type,
+		    BUILT_IN_WRITEABLE, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "writerecord" : "WRITERECORD",
+		    chill_predefined_function_type,
+		    BUILT_IN_WRITERECORD, NULL_PTR);
+  builtin_function ((ignore_case || ! special_UC) ? "writetext" : "WRITETEXT",
+		    chill_predefined_function_type,
+		    BUILT_IN_WRITETEXT, NULL_PTR);
+
+  /* build function prototypes */
+  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))));
+  ptr_ftype_ptr_ptr_int_ptr_int_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,
+            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_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_ptr_int_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,
+                tree_cons (NULL_TREE, ptr_type_node,
+                  tree_cons (NULL_TREE, integer_type_node,
+		    endlink))))))));
+  void_ftype_ptr_ptr_int_int_int_long_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, integer_type_node,
+              tree_cons (NULL_TREE, integer_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)))))))));
+  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))));
+  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))));
+  ptr_ftype_ptr_int_ptr_ptr_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, ptr_type_node,
+            tree_cons (NULL_TREE, ptr_type_node,
+              tree_cons (NULL_TREE, integer_type_node,
+                endlink))))));
+  void_ftype_ptr_int_ptr_luns_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, long_unsigned_type_node,
+              tree_cons (NULL_TREE, ptr_type_node,
+                tree_cons (NULL_TREE, integer_type_node,
+                  endlink)))))));
+  luns_ftype_ptr_ptr_int = 
+    build_function_type (long_unsigned_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_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_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,
+              endlink)))));
+  void_ftype_ptr_int_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,
+                  tree_cons (NULL_TREE, ptr_type_node,
+                    tree_cons (NULL_TREE, integer_type_node,
+                      endlink)))))))));
+
+  builtin_function ("__associate", ptr_ftype_ptr_ptr_int_ptr_int_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__connect", void_ftype_ptr_ptr_int_int_int_long_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__create", void_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__delete", void_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__disconnect", void_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__dissociate", void_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__eoln", bool_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__existing", bool_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__getassociation", ptr_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__gettextaccess", ptr_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__gettextindex", luns_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__gettextrecord", ptr_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__getusage", int_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__indexable", bool_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__isassociated", bool_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__modify", void_ftype_ptr_ptr_int_ptr_int_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__outoffile", bool_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__readable", bool_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__readrecord", ptr_ftype_ptr_int_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__readtext_f", void_ftype_ptr_int_ptr_int_ptr_int_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__readtext_s", void_ftype_ptr_int_ptr_int_ptr_int_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__sequencible", bool_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__settextaccess", void_ftype_ptr_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__settextindex", void_ftype_ptr_int_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__settextrecord", void_ftype_ptr_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__variable", bool_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__writeable", bool_ftype_ptr_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__writerecord", void_ftype_ptr_int_ptr_luns_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__writetext_f", void_ftype_ptr_int_ptr_int_ptr_int_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__writetext_s", void_ftype_ptr_int_ptr_int_ptr_int_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+
+  /* declare ASSOCIATION, ACCESS, and TEXT modes */
+  build_io_types ();
+
+  /* declare the predefined text locations */
+  declare_predefined_file ((ignore_case || ! special_UC) ?  "stdin" : "STDIN",
+			   "chill_stdin");
+  declare_predefined_file ((ignore_case || ! special_UC) ?  "stdout" : "STDOUT",
+			   "chill_stdout");
+  declare_predefined_file ((ignore_case || ! special_UC) ?  "stderr" : "STDERR",
+			   "chill_stderr");
+
+  /* last, but not least, build the chill IO-list type */
+  build_chill_io_list_type ();
+
+  maximum_field_alignment = save_maximum_field_alignment;
+}
+
+/* function returns the recordmode of an ACCESS */
+tree
+access_recordmode (access)
+     tree access;
+{
+  tree field;
+
+  if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
+    return NULL_TREE;
+  if (! CH_IS_ACCESS_MODE (access))
+    return NULL_TREE;
+
+  field = TYPE_FIELDS (access);
+  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (field) == TYPE_DECL &&
+	  DECL_NAME (field) == get_identifier ("__recordmode"))
+	return TREE_TYPE (field);
+    }
+  return void_type_node;
+}
+
+/* function invalidates the recordmode of an ACCESS */
+void
+invalidate_access_recordmode (access)
+     tree access;
+{
+  tree field;
+
+  if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
+    return;
+  if (! CH_IS_ACCESS_MODE (access))
+    return;
+
+  field = TYPE_FIELDS (access);
+  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (field) == TYPE_DECL &&
+	  DECL_NAME (field) == get_identifier ("__recordmode"))
+	{
+	  TREE_TYPE (field) = error_mark_node;
+	  return;
+	}
+    }
+}
+
+/* function returns the index mode of an ACCESS if there is one,
+   otherwise NULL_TREE */
+tree
+access_indexmode (access)
+     tree access;
+{
+  tree field;
+
+  if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
+    return NULL_TREE;
+  if (! CH_IS_ACCESS_MODE (access))
+    return NULL_TREE;
+
+  field = TYPE_FIELDS (access);
+  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (field) == TYPE_DECL &&
+	  DECL_NAME (field) == get_identifier ("__indexmode"))
+	return TREE_TYPE (field);
+    }
+  return void_type_node;
+}
+
+/* function returns one if an ACCESS was specified DYNAMIC, otherwise zero */
+tree
+access_dynamic (access)
+     tree access;
+{
+  tree field;
+
+  if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
+    return NULL_TREE;
+  if (! CH_IS_ACCESS_MODE (access))
+    return NULL_TREE;
+
+  field = TYPE_FIELDS (access);
+  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (field) == CONST_DECL)
+	return DECL_INITIAL (field);
+    }
+  return integer_zero_node;
+}
+
+#if 0
+   returns a structure like
+   STRUCT (data STRUCT (flags ULONG,
+                        reclength ULONG,
+                        lowindex LONG,
+                        highindex LONG,
+                        association PTR,
+                        base ULONG,
+                        store_loc PTR,
+                        rectype LONG),
+   this is followed by a
+   TYPE_DECL __recordmode recordmode ? recordmode : void_type_node
+   TYPE_DECL __indexmode  indexmode  ? indexmode  : void_type_node
+   CONST_DECL __dynamic   dynamic ? integer_one_node : integer_zero_node
+#endif
+
+static tree
+build_access_part ()
+{
+  tree listbase, decl;
+
+  listbase = build_decl (FIELD_DECL, get_identifier ("flags"),
+			 long_unsigned_type_node);
+  decl = build_decl (FIELD_DECL, get_identifier ("reclength"),
+		     long_unsigned_type_node);
+  listbase = chainon (listbase, decl);
+  decl = build_decl (FIELD_DECL, get_identifier ("lowindex"),
+		     long_unsigned_type_node);
+  listbase = chainon (listbase, decl);
+  decl = build_decl (FIELD_DECL, get_identifier ("highindex"),
+		     long_integer_type_node);
+  listbase = chainon (listbase, decl);
+  decl = build_decl (FIELD_DECL, get_identifier ("association"),
+		     ptr_type_node);
+  listbase = chainon (listbase, decl);
+  decl = build_decl (FIELD_DECL, get_identifier ("base"),
+		     long_unsigned_type_node);
+  listbase = chainon (listbase, decl);
+  decl = build_decl (FIELD_DECL, get_identifier ("storelocptr"),
+		     ptr_type_node);
+  listbase = chainon (listbase, decl);
+  decl = build_decl (FIELD_DECL, get_identifier ("rectype"),
+		     long_integer_type_node);
+  listbase = chainon (listbase, decl);
+  return build_chill_struct_type (listbase);
+}
+
+tree
+build_access_mode (indexmode, recordmode, dynamic)
+     tree indexmode;
+     tree recordmode;
+     int dynamic;
+{
+  tree type, listbase, decl, datamode;
+
+  if (indexmode != NULL_TREE && TREE_CODE (indexmode) == ERROR_MARK)
+    return error_mark_node;
+  if (recordmode != NULL_TREE && TREE_CODE (recordmode) == ERROR_MARK)
+    return error_mark_node;
+
+  datamode = build_access_part ();
+  
+  type = make_node (RECORD_TYPE);
+  listbase = build_decl (FIELD_DECL, get_identifier ("data"),
+			 datamode);
+  TYPE_FIELDS (type) = listbase;
+  decl = build_lang_decl (TYPE_DECL, get_identifier ("__recordmode"),
+			  recordmode == NULL_TREE ? void_type_node : recordmode);
+  chainon (listbase, decl);
+  decl = build_lang_decl (TYPE_DECL, get_identifier ("__indexmode"),
+			  indexmode == NULL_TREE ? void_type_node : indexmode);
+  chainon (listbase, decl);
+  decl = build_decl (CONST_DECL, get_identifier ("__dynamic"),
+		     integer_type_node);
+  DECL_INITIAL (decl) = dynamic ? integer_one_node : integer_zero_node;
+  chainon (listbase, decl);
+  CH_IS_ACCESS_MODE (type) = 1;
+  CH_TYPE_NONVALUE_P (type) = 1;
+  return type;
+}
+
+#if 0
+  returns a structure like:
+  STRUCT (txt STRUCT (flags ULONG,
+                      text_record PTR,
+                      access_sub PTR,
+                      actual_index LONG),
+          acc STRUCT (flags ULONG,
+                      reclength ULONG,
+                      lowindex LONG,
+                      highindex LONG,
+                      association PTR,
+                      base ULONG,
+                      store_loc PTR,
+                      rectype LONG),
+          tloc CHARS(textlength) VARYING;
+          )
+  followed by
+  TYPE_DECL __indexmode indexmode ? indexmode : void_type_node
+  CONST_DECL __text_length
+  CONST_DECL __dynamic  dynamic ? integer_one_node : integer_zero_node
+#endif
+tree
+build_text_mode (textlength, indexmode, dynamic)
+     tree textlength;
+     tree indexmode;
+     int dynamic;
+{
+  tree txt, acc, listbase, decl, type, tltype;
+  tree savedlength = textlength;
+
+  if (indexmode != NULL_TREE && TREE_CODE (indexmode) == ERROR_MARK)
+    return error_mark_node;
+  if (textlength == NULL_TREE || TREE_CODE (textlength) == ERROR_MARK)
+    return error_mark_node;
+
+  /* build the structure */
+  listbase = build_decl (FIELD_DECL, get_identifier ("flags"),
+			 long_unsigned_type_node);
+  decl = build_decl (FIELD_DECL, get_identifier ("text_record"),
+		     ptr_type_node);
+  listbase = chainon (listbase, decl);
+  decl = build_decl (FIELD_DECL, get_identifier ("access_sub"),
+		     ptr_type_node);
+  listbase = chainon (listbase, decl);
+  decl = build_decl (FIELD_DECL, get_identifier ("actual_index"),
+		     long_integer_type_node);
+  listbase = chainon (listbase, decl);
+  txt = build_chill_struct_type (listbase);
+
+  acc = build_access_part ();
+
+  type = make_node (RECORD_TYPE);
+  listbase = build_decl (FIELD_DECL, get_identifier ("txt"), txt);
+  TYPE_FIELDS (type) = listbase;
+  decl = build_decl (FIELD_DECL, get_identifier ("acc"), acc);
+  chainon (listbase, decl);
+  /* the text location */
+  tltype = build_string_type (char_type_node, textlength);
+  tltype = build_varying_struct (tltype);
+  decl = build_decl (FIELD_DECL, get_identifier ("tloc"),
+		     tltype);
+  chainon (listbase, decl);
+  /* the index mode */
+  decl = build_lang_decl (TYPE_DECL, get_identifier ("__indexmode"),
+			  indexmode == NULL_TREE ? void_type_node : indexmode);
+  chainon (listbase, decl);
+  /* save dynamic */
+  decl = build_decl (CONST_DECL, get_identifier ("__textlength"),
+		     integer_type_node);
+  if (TREE_CODE (textlength) == COMPONENT_REF)
+    /* FIXME: we cannot use one and the same COMPONENT_REF twice, so build
+       another one */
+    savedlength = build_component_ref (TREE_OPERAND (textlength, 0),
+				       TREE_OPERAND (textlength, 1));
+  DECL_INITIAL (decl) = savedlength;
+  chainon (listbase, decl);
+  /* save dynamic */
+  decl = build_decl (CONST_DECL, get_identifier ("__dynamic"),
+		     integer_type_node);
+  DECL_INITIAL (decl) = dynamic ? integer_one_node : integer_zero_node;
+  chainon (listbase, decl);
+  CH_IS_TEXT_MODE (type) = 1;
+  CH_TYPE_NONVALUE_P (type) = 1;
+  return type;
+}
+
+tree
+check_text_length (type, length)
+     tree type, length;
+{
+  if (length == NULL_TREE || TREE_CODE (length) == ERROR_MARK)
+    return length;
+  if (TREE_TYPE (length) == NULL_TREE
+      || !CH_SIMILAR (TREE_TYPE (length), integer_type_node))
+    {
+      error ("non-integral text length");
+      return integer_one_node;
+    }
+  if (TREE_CODE (length) != INTEGER_CST)
+    {
+      error ("non-constant text length");
+      return integer_one_node;
+    }
+  if (compare_int_csts (LE_EXPR, length, integer_zero_node))
+    {
+      error ("text length must be greater then 0");
+      return integer_one_node;
+    }
+  return length;
+}
+
+tree
+text_indexmode (text)
+     tree text;
+{
+  tree field;
+
+  if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
+    return NULL_TREE;
+  if (! CH_IS_TEXT_MODE (text))
+    return NULL_TREE;
+
+  field = TYPE_FIELDS (text);
+  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (field) == TYPE_DECL)
+	return TREE_TYPE (field);
+    }
+  return void_type_node;
+}
+
+tree
+text_dynamic (text)
+     tree text;
+{
+  tree field;
+
+  if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
+    return NULL_TREE;
+  if (! CH_IS_TEXT_MODE (text))
+    return NULL_TREE;
+
+  field = TYPE_FIELDS (text);
+  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (field) == CONST_DECL &&
+	  DECL_NAME (field) == get_identifier ("__dynamic"))
+	return DECL_INITIAL (field);
+    }
+  return integer_zero_node;
+}
+
+tree
+text_length (text)
+     tree text;
+{
+  tree field;
+
+  if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
+    return NULL_TREE;
+  if (! CH_IS_TEXT_MODE (text))
+    return NULL_TREE;
+
+  field = TYPE_FIELDS (text);
+  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (field) == CONST_DECL &&
+	  DECL_NAME (field) == get_identifier ("__textlength"))
+	return DECL_INITIAL (field);
+    }
+  return integer_zero_node;
+}
+
+static tree
+textlocation_mode (text)
+     tree text;
+{
+  tree field;
+
+  if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
+    return NULL_TREE;
+  if (! CH_IS_TEXT_MODE (text))
+    return NULL_TREE;
+
+  field = TYPE_FIELDS (text);
+  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
+    {
+      if (TREE_CODE (field) == FIELD_DECL &
+	  DECL_NAME (field) == get_identifier ("tloc"))
+	return TREE_TYPE (field);
+    }
+  return NULL_TREE;
+}
+
+static int
+check_assoc (assoc, argnum, errmsg)
+     tree assoc;
+     int argnum;
+     char *errmsg;
+{
+  if (assoc == NULL_TREE || TREE_CODE (assoc) == ERROR_MARK)
+    return 0;
+
+  if (! CH_IS_ASSOCIATION_MODE (TREE_TYPE (assoc)))
+    {
+      error ("argument %d of %s must be of mode ASSOCIATION", argnum, errmsg);
+      return 0;
+    }
+  if (! CH_LOCATION_P (assoc))
+    {
+      error ("argument %d of %s must be a location", argnum, errmsg);
+      return 0;
+    }
+  return 1;
+}
+
+tree
+build_chill_associate (assoc, fname, attr)
+     tree assoc;
+     tree fname;
+     tree attr;
+{
+  tree arg1, arg2, arg3, arg4, arg5, arg6, arg7;
+  int had_errors = 0;
+  tree result;
+
+  /* make some checks */
+  if (fname == NULL_TREE || TREE_CODE (fname) == ERROR_MARK)
+    return error_mark_node;
+
+  /* check the association */
+  if (! check_assoc (assoc, 1, "ASSOCIATION"))
+    had_errors = 1;
+  else
+    /* build a pointer to the association */
+    arg1 = force_addr_of (assoc);
+
+  /* check the filename, must be a string */
+  if (CH_CHARS_TYPE_P (TREE_TYPE (fname)) ||
+      (flag_old_strings && TREE_CODE (fname) == INTEGER_CST &&
+       TREE_CODE (TREE_TYPE (fname)) == CHAR_TYPE))
+    {
+      if (int_size_in_bytes (TREE_TYPE (fname)) == 0)
+	{
+	  error ("argument 2 of ASSOCIATE must not be an empty string");
+	  had_errors = 1;
+	}
+      else
+	{
+	  arg2 = force_addr_of (fname);
+	  arg3 = size_in_bytes (TREE_TYPE (fname));
+	}
+    }
+  else if (chill_varying_string_type_p (TREE_TYPE (fname)))
+    {
+      arg2 = force_addr_of (build_component_ref (fname, var_data_id));
+      arg3 = build_component_ref (fname, var_length_id);
+    }
+  else
+    {
+      error ("argument 2 to ASSOCIATE must be a string");
+      had_errors = 1;
+    }
+
+  /* check attr argument, must be a string too */
+  if (attr == NULL_TREE)
+    {
+      arg4 = null_pointer_node;
+      arg5 = integer_zero_node;
+    }
+  else
+    {
+      attr = TREE_VALUE (attr);
+      if (attr == NULL_TREE || TREE_CODE (attr) == ERROR_MARK)
+	had_errors = 1;
+      else
+	{
+	  if (CH_CHARS_TYPE_P (TREE_TYPE (attr)) ||
+	      (flag_old_strings && TREE_CODE (attr) == INTEGER_CST &&
+	       TREE_CODE (TREE_TYPE (attr)) == CHAR_TYPE))
+	    {
+	      if (int_size_in_bytes (TREE_TYPE (attr)) == 0)
+		{
+		  arg4 = null_pointer_node;
+		  arg5 = integer_zero_node;
+		}
+	      else
+		{
+		  arg4 = force_addr_of (attr);
+		  arg5 = size_in_bytes (TREE_TYPE (attr));
+		}
+	    }
+	  else if (chill_varying_string_type_p (TREE_TYPE (attr)))
+	    {
+	      arg4 = force_addr_of (build_component_ref (attr, var_data_id));
+	      arg5 = build_component_ref (attr, var_length_id);
+	    }
+	  else
+	    {
+	      error ("argument 3 to ASSOCIATE must be a string");
+	      had_errors = 1;
+	    }
+	}
+    }
+
+  if (had_errors)
+    return error_mark_node;
+
+  /* other arguments */
+  arg6 = force_addr_of (get_chill_filename ());
+  arg7 = get_chill_linenumber ();
+
+  result = build_chill_function_call (
+     lookup_name (get_identifier ("__associate")),
+            tree_cons (NULL_TREE, arg1,
+              tree_cons (NULL_TREE, arg2,
+                tree_cons (NULL_TREE, arg3,
+                  tree_cons (NULL_TREE, arg4,
+                    tree_cons (NULL_TREE, arg5,
+                      tree_cons (NULL_TREE, arg6,
+                        tree_cons (NULL_TREE, arg7, NULL_TREE))))))));
+  
+  TREE_TYPE (result) = build_chill_pointer_type (TREE_TYPE (assoc));
+  return result;
+}
+
+static tree
+assoc_call (assoc, func, name)
+     tree assoc;
+     tree func;
+     char *name;
+{
+  tree arg1, arg2, arg3;
+  tree result;
+
+  if (! check_assoc (assoc, 1, name))
+    return error_mark_node;
+
+  arg1 = force_addr_of (assoc);
+  arg2 = force_addr_of (get_chill_filename ());
+  arg3 = get_chill_linenumber ();
+
+  result = build_chill_function_call (func,
+            tree_cons (NULL_TREE, arg1,
+              tree_cons (NULL_TREE, arg2,
+                tree_cons (NULL_TREE, arg3, NULL_TREE))));
+  return result;
+}
+
+tree
+build_chill_isassociated (assoc)
+     tree assoc;
+{
+  tree result = assoc_call (assoc,
+			    lookup_name (get_identifier ("__isassociated")),
+			    "ISASSOCIATED");
+  return result;
+}
+
+tree
+build_chill_existing (assoc)
+     tree assoc;
+{
+  tree result = assoc_call (assoc,
+			    lookup_name (get_identifier ("__existing")),
+			    "EXISTING");
+  return result;
+}
+
+tree
+build_chill_readable (assoc)
+     tree assoc;
+{
+  tree result = assoc_call (assoc,
+			    lookup_name (get_identifier ("__readable")),
+			    "READABLE");
+  return result;
+}
+
+tree
+build_chill_writeable (assoc)
+     tree assoc;
+{
+  tree result = assoc_call (assoc,
+			    lookup_name (get_identifier ("__writeable")),
+			    "WRITEABLE");
+  return result;
+}
+
+tree
+build_chill_sequencible (assoc)
+     tree assoc;
+{
+  tree result = assoc_call (assoc,
+			    lookup_name (get_identifier ("__sequencible")),
+			    "SEQUENCIBLE");
+  return result;
+}
+
+tree
+build_chill_variable (assoc)
+     tree assoc;
+{
+  tree result = assoc_call (assoc,
+			    lookup_name (get_identifier ("__variable")),
+			    "VARIABLE");
+  return result;
+}
+
+tree
+build_chill_indexable (assoc)
+     tree assoc;
+{
+  tree result = assoc_call (assoc,
+			    lookup_name (get_identifier ("__indexable")),
+			    "INDEXABLE");
+  return result;
+}
+
+tree
+build_chill_dissociate (assoc)
+     tree assoc;
+{
+  tree result = assoc_call (assoc,
+			    lookup_name (get_identifier ("__dissociate")),
+			    "DISSOCIATE");
+  return result;
+}
+
+tree
+build_chill_create (assoc)
+     tree assoc;
+{
+  tree result = assoc_call (assoc,
+			    lookup_name (get_identifier ("__create")),
+			    "CREATE");
+  return result;
+}
+
+tree
+build_chill_delete (assoc)
+     tree assoc;
+{
+  tree result = assoc_call (assoc,
+			    lookup_name (get_identifier ("__delete")),
+			    "DELETE");
+  return result;
+}
+
+tree
+build_chill_modify (assoc, list)
+     tree assoc;
+     tree list;
+{
+  tree arg1, arg2, arg3, arg4, arg5, arg6, arg7;
+  int had_errors = 0, numargs;
+  tree fname = NULL_TREE, attr = NULL_TREE;
+  tree result;
+
+  /* check the association */
+  if (! check_assoc (assoc, 1, "MODIFY"))
+    had_errors = 1;
+  else
+    arg1 = force_addr_of (assoc);
+
+  /* look how much arguments we have got */
+  numargs = list_length (list);
+  switch (numargs)
+    {
+    case 0:
+      break;
+    case 1:
+      fname = TREE_VALUE (list);
+      break;
+    case 2:
+      fname = TREE_VALUE (list);
+      attr = TREE_VALUE (TREE_CHAIN (list));
+      break;
+    default:
+      error ("Too many arguments in call to MODIFY");
+      had_errors = 1;
+      break;
+    }
+
+  if (fname !=  NULL_TREE && fname != null_pointer_node)
+    {
+      if (CH_CHARS_TYPE_P (TREE_TYPE (fname)) ||
+	  (flag_old_strings && TREE_CODE (fname) == INTEGER_CST &&
+	   TREE_CODE (TREE_TYPE (fname)) == CHAR_TYPE))
+	{
+	  if (int_size_in_bytes (TREE_TYPE (fname)) == 0)
+	    {
+	      error ("argument 2 of MODIFY must not be an empty string");
+	      had_errors = 1;
+	    }
+	  else
+	    {
+	      arg2 = force_addr_of (fname);
+	      arg3 = size_in_bytes (TREE_TYPE (fname));
+	    }
+	}
+      else if (chill_varying_string_type_p (TREE_TYPE (fname)))
+	{
+	  arg2 = force_addr_of (build_component_ref (fname, var_data_id));
+	  arg3 = build_component_ref (fname, var_length_id);
+	}
+      else
+	{
+	  error ("argument 2 to MODIFY must be a string");
+	  had_errors = 1;
+	}
+    }
+  else
+    {
+      arg2 = null_pointer_node;
+      arg3 = integer_zero_node;
+    }
+
+  if (attr != NULL_TREE && attr != null_pointer_node)
+    {
+      if (CH_CHARS_TYPE_P (TREE_TYPE (attr)) ||
+	  (flag_old_strings && TREE_CODE (attr) == INTEGER_CST &&
+	   TREE_CODE (TREE_TYPE (attr)) == CHAR_TYPE))
+	{
+	  if (int_size_in_bytes (TREE_TYPE (attr)) == 0)
+	    {
+	      arg4 = null_pointer_node;
+	      arg5 = integer_zero_node;
+	    }
+	  else
+	    {
+	      arg4 = force_addr_of (attr);
+	      arg5 = size_in_bytes (TREE_TYPE (attr));
+	    }
+	}
+      else if (chill_varying_string_type_p (TREE_TYPE (attr)))
+	{
+	  arg4 = force_addr_of (build_component_ref (attr, var_data_id));
+	  arg5 = build_component_ref (attr, var_length_id);
+	}
+      else
+	{
+	  error ("argument 3 to MODIFY must be a string");
+	  had_errors = 1;
+	}
+    }
+  else
+    {
+      arg4 = null_pointer_node;
+      arg5 = integer_zero_node;
+    }
+
+  if (had_errors)
+    return error_mark_node;
+
+  /* other arguments */
+  arg6 = force_addr_of (get_chill_filename ());
+  arg7 = get_chill_linenumber ();
+
+  result = build_chill_function_call (
+     lookup_name (get_identifier ("__modify")),
+            tree_cons (NULL_TREE, arg1,
+              tree_cons (NULL_TREE, arg2,
+                tree_cons (NULL_TREE, arg3,
+                  tree_cons (NULL_TREE, arg4,
+                    tree_cons (NULL_TREE, arg5,
+                      tree_cons (NULL_TREE, arg6,
+                        tree_cons (NULL_TREE, arg7, NULL_TREE))))))));
+  
+  return result;
+}
+
+static int
+check_transfer (transfer, argnum, errmsg)
+     tree transfer;
+     int argnum;
+     char *errmsg;
+{
+  int result = 0;
+
+  if (transfer == NULL_TREE || TREE_CODE (transfer) == ERROR_MARK)
+    return 0;
+
+  if (CH_IS_ACCESS_MODE (TREE_TYPE (transfer)))
+    result = 1;
+  else if (CH_IS_TEXT_MODE (TREE_TYPE (transfer)))
+    result = 2;
+  else
+    {
+      error ("argument %d of %s must be an ACCESS or TEXT mode", argnum, errmsg);
+      return 0;
+    }
+  if (! CH_LOCATION_P (transfer))
+    {
+      error ("argument %d of %s must be a location", argnum, errmsg);
+      return 0;
+    }
+  return result;
+}
+
+/* define bits in an access/text flag word.
+   NOTE: this must be consistent with runtime/iomodes.h */
+#define IO_TEXTLOCATION 0x80000000
+#define IO_INDEXED      0x00000001
+#define IO_TEXTIO       0x00000002
+#define IO_OUTOFFILE    0x00010000
+
+/* generated initialisation code for ACCESS and TEXT.
+   functions gets called from do_decl. */
+void init_access_location (decl, type)
+     tree decl;
+     tree type;
+{
+  tree recordmode = access_recordmode (type);
+  tree indexmode = access_indexmode (type);
+  int flags_init = 0;
+  tree data = build_component_ref (decl, get_identifier ("data"));
+  tree lowindex = integer_zero_node;
+  tree highindex = integer_zero_node;
+  tree rectype, reclen;
+
+  /* flag word */
+  if (indexmode != NULL_TREE && indexmode != void_type_node)
+    {
+      flags_init |= IO_INDEXED;
+      lowindex = convert (integer_type_node, TYPE_MIN_VALUE (indexmode));
+      highindex = convert (integer_type_node, TYPE_MAX_VALUE (indexmode));
+    }
+
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("flags")),
+        build_int_2 (flags_init, 0)));
+
+  /* record length */
+  if (recordmode == NULL_TREE || recordmode == void_type_node)
+    {
+      reclen = integer_zero_node;
+      rectype = integer_zero_node;
+    }
+  else if (chill_varying_string_type_p (recordmode))
+    {
+      tree fields = TYPE_FIELDS (recordmode);
+      tree len1, len2;
+
+      /* don't count any padding bytes at end of varying */
+      len1 = size_in_bytes (TREE_TYPE (fields));
+      fields = TREE_CHAIN (fields);
+      len2 = size_in_bytes (TREE_TYPE (fields));
+      reclen = fold (build (PLUS_EXPR, long_integer_type_node, len1, len2));
+      rectype = build_int_2 (2, 0);
+    }
+  else
+    {
+      reclen = size_in_bytes (recordmode);
+      rectype = integer_one_node;
+    }
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("reclength")), reclen));
+
+  /* record type */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("rectype")), rectype));
+
+  /* the index */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("lowindex")), lowindex));
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("highindex")), highindex));
+
+  /* association */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_chill_component_ref (data, get_identifier ("association")),
+        null_pointer_node));
+
+  /* storelocptr */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("storelocptr")), null_pointer_node));
+}
+
+void init_text_location (decl, type)
+     tree decl;
+     tree type;
+{
+  tree indexmode = text_indexmode (type);
+  tree textlength = text_length (type);
+  unsigned long accessflags = 0;
+  unsigned long textflags = IO_TEXTLOCATION;
+  tree lowindex = integer_zero_node;
+  tree highindex = integer_zero_node;
+  tree data, tloc, tlocfields, len1, len2, reclen;
+
+  if (indexmode != NULL_TREE && indexmode != void_type_node)
+    {
+      accessflags |= IO_INDEXED;
+      lowindex = convert (integer_type_node, TYPE_MIN_VALUE (indexmode));
+      highindex = convert (integer_type_node, TYPE_MAX_VALUE (indexmode));
+    }
+
+  tloc = build_component_ref (decl, get_identifier ("tloc"));
+  /* fill access part of text location */
+  data = build_component_ref (decl, get_identifier ("acc"));
+  /* flag word */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("flags")),
+        build_int_2 (accessflags, 0)));
+
+  /* record length, don't count any padding bytes at end of varying */
+  tlocfields = TYPE_FIELDS (TREE_TYPE (tloc));
+  len1 = size_in_bytes (TREE_TYPE (tlocfields));
+  tlocfields = TREE_CHAIN (tlocfields);
+  len2 = size_in_bytes (TREE_TYPE (tlocfields));
+  reclen = fold (build (PLUS_EXPR, long_integer_type_node, len1, len2));
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("reclength")),
+        reclen));
+
+  /* the index */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("lowindex")), lowindex));
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("highindex")), highindex));
+
+  /* association */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_chill_component_ref (data, get_identifier ("association")),
+        null_pointer_node));
+
+  /* storelocptr */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("storelocptr")),
+        null_pointer_node));
+
+  /* record type */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("rectype")),
+        build_int_2 (2, 0))); /* VaryingChars */
+
+  /* fill text part */
+  data = build_component_ref (decl, get_identifier ("txt"));
+  /* flag word */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("flags")),
+        build_int_2 (textflags, 0)));
+
+  /* pointer to text record */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("text_record")),
+        force_addr_of (tloc)));
+
+  /* pointer to the access */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("access_sub")),
+        force_addr_of (build_component_ref (decl, get_identifier ("acc")))));
+
+  /* actual length */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (data, get_identifier ("actual_index")),
+        integer_zero_node));
+
+  /* length of text record */
+  expand_expr_stmt (
+    build_chill_modify_expr (
+      build_component_ref (tloc, get_identifier (VAR_LENGTH)),
+        integer_zero_node));
+}
+
+static int
+connect_process_optionals (optionals, whereptr, indexptr, indexmode)
+     tree optionals;
+     tree *whereptr;
+     tree *indexptr;
+     tree indexmode;
+{
+  tree where = NULL_TREE, theindex = NULL_TREE;
+  int had_errors = 0;
+
+  if (optionals != NULL_TREE)
+    {
+      /* get the where expression */
+      where = TREE_VALUE (optionals);
+      if (where == NULL_TREE || TREE_CODE (where) == ERROR_MARK)
+	had_errors = 1;
+      else
+	{
+	  if (! CH_IS_WHERE_MODE (TREE_TYPE (where)))
+	    {
+	      error ("argument 4 of CONNECT must be of mode WHERE");
+	      had_errors = 1;
+	    }
+	  where = convert (integer_type_node, where);
+	}
+      optionals = TREE_CHAIN (optionals);
+    }
+  if (optionals != NULL_TREE)
+    {
+      theindex = TREE_VALUE (optionals);
+      if (theindex == NULL_TREE || TREE_CODE (theindex) == ERROR_MARK)
+	had_errors = 1;
+      else
+	{
+	  if (indexmode == void_type_node)
+	    {
+	      error ("index expression for ACCESS without index");
+	      had_errors = 1;
+	    }
+	  else if (! CH_COMPATIBLE (theindex, indexmode))
+	    {
+	      error ("incompatible index mode");
+	      had_errors = 1;
+	    }
+	}
+    }
+  if (had_errors)
+    return 0;
+
+  *whereptr = where;
+  *indexptr = theindex;
+  return 1;
+}
+
+static tree
+connect_text (assoc, text, usage, optionals)
+     tree assoc;
+     tree text;
+     tree usage;
+     tree optionals;
+{
+  tree where = NULL_TREE, theindex = NULL_TREE;
+  tree indexmode = text_indexmode (TREE_TYPE (text));
+  tree result, what_where, have_index, what_index;
+
+  /* process optionals */
+  if (!connect_process_optionals (optionals, &where, &theindex, indexmode))
+    return error_mark_node;
+
+  what_where = where == NULL_TREE ? integer_zero_node : where;
+  have_index = theindex == NULL_TREE ? integer_zero_node
+                                     : integer_one_node;
+  what_index = theindex == NULL_TREE ? integer_zero_node
+                                     : convert (integer_type_node, theindex);
+  result = build_chill_function_call (
+             lookup_name (get_identifier ("__connect")),
+               tree_cons (NULL_TREE, force_addr_of (text),
+                 tree_cons (NULL_TREE, force_addr_of (assoc),
+                   tree_cons (NULL_TREE, convert (integer_type_node, usage),
+                     tree_cons (NULL_TREE, what_where,
+                       tree_cons (NULL_TREE, have_index,
+		 	 tree_cons (NULL_TREE, what_index,
+                           tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                             tree_cons (NULL_TREE, get_chill_linenumber (),
+					NULL_TREE)))))))));
+  return result;
+}
+
+static tree
+connect_access (assoc, transfer, usage, optionals)
+     tree assoc;
+     tree transfer;
+     tree usage;
+     tree optionals;
+{
+  tree where = NULL_TREE, theindex = NULL_TREE;
+  tree indexmode = access_indexmode (TREE_TYPE (transfer));
+  tree result, what_where, have_index, what_index;
+
+  /* process the optionals */
+  if (! connect_process_optionals (optionals, &where, &theindex, indexmode))
+    return error_mark_node;
+
+  /* now the call */
+  what_where = where == NULL_TREE ? integer_zero_node : where;
+  have_index = theindex == NULL_TREE ? integer_zero_node : integer_one_node;
+  what_index = theindex == NULL_TREE ? integer_zero_node : convert (integer_type_node, theindex);
+  result = build_chill_function_call (
+             lookup_name (get_identifier ("__connect")),
+               tree_cons (NULL_TREE, force_addr_of (transfer),
+                 tree_cons (NULL_TREE, force_addr_of (assoc),
+                   tree_cons (NULL_TREE, convert (integer_type_node, usage),
+                     tree_cons (NULL_TREE, what_where,
+                       tree_cons (NULL_TREE, have_index,
+			 tree_cons (NULL_TREE, what_index,
+                           tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                             tree_cons (NULL_TREE, get_chill_linenumber (),
+					NULL_TREE)))))))));
+  return result;
+}
+
+tree
+build_chill_connect (transfer, assoc, usage, optionals)
+     tree transfer;
+     tree assoc;
+     tree usage;
+     tree optionals;
+{
+  int had_errors = 0;
+  int what = 0;
+  tree result = error_mark_node;
+
+  if (! check_assoc (assoc, 2, "CONNECT"))
+    had_errors = 1;
+
+  /* check usage */
+  if (usage == NULL_TREE || TREE_CODE (usage) == ERROR_MARK)
+    return error_mark_node;
+
+  if (! CH_IS_USAGE_MODE (TREE_TYPE (usage)))
+    {
+      error ("argument 3 to CONNECT must be of mode USAGE");
+      had_errors = 1;
+    }
+  if (had_errors)
+    return error_mark_node;
+
+  /* look what we have got */
+  what = check_transfer (transfer, 1, "CONNECT");
+  switch (what)
+    {
+    case 1:
+      /* we have an ACCESS */
+      result = connect_access (assoc, transfer, usage, optionals);
+      break;
+    case 2:
+      /* we have a TEXT */
+      result = connect_text (assoc, transfer, usage, optionals);
+      break;
+    default:
+      result = error_mark_node;
+    }
+  return result;
+}
+
+static int
+check_access (access, argnum, errmsg)
+     tree access;
+     int argnum;
+     char *errmsg;
+{
+  if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
+    return 1;
+
+  if (! CH_IS_ACCESS_MODE (TREE_TYPE (access)))
+    {
+      error ("argument %d of %s must be of mode ACCESS", argnum, errmsg);
+      return 0;
+    }
+  if (! CH_LOCATION_P (access))
+    {
+      error ("argument %d of %s must be a location", argnum, errmsg);
+      return 0;
+    }
+  return 1;
+}
+
+tree
+build_chill_readrecord (access, optionals)
+     tree access;
+     tree optionals;
+{
+  int len;
+  tree recordmode, indexmode, dynamic, result;
+  tree index = NULL_TREE, location = NULL_TREE;
+
+  if (! check_access (access, 1, "READRECORD"))
+    return error_mark_node;
+
+  recordmode = access_recordmode (TREE_TYPE (access));
+  indexmode = access_indexmode (TREE_TYPE (access));
+  dynamic = access_dynamic (TREE_TYPE (access));
+
+  /* process the optionals */
+  len = list_length (optionals);
+  if (indexmode != void_type_node)
+    {
+      /* we must have an index */
+      if (!len)
+	{
+	  error ("Too few arguments in call to `readrecord'");
+	  return error_mark_node;
+	}
+      index = TREE_VALUE (optionals);
+      if (index == NULL_TREE || TREE_CODE (index) == ERROR_MARK)
+	return error_mark_node;
+      optionals = TREE_CHAIN (optionals);
+      if (! CH_COMPATIBLE (index, indexmode))
+	{
+	  error ("incompatible index mode");
+	  return error_mark_node;
+	}
+    }
+
+  /* check the record mode, if one */
+  if (optionals != NULL_TREE)
+    {
+      location = TREE_VALUE (optionals);
+      if (location == NULL_TREE || TREE_CODE (location) == ERROR_MARK)
+	return error_mark_node;
+      if (recordmode != void_type_node &&
+	  ! CH_COMPATIBLE (location, recordmode))
+	{
+
+	  error ("incompatible record mode");
+	  return error_mark_node;
+	}
+      if (TYPE_READONLY_PROPERTY (TREE_TYPE (location)))
+	{
+	  error ("store location must not be READonly");
+	  return error_mark_node;
+	}
+      location = force_addr_of (location);
+    }
+  else
+    location = null_pointer_node;
+
+  index = index == NULL_TREE ? integer_zero_node : convert (integer_type_node, index);
+  result = build_chill_function_call (
+            lookup_name (get_identifier ("__readrecord")),
+              tree_cons (NULL_TREE, force_addr_of (access),
+                tree_cons (NULL_TREE, index,
+                  tree_cons (NULL_TREE, location,
+                    tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                      tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))))));
+
+  TREE_TYPE (result) = build_chill_pointer_type (recordmode);
+  return result;
+}
+
+tree
+build_chill_writerecord (access, optionals)
+     tree access;
+     tree optionals;
+{
+  int had_errors = 0, len;
+  tree recordmode, indexmode, dynamic;
+  tree index = NULL_TREE, location = NULL_TREE;
+  tree result;
+
+  if (! check_access (access, 1, "WRITERECORD"))
+    return error_mark_node;
+
+  recordmode = access_recordmode (TREE_TYPE (access));
+  indexmode = access_indexmode (TREE_TYPE (access));
+  dynamic = access_dynamic (TREE_TYPE (access));
+
+  /* process the optionals */
+  len = list_length (optionals);
+  if (indexmode != void_type_node && len != 2)
+    {
+      error ("Too few arguments in call to `writerecord'");
+      return error_mark_node;
+    }
+  if (indexmode != void_type_node)
+    {
+      index = TREE_VALUE (optionals);
+      if (index == NULL_TREE || TREE_CODE (index) == ERROR_MARK)
+	return error_mark_node;
+      location = TREE_VALUE (TREE_CHAIN (optionals));
+      if (location == NULL_TREE || TREE_CODE (location) == ERROR_MARK)
+	return error_mark_node;
+    }
+  else
+    location = TREE_VALUE (optionals);
+
+  /* check the index */
+  if (indexmode != void_type_node)
+    {
+      if (! CH_COMPATIBLE (index, indexmode))
+	{
+	  error ("incompatible index mode");
+	  had_errors = 1;
+	}
+    }
+  /* check the record mode */
+  if (recordmode == void_type_node)
+    {
+      error ("transfer to ACCESS without record mode");
+      had_errors = 1;
+    }
+  else if (! CH_COMPATIBLE (location, recordmode))
+    {
+      error ("incompatible record mode");
+      had_errors = 1;
+    }
+  if (had_errors)
+    return error_mark_node;
+
+  index = index == NULL_TREE ? integer_zero_node : convert (integer_type_node, index);
+
+  result = build_chill_function_call (
+             lookup_name (get_identifier ("__writerecord")),
+               tree_cons (NULL_TREE, force_addr_of (access),
+                 tree_cons (NULL_TREE, index,
+                   tree_cons (NULL_TREE, force_addr_of (location),
+		     tree_cons (NULL_TREE, size_in_bytes (TREE_TYPE (location)),
+                       tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                         tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE)))))));
+  return result;
+}
+
+tree
+build_chill_disconnect (transfer)
+     tree transfer;
+{
+  tree result;
+
+  if (! check_transfer (transfer, 1, "DISCONNECT"))
+    return error_mark_node;
+  result = build_chill_function_call (
+             lookup_name (get_identifier ("__disconnect")),
+               tree_cons (NULL_TREE, force_addr_of (transfer),
+                 tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                   tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
+  return result;
+}
+
+tree
+build_chill_getassociation (transfer)
+     tree transfer;
+{
+  tree result;
+
+  if (! check_transfer (transfer, 1, "GETASSOCIATION"))
+    return error_mark_node;
+
+  result = build_chill_function_call (
+            lookup_name (get_identifier ("__getassociation")),
+              tree_cons (NULL_TREE, force_addr_of (transfer),
+                tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                  tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
+  TREE_TYPE (result) = build_chill_pointer_type (association_type_node);
+  return result;
+}
+
+tree
+build_chill_getusage (transfer)
+     tree transfer;
+{
+  tree result;
+
+  if (! check_transfer (transfer, 1, "GETUSAGE"))
+    return error_mark_node;
+
+  result = build_chill_function_call (
+            lookup_name (get_identifier ("__getusage")),
+              tree_cons (NULL_TREE, force_addr_of (transfer),
+                tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                  tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
+  TREE_TYPE (result) = usage_type_node;
+  return result;
+}
+
+tree
+build_chill_outoffile (transfer)
+     tree transfer;
+{
+  tree result;
+
+  if (! check_transfer (transfer, 1, "OUTOFFILE"))
+    return error_mark_node;
+
+  result = build_chill_function_call (
+             lookup_name (get_identifier ("__outoffile")),
+               tree_cons (NULL_TREE, force_addr_of (transfer),
+                 tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                   tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
+  return result;
+}
+
+static int
+check_text (text, argnum, errmsg)
+     tree text;
+     int argnum;
+     char *errmsg;
+{
+  if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
+    return 0;
+  if (! CH_IS_TEXT_MODE (TREE_TYPE (text)))
+    {
+      error ("argument %d of %s must be of mode TEXT", argnum, errmsg);
+      return 0;
+    }
+  if (! CH_LOCATION_P (text))
+    {
+      error ("argument %d of %s must be a location", argnum, errmsg);
+      return 0;
+    }
+  return 1;
+}
+
+tree
+build_chill_eoln (text)
+     tree text;
+{
+  tree result;
+
+  if (! check_text (text, 1, "EOLN"))
+    return error_mark_node;
+
+  result = build_chill_function_call (
+             lookup_name (get_identifier ("__eoln")),
+               tree_cons (NULL_TREE, force_addr_of (text),
+                 tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                   tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
+  return result;
+}
+
+tree
+build_chill_gettextindex (text)
+     tree text;
+{
+  tree result;
+
+  if (! check_text (text, 1, "GETTEXTINDEX"))
+    return error_mark_node;
+
+  result = build_chill_function_call (
+             lookup_name (get_identifier ("__gettextindex")),
+               tree_cons (NULL_TREE, force_addr_of (text),
+                 tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                   tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
+  return result;
+}
+
+tree
+build_chill_gettextrecord (text)
+     tree text;
+{
+  tree textmode, result;
+
+  if (! check_text (text, 1, "GETTEXTRECORD"))
+    return error_mark_node;
+
+  textmode = textlocation_mode (TREE_TYPE (text));
+  if (textmode == NULL_TREE)
+    {
+      error ("TEXT doesn't have a location");  /* FIXME */
+      return error_mark_node;
+    }
+  result = build_chill_function_call (
+            lookup_name (get_identifier ("__gettextrecord")),
+              tree_cons (NULL_TREE, force_addr_of (text),
+                tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                  tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
+  TREE_TYPE (result) = build_chill_pointer_type (textmode);
+  CH_DERIVED_FLAG (result) = 1;
+  return result;
+}
+
+tree
+build_chill_gettextaccess (text)
+     tree text;
+{
+  tree access, refaccess, acc, decl, listbase;
+  tree tlocmode, indexmode, dynamic;
+  tree result;
+  extern int maximum_field_alignment;
+  int save_maximum_field_alignment = maximum_field_alignment;
+
+  if (! check_text (text, 1, "GETTEXTACCESS"))
+    return error_mark_node;
+
+  tlocmode = textlocation_mode (TREE_TYPE (text));
+  indexmode = text_indexmode (TREE_TYPE (text));
+  dynamic = text_dynamic (TREE_TYPE (text));
+
+  /* we have to build a type for the access */
+  acc = build_access_part ();
+  access = make_node (RECORD_TYPE);
+  listbase = build_decl (FIELD_DECL, get_identifier ("data"), acc);
+  TYPE_FIELDS (access) = listbase;
+  decl = build_lang_decl (TYPE_DECL, get_identifier ("__recordmode"),
+			  tlocmode);
+  chainon (listbase, decl);
+  decl = build_lang_decl (TYPE_DECL, get_identifier ("__indexmode"),
+			  indexmode);
+  chainon (listbase, decl);
+  decl = build_decl (CONST_DECL, get_identifier ("__dynamic"),
+		     integer_type_node);
+  DECL_INITIAL (decl) = dynamic;
+  chainon (listbase, decl);
+  maximum_field_alignment = 0;
+  layout_chill_struct_type (access);
+  maximum_field_alignment = save_maximum_field_alignment;
+  CH_IS_ACCESS_MODE (access) = 1;
+  CH_TYPE_NONVALUE_P (access) = 1;
+
+  refaccess = build_chill_pointer_type (access);
+
+  result = build_chill_function_call (
+            lookup_name (get_identifier ("__gettextaccess")),
+              tree_cons (NULL_TREE, force_addr_of (text),
+                tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                  tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
+  TREE_TYPE (result) = refaccess;
+  CH_DERIVED_FLAG (result) = 1;
+  return result;
+}
+
+tree
+build_chill_settextindex (text, expr)
+     tree text;
+     tree expr;
+{
+  tree result;
+
+  if (! check_text (text, 1, "SETTEXTINDEX"))
+    return error_mark_node;
+  if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+    return error_mark_node;
+  result = build_chill_function_call (
+             lookup_name (get_identifier ("__settextindex")),
+               tree_cons (NULL_TREE, force_addr_of (text),
+                 tree_cons (NULL_TREE, expr,
+                   tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                     tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE)))));
+  return result;
+}
+
+tree
+build_chill_settextaccess (text, access)
+     tree text;
+     tree access;
+{
+  tree result;
+  tree textindexmode, accessindexmode;
+  tree textrecordmode, accessrecordmode;
+
+  if (! check_text (text, 1, "SETTEXTACCESS"))
+    return error_mark_node;
+  if (! check_access (access, 2, "SETTEXTACCESS"))
+    return error_mark_node;
+
+  textindexmode = text_indexmode (TREE_TYPE (text));
+  accessindexmode = access_indexmode (TREE_TYPE (access));
+  if (textindexmode != accessindexmode)
+    {
+      if (! chill_read_compatible (textindexmode, accessindexmode))
+	{
+	  error ("incompatible index mode for SETETEXTACCESS");
+	  return error_mark_node;
+	}
+    }
+  textrecordmode = textlocation_mode (TREE_TYPE (text));
+  accessrecordmode = access_recordmode (TREE_TYPE (access));
+  if (textrecordmode != accessrecordmode)
+    {
+      if (! chill_read_compatible (textrecordmode, accessrecordmode))
+	{
+	  error ("incompatible record mode for SETTEXTACCESS");
+	  return error_mark_node;
+	}
+    }
+  result = build_chill_function_call (
+             lookup_name (get_identifier ("__settextaccess")),
+               tree_cons (NULL_TREE, force_addr_of (text),
+                 tree_cons (NULL_TREE, force_addr_of (access),
+                   tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                     tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE)))));
+  return result;
+}
+
+tree
+build_chill_settextrecord (text, charloc)
+     tree text;
+     tree charloc;
+{
+  tree result;
+  int had_errors = 0;
+  tree tlocmode;
+
+  if (! check_text (text, 1, "SETTEXTRECORD"))
+    return error_mark_node;
+  if (charloc == NULL_TREE || TREE_CODE (charloc) == ERROR_MARK)
+    return error_mark_node;
+
+  /* check the location */
+  if (! CH_LOCATION_P (charloc))
+    {
+      error ("parameter 2 must be a location");
+      return error_mark_node;
+    }
+  tlocmode = textlocation_mode (TREE_TYPE (text));
+  if (! chill_varying_string_type_p (TREE_TYPE (charloc)))
+    had_errors = 1;
+  else if (int_size_in_bytes (tlocmode) != int_size_in_bytes (TREE_TYPE (charloc)))
+    had_errors = 1;
+  if (had_errors)
+    {
+      error ("incompatible modes in parameter 2");
+      return error_mark_node;
+    }
+  result = build_chill_function_call (
+             lookup_name (get_identifier ("__settextrecord")),
+               tree_cons (NULL_TREE, force_addr_of (text),
+                 tree_cons (NULL_TREE, force_addr_of (charloc),
+                   tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
+                     tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE)))));
+  return result;
+}
+
+/* process iolist for READ- and WRITETEXT */
+
+/* function walks through types as long as they are ranges,
+   returns the type and min- and max-value form starting type.
+   */
+
+static tree
+get_final_type_and_range (item, low, high)
+     tree  item;
+     tree *low;
+     tree *high;
+{
+  tree	wrk = item;
+    
+  *low = TYPE_MIN_VALUE (wrk);
+  *high = TYPE_MAX_VALUE (wrk);
+  while (TREE_CODE (wrk) == INTEGER_TYPE &&
+	 TREE_TYPE (wrk) != NULL_TREE &&
+	 TREE_CODE (TREE_TYPE (wrk)) == INTEGER_TYPE &&
+	 TREE_TYPE (TREE_TYPE (wrk)) != NULL_TREE)
+    wrk = TREE_TYPE (wrk);
+    
+  return (TREE_TYPE (wrk));
+}
+
+static void
+process_io_list (exprlist, iolist_addr, iolist_length, iolist_rtx, do_read,
+		 argoffset)
+     tree exprlist;
+     tree *iolist_addr;
+     tree *iolist_length;
+     rtx *iolist_rtx;
+     int do_read;
+     int argoffset;
+{
+  tree idxlist;
+  int idxcnt;
+  int iolen;
+  tree iolisttype, iolist;
+
+  if (exprlist == NULL_TREE)
+    return;
+  
+  iolen = list_length (exprlist);
+  
+  /* build indexlist for the io list */
+  idxlist = build_tree_list (NULL_TREE,
+			     build_chill_range_type (NULL_TREE,
+						     integer_one_node,
+						     build_int_2 (iolen, 0)));
+  
+  /* build the io-list type */
+  iolisttype = build_chill_array_type (TREE_TYPE (chill_io_list_type), 
+				       idxlist, 0, NULL_TREE);
+  
+  /* declare the iolist */
+  iolist = build_decl (VAR_DECL, get_unique_identifier (do_read ? "RDTEXT" : "WRTEXT"),
+		       iolisttype);
+  
+  /* we want to get a variable which gets marked unused after
+     the function call, This is a little bit tricky cause the 
+     address of this variable will be taken and therefor the variable
+     gets moved out one level. However, we REALLY don't need this
+     variable again. Solution: push 2 levels and do pop and free
+     twice at the end. */
+  push_temp_slots ();
+  push_temp_slots ();
+  *iolist_rtx = assign_temp (TREE_TYPE (iolist), 0, 1, 0);
+  DECL_RTL (iolist) = *iolist_rtx;
+
+  /* process the exprlist */
+  idxcnt = 1;
+  while (exprlist != NULL_TREE)
+    {
+      tree item = TREE_VALUE (exprlist);
+      tree idx = build_int_2 (idxcnt++, 0);
+      char *fieldname = 0;
+      char *enumname = 0;
+      tree array_ref = build_chill_array_ref_1 (iolist, idx);
+      tree item_type;
+      tree range_low = NULL_TREE, range_high = NULL_TREE;
+      int have_range = 0;
+      tree item_addr = null_pointer_node;
+      int referable = 0;
+      int readonly = 0;
+
+      /* next value in exprlist */
+      exprlist = TREE_CHAIN (exprlist);
+      if (item == NULL_TREE || TREE_CODE (item) == ERROR_MARK)
+	continue;
+
+      item_type = TREE_TYPE (item);
+      if (item_type == NULL_TREE)
+	{
+	  if (TREE_CODE (item) == COND_EXPR || TREE_CODE (item) == CASE_EXPR)
+	    error ("conditional expression not allowed in this context");
+	  else
+	    error ("untyped expression as argument %d", idxcnt + 1 + argoffset);
+	  continue;
+	}
+      else if (TREE_CODE (item_type) == ERROR_MARK)
+	continue;
+	  
+      if (TREE_CODE (item_type) == REFERENCE_TYPE)
+	{
+	  item_type = TREE_TYPE (item_type);
+	  item = convert (item_type, item);
+	}
+
+      /* check for a range */
+      if (TREE_CODE (item_type) == INTEGER_TYPE &&
+	  TREE_TYPE (item_type) != NULL_TREE)
+	{
+	  /* we have a range. NOTE, however, on writetext we don't process ranges  */
+	  item_type = get_final_type_and_range (item_type,
+						&range_low, &range_high);
+	  have_range = 1;
+	}
+
+      readonly = TYPE_READONLY_PROPERTY (item_type);
+      referable = CH_REFERABLE (item);
+      if (referable)
+	item_addr = force_addr_of (item);
+      /* if we are in read and have readonly we can't do this */
+      if (readonly && do_read)
+	{
+	  item_addr = null_pointer_node;
+	  referable = 0;
+	}
+
+      /* process different types */
+      if (TREE_CODE (item_type) == INTEGER_TYPE)
+	{
+	  int type_size = TREE_INT_CST_LOW (TYPE_SIZE (item_type));
+	  tree to_assign = NULL_TREE;
+
+	  if (do_read && referable)
+	    {
+	      /* process an integer in case of READTEXT and expression is
+		 referable and not READONLY */
+	      to_assign = item_addr;
+	      if (have_range)
+		{
+		  /* do it for a range */
+		  tree t, __forxx, __ptr, __low, __high;
+		  tree what_upper, what_lower;
+
+		  /* determine the name in the union of lower and upper */
+		  if (TREE_UNSIGNED (item_type))
+		    fieldname = "_ulong";
+		  else
+		    fieldname = "_slong";
+
+		  switch (type_size)
+		    {
+		    case 8:
+		      if (TREE_UNSIGNED (item_type))
+			enumname = "__IO_UByteRangeLoc";
+		      else
+			enumname = "__IO_ByteRangeLoc";
+		      break;
+		    case 16:
+		      if (TREE_UNSIGNED (item_type))
+			enumname = "__IO_UIntRangeLoc";
+		      else
+			enumname = "__IO_IntRangeLoc";
+		      break;
+		    case 32:
+		      if (TREE_UNSIGNED (item_type))
+			enumname = "__IO_ULongRangeLoc";
+		      else
+			enumname = "__IO_LongRangeLoc";
+		      break;
+		    default:
+		      error ("Cannot process %d bits integer for READTEXT argument %d.",
+			     type_size, idxcnt + 1 + argoffset);
+		      continue;
+		    }
+
+		  /* set up access to structure */
+		  t = build_component_ref (array_ref,
+					   get_identifier ("__t"));
+		  __forxx = build_component_ref (t, get_identifier ("__locintrange"));
+		  __ptr = build_component_ref (__forxx, get_identifier ("ptr"));
+		  __low = build_component_ref (__forxx, get_identifier ("lower"));
+		  what_lower = build_component_ref (__low, get_identifier (fieldname));
+		  __high = build_component_ref (__forxx, get_identifier ("upper"));
+		  what_upper = build_component_ref (__high, get_identifier (fieldname));
+
+		  /* do the assignments */
+		  expand_assignment (__ptr, item_addr, 0, 0);
+		  expand_assignment (what_lower, range_low, 0, 0);
+		  expand_assignment (what_upper, range_high, 0, 0);
+		  fieldname = 0;
+		}
+	      else
+		{
+		  /* no range */
+		  fieldname = "__locint";
+		  switch (type_size)
+		    {
+		    case 8:
+		      if (TREE_UNSIGNED (item_type))
+			enumname = "__IO_UByteLoc";
+		      else
+			enumname = "__IO_ByteLoc";
+		      break;
+		    case 16:
+		      if (TREE_UNSIGNED (item_type))
+			enumname = "__IO_UIntLoc";
+		      else
+			enumname = "__IO_IntLoc";
+		      break;
+		    case 32:
+		      if (TREE_UNSIGNED (item_type))
+			enumname = "__IO_ULongLoc";
+		      else
+			enumname = "__IO_LongLoc";
+		      break;
+		    default:
+		      error ("Cannot process %d bits integer for READTEXT argument %d.",
+			     type_size, idxcnt + 1 + argoffset);
+		      continue;
+		    }
+		}
+	    }
+	  else
+	    {
+	      /* process an integer in case of WRITETEXT */
+	      to_assign = item;
+	      switch (type_size)
+		{
+		case 8:
+		  if (TREE_UNSIGNED (item_type))
+		    {
+		      enumname = "__IO_UByteVal";
+		      fieldname = "__valubyte";
+		    }
+		  else
+		    {
+		      enumname = "__IO_ByteVal";
+		      fieldname = "__valbyte";
+		    }
+		  break;
+		case 16:
+		  if (TREE_UNSIGNED (item_type))
+		    {
+		      enumname = "__IO_UIntVal";
+		      fieldname = "__valuint";
+		    }
+		  else
+		    {
+		      enumname = "__IO_IntVal";
+		      fieldname = "__valint";
+		    }
+		  break;
+		case 32:
+		try_long:
+		  if (TREE_UNSIGNED (item_type))
+		    {
+		      enumname = "__IO_ULongVal";
+		      fieldname = "__valulong";
+		    }
+		  else
+		    {
+		      enumname = "__IO_LongVal";
+		      fieldname = "__vallong";
+		    }
+		  break;
+		case 64:
+		  /* convert it back to {unsigned}long. */
+		  if (TREE_UNSIGNED (item_type))
+		    item_type = long_unsigned_type_node;
+		  else
+		    item_type = long_integer_type_node;
+		  item = convert (item_type, item);
+		  goto try_long;
+		default:
+		  /* This kludge is because the lexer gives literals
+		     the type long_long_{integer,unsigned}_type_node.  */
+		  if (TREE_CODE (item) == INTEGER_CST)
+		    {
+		      if (int_fits_type_p (item, long_integer_type_node))
+			{
+			  item_type = long_integer_type_node;
+			  item = convert (item_type, item);
+			  goto try_long;
+			}
+		      if (int_fits_type_p (item, long_unsigned_type_node))
+			{
+			  item_type = long_unsigned_type_node;
+			  item = convert (item_type, item);
+			  goto try_long;
+			}
+		    }
+		  error ("Cannot process %d bits integer WRITETEXT argument %d.",
+			 type_size, idxcnt + 1 + argoffset);
+		  continue;
+		}
+	    }
+	  if (fieldname)
+	    {
+	      tree	t, __forxx;
+	      
+	      t = build_component_ref (array_ref,
+				       get_identifier ("__t"));
+	      __forxx = build_component_ref (t, get_identifier (fieldname));
+	      expand_assignment (__forxx, to_assign, 0, 0);
+	    }
+	}
+      else if (TREE_CODE (item_type) == CHAR_TYPE)
+	{
+	  tree	to_assign = NULL_TREE;
+
+	  if (do_read && readonly)
+	    {
+	      error ("argument %d is READonly", idxcnt + 1 + argoffset);
+	      continue;
+	    }
+	  if (do_read)
+	    {
+	      if (! referable)
+		{
+		  error ("argument %d must be referable", idxcnt + 1 + argoffset);
+		  continue;
+		}
+	      if (have_range)
+		{
+		  tree t, forxx, ptr, lower, upper;
+
+		  t = build_component_ref (array_ref, get_identifier ("__t"));
+		  forxx = build_component_ref (t, get_identifier ("__loccharrange"));
+		  ptr = build_component_ref (forxx, get_identifier ("ptr"));
+		  lower = build_component_ref (forxx, get_identifier ("lower"));
+		  upper = build_component_ref (forxx, get_identifier ("upper"));
+		  expand_assignment (ptr, item_addr, 0, 0);
+		  expand_assignment (lower, range_low, 0, 0);
+		  expand_assignment (upper, range_high, 0, 0);
+
+		  fieldname = 0;
+		  enumname = "__IO_CharRangeLoc";
+		}
+	      else
+		{
+		  to_assign = item_addr;
+		  fieldname = "__locchar";
+		  enumname = "__IO_CharLoc";
+		}
+	    }
+	  else
+	    {
+	      to_assign = item;
+	      enumname = "__IO_CharVal";
+	      fieldname = "__valchar";
+	    }
+	  
+	  if (fieldname)
+	    {
+	      tree t, forxx;
+
+	      t = build_component_ref (array_ref, get_identifier ("__t"));
+	      forxx = build_component_ref (t, get_identifier (fieldname));
+	      expand_assignment (forxx, to_assign, 0, 0);
+	    }
+	}
+      else if (TREE_CODE (item_type) == BOOLEAN_TYPE)
+	{
+	  tree to_assign;
+
+	  if (do_read && readonly)
+	    {
+	      error ("argument %d is READonly", idxcnt + 1 + argoffset);
+	      continue;
+	    }
+	  if (do_read)
+	    {
+	      if (! referable)
+		{
+		  error ("argument %d must be referable", idxcnt + 1 + argoffset);
+		  continue;
+		}
+	      if (have_range)
+		{
+		  tree t, forxx, ptr, lower, upper;
+
+		  t = build_component_ref (array_ref, get_identifier ("__t"));
+		  forxx = build_component_ref (t, get_identifier ("__locboolrange"));
+		  ptr = build_component_ref (forxx, get_identifier ("ptr"));
+		  lower = build_component_ref (forxx, get_identifier ("lower"));
+		  upper = build_component_ref (forxx, get_identifier ("upper"));
+		  expand_assignment (ptr, item_addr, 0, 0);
+		  expand_assignment (lower, range_low, 0, 0);
+		  expand_assignment (upper, range_high, 0, 0);
+
+		  fieldname = 0;
+		  enumname = "__IO_BoolRangeLoc";
+		}
+	      else
+		{
+		  to_assign = item_addr;
+		  fieldname = "__locbool";
+		  enumname = "__IO_BoolLoc";
+		}
+	    }
+	  else
+	    {
+	      to_assign = item;
+	      enumname = "__IO_BoolVal";
+	      fieldname = "__valbool";
+	    }
+	  if (fieldname)
+	    {
+	      tree	t, forxx;
+	      
+	      t = build_component_ref (array_ref, get_identifier ("__t"));
+	      forxx = build_component_ref (t, get_identifier (fieldname));
+	      expand_assignment (forxx, to_assign, 0, 0);
+	    }
+	}
+      else if (TREE_CODE (item_type) == ENUMERAL_TYPE)
+	{
+	  /* process an enum */
+	  tree table_name;
+	  tree context_of_type;
+	  tree t;
+
+	  /* determine the context of the type.
+	     if TYPE_NAME (item_type) == NULL_TREE
+	     if TREE_CODE (item) == INTEGER_CST
+	     context = NULL_TREE -- this is wrong but should work for now
+	     else
+	     context = DECL_CONTEXT (item)
+	     else
+	     context = DECL_CONTEXT (TYPE_NAME (item_type)) */
+
+	  if (TYPE_NAME (item_type) == NULL_TREE)
+	    {
+	      if (TREE_CODE (item) == INTEGER_CST)
+		context_of_type = NULL_TREE;
+	      else
+		context_of_type = DECL_CONTEXT (item);
+	    }
+	  else
+	    context_of_type = DECL_CONTEXT (TYPE_NAME (item_type));
+	      
+	  table_name = add_enum_to_list (item_type, context_of_type);
+	  t = build_component_ref (array_ref, get_identifier ("__t"));
+
+	  if (do_read && readonly)
+	    {
+	      error ("argument %d is READonly", idxcnt + 1 + argoffset);
+	      continue;
+	    }
+	  if (do_read)
+	    {
+	      if (! referable)
+		{
+		  error ("argument %d must be referable", idxcnt + 1 + argoffset);
+		  continue;
+		}
+	      if (have_range)
+		{
+		  tree forxx, ptr, len, nametable, lower, upper;
+
+		  forxx = build_component_ref (t, get_identifier ("__locsetrange"));
+		  ptr = build_component_ref (forxx, get_identifier ("ptr"));
+		  len = build_component_ref (forxx, get_identifier ("length"));
+		  nametable = build_component_ref (forxx, get_identifier ("name_table"));
+		  lower = build_component_ref (forxx, get_identifier ("lower"));
+		  upper = build_component_ref (forxx, get_identifier ("upper"));
+		  expand_assignment (ptr, item_addr, 0, 0);
+		  expand_assignment (len, size_in_bytes (item_type), 0, 0);
+		  expand_assignment (nametable, table_name, 0, 0);
+		  expand_assignment (lower, range_low, 0, 0);
+		  expand_assignment (upper, range_high, 0, 0);
+
+		  enumname = "__IO_SetRangeLoc";
+		}
+	      else
+		{
+		  tree forxx, ptr, len, nametable;
+
+		  forxx = build_component_ref (t, get_identifier ("__locset"));
+		  ptr = build_component_ref (forxx, get_identifier ("ptr"));
+		  len = build_component_ref (forxx, get_identifier ("length"));
+		  nametable = build_component_ref (forxx, get_identifier ("name_table"));
+		  expand_assignment (ptr, item_addr, 0, 0);
+		  expand_assignment (len, size_in_bytes (item_type), 0, 0);
+		  expand_assignment (nametable, table_name, 0, 0);
+
+		  enumname = "__IO_SetLoc";
+		}
+	    }
+	  else
+	    {
+	      tree forxx, value, nametable;
+
+	      forxx = build_component_ref (t, get_identifier ("__valset"));
+	      value = build_component_ref (forxx, get_identifier ("value"));
+	      nametable = build_component_ref (forxx, get_identifier ("name_table"));
+	      expand_assignment (value, item, 0, 0);
+	      expand_assignment (nametable, table_name, 0, 0);
+
+	      enumname = "__IO_SetVal";
+	    }
+	}
+      else if (chill_varying_string_type_p (item_type))
+	{
+	  /* varying char string */
+	  tree t = build_component_ref (array_ref, get_identifier ("__t"));
+	  tree forxx = build_component_ref (t, get_identifier ("__loccharstring"));
+	  tree string = build_component_ref (forxx, get_identifier ("string"));
+	  tree length = build_component_ref (forxx, get_identifier ("string_length"));
+
+	  if (do_read && readonly)
+	    {
+	      error ("argument %d is READonly", idxcnt + 1 + argoffset);
+	      continue;
+	    }
+	  if (do_read)
+	    {
+	      /* in this read case the argument must be referable */
+	      if (! referable)
+		{
+		  error ("argument %d must be referable", idxcnt + 1 + argoffset);
+		  continue;
+		}
+	    }
+	  else if (! referable)
+	    {
+	      /* in the write case we create a temporary if not referable */
+	      rtx t;
+	      tree loc = build_decl (VAR_DECL,
+				     get_unique_identifier ("WRTEXTVS"),
+				     item_type);
+	      t = assign_temp (item_type, 0, 1, 0);
+	      DECL_RTL (loc) = t;
+	      expand_assignment (loc, item, 0, 0);
+	      item_addr = force_addr_of (loc);
+	      item = loc;
+	    }
+
+	  expand_assignment (string, item_addr, 0, 0);
+	  if (do_read)
+	    /* we must pass the maximum length of the varying */
+	    expand_assignment (length,
+			       size_in_bytes (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (item_type)))),
+			       0, 0);
+	  else
+	      /* we pass the actual length of the string */
+	    expand_assignment (length,
+			       build_component_ref (item, var_length_id),
+			       0, 0);
+
+	  enumname = "__IO_CharVaryingLoc";
+	}
+      else if (CH_CHARS_TYPE_P (item_type))
+	{
+	  /* fixed character string */
+	  tree the_size;
+	  tree t = build_component_ref (array_ref, get_identifier ("__t"));
+	  tree forxx = build_component_ref (t, get_identifier ("__loccharstring"));
+	  tree string = build_component_ref (forxx, get_identifier ("string"));
+	  tree length = build_component_ref (forxx, get_identifier ("string_length"));
+
+	  if (do_read && readonly)
+	    {
+	      error ("argument %d is READonly", idxcnt + 1 + argoffset);
+	      continue;
+	    }
+	  if (do_read)
+	    {
+	      /* in this read case the argument must be referable */
+	      if (! CH_REFERABLE (item))
+		{
+		  error ("argument %d must be referable", idxcnt + 1 + argoffset);
+		  continue;
+		}
+	      else
+		item_addr = force_addr_of (item);
+	      the_size = size_in_bytes (item_type);
+	      enumname = "__IO_CharStrLoc";
+	    }
+	  else
+	    {
+	      if (! CH_REFERABLE (item))
+		{
+		  /* in the write case we create a temporary if not referable */
+		  rtx t;
+		  int howmuchbytes;
+
+		  howmuchbytes = int_size_in_bytes (item_type);
+		  if (howmuchbytes != -1)
+		    {
+		      /* fixed size */
+		      tree loc = build_decl (VAR_DECL,
+					     get_unique_identifier ("WRTEXTVS"),
+					     item_type);
+		      t = assign_temp (item_type, 0, 1, 0);
+		      DECL_RTL (loc) = t;
+		      expand_assignment (loc, item, 0, 0);
+		      item_addr = force_addr_of (loc);
+		      the_size = size_in_bytes (item_type);
+		      enumname = "__IO_CharStrLoc";
+		    }
+		  else
+		    {
+		      tree type, string, exp, loc;
+
+		      if ((howmuchbytes = intsize_of_charsexpr (item)) == -1)
+			{
+			  error ("cannot process argument %d of WRITETEXT, unknown size",
+				 idxcnt + 1 + argoffset);
+			  continue;
+			}
+		      string = build_string_type (char_type_node,
+						  build_int_2 (howmuchbytes, 0));
+		      type = build_varying_struct (string);
+		      loc = build_decl (VAR_DECL,
+					get_unique_identifier ("WRTEXTCS"),
+					type);
+		      t = assign_temp (type, 0, 1, 0);
+		      DECL_RTL (loc) = t;
+		      exp = chill_convert_for_assignment (type, item, 0);
+		      expand_assignment (loc, exp, 0, 0);
+		      item_addr = force_addr_of (loc);
+		      the_size = integer_zero_node;
+		      enumname = "__IO_CharVaryingLoc";
+		    }
+		}
+	      else
+		{
+		  item_addr = force_addr_of (item);
+		  the_size = size_in_bytes (item_type);
+		  enumname = "__IO_CharStrLoc";
+		}
+	    }
+
+	  expand_assignment (string, item_addr, 0, 0);
+	  expand_assignment (length, size_in_bytes (item_type), 0, 0);
+
+	}
+      else if (CH_BOOLS_TYPE_P (item_type))
+	{
+	  /* we have a bitstring */
+	  tree t = build_component_ref (array_ref, get_identifier ("__t"));
+	  tree forxx = build_component_ref (t, get_identifier ("__loccharstring"));
+	  tree string = build_component_ref (forxx, get_identifier ("string"));
+	  tree length = build_component_ref (forxx, get_identifier ("string_length"));
+
+	  if (do_read && readonly)
+	    {
+	      error ("argument %d is READonly", idxcnt + 1 + argoffset);
+	      continue;
+	    }
+	  if (do_read)
+	    {
+	      /* in this read case the argument must be referable */
+	      if (! referable)
+		{
+		  error ("argument %d must be referable", idxcnt + 1 + argoffset);
+		  continue;
+		}
+	    }
+	  else if (! referable)
+	    {
+	      /* in the write case we create a temporary if not referable */
+	      tree loc = build_decl (VAR_DECL,
+				     get_unique_identifier ("WRTEXTVS"),
+				     item_type);
+	      DECL_RTL (loc) = assign_temp (item_type, 0, 1, 0);
+	      expand_assignment (loc, item, 0, 0);
+	      item_addr = force_addr_of (loc);
+	    }
+
+	  expand_assignment (string, item_addr, 0, 0);
+	  expand_assignment (length, build_chill_length (item), 0, 0);
+
+	  enumname = "__IO_BitStrLoc";
+	}
+      else if (TREE_CODE (item_type) == REAL_TYPE)
+	{
+	  /* process a (long_)real */
+	  tree	t, forxx, to_assign;
+
+	  if (do_read && readonly)
+	    {
+	      error ("argument %d is READonly", idxcnt + 1 + argoffset);
+	      continue;
+	    }
+	  if (do_read && ! referable)
+	    {
+	      error ("argument %d must be referable", idxcnt + 1 + argoffset);
+	      continue;
+	    }
+
+	  if (lookup_name (ridpointers[RID_FLOAT]) == TYPE_NAME (item_type))
+	    {
+	      /* we have a real */
+	      if (do_read)
+		{
+		  enumname = "__IO_RealLoc";
+		  fieldname = "__locreal";
+		  to_assign = item_addr;
+		}
+	      else
+		{
+		  enumname = "__IO_RealVal";
+		  fieldname = "__valreal";
+		  to_assign = item;
+		}
+	    }
+	  else
+	    {
+	      /* we have a long_real */
+	      if (do_read)
+		{
+		  enumname = "__IO_LongRealLoc";
+		  fieldname = "__loclongreal";
+		  to_assign = item_addr;
+		}
+	      else
+		{
+		  enumname = "__IO_LongRealVal";
+		  fieldname = "__vallongreal";
+		  to_assign = item;
+		}
+	    }
+	  t = build_component_ref (array_ref, get_identifier ("__t"));
+	  forxx = build_component_ref (t, get_identifier (fieldname));
+	  expand_assignment (forxx, to_assign, 0, 0);
+	}
+#if 0
+      /* don't process them for now */
+      else if (TREE_CODE (item_type) == POINTER_TYPE)
+	{
+	  /* we have a pointer */
+	  tree	__t, __forxx;
+	      
+	  __t = build_component_ref (array_ref, get_identifier ("__t"));
+	  __forxx = build_component_ref (__t, get_identifier ("__forpointer"));
+	  expand_assignment (__forxx, item, 0, 0);
+	  enumname = "_IO_Pointer";
+	}
+      else if (item_type == instance_type_node)
+	{
+	  /* we have an INSTANCE */
+	  tree	__t, __forxx;
+	      
+	  __t = build_component_ref (array_ref, get_identifier ("__t"));
+	  __forxx = build_component_ref (__t, get_identifier ("__forinstance"));
+	  expand_assignment (__forxx, item, 0, 0);
+	  enumname = "_IO_Instance";
+	}
+#endif
+      else
+	{
+	  /* datatype is not yet implemented, issue a warning */
+	  error ("cannot process mode of argument %d for %sTEXT.", idxcnt + 1 + argoffset,
+		 do_read ? "READ" : "WRITE");
+	  enumname = "__IO_UNUSED";
+	}
+	  
+      /* do assignment of the enum */
+      if (enumname)
+	{
+	  tree descr = build_component_ref (array_ref,
+					    get_identifier ("__descr"));
+	  expand_assignment (descr,
+			     lookup_name (get_identifier (enumname)), 0, 0);
+	}
+    }
+  
+  /* set up address and length of iolist */
+  *iolist_addr = build_chill_addr_expr (iolist, (char *)0);
+  *iolist_length = build_int_2 (iolen, 0);
+}
+
+/* check the format string */
+#define LET 0x0001
+#define BIN 0x0002
+#define DEC 0x0004
+#define OCT 0x0008
+#define HEX 0x0010
+#define USC 0x0020
+#define BIL 0x0040
+#define SPC 0x0080
+#define SCS 0x0100
+#define IOC 0x0200
+#define EDC 0x0400
+#define CVC 0x0800
+
+#define isDEC(c)  ( chartab[(c)] & DEC )
+#define isCVC(c)  ( chartab[(c)] & CVC )
+#define isEDC(c)  ( chartab[(c)] & EDC )
+#define isIOC(c)  ( chartab[(c)] & IOC )
+#define isUSC(c)
+#define isXXX(c,XXX)  ( chartab[(c)] & XXX )
+
+static
+short int chartab[256] = {
+  0, 0, 0, 0, 0, 0, 0, 0, 
+  0, SPC, SPC, SPC, SPC, SPC, 0, 0, 
+
+  0, 0, 0, 0, 0, 0, 0, 0, 
+  0, 0, 0, 0, 0, 0, 0, 0, 
+
+  SPC, IOC, 0, 0, 0, 0, 0, 0, 
+  SCS, SCS, SCS, SCS+IOC, SCS, SCS+IOC, SCS, SCS+IOC, 
+  BIN+OCT+DEC+HEX, BIN+OCT+DEC+HEX, OCT+DEC+HEX, OCT+DEC+HEX, OCT+DEC+HEX,
+     OCT+DEC+HEX, OCT+DEC+HEX, OCT+DEC+HEX, 
+  DEC+HEX, DEC+HEX, SCS, SCS, SCS+EDC, SCS+IOC, SCS+EDC, IOC, 
+
+  0, LET+HEX+BIL, LET+HEX+BIL+CVC, LET+HEX+BIL+CVC, LET+HEX+BIL, LET+HEX, 
+     LET+HEX+CVC, LET, 
+  LET+BIL+CVC, LET, LET, LET, LET, LET, LET, LET+CVC, 
+
+  LET, LET, LET, LET, LET+EDC, LET, LET, LET,
+  LET+EDC, LET, LET, SCS, 0, SCS, 0, USC, 
+
+  0, LET+HEX, LET+HEX, LET+HEX, LET+HEX, LET+HEX, LET+HEX, LET, 
+  LET, LET, LET, LET, LET, LET, LET, LET, 
+
+  LET, LET, LET, LET, LET, LET, LET, LET,
+  LET, LET, LET, 0, 0, 0, 0, 0 
+};
+
+typedef enum
+{
+  FormatText, FirstPercent, RepFact, ConvClause, EditClause, ClauseEnd,
+  AfterWidth, FractWidth, FractWidthCont, ExpoWidth, ExpoWidthCont, 
+  ClauseWidth, CatchPadding, LastPercent
+} fcsstate_t;
+
+#define CONVERSIONCODES "CHOBF"
+typedef enum
+{
+  DefaultConv, HexConv, OctalConv, BinaryConv, ScientConv
+} convcode_t;
+static convcode_t     convcode;
+
+typedef enum
+{
+  False, True,
+} Boolean;
+
+static unsigned long  fractionwidth;
+
+#define IOCODES "/+-?!="
+typedef enum {
+  NextRecord, NextPage, CurrentLine, Prompt, Emit, EndPage
+} iocode_t;
+static iocode_t       iocode;
+
+#define EDITCODES "X<>T"
+typedef enum {
+  SpaceSkip, SkipLeft, SkipRight, Tabulation
+} editcode_t;
+static editcode_t     editcode;
+
+static unsigned long  clausewidth;
+static Boolean        leftadjust;
+static Boolean        overflowev;
+static Boolean        dynamicwid;
+static Boolean        paddingdef;
+static char           paddingchar;
+static Boolean        fractiondef;
+static Boolean        exponentdef;
+static unsigned long  exponentwidth;
+static unsigned long  repetition;
+
+typedef enum {
+  NormalEnd, EndAtParen, TextFailEnd 
+} formatexit_t;
+
+/* NOTE: varibale have to be set to False before calling check_format_string */
+static Boolean empty_printed;
+
+static int formstroffset;
+
+static tree
+check_exprlist (code, exprlist, argnum, repetition)
+     convcode_t code;
+     tree exprlist;
+     int argnum;
+     unsigned long repetition;
+{
+  tree expr, type, result;
+
+  while (repetition--)
+    {
+      if (exprlist == NULL_TREE)
+	{
+	  if (empty_printed == False)
+	    {
+	      warning ("too few arguments for this format string");
+	      empty_printed = True;
+	    }
+	  return NULL_TREE;
+	}
+      expr = TREE_VALUE (exprlist);
+      result = exprlist = TREE_CHAIN (exprlist);
+      if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
+	return result;
+      type = TREE_TYPE (expr);
+      if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+	return result;
+      if (TREE_CODE (type) == REFERENCE_TYPE)
+	type = TREE_TYPE (type);
+      if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
+	return result;
+      
+      switch (code)
+	{
+	case DefaultConv:
+	  /* %C, everything is allowed. Not know types are flaged later. */
+	  break;
+	case ScientConv:
+	  /* %F, must be a REAL */
+	  if (TREE_CODE (type) != REAL_TYPE)
+	    warning ("type of argument %d invalid for conversion code at offset %d",
+		     argnum, formstroffset);
+	  break;
+	case HexConv:
+	case OctalConv:
+	case BinaryConv:
+	case -1:
+	  /* %H, %O, %B, and V as clause width */
+	  if (TREE_CODE (type) != INTEGER_TYPE)
+	    warning ("type of argument %d invalid for conversion code at offset %d",
+		     argnum, formstroffset);
+	  break;
+	default:
+	  /* there is an invalid conversion code */
+	  break;
+	}
+    }
+  return result;
+}
+
+static formatexit_t
+scanformcont (fcs, len, fcsptr, lenptr, exprlist, exprptr,
+	      firstargnum, nextargnum)
+     char *fcs;
+     int len;
+     char **fcsptr;
+     int *lenptr;
+     tree exprlist;
+     tree *exprptr;
+     int firstargnum;
+     int *nextargnum;
+{
+  fcsstate_t state = FormatText;
+  char curr;
+  int dig;
+
+  while (len--)
+    {
+      curr = *fcs++;
+      formstroffset++;
+      switch (state)
+	{
+	case FormatText: 
+	  if (curr == '%')
+	    state = FirstPercent;
+	  break;
+	  
+	after_first_percent: ;
+	case FirstPercent: 
+	  if (curr == '%')
+	    {
+	      state = FormatText;
+	      break;
+	    }
+	  if (curr == ')')
+	    {
+	      *lenptr = len;
+	      *fcsptr = fcs;
+	      *exprptr = exprlist;
+	      *nextargnum = firstargnum;
+	      return EndAtParen;
+	    }
+	  if (isDEC (curr))
+	    {
+	      state = RepFact;
+	      repetition = curr - '0';
+	      break;
+	    }
+	  
+	  repetition = 1; 
+	  
+	test_for_control_codes: ;
+	  if (isCVC (curr))
+	    {
+	      state = ConvClause;
+	      convcode = strchr (CONVERSIONCODES, curr) - CONVERSIONCODES;
+	      leftadjust = False;
+	      overflowev = False;
+	      dynamicwid = False;
+	      paddingdef = False;
+	      paddingchar = ' ';
+	      fractiondef = False;
+	      /* fractionwidth = 0; default depends on mode ! */
+	      exponentdef = False;
+	      exponentwidth = 3;
+	      clausewidth = 0;
+	      /* check the argument */
+	      exprlist = check_exprlist (convcode, exprlist, firstargnum, repetition);
+	      firstargnum++;
+	      break;        
+	    }
+	  if (isEDC (curr))
+	    {
+	      state = EditClause;
+	      editcode = strchr (EDITCODES, curr) - EDITCODES;
+	      dynamicwid = False;
+	      clausewidth = editcode == Tabulation ? 0 : 1;        
+	      break;        
+	    }
+	  if (isIOC (curr))
+	    {
+	      state = ClauseEnd;
+	      iocode = strchr (IOCODES, curr) - IOCODES;
+	      break;        
+	    }
+	  if (curr == '(')
+	    {
+	      unsigned long times = repetition;
+	      int  cntlen;
+	      char* cntfcs;
+	      tree cntexprlist;
+	      int nextarg;
+
+	      while (times--)
+		{
+		  if (scanformcont (fcs, len, &cntfcs, &cntlen,
+				    exprlist, &cntexprlist,
+				    firstargnum, &nextarg) != EndAtParen )
+		    {
+		      warning ("unmatched open paren");
+		      break;
+		    }
+		  exprlist = cntexprlist;
+		}
+	      fcs = cntfcs;
+	      len = cntlen;
+	      if (len < 0)
+		len = 0;
+	      exprlist = cntexprlist;
+	      firstargnum = nextarg;
+	      state  = FormatText;
+	      break;
+	    }
+	  warning ("bad format specification character (offset %d)", formstroffset);
+	  state = FormatText;
+	  /* skip one argument */
+	  if (exprlist != NULL_TREE)
+	    exprlist = TREE_CHAIN (exprlist);
+	  break;
+	  
+	case RepFact:
+	  if (isDEC (curr))
+	    {
+	      dig = curr - '0';
+	      if (repetition > (ULONG_MAX - dig)/10)
+		{
+		  warning ("repetition factor overflow (offset %d)", formstroffset);
+		  return TextFailEnd;
+		}
+	      repetition = repetition*10 + dig;
+	      break;
+	    }
+	  goto test_for_control_codes;
+	  
+	case ConvClause:
+	  if (isDEC (curr))
+	    {
+	      state = ClauseWidth;
+	      clausewidth = curr - '0';
+	      break;
+	    }
+	  if (curr == 'L')  
+	    {
+	      if (leftadjust)
+		warning ("duplicate qualifier (offset %d)", formstroffset);
+	      leftadjust = True;
+	      break;
+	    }
+	  if (curr == 'E')
+	    {
+	      if (overflowev)
+		warning ("duplicate qualifier (offset %d)", formstroffset);
+	      overflowev = True;
+	      break;
+	    }
+	  if (curr == 'P')
+	    {
+	      if (paddingdef)
+		warning ("duplicate qualifier (offset %d)", formstroffset);
+	      paddingdef = True;
+	      state = CatchPadding;
+	      break;
+	    }
+	  
+	test_for_variable_width: ;
+	  if (curr == 'V')
+	    {
+	      dynamicwid = True;
+	      state = AfterWidth;
+	      exprlist = check_exprlist (-1, exprlist, firstargnum, 1);
+	      firstargnum++;
+	      break;
+	    }
+	  goto test_for_fraction_width;
+	  
+	case ClauseWidth:
+	  if (isDEC (curr))
+	    {
+	      dig = curr - '0';
+	      if (clausewidth > (ULONG_MAX - dig)/10)
+		warning ("clause width overflow (offset %d)", formstroffset);
+	      else
+		clausewidth = clausewidth*10 + dig;
+	      break;
+	    }
+	  /* fall through */
+	  
+	test_for_fraction_width: ;
+	case AfterWidth:
+	  if (curr == '.')
+	    {
+	      if (convcode != DefaultConv && convcode != ScientConv)
+		{
+		  warning ("no fraction (offset %d)", formstroffset);
+		  state = FormatText;
+		  break;
+		}
+	      fractiondef = True;
+	      state = FractWidth;
+	      break;
+	    }
+	  goto test_for_exponent_width;
+	  
+	case FractWidth:
+	  if (isDEC (curr))
+	    {
+	      state = FractWidthCont;
+	      fractionwidth = curr - '0';
+	      break;
+	    }
+	  else
+	    warning ("no fraction width (offset %d)", formstroffset);
+	  
+	case FractWidthCont:
+	  if (isDEC (curr))
+	    {
+	      dig = curr - '0';
+	      if (fractionwidth > (ULONG_MAX - dig)/10)
+		warning ("fraction width overflow (offset %d)", formstroffset);
+	      else
+		fractionwidth = fractionwidth*10 + dig;
+	      break;
+	    }
+	  
+	test_for_exponent_width: ;
+	  if (curr == ':')
+	    {
+	      if (convcode != ScientConv)
+		{
+		  warning ("no exponent (offset %d)", formstroffset);
+		  state = FormatText;
+		  break;
+		}
+	      exponentdef = True;
+	      state = ExpoWidth;
+	      break;
+	    }
+	  goto test_for_final_percent;
+	  
+	case ExpoWidth:
+	  if (isDEC (curr))
+	    {
+	      state = ExpoWidthCont;
+	      exponentwidth = curr - '0';
+	      break;
+	    }
+	  else
+	    warning ("no exponent width (offset %d)", formstroffset);
+	  
+	case ExpoWidthCont:
+	  if (isDEC (curr))
+	    {
+	      dig = curr - '0';
+	      if (exponentwidth > (ULONG_MAX - dig)/10)
+		warning ("exponent width overflow (offset %d)", formstroffset);
+	      else
+		exponentwidth = exponentwidth*10 + dig;
+	      break;
+	    }
+	  /* fall through  */
+	  
+	test_for_final_percent: ;
+	case ClauseEnd:
+	  if (curr == '%')
+	    {
+	      state = LastPercent;
+	      break;
+	    }
+	  
+	do_the_action: ;
+	  state = FormatText;
+	  break;
+	  
+	case CatchPadding:
+	  paddingchar = curr;
+	  state = ConvClause;
+	  break;
+	  
+	case EditClause:
+	  if (isDEC (curr))
+	    {
+	      state = ClauseWidth;
+	      clausewidth = curr - '0';
+	      break;
+	    }
+	  goto test_for_variable_width; 
+	  
+	case LastPercent:
+	  if (curr == '.')
+	    {
+	      state = FormatText;
+	      break;
+	    }
+	  goto after_first_percent;
+	  
+	default:
+	  error ("internal error in check_format_string");
+	}
+    }
+
+  switch (state)
+    {
+    case FormatText:
+      break;
+    case FirstPercent:
+    case LastPercent:
+    case RepFact:
+    case FractWidth:
+    case ExpoWidth:
+      warning ("bad format specification character (offset %d)", formstroffset);      
+      break;
+    case CatchPadding:
+      warning ("no padding character (offset %d)", formstroffset);
+      break;
+    default:
+      break;
+    }
+  *fcsptr = fcs;
+  *lenptr = len;
+  *exprptr = exprlist;
+  *nextargnum = firstargnum;
+  return NormalEnd;
+}
+static void
+check_format_string (format_str, exprlist, firstargnum)
+     tree format_str;
+     tree exprlist;
+     int firstargnum;
+{
+  char *x;
+  int y, yy;
+  tree z = NULL_TREE;
+
+  if (TREE_CODE (format_str) != STRING_CST)
+    /* do nothing if we don't have a string constant */
+    return;
+
+  formstroffset = -1;
+  scanformcont (TREE_STRING_POINTER (format_str),
+		TREE_STRING_LENGTH (format_str), &x, &y,
+		exprlist, &z,
+		firstargnum, &yy);
+  if (z != NULL_TREE)
+    /* too  may arguments for format string */
+    warning ("too many arguments for this format string");
+}
+
+static int
+get_max_size (expr)
+     tree expr;
+{
+  if (TREE_CODE (expr) == INDIRECT_REF)
+    {
+      tree x = TREE_OPERAND (expr, 0);
+      tree y = TREE_OPERAND (x, 0);
+      return int_size_in_bytes (TREE_TYPE (y));
+    }
+  else if (TREE_CODE (expr) == CONCAT_EXPR)
+    return intsize_of_charsexpr (expr);
+  else
+    return int_size_in_bytes (TREE_TYPE (expr));
+}
+
+static int
+intsize_of_charsexpr (expr)
+     tree expr;
+{
+  int op0size, op1size;
+
+  if (TREE_CODE (expr) != CONCAT_EXPR)
+    return -1;
+
+  /* find maximum length of CONCAT_EXPR, this is the worst case */
+  op0size = get_max_size (TREE_OPERAND (expr, 0));
+  op1size = get_max_size (TREE_OPERAND (expr, 1));
+  if (op0size == -1 || op1size == -1)
+    return -1;
+  return op0size + op1size;
+}
+
+tree
+build_chill_writetext (text_arg, exprlist)
+     tree text_arg, exprlist;
+{
+  tree iolist_addr = null_pointer_node;
+  tree iolist_length = integer_zero_node;
+  tree fstr_addr;
+  tree fstr_length;
+  tree outstr_addr;
+  tree outstr_length;
+  tree fstrtype;
+  tree outfunction;
+  tree filename, linenumber;
+  tree format_str = NULL_TREE, indexexpr = NULL_TREE;
+  rtx  iolist_rtx = NULL_RTX;
+  int argoffset = 0;
+
+  /* make some checks */
+  if (text_arg == NULL_TREE || TREE_CODE (text_arg) == ERROR_MARK)
+    return error_mark_node;
+
+  if (exprlist != NULL_TREE)
+    {
+      if (TREE_CODE (exprlist) != TREE_LIST)
+	return error_mark_node;
+    }
+  
+  /* check the text argument */
+  if (chill_varying_string_type_p (TREE_TYPE (text_arg)))
+    {
+      /* build outstr-addr and outstr-length assuming that this is a CHAR (n) VARYING */
+      outstr_addr = force_addr_of (text_arg);
+      outstr_length = size_in_bytes (CH_VARYING_ARRAY_TYPE (TREE_TYPE (text_arg)));
+      outfunction = lookup_name (get_identifier ("__writetext_s"));
+      format_str = TREE_VALUE (exprlist);
+      exprlist = TREE_CHAIN (exprlist);
+    }
+  else if (CH_IS_TEXT_MODE (TREE_TYPE (text_arg)))
+    {
+      /* we have a text mode */
+      tree indexmode;
+
+      if (! check_text (text_arg, 1, "WRITETEXT"))
+	return error_mark_node;
+      indexmode = text_indexmode (TREE_TYPE (text_arg));
+      if (indexmode == void_type_node)
+	{
+	  /* no index */
+	  format_str = TREE_VALUE (exprlist);
+	  exprlist = TREE_CHAIN (exprlist);
+	}
+      else
+	{
+	  /* we have an index. there must be an index argument before format string */
+	  indexexpr = TREE_VALUE (exprlist);
+	  exprlist = TREE_CHAIN (exprlist);
+	  if (! CH_COMPATIBLE (indexexpr, indexmode))
+	    {
+	      if (chill_varying_string_type_p (TREE_TYPE (indexexpr)) ||
+		  (CH_CHARS_TYPE_P (TREE_TYPE (indexexpr)) ||
+		   (flag_old_strings && TREE_CODE (indexexpr) == INTEGER_CST &&
+		    TREE_CODE (TREE_TYPE (indexexpr)) == CHAR_TYPE)))
+		error ("missing index expression");
+	      else
+		error ("incompatible index mode");
+	      return error_mark_node;
+	    }
+	  if (exprlist == NULL_TREE)
+	    {
+	      error ("Too few arguments in call to `writetext'");
+	      return error_mark_node;
+	    }
+	  format_str = TREE_VALUE (exprlist);
+	  exprlist = TREE_CHAIN (exprlist);
+	  argoffset = 1;
+	}
+      outstr_addr = force_addr_of (text_arg);
+      outstr_length = convert (integer_type_node, indexexpr);
+      outfunction = lookup_name (get_identifier ("__writetext_f"));
+    }
+  else
+    {
+      error ("argument 1 for WRITETEXT must be a TEXT or CHARS(n) VARYING location");
+      return error_mark_node;
+    }
+  
+  /* check the format string */
+  fstrtype = TREE_TYPE (format_str);
+  if (CH_CHARS_TYPE_P (fstrtype) ||
+      (flag_old_strings && TREE_CODE (format_str) == INTEGER_CST &&
+       TREE_CODE (fstrtype) == CHAR_TYPE))
+    {
+      /* we have a character string */
+      fstr_addr = force_addr_of (format_str);
+      fstr_length = size_in_bytes (fstrtype);
+    }
+  else if (chill_varying_string_type_p (TREE_TYPE (format_str)))
+    {
+      /* we have a varying char string */
+      fstr_addr
+	= force_addr_of (build_component_ref (format_str, var_data_id));
+      fstr_length = build_component_ref (format_str, var_length_id);
+    }
+  else
+    {
+      error ("`format string' for WRITETEXT must be a CHARACTER string");
+      return error_mark_node;
+    }
+
+  empty_printed = False;
+  check_format_string (format_str, exprlist, argoffset + 3);
+  process_io_list (exprlist, &iolist_addr, &iolist_length, &iolist_rtx, 0, argoffset);
+  
+  /* tree to call the function */
+
+  filename = force_addr_of (get_chill_filename ());
+  linenumber = get_chill_linenumber ();
+
+  expand_expr_stmt (
+    build_chill_function_call (outfunction,
+      tree_cons (NULL_TREE, outstr_addr,
+	tree_cons (NULL_TREE, outstr_length,
+	  tree_cons (NULL_TREE, fstr_addr,
+	    tree_cons (NULL_TREE, fstr_length,
+	      tree_cons (NULL_TREE, iolist_addr,
+		tree_cons (NULL_TREE, iolist_length,
+		  tree_cons (NULL_TREE, filename,
+		    tree_cons (NULL_TREE, linenumber,
+		      NULL_TREE))))))))));
+
+  /* get rid of the iolist variable, if we have one */
+  if (iolist_rtx != NULL_RTX)
+    {
+      free_temp_slots ();
+      pop_temp_slots ();
+      free_temp_slots ();
+      pop_temp_slots ();
+    }
+
+  /* return something the rest of the machinery can work with,
+     i.e. (void)0 */
+  return build1 (CONVERT_EXPR, void_type_node, integer_zero_node);
+}
+
+tree
+build_chill_readtext (text_arg, exprlist)
+     tree text_arg, exprlist;
+{
+  tree instr_addr, instr_length, infunction;
+  tree fstr_addr, fstr_length, fstrtype;
+  tree iolist_addr = null_pointer_node;
+  tree iolist_length = integer_zero_node;
+  tree filename, linenumber;
+  tree format_str = NULL_TREE, indexexpr = NULL_TREE;
+  rtx  iolist_rtx = NULL_RTX;
+  int argoffset = 0;
+
+  /* make some checks */
+  if (text_arg == NULL_TREE || TREE_CODE (text_arg) == ERROR_MARK)
+    return error_mark_node;
+
+  if (exprlist != NULL_TREE)
+    {
+      if (TREE_CODE (exprlist) != TREE_LIST)
+	return error_mark_node;
+    }
+  
+  /* check the text argument */
+  if (CH_CHARS_TYPE_P (TREE_TYPE (text_arg)))
+    {
+      instr_addr = force_addr_of (text_arg);
+      instr_length = size_in_bytes (TREE_TYPE (text_arg));
+      infunction = lookup_name (get_identifier ("__readtext_s"));
+      format_str = TREE_VALUE (exprlist);
+      exprlist = TREE_CHAIN (exprlist);
+    }
+  else if (chill_varying_string_type_p (TREE_TYPE (text_arg)))
+    {
+      instr_addr
+	= force_addr_of (build_component_ref (text_arg, var_data_id));
+      instr_length = build_component_ref (text_arg, var_length_id);
+      infunction = lookup_name (get_identifier ("__readtext_s"));
+      format_str = TREE_VALUE (exprlist);
+      exprlist = TREE_CHAIN (exprlist);
+    }
+  else if (CH_IS_TEXT_MODE (TREE_TYPE (text_arg)))
+    {
+      /* we have a text mode */
+      tree indexmode;
+
+      if (! check_text (text_arg, 1, "READTEXT"))
+	return error_mark_node;
+      indexmode = text_indexmode (TREE_TYPE (text_arg));
+      if (indexmode == void_type_node)
+	{
+	  /* no index */
+	  format_str = TREE_VALUE (exprlist);
+	  exprlist = TREE_CHAIN (exprlist);
+	}
+      else
+	{
+	  /* we have an index. there must be an index argument before format string */
+	  indexexpr = TREE_VALUE (exprlist);
+	  exprlist = TREE_CHAIN (exprlist);
+	  if (! CH_COMPATIBLE (indexexpr, indexmode))
+	    {
+	      if (chill_varying_string_type_p (TREE_TYPE (indexexpr)) ||
+		  (CH_CHARS_TYPE_P (TREE_TYPE (indexexpr)) ||
+		   (flag_old_strings && TREE_CODE (indexexpr) == INTEGER_CST &&
+		    TREE_CODE (TREE_TYPE (indexexpr)) == CHAR_TYPE)))
+		error ("missing index expression");
+	      else
+		error ("incompatible index mode");
+	      return error_mark_node;
+	    }
+	  if (exprlist == NULL_TREE)
+	    {
+	      error ("Too few arguments in call to `readtext'");
+	      return error_mark_node;
+	    }
+	  format_str = TREE_VALUE (exprlist);
+	  exprlist = TREE_CHAIN (exprlist);
+	  argoffset = 1;
+	}
+      instr_addr = force_addr_of (text_arg);
+      instr_length = convert (integer_type_node, indexexpr);
+      infunction = lookup_name (get_identifier ("__readtext_f"));
+    }
+  else
+    {
+      error ("argument 1 for READTEXT must be a TEXT location or CHARS(n) [ VARYING ] expression");
+      return error_mark_node;
+    }
+  
+  /* check the format string */
+  fstrtype = TREE_TYPE (format_str);
+  if (CH_CHARS_TYPE_P (fstrtype))
+    {
+      /* we have a character string */
+      fstr_addr = force_addr_of (format_str);
+      fstr_length = size_in_bytes (fstrtype);
+    }
+  else if (chill_varying_string_type_p (fstrtype))
+    {
+      /* we have a CHARS(n) VARYING */
+      fstr_addr
+	= force_addr_of (build_component_ref (format_str, var_data_id));
+      fstr_length = build_component_ref (format_str, var_length_id);
+    }
+  else
+    {
+      error ("`format string' for READTEXT must be a CHARACTER string");
+      return error_mark_node;
+    }
+
+  empty_printed = False;
+  check_format_string (format_str, exprlist, argoffset + 3);
+  process_io_list (exprlist, &iolist_addr, &iolist_length, &iolist_rtx, 1, argoffset);
+
+  /* build the function call */
+  filename = force_addr_of (get_chill_filename ());
+  linenumber = get_chill_linenumber ();
+  expand_expr_stmt (
+    build_chill_function_call (infunction,
+      tree_cons (NULL_TREE, instr_addr,
+	tree_cons (NULL_TREE, instr_length,
+	  tree_cons (NULL_TREE, fstr_addr,
+	    tree_cons (NULL_TREE, fstr_length,
+	      tree_cons (NULL_TREE, iolist_addr,
+		tree_cons (NULL_TREE, iolist_length,
+		  tree_cons (NULL_TREE, filename,
+		    tree_cons (NULL_TREE, linenumber,
+		      NULL_TREE))))))))));
+  
+  /* get rid of the iolist variable, if we have one */
+  if (iolist_rtx != NULL_RTX)
+    {
+      free_temp_slots ();
+      pop_temp_slots ();
+      free_temp_slots ();
+      pop_temp_slots ();
+    }
+  
+  /* return something the rest of the machinery can work with,
+     i.e. (void)0 */
+  return build1 (CONVERT_EXPR, void_type_node, integer_zero_node);
+}
+
+/* this function build all neccesary enum-tables used for
+   WRITETEXT or READTEXT of an enum */
+
+void build_enum_tables ()
+{
+  SAVE_ENUM_NAMES	*names;
+  SAVE_ENUMS		*wrk;
+  void		*saveptr;
+  /* 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;
+    
+  if (pass == 1)
+    return;
+
+  save_maximum_field_alignment = maximum_field_alignment;
+  maximum_field_alignment = 0;
+
+  /* output all names */
+  names = used_enum_names;
+    
+  while (names != (SAVE_ENUM_NAMES *)0)
+    {
+      tree	var = get_unique_identifier ("ENUMNAME");
+      tree	type;
+	
+      type = build_string_type (char_type_node,
+				build_int_2 (IDENTIFIER_LENGTH (names->name) + 1, 0));
+      names->decl = decl_temp1 (var, type, 1,
+				build_chill_string (IDENTIFIER_LENGTH (names->name) + 1,
+						    IDENTIFIER_POINTER (names->name)),
+				0, 0);
+      names = names->forward;
+    }
+
+  /* output the tables and pointers to tables */
+  wrk = used_enums;
+  while (wrk != (SAVE_ENUMS *)0)
+    {
+      tree	varptr = wrk->ptrdecl;
+      tree	table_addr = null_pointer_node;
+      tree	init = NULL_TREE, one_entry;
+      tree	table, idxlist, tabletype, addr;
+      SAVE_ENUM_VALUES	*vals;
+      int	i;
+	
+      vals = wrk->vals;
+      for (i = 0; i < wrk->num_vals; i++)
+	{
+	  tree decl = vals->name->decl;
+	  addr = build1 (ADDR_EXPR,
+			 build_pointer_type (char_type_node),
+			 decl);
+	  TREE_CONSTANT (addr) = 1;
+	  one_entry = tree_cons (NULL_TREE, build_int_2 (vals->val, 0),
+				 tree_cons (NULL_TREE, addr, NULL_TREE));
+	  one_entry = build_nt (CONSTRUCTOR, NULL_TREE, one_entry);
+	  init = tree_cons (NULL_TREE, one_entry, init);
+	  vals++;
+	}
+
+      /* add the terminator (name = null_pointer_node) to constructor */
+      one_entry = tree_cons (NULL_TREE, integer_zero_node,
+			     tree_cons (NULL_TREE, null_pointer_node, NULL_TREE));
+      one_entry = build_nt (CONSTRUCTOR, NULL_TREE, one_entry);
+      init = tree_cons (NULL_TREE, one_entry, init);
+      init = nreverse (init);
+      init = build_nt (CONSTRUCTOR, NULL_TREE, init);
+      TREE_CONSTANT (init) = 1;
+
+      /* generate table */
+      idxlist = build_tree_list (NULL_TREE,
+				 build_chill_range_type (NULL_TREE,
+							 integer_zero_node,
+							 build_int_2 (wrk->num_vals, 0)));
+      tabletype = build_chill_array_type (TREE_TYPE (enum_table_type),
+					  idxlist, 0, NULL_TREE);
+      table = decl_temp1 (get_unique_identifier ("ENUMTAB"), tabletype,
+			  1, init, 0, 0);
+      table_addr = build1 (ADDR_EXPR,
+			   build_pointer_type (TREE_TYPE (enum_table_type)),
+			   table);
+      TREE_CONSTANT (table_addr) = 1;
+
+      /* generate pointer to table */
+      decl_temp1 (DECL_NAME (varptr), TREE_TYPE (table_addr),
+		  1, table_addr, 0, 0);
+
+      /* free that stuff */
+      saveptr = wrk->forward;
+	
+      free (wrk->vals);
+      free (wrk);
+	
+      /* next enum */
+      wrk = saveptr;
+    }
+
+  /* free all the names */
+  names = used_enum_names;
+  while (names != (SAVE_ENUM_NAMES *)0)
+    {
+      saveptr = names->forward;
+      free (names);
+      names = saveptr;
+    }
+
+  used_enums = (SAVE_ENUMS *)0;
+  used_enum_names = (SAVE_ENUM_NAMES *)0;
+  maximum_field_alignment = save_maximum_field_alignment;
+}
diff --git a/gcc/ch/lex.c b/gcc/ch/lex.c
new file mode 100644
index 0000000..a3dbbb2
--- /dev/null
+++ b/gcc/ch/lex.c
@@ -0,0 +1,2169 @@
+/* Lexical analyzer for GNU CHILL. -*- C -*-
+   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
+	 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 <errno.h>
+#include <setjmp.h>
+#include <ctype.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+
+#include "config.h"
+#include "tree.h"
+#include "input.h"
+
+#include "lex.h"
+#include "ch-tree.h"
+#include "flags.h"
+#include "parse.h"
+#include "obstack.h"
+
+#ifdef MULTIBYTE_CHARS
+#include <stdlib.h>
+#include <locale.h>
+#endif
+
+/* include the keyword recognizers */
+#include "hash.h"
+
+#undef strchr
+
+FILE* finput;
+
+static int	last_token = 0;
+/* Sun's C compiler warns about the safer sequence 
+   do { .. } while 0 
+   when there's a 'return' inside the braces, so don't use it */
+#define RETURN_TOKEN(X) { last_token = X; return (X); }
+
+/* This is set non-zero to force incoming tokens to lowercase. */
+extern int ignore_case;
+
+extern int module_number;
+extern int serious_errors;
+
+/* This is non-zero to recognize only uppercase special words. */
+extern int special_UC;
+
+extern struct obstack permanent_obstack;
+extern struct obstack temporary_obstack;
+
+#ifndef errno
+extern int errno;
+#endif
+
+extern tree build_string_type        PROTO((tree, tree));
+extern void error                    PROTO((char *, ...));
+extern void error_with_file_and_line PROTO((char *, int, char *, ...));
+extern void grant_use_seizefile      PROTO((char *));
+extern void pedwarn                  PROTO((char *, ...));
+extern void pfatal_with_name         PROTO((char *));
+extern void push_obstacks PROTO((struct obstack *, struct obstack *));
+extern void set_identifier_size      PROTO((int));
+extern void sorry                    PROTO((char *, ...));
+extern int  target_isinf             PROTO((REAL_VALUE_TYPE));
+extern int  tolower                  PROTO((int));
+extern void warning                  PROTO((char *, ...));
+
+/* forward declarations */
+static void close_input_file         PROTO((char *));
+static tree convert_bitstring        PROTO((char *));
+static tree convert_integer          PROTO((char *));
+static void maybe_downcase           PROTO((char *));
+static int  maybe_number             PROTO((char *));
+static tree equal_number             PROTO((void));
+static void handle_use_seizefile_directive PROTO((int));
+static int  handle_name		     PROTO((tree));
+static void push_back                PROTO((int));
+static char *readstring              PROTO((int, int *));
+static void read_directive	     PROTO((void));
+static tree read_identifier	     PROTO((int));
+static tree read_number              PROTO((int));
+static void skip_c_comment           PROTO((void));
+static void skip_line_comment        PROTO((void));
+static int  skip_whitespace          PROTO((void));
+static tree string_or_char           PROTO((int, char *));
+
+/* next variables are public, because ch-actions uses them */
+
+/* the default grantfile name, set by lang_init */
+tree default_grant_file = 0;
+
+/* These tasking-related variables are NULL at the start of each 
+   compiler pass, and are set to an expression tree if and when
+   a compiler directive is parsed containing an expression.
+   The NULL state is significant;  it means 'no user-specified
+   signal_code (or whatever) has been parsed'. */
+
+/* process type, set by <> PROCESS_TYPE = number <> */
+tree process_type = NULL_TREE;
+
+/* send buffer default priority,
+   set by <> SEND_BUFFER_DEFAULT_PRIORITY = number <> */
+tree send_buffer_prio = NULL_TREE;
+
+/* send signal default priority,
+   set by <> SEND_SIGNAL_DEFAULT_PRIORITY = number <> */
+tree send_signal_prio = NULL_TREE;
+
+/* signal code, set by <> SIGNAL_CODE = number <> */
+tree signal_code = NULL_TREE;
+
+/* flag for range checking */
+int range_checking = 1;
+
+/* flag for NULL pointer checking */
+int empty_checking = 1;
+
+/* flag to indicate making all procedure local variables
+   to be STATIC */
+int all_static_flag = 0;
+
+/* flag to indicate -fruntime-checking command line option.
+   Needed for initializing range_checking and empty_checking
+   before pass 2 */
+int runtime_checking_flag = 1;
+
+/* The elements of `ridpointers' are identifier nodes
+   for the reserved type names and storage classes.
+   It is indexed by a RID_... value.  */
+tree ridpointers[(int) RID_MAX];
+
+/* Nonzero tells yylex to ignore \ in string constants.  */
+static int ignore_escape_flag = 0;
+
+static int maxtoken;		/* Current nominal length of token buffer.  */
+char *token_buffer;	/* Pointer to token buffer.
+			   Actual allocated length is maxtoken + 2.
+			   This is not static because objc-parse.y uses it.  */
+
+/* implement yylineno handling for flex */
+#define yylineno lineno
+
+static int inside_c_comment = 0;
+
+static int saw_eol = 0; /* 1 if we've just seen a '\n' */
+static int saw_eof = 0; /* 1 if we've just seen an EOF */
+
+typedef struct string_list
+  {
+    struct string_list *next;
+    char               *str;
+  } STRING_LIST;
+
+/* list of paths specified on the compiler command line by -L options. */
+static STRING_LIST *seize_path_list = (STRING_LIST *)0;
+
+/* List of seize file names.  Each TREE_VALUE is an identifier
+   (file name) from a <>USE_SEIZE_FILE<> directive.
+   The TREE_PURPOSE is non-NULL if a USE_SEIZE_FILE directive has been
+   written to the grant file. */
+static tree files_to_seize     = NULL_TREE;
+/* Last node on files_to_seize list. */
+static tree last_file_to_seize = NULL_TREE;
+/* Pointer into files_to_seize list:  Next unparsed file to read. */
+static tree next_file_to_seize = NULL_TREE;
+
+/* The most recent use_seize_file directive. */
+tree use_seizefile_name = NULL_TREE;
+
+/* If non-NULL, the name of the seizefile we're currently processing. */
+tree current_seizefile_name = NULL_TREE;
+
+/* called to reset for pass 2 */
+static void
+ch_lex_init ()
+{
+  current_seizefile_name = NULL_TREE;
+
+  lineno = 0;
+
+  saw_eol = 0;
+  saw_eof = 0;
+  /* Initialize these compiler-directive variables. */
+  process_type     = NULL_TREE;
+  send_buffer_prio = NULL_TREE;
+  send_signal_prio = NULL_TREE;
+  signal_code      = NULL_TREE;
+  all_static_flag  = 0;
+  /* reinitialize rnage checking and empty checking */
+  range_checking = runtime_checking_flag;
+  empty_checking = runtime_checking_flag;
+}
+
+
+char *
+init_parse (filename)
+     char *filename;
+{
+  int lowercase_standard_names = ignore_case || ! special_UC;
+
+  /* Open input file.  */
+  if (filename == 0 || !strcmp (filename, "-"))
+    {
+      finput = stdin;
+      filename = "stdin";
+    }
+  else
+    finput = fopen (filename, "r");
+  if (finput == 0)
+    pfatal_with_name (filename);
+
+#ifdef IO_BUFFER_SIZE
+  setvbuf (finput, (char *) xmalloc (IO_BUFFER_SIZE), _IOFBF, IO_BUFFER_SIZE);
+#endif
+
+  /* Make identifier nodes long enough for the language-specific slots.  */
+  set_identifier_size (sizeof (struct lang_identifier));
+
+  /* Start it at 0, because check_newline is called at the very beginning
+     and will increment it to 1.  */
+  lineno = 0;
+
+  /* Initialize these compiler-directive variables. */
+  process_type     = NULL_TREE;
+  send_buffer_prio = NULL_TREE;
+  send_signal_prio = NULL_TREE;
+  signal_code      = NULL_TREE;
+
+  maxtoken         = 40;
+  token_buffer     = xmalloc ((unsigned)(maxtoken + 2));
+
+  init_chill_expand ();
+
+#define ENTER_STANDARD_NAME(RID, LOWER, UPPER) \
+  ridpointers[(int) RID] = \
+    get_identifier (lowercase_standard_names ? LOWER : UPPER)
+
+  ENTER_STANDARD_NAME (RID_ALL,		"all",		"ALL");
+  ENTER_STANDARD_NAME (RID_ASSERTFAIL,	"assertfail",	"ASSERTFAIL");
+  ENTER_STANDARD_NAME (RID_ASSOCIATION,	"association",	"ASSOCIATION");
+  ENTER_STANDARD_NAME (RID_BIN,         "bin",          "BIN");
+  ENTER_STANDARD_NAME (RID_BOOL,	"bool",		"BOOL");
+  ENTER_STANDARD_NAME (RID_BOOLS,	"bools",	"BOOLS");
+  ENTER_STANDARD_NAME (RID_BYTE,	"byte",		"BYTE");
+  ENTER_STANDARD_NAME (RID_CHAR,	"char",		"CHAR");
+  ENTER_STANDARD_NAME (RID_DOUBLE,	"double",	"DOUBLE");
+  ENTER_STANDARD_NAME (RID_DURATION,    "duration",     "DURATION");
+  ENTER_STANDARD_NAME (RID_DYNAMIC,	"dynamic",	"DYNAMIC");
+  ENTER_STANDARD_NAME (RID_ELSE,	"else",		"ELSE");
+  ENTER_STANDARD_NAME (RID_EMPTY,	"empty",	"EMPTY");
+  ENTER_STANDARD_NAME (RID_FALSE,	"false",	"FALSE");
+  ENTER_STANDARD_NAME (RID_FLOAT,	"float",	"FLOAT");
+  ENTER_STANDARD_NAME (RID_GENERAL,	"general",	"GENERAL");
+  ENTER_STANDARD_NAME (RID_IN,		"in",		"IN");
+  ENTER_STANDARD_NAME (RID_INLINE,	"inline",	"INLINE");
+  ENTER_STANDARD_NAME (RID_INOUT,	"inout",	"INOUT");
+  ENTER_STANDARD_NAME (RID_INSTANCE,	"instance",	"INSTANCE");
+  ENTER_STANDARD_NAME (RID_INT,		"int",		"INT");
+  ENTER_STANDARD_NAME (RID_LOC,		"loc",		"LOC");
+  ENTER_STANDARD_NAME (RID_LONG,	"long",		"LONG");
+  ENTER_STANDARD_NAME (RID_LONG_REAL,	"long_real",	"LONG_REAL");
+  ENTER_STANDARD_NAME (RID_NULL,	"null",		"NULL");
+  ENTER_STANDARD_NAME (RID_OUT,		"out",		"OUT");
+  ENTER_STANDARD_NAME (RID_OVERFLOW,	"overflow",	"OVERFLOW");
+  ENTER_STANDARD_NAME (RID_PTR,		"ptr",		"PTR");
+  ENTER_STANDARD_NAME (RID_READ,	"read",		"READ");
+  ENTER_STANDARD_NAME (RID_REAL,	"real",		"REAL");
+  ENTER_STANDARD_NAME (RID_RANGE,	"range",	"RANGE");
+  ENTER_STANDARD_NAME (RID_RANGEFAIL,	"rangefail",	"RANGEFAIL");
+  ENTER_STANDARD_NAME (RID_RECURSIVE,	"recursive",	"RECURSIVE");
+  ENTER_STANDARD_NAME (RID_SHORT,	"short",	"SHORT");
+  ENTER_STANDARD_NAME (RID_SIMPLE,	"simple",	"SIMPLE");
+  ENTER_STANDARD_NAME (RID_TIME,        "time",         "TIME");
+  ENTER_STANDARD_NAME (RID_TRUE,	"true",		"TRUE");
+  ENTER_STANDARD_NAME (RID_UBYTE,	"ubyte",	"UBYTE");
+  ENTER_STANDARD_NAME (RID_UINT,	"uint",		"UINT");
+  ENTER_STANDARD_NAME (RID_ULONG,	"ulong",	"ULONG");
+  ENTER_STANDARD_NAME (RID_UNSIGNED,	"unsigned",	"UNSIGNED");
+  ENTER_STANDARD_NAME (RID_USHORT,	"ushort",	"USHORT");
+  ENTER_STANDARD_NAME (RID_VOID,	"void",		"VOID");
+
+  return filename;
+}
+
+void
+finish_parse ()
+{
+  if (finput != NULL)
+    fclose (finput);
+}
+
+static int yywrap ();
+
+#define YY_PUTBACK_SIZE 5
+#define YY_BUF_SIZE 1000
+
+static char yy_buffer[YY_PUTBACK_SIZE + YY_BUF_SIZE];
+static char *yy_cur = yy_buffer + YY_PUTBACK_SIZE;
+static char *yy_lim = yy_buffer + YY_PUTBACK_SIZE;
+
+int yy_refill ()
+{
+  char *buf = yy_buffer + YY_PUTBACK_SIZE;
+  int c, result;
+  bcopy (yy_cur - YY_PUTBACK_SIZE, yy_buffer, YY_PUTBACK_SIZE);
+  yy_cur = buf;
+
+ retry:
+  if (saw_eof)
+    {
+      if (yywrap ())
+	return EOF;
+      saw_eof = 0;
+      goto retry;
+    }
+
+  result = 0;
+  while (saw_eol)
+    {
+      c = check_newline ();
+      if (c == EOF)
+        {
+	  saw_eof = 1;
+	  goto retry;
+	}
+      else if (c != '\n')
+	{
+	  saw_eol = 0;
+	  buf[result++] = c;
+	}
+    }
+  
+  while (result < YY_BUF_SIZE)
+    {
+      c = getc(finput);
+      if (c == EOF)
+        {
+	  saw_eof = 1;
+	  break;
+	}
+      buf[result++] = c;
+      
+      /* Because we might switch input files on a compiler directive
+	 (that end with '>', don't read past a '>', just in case. */
+      if (c == '>')
+	break;
+      
+      if (c == '\n')
+	{
+#ifdef YYDEBUG
+	  extern int yydebug;
+	  if (yydebug)
+            fprintf (stderr, "-------------------------- finished Line %d\n",
+		     yylineno);
+#endif
+	  saw_eol = 1;
+	  break;
+	}
+    }
+
+  yy_lim = yy_cur + result;
+
+  return yy_lim > yy_cur ? *yy_cur++ : EOF;
+}
+
+#define input() (yy_cur < yy_lim ? *yy_cur++ : yy_refill ())
+
+#define unput(c) (*--yy_cur = (c))
+
+
+int starting_pass_2 = 0;
+
+int
+yylex ()
+{
+  int nextc;
+  int len;
+  char* tmp;
+  int base;
+  int ch;
+ retry:
+  ch = input ();
+  if (starting_pass_2)
+    {
+      starting_pass_2 = 0;
+      unput (ch);
+      return END_PASS_1;
+    }
+  switch (ch)
+    {
+    case ' ': case '\t': case '\n': case '\f': case '\b': case '\v': case '\r':
+      goto retry;
+    case '[':
+      return LPC;
+    case ']':
+      return RPC;
+    case '{':
+      return LC;
+    case '}':
+      return RC;
+    case '(':
+      nextc = input ();
+      if (nextc == ':')
+	return LPC;
+      unput (nextc);
+      return LPRN;
+    case ')':
+      return RPRN;
+    case ':':
+      nextc = input ();
+      if (nextc == ')')
+	return RPC;
+      else if (nextc == '=')
+	return ASGN;
+      unput (nextc);
+      return COLON;
+    case ',':
+      return COMMA;
+    case ';':
+      return SC;
+    case '+':
+      return PLUS;
+    case '-':
+      nextc = input ();
+      if (nextc == '>')
+	return ARROW;
+      if (nextc == '-')
+	{
+	  skip_line_comment ();
+	  goto retry;
+	}
+      unput (nextc);
+      return SUB;
+    case '*':
+      return MUL;
+    case '=':
+      return EQL;
+    case '/':
+      nextc = input ();
+      if (nextc == '/')
+	return CONCAT;
+      else if (nextc == '=')
+	return NE;
+      else if (nextc == '*')
+	{
+	  skip_c_comment ();
+	  goto retry;
+	}
+      unput (nextc);
+      return DIV;
+    case '<':
+      nextc = input ();
+      if (nextc == '=')
+	return LTE;
+      if (nextc == '>')
+	{
+	  read_directive ();
+	  goto retry;
+	}
+      unput (nextc);
+      return LT;
+    case '>':
+      nextc = input ();
+      if (nextc == '=')
+	return GTE;
+      unput (nextc);
+      return GT;
+
+    case 'D': case 'd':
+      base = 10;
+      goto maybe_digits;
+    case 'B': case 'b':
+      base = 2;
+      goto maybe_digits;
+    case 'H': case 'h':
+      base = 16;
+      goto maybe_digits;
+    case 'O': case 'o':
+      base = 8;
+      goto maybe_digits;
+    case 'C': case 'c':
+      nextc = input ();
+      if (nextc == '\'')
+	{
+	  int byte_val = 0;
+	  char *start;
+	  int len = 0;  /* Number of hex digits seen. */
+	  for (;;)
+	    {
+	      ch = input ();
+	      if (ch == '\'')
+		break;
+	      if (ch == '_')
+		continue;
+	      if (!isxdigit (ch))           /* error on non-hex digit */
+		{
+		  if (pass == 1)
+		    error ("invalid C'xx' ");
+		  break;
+		}
+	      if (ch >= 'a')
+		ch -= ' ';
+	      ch -= '0';
+	      if (ch > 9)
+		ch -= 7;
+	      byte_val *= 16;
+	      byte_val += (int)ch;
+
+	      if (len & 1) /* collected two digits, save byte */
+		obstack_1grow (&temporary_obstack, (char) byte_val);
+	      len++;
+	    }
+	  start = obstack_finish (&temporary_obstack);
+	  yylval.ttype = string_or_char (len >> 1, start);
+	  obstack_free (&temporary_obstack, start);
+	  return len == 2 ? SINGLECHAR : STRING;
+	}
+      unput (nextc);
+      goto letter;
+
+    maybe_digits:
+      nextc = input ();
+      if (nextc == '\'')
+	{
+	  char *start;
+	  obstack_1grow (&temporary_obstack, ch);
+	  obstack_1grow (&temporary_obstack, nextc);
+	  for (;;)
+	    {
+	      ch = input ();
+	      if (isalnum (ch))
+		obstack_1grow (&temporary_obstack, ch);
+	      else if (ch != '_')
+		break;
+	    }
+	  obstack_1grow (&temporary_obstack, '\0');
+	  start = obstack_finish (&temporary_obstack);
+	  if (ch != '\'')
+	    {
+	      unput (ch);
+	      yylval.ttype = convert_integer (start); /* Pass base? */
+	      return NUMBER;
+	    }
+	  else
+	    {
+	      yylval.ttype = convert_bitstring (start);
+	      return BITSTRING;
+	    }
+	}
+      unput (nextc);
+      goto letter;
+
+    case 'A':                                   case 'E':
+    case 'F':  case 'G':             case 'I':  case 'J':
+    case 'K':  case 'L':  case 'M':  case 'N':
+    case 'P':  case 'Q':  case 'R':  case 'S':  case 'T':
+    case 'U':  case 'V':  case 'W':  case 'X':  case 'Y':
+    case 'Z':
+    case 'a':                                   case 'e':
+    case 'f':  case 'g':             case 'i':  case 'j':
+    case 'k':  case 'l':  case 'm':  case 'n':
+    case 'p':  case 'q':  case 'r':  case 's':  case 't':
+    case 'u':  case 'v':  case 'w':  case 'x':  case 'y':
+    case 'z':
+    case '_':
+    letter:
+      return handle_name (read_identifier (ch));
+    case '\'':
+      tmp = readstring ('\'', &len);
+      yylval.ttype = string_or_char (len, tmp);
+      free (tmp);
+      return len == 1 ? SINGLECHAR : STRING;
+    case '\"':
+      tmp = readstring ('\"', &len);
+      yylval.ttype = build_chill_string (len, tmp);
+      free (tmp);
+      return STRING;
+    case '.':
+      nextc = input ();
+      unput (nextc);
+      if (isdigit (nextc)) /* || nextc == '_')  we don't start numbers with '_' */
+	goto number;
+      return DOT;
+    case '0': case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9':
+    number:
+      yylval.ttype = read_number (ch);
+      return TREE_CODE (yylval.ttype) == REAL_CST ? FLOATING : NUMBER;
+    default:
+      return ch;
+    }
+}
+
+static void
+close_input_file (fn)
+  char *fn;
+{
+  if (finput == NULL)
+    abort ();
+
+  if (finput != stdin && fclose (finput) == EOF)
+    {
+      error ("can't close %s", fn);
+      abort ();
+    }
+  finput = NULL;
+}
+
+/* Return an identifier, starting with FIRST and then reading
+   more characters using input().  Return an IDENTIFIER_NODE. */
+
+static tree
+read_identifier (first)
+     int first; /* First letter of identifier */
+{
+  tree id;
+  char *start;
+  for (;;)
+    {
+      obstack_1grow (&temporary_obstack, first);
+      first = input ();
+      if (first == EOF)
+	break;
+      if (! isalnum (first) && first != '_')
+	{
+	  unput (first);
+	  break;
+	}
+    }
+  obstack_1grow (&temporary_obstack, '\0');
+  start = obstack_finish (&temporary_obstack);
+  maybe_downcase (start);
+  id = get_identifier (start);
+  obstack_free (&temporary_obstack, start);
+  return id;
+}
+
+/* Given an identifier ID, check to see if it is a reserved name,
+   and return the appropriate token type. */
+
+static int
+handle_name (id)
+     tree id;
+{
+  struct resword *tp;
+  tp = in_word_set (IDENTIFIER_POINTER (id), IDENTIFIER_LENGTH (id));
+  if (tp != NULL
+      && special_UC == isupper (tp->name[0])
+      && (tp->flags == RESERVED || tp->flags == PREDEF))
+    {
+      if (tp->rid != NORID)
+	yylval.ttype = ridpointers[tp->rid];
+      else if (tp->token == THIS)
+	yylval.ttype = lookup_name (get_identifier ("__whoami"));
+      return tp->token;
+    }
+  yylval.ttype = id;
+  return NAME;
+}
+
+static tree
+read_number (ch)
+     int ch; /* Initial character */
+{
+  tree num;
+  char *start;
+  int is_float = 0;
+  for (;;)
+    {
+      if (ch != '_')
+	obstack_1grow (&temporary_obstack, ch);
+      ch = input ();
+      if (! isdigit (ch) && ch != '_')
+	break;
+    }
+  if (ch == '.')
+    {
+      do
+	{
+	  if (ch != '_')
+	    obstack_1grow (&temporary_obstack, ch);
+	  ch = input ();
+	} while (isdigit (ch) || ch == '_');
+      is_float++;
+    }
+  if (ch == 'd' || ch == 'D' || ch == 'e' || ch == 'E')
+    {
+      /* Convert exponent indication [eEdD] to 'e'. */
+      obstack_1grow (&temporary_obstack, 'e');
+      ch = input ();
+      if (ch == '+' || ch == '-')
+	{
+	  obstack_1grow (&temporary_obstack, ch);
+	  ch = input ();
+	}
+      if (isdigit (ch) || ch == '_')
+	{
+	  do
+	    {
+	      if (ch != '_')
+		obstack_1grow (&temporary_obstack, ch);
+	      ch = input ();
+	    } while (isdigit (ch) || ch == '_');
+	}
+      else
+	{
+	  error ("malformed exponent part of floating-point literal");
+	}
+      is_float++;
+    }
+  if (ch != EOF)
+    unput (ch);
+  obstack_1grow (&temporary_obstack, '\0');
+  start = obstack_finish (&temporary_obstack);
+  if (is_float)
+    {
+      REAL_VALUE_TYPE value;
+      tree  type = double_type_node;
+      errno = 0;
+      value = REAL_VALUE_ATOF (start, TYPE_MODE (type));
+      obstack_free (&temporary_obstack, start);
+      if (TARGET_FLOAT_FORMAT != IEEE_FLOAT_FORMAT
+	  && REAL_VALUE_ISINF (value) && pedantic)
+	pedwarn ("real number exceeds range of REAL");
+      num = build_real (type, value);
+    }
+  else
+    num = convert_integer (start);
+  CH_DERIVED_FLAG (num) = 1;
+  return num;
+}
+
+/* Skip to the end of a compiler directive. */
+
+static void
+skip_directive ()
+{
+  int ch = input ();
+  for (;;)
+    {
+      if (ch == EOF)
+	{
+	  error ("end-of-file in '<>' directive");
+	  break;
+	}
+      if (ch == '\n')
+	break;
+      if (ch == '<')
+	{
+	  ch = input ();
+	  if (ch == '>')
+	    break;
+	}
+      ch = input ();
+    }
+  starting_pass_2 = 0;
+}
+
+/* Read a compiler directive.  ("<>{WS}" have already been read. ) */
+static void
+read_directive ()
+{
+  struct resword *tp;
+  tree id;
+  int ch = skip_whitespace();
+  if (isalpha (ch) || ch == '_')
+    id = read_identifier (ch);
+  else if (ch == EOF)
+    {
+      error ("end-of-file in '<>' directive"); 
+      to_global_binding_level (); 
+      return;
+    }
+  else
+    {
+      warning ("unrecognized compiler directive");
+      skip_directive ();
+      return;
+    }
+  tp = in_word_set (IDENTIFIER_POINTER (id), IDENTIFIER_LENGTH (id));
+  if (tp == NULL || special_UC != isupper (tp->name[0]))
+    {
+      if (pass == 1)
+	warning ("unrecognized compiler directive `%s'",
+		 IDENTIFIER_POINTER (id));
+    }
+  else
+    switch (tp->token)
+      {
+      case ALL_STATIC_OFF:
+	all_static_flag = 0;
+	break;
+      case ALL_STATIC_ON:
+	all_static_flag = 1;
+	break;
+      case EMPTY_OFF:
+	empty_checking = 0;
+	break;
+      case EMPTY_ON:
+	empty_checking = 1;
+	break;
+      case IGNORED_DIRECTIVE:
+	break;
+      case PROCESS_TYPE_TOKEN:
+	process_type = equal_number ();
+	break;
+      case RANGE_OFF:
+	range_checking = 0;
+	break;
+      case RANGE_ON:
+	range_checking = 1;
+	break;
+      case SEND_SIGNAL_DEFAULT_PRIORITY: 
+	send_signal_prio = equal_number ();
+	break;
+      case SEND_BUFFER_DEFAULT_PRIORITY:
+	send_buffer_prio = equal_number ();
+	break;
+      case SIGNAL_CODE:
+	signal_code = equal_number ();
+	break;
+      case USE_SEIZE_FILE:
+	handle_use_seizefile_directive (0);
+	break;
+      case USE_SEIZE_FILE_RESTRICTED:
+	handle_use_seizefile_directive (1);
+	break;
+      default:
+	if (pass == 1)
+	  warning ("unrecognized compiler directive `%s'", 
+		   IDENTIFIER_POINTER (id));
+	break;
+      }
+  skip_directive ();
+}
+
+
+tree
+build_chill_string (len, str)
+    int   len;
+    char  *str;
+{
+  tree t;
+
+  push_obstacks (&permanent_obstack, &permanent_obstack);
+  t = build_string (len, str);
+  TREE_TYPE (t) = build_string_type (char_type_node, 
+				     build_int_2 (len, 0));
+  CH_DERIVED_FLAG (t) = 1;
+  pop_obstacks ();
+  return t;
+}
+
+
+static tree
+string_or_char (len, str)
+     int   len;
+     char *str;
+{
+  tree result;
+  
+  push_obstacks (&permanent_obstack, &permanent_obstack);
+  if (len == 1)
+    {
+      result = build_int_2 ((unsigned char)str[0], 0);
+      CH_DERIVED_FLAG (result) = 1;
+      TREE_TYPE (result) = char_type_node;
+    }
+  else
+    result = build_chill_string (len, str);
+  pop_obstacks ();
+  return result;
+}
+
+
+static void
+maybe_downcase (str)
+    char        *str;
+{
+  if (! ignore_case)
+    return;
+  while (*str)
+    {
+      if (isupper (*str))
+	*str = tolower (*str);
+      str++;
+    }
+}
+
+
+static int
+maybe_number (s)
+  char	*s;
+{
+  char	fc;
+  
+  /* check for decimal number */
+  if (*s >= '0' && *s <= '9')
+    {
+      while (*s)
+	{
+	  if (*s >= '0' && *s <= '9')
+	    s++;
+	  else
+	    return 0;
+	}
+      return 1;
+    }
+  
+  fc = *s;
+  if (s[1] != '\'')
+    return 0;
+  s += 2;
+  while (*s)
+    {
+      switch (fc)
+	{
+	case 'd':
+	case 'D':
+	  if (*s < '0' || *s > '9')
+	    return 0;
+	  break;
+	case 'h':
+	case 'H':
+	  if (!isxdigit (*s))
+	    return 0;
+	  break;
+	case 'b':
+	case 'B':
+	  if (*s < '0' || *s > '1')
+	    return 0;
+	  break;
+	case 'o':
+	case 'O':
+	  if (*s < '0' || *s > '7')
+	    return 0;
+	  break;
+	default:
+	  return 0;
+	}
+      s++;
+    }
+  return 1;
+}
+
+static void
+push_back (c)
+char c;
+{
+  if (c == '\n')
+    lineno--;
+  unput (c);
+}
+
+static char *
+readstring (terminator, len)
+     char terminator;
+     int *len;
+{
+  int      c;
+  unsigned allocated = 1024;
+  char    *tmp = xmalloc (allocated);
+  int      i = 0;
+  
+  for (;;)
+    {
+      c = input ();
+      if (c == terminator)
+	{
+	  if ((c = input ()) != terminator)
+	    {
+	      unput (c);
+	      break;
+	    }
+	  else
+	    c = terminator;
+	}
+      if (c == '\n' || c == EOF)
+	  goto unterminated;
+      if (c == '^')
+	{
+	  c = input();
+	  if (c == EOF || c == '\n')
+	    goto unterminated;
+	  if (c == '^')
+	    goto storeit;
+	  if (c == '(')
+	    {
+	      int cc, count = 0;
+	      int base = 10;
+	      int next_apos = 0;
+	      int check_base = 1;
+	      c = 0;
+	      while (1)
+		{
+		  cc = input ();
+		  if (cc == terminator)
+		    {
+		      if (!(terminator == '\'' && next_apos))
+			{
+			  error ("unterminated control sequence");
+			  serious_errors++;
+			  goto done;
+			}
+		    }
+		  if (cc == EOF || cc == '\n')
+		    {
+		      c = cc;
+		      goto unterminated;
+		    }
+		  if (next_apos)
+		    {
+		      next_apos = 0;
+		      if (cc != '\'')
+			{
+			  error ("invalid integer literal in control sequence");
+			  serious_errors++;
+			  goto done;
+			}
+		      continue;
+		    }
+		  if (cc == ' ' || cc == '\t')
+		    continue;
+		  if (cc == ')')
+		    {
+		      if ((c < 0 || c > 255) && (pass == 1))
+			error ("control sequence overflow");
+		      if (! count && pass == 1)
+			error ("invalid control sequence");
+		      break;
+		    }
+		  else if (cc == ',')
+		    {
+		      if ((c < 0 || c > 255) && (pass == 1))
+			error ("control sequence overflow");
+		      if (! count && pass == 1)
+			error ("invalid control sequence");
+		      tmp[i++] = c;
+		      if (i == allocated)
+			{
+			  allocated += 1024;
+			  tmp = xrealloc (tmp, allocated);
+			}
+		      c = count = 0;
+		      base = 10;
+		      check_base = 1;
+		      continue;
+		    }
+		  else if (cc == '_')
+		    {
+		      if (! count && pass == 1)
+			error ("invalid integer literal in control sequence");
+		      continue;
+		    }
+		  if (check_base)
+		    {
+		      if (cc == 'D' || cc == 'd')
+			{
+			  base = 10;
+			  next_apos = 1;
+			}
+		      else if (cc == 'H' || cc == 'h')
+			{
+			  base = 16;
+			  next_apos = 1;
+			}
+		      else if (cc == 'O' || cc == 'o')
+			{
+			  base = 8;
+			  next_apos = 1;
+			}
+		      else if (cc == 'B' || cc == 'b')
+			{
+			  base = 2;
+			  next_apos = 1;
+			}
+		      check_base = 0;
+		      if (next_apos)
+			continue;
+		    }
+		  if (base == 2)
+		    {
+		      if (cc < '0' || cc > '1')
+			cc = -1;
+		      else
+			cc -= '0';
+		    }
+		  else if (base == 8)
+		    {
+		      if (cc < '0' || cc > '8')
+			cc = -1;
+		      else
+			cc -= '0';
+		    }
+		  else if (base == 10)
+		    {
+		      if (! isdigit (cc))
+			cc = -1;
+		      else
+			cc -= '0';
+		    }
+		  else if (base == 16)
+		    {
+		      if (!isxdigit (cc))
+			cc = -1;
+		      else
+			{
+			  if (cc >= 'a')
+			    cc -= ' ';
+			  cc -= '0';
+			  if (cc > 9)
+			    cc -= 7;
+			}
+		    }
+		  else
+		    {
+		      error ("invalid base in read control sequence");
+		      abort ();
+		    }
+		  if (cc == -1)
+		    {
+		      /* error in control sequence */
+		      if (pass == 1)
+			error ("invalid digit in control sequence");
+		      cc = 0;
+		    }
+		  c = (c * base) + cc;
+		  count++;
+		}
+	    }
+	  else
+	    c ^= 64;
+	}
+    storeit:
+      tmp[i++] = c;
+      if (i == allocated)
+	{
+	  allocated += 1024;
+	  tmp = xrealloc (tmp, allocated);
+	}
+    }
+ done:
+  tmp [*len = i] = '\0';
+  return tmp;
+
+unterminated:
+  if (c == '\n')
+    unput ('\n');
+  *len = 1;
+  if (pass == 1)
+    error ("unterminated string literal");  
+  to_global_binding_level ();
+  tmp[0] = '\0';
+  return tmp;
+}
+
+/* Convert an integer INTCHARS into an INTEGER_CST.
+   INTCHARS is on the temporary_obstack, and is popped by this function. */
+
+static tree
+convert_integer (intchars)
+     char *intchars;
+{
+#ifdef YYDEBUG
+  extern int yydebug;
+#endif
+  char *p = intchars;
+  char         *oldp = p;
+  int		base = 10, tmp;
+  int           valid_chars = 0;
+  int		overflow = 0;
+  tree		type;
+  HOST_WIDE_INT val_lo = 0, val_hi = 0;
+  tree		val;
+  
+  /* determine the base */
+  switch (*p)
+    {
+    case 'd':
+    case 'D':
+      p += 2;
+      break;
+    case 'o':
+    case 'O':
+      p += 2;
+      base = 8;
+      break;
+    case 'h':
+    case 'H':
+      p += 2;
+      base = 16;
+      break;
+    case 'b':
+    case 'B':
+      p += 2;
+      base = 2;
+      break;
+    default:
+      if (!isdigit (*p))   /* this test is for equal_number () */
+	{
+	  obstack_free (&temporary_obstack, intchars);
+	  return 0;
+	}
+      break;
+    }
+  
+  while (*p)
+    {
+      tmp = *p++;
+      if ((tmp == '\'') || (tmp == '_'))
+	continue;
+      if (tmp < '0')
+	goto bad_char;
+      if (tmp >= 'a')      /* uppercase the char */
+	tmp -= ' ';
+      switch (base)        /* validate the characters */
+	{
+	case 2:
+	  if (tmp > '1')
+	    goto bad_char;
+	  break;
+	case 8:
+	  if (tmp > '7')
+	    goto bad_char;
+	  break;
+	case 10:
+	  if (tmp > '9')
+	    goto bad_char;
+	  break;
+	case 16:
+	  if (tmp > 'F')
+	    goto bad_char;
+	  if (tmp > '9' && tmp < 'A')
+	    goto bad_char;
+	  break;
+	default:
+	  abort ();
+	}
+      tmp -= '0';
+      if (tmp > 9)
+	tmp -= 7;
+      if (mul_double (val_lo, val_hi, base, 0, &val_lo, &val_hi))
+	overflow++;
+      add_double (val_lo, val_hi, tmp, 0, &val_lo, &val_hi);
+      if (val_hi < 0)
+	overflow++;
+      valid_chars++;
+    }
+ bad_char:
+  obstack_free (&temporary_obstack, intchars);
+  if (!valid_chars)
+    {
+      if (pass == 2)
+	error ("invalid number format `%s'", oldp);
+      return 0;
+    }
+  val = build_int_2 (val_lo, val_hi);
+  /* We set the type to long long (or long long unsigned) so that
+     constant fold of literals is less likely to overflow.  */
+  if (int_fits_type_p (val, long_long_integer_type_node))
+    type = long_long_integer_type_node;
+  else
+    {
+      if (! int_fits_type_p (val, long_long_unsigned_type_node))
+	overflow++;
+      type = long_long_unsigned_type_node;
+    }
+  TREE_TYPE (val) = type;
+  CH_DERIVED_FLAG (val) = 1;
+  
+  if (overflow)
+    error ("integer literal too big");
+
+  return val;
+}
+
+/* Convert a bitstring literal on the temporary_obstack to
+   a bitstring CONSTRUCTOR.  Free the literal from the obstack. */
+
+static tree
+convert_bitstring (p)
+     char *p;
+{
+#ifdef YYDEBUG
+  extern int yydebug;
+#endif
+  int bl = 0, valid_chars = 0, bits_per_char = 0, c, k;
+  tree initlist = NULL_TREE;
+  tree val;
+  
+  /* Move p to stack so we can re-use temporary_obstack for result. */
+  char *oldp = (char*) alloca (strlen (p) + 1);
+  if (oldp == 0) fatal ("stack space exhausted");
+  strcpy (oldp, p);
+  obstack_free (&temporary_obstack, p);
+  p = oldp;
+  
+  switch (*p)
+    {
+    case 'h':
+    case 'H':
+      bits_per_char = 4;
+      break;
+    case 'o':
+    case 'O':
+      bits_per_char = 3;
+      break;
+    case 'b':
+    case 'B':
+      bits_per_char = 1;
+      break;
+    }
+  p += 2;
+
+  while (*p)
+    {
+      c = *p++;
+      if (c == '_' || c == '\'')
+	continue;
+      if (c >= 'a')
+	c -= ' ';
+      c -= '0';
+      if (c > 9)
+	c -= 7;
+      valid_chars++;
+      
+      for (k = BYTES_BIG_ENDIAN ? bits_per_char - 1 : 0;
+	   BYTES_BIG_ENDIAN ? k >= 0 : k < bits_per_char;
+	   bl++, BYTES_BIG_ENDIAN ? k-- : k++)
+	{
+	  if (c & (1 << k))
+	    initlist = tree_cons (NULL_TREE, build_int_2 (bl, 0), initlist);
+        }
+    }
+#if 0
+  /* as long as BOOLS(0) is valid it must tbe possible to
+     specify an empty bitstring */
+  if (!valid_chars)
+    {
+      if (pass == 2)
+	error ("invalid number format `%s'", oldp);
+      return 0;
+    }
+#endif
+  val = build (CONSTRUCTOR,
+	       build_bitstring_type (size_int (bl)),
+	       NULL_TREE, nreverse (initlist));
+  TREE_CONSTANT (val) = 1;
+  CH_DERIVED_FLAG (val) = 1;
+  return val;
+}
+
+/* Check if two filenames name the same file.
+   This is done by stat'ing both files and comparing their inodes.
+
+   Note: we have to take care of seize_path_list. Therefore do it the same
+   way as in yywrap. FIXME: This probably can be done better. */
+
+static int
+same_file (filename1, filename2)
+     char *filename1;
+     char *filename2;
+{
+  struct stat s[2];
+  char        *fn_input[2];
+  int         i, stat_status;
+  extern char *strchr();
+  
+  if (grant_only_flag)
+    /* do nothing in this case */
+    return 0;
+
+  /* if filenames are equal -- return 1, cause there is no need
+     to search in the include list in this case */
+  if (strcmp (filename1, filename2) == 0)
+    return 1;
+  
+  fn_input[0] = filename1;
+  fn_input[1] = filename2;
+
+  for (i = 0; i < 2; i++)
+    {
+      stat_status = stat (fn_input[i], &s[i]);
+      if (stat_status < 0 &&
+	  strchr (fn_input[i], '/') == 0)
+        {
+	  STRING_LIST *plp;
+	  char        *path;
+	  
+	  for (plp = seize_path_list; plp != 0; plp = plp->next)
+	    {
+	      path = (char *)xmalloc (strlen (fn_input[i]) +
+				      strlen (plp->str) + 2);
+	      sprintf (path, "%s/%s", plp->str, fn_input[i]);
+	      stat_status = stat (path, &s[i]);
+	      free (path);
+	      if (stat_status >= 0)
+	        break;
+  	    }
+        }
+      if (stat_status < 0)
+        pfatal_with_name (fn_input[i]);
+  }
+  return s[0].st_ino == s[1].st_ino && s[0].st_dev == s[1].st_dev;
+}
+
+/*
+ * Note that simply appending included file names to a list in this
+ * way completely eliminates the need for nested files, and the
+ * associated book-keeping, since the EOF processing in the lexer
+ * will simply process the files one at a time, in the order that the
+ * USE_SEIZE_FILE directives were scanned.
+ */
+static void
+handle_use_seizefile_directive (restricted)
+    int restricted;
+{
+  tree seen;
+  int   len;
+  int   c = skip_whitespace ();
+  char *use_seizefile_str = readstring (c, &len);
+
+  if (pass > 1)
+    return;
+
+  if (c != '\'' && c != '\"')
+    {
+      error ("USE_SEIZE_FILE directive must be followed by string");
+      return;
+    }
+
+  use_seizefile_name = get_identifier (use_seizefile_str);
+  CH_USE_SEIZEFILE_RESTRICTED (use_seizefile_name) = restricted;
+  
+  if (!grant_only_flag)
+    {
+      /* If file foo.ch contains a <> use_seize_file "bar.grt" <>,
+	 and file bar.ch contains a <> use_seize_file "foo.grt" <>,
+	 then if we're compiling foo.ch, we will indirectly be
+	 asked to seize foo.grt.  Don't. */
+      extern char *grant_file_name;
+      if (strcmp (use_seizefile_str, grant_file_name) == 0)
+	return;
+
+      /* Check if the file is already on the list. */
+      for (seen = files_to_seize; seen != NULL_TREE; seen = TREE_CHAIN (seen))
+	if (same_file (IDENTIFIER_POINTER (TREE_VALUE (seen)),
+		       use_seizefile_str))
+	  return;  /* Previously seen; nothing to do. */
+    }
+
+  /* Haven't been asked to seize this file yet, so add
+     its name to the list. */
+  {
+    tree pl = perm_tree_cons (0, use_seizefile_name, NULL_TREE);
+    if (files_to_seize == NULL_TREE)
+      files_to_seize = pl;
+    else
+      TREE_CHAIN (last_file_to_seize) = pl;
+    if (next_file_to_seize == NULL_TREE)
+      next_file_to_seize = pl;
+    last_file_to_seize = pl;
+  }
+}
+
+
+/*
+ * get input, convert to lower case for comparison
+ */
+int
+getlc (file)
+     FILE *file;
+{
+  register int c;
+
+  c = getc (file);  
+  if (isupper (c) && ignore_case)
+    c = tolower (c);
+  return c;
+}
+
+/* At the beginning of a line, increment the line number and process
+   any #-directive on this line.  If the line is a #-directive, read
+   the entire line and return a newline.  Otherwise, return the line's
+   first non-whitespace character.
+
+   (Each language front end has a check_newline() function that is called
+   from lang_init() for that language.  One of the things this function
+   must do is read the first line of the input file, and if it is a #line
+   directive, extract the filename from it and use it to initialize
+   main_input_filename.  Proper generation of debugging information in
+   the normal "front end calls cpp then calls cc1XXXX environment" depends
+   upon this being done.) */
+
+int
+check_newline ()
+{
+  register int c;
+
+  lineno++;
+
+  /* Read first nonwhite char on the line.  */
+
+  c = getc (finput);
+
+  while (c == ' ' || c == '\t')
+    c = getc (finput);
+
+  if (c != '#' || inside_c_comment)
+    {
+      /* If not #, return it so caller will use it.  */
+      return c;
+    }
+
+  /* Read first nonwhite char after the `#'.  */
+
+  c = getc (finput);
+  while (c == ' ' || c == '\t')
+    c = getc (finput);
+
+  /* If a letter follows, then if the word here is `line', skip
+     it and ignore it; otherwise, ignore the line, with an error
+     if the word isn't `pragma', `ident', `define', or `undef'.  */
+
+  if (isupper (c) && ignore_case)
+    c = tolower (c);
+
+  if (c >= 'a' && c <= 'z')
+    {
+      if (c == 'p')
+	{
+	  if (getlc (finput) == 'r'
+	      && getlc (finput) == 'a'
+	      && getlc (finput) == 'g'
+	      && getlc (finput) == 'm'
+	      && getlc (finput) == 'a'
+	      && (isspace (c = getlc (finput))))
+	    {
+#ifdef HANDLE_PRAGMA
+	      return HANDLE_PRAGMA (finput, c);
+#else
+	      goto skipline;
+#endif /* HANDLE_PRAGMA */
+	    }
+	}
+
+      else if (c == 'd')
+	{
+	  if (getlc (finput) == 'e'
+	      && getlc (finput) == 'f'
+	      && getlc (finput) == 'i'
+	      && getlc (finput) == 'n'
+	      && getlc (finput) == 'e'
+	      && (isspace (c = getlc (finput))))
+	    {
+#if 0 /*def DWARF_DEBUGGING_INFO*/
+	      if (c != '\n'
+		  && (debug_info_level == DINFO_LEVEL_VERBOSE)
+		  && (write_symbols == DWARF_DEBUG))
+	        dwarfout_define (lineno, get_directive_line (finput));
+#endif /* DWARF_DEBUGGING_INFO */
+	      goto skipline;
+	    }
+	}
+      else if (c == 'u')
+	{
+	  if (getlc (finput) == 'n'
+	      && getlc (finput) == 'd'
+	      && getlc (finput) == 'e'
+	      && getlc (finput) == 'f'
+	      && (isspace (c = getlc (finput))))
+	    {
+#if 0 /*def DWARF_DEBUGGING_INFO*/
+	      if (c != '\n'
+		  && (debug_info_level == DINFO_LEVEL_VERBOSE)
+		  && (write_symbols == DWARF_DEBUG))
+	        dwarfout_undef (lineno, get_directive_line (finput));
+#endif /* DWARF_DEBUGGING_INFO */
+	      goto skipline;
+	    }
+	}
+      else if (c == 'l')
+	{
+	  if (getlc (finput) == 'i'
+	      && getlc (finput) == 'n'
+	      && getlc (finput) == 'e'
+	      && ((c = getlc (finput)) == ' ' || c == '\t'))
+	    goto linenum;
+	}
+#if 0
+      else if (c == 'i')
+	{
+	  if (getlc (finput) == 'd'
+	      && getlc (finput) == 'e'
+	      && getlc (finput) == 'n'
+	      && getlc (finput) == 't'
+	      && ((c = getlc (finput)) == ' ' || c == '\t'))
+	    {
+	      /* #ident.  The pedantic warning is now in cccp.c.  */
+
+	      /* Here we have just seen `#ident '.
+		 A string constant should follow.  */
+
+	      while (c == ' ' || c == '\t')
+		c = getlc (finput);
+
+	      /* If no argument, ignore the line.  */
+	      if (c == '\n')
+		return c;
+
+	      ungetc (c, finput);
+	      token = yylex ();
+	      if (token != STRING
+		  || TREE_CODE (yylval.ttype) != STRING_CST)
+		{
+		  error ("invalid #ident");
+		  goto skipline;
+		}
+
+	      if (!flag_no_ident)
+		{
+#ifdef ASM_OUTPUT_IDENT
+		  extern FILE *asm_out_file;
+		  ASM_OUTPUT_IDENT (asm_out_file, TREE_STRING_POINTER (yylval.ttype));
+#endif
+		}
+
+	      /* Skip the rest of this line.  */
+	      goto skipline;
+	    }
+	}
+#endif
+
+      error ("undefined or invalid # directive");
+      goto skipline;
+    }
+
+linenum:
+  /* Here we have either `#line' or `# <nonletter>'.
+     In either case, it should be a line number; a digit should follow.  */
+
+  while (c == ' ' || c == '\t')
+    c = getlc (finput);
+
+  /* If the # is the only nonwhite char on the line,
+     just ignore it.  Check the new newline.  */
+  if (c == '\n')
+    return c;
+
+  /* Something follows the #; read a token.  */
+
+  if (isdigit(c))
+    {
+      int old_lineno = lineno;
+      int used_up = 0;
+      int l = 0;
+      extern struct obstack permanent_obstack;
+
+      do
+	{
+	  l = l * 10 + (c - '0'); /* FIXME Not portable */
+	  c = getlc(finput);
+	} while (isdigit(c));
+      /* subtract one, because it is the following line that
+	 gets the specified number */
+
+      l--;
+
+      /* Is this the last nonwhite stuff on the line?  */
+      c = getlc (finput);
+      while (c == ' ' || c == '\t')
+	c = getlc (finput);
+      if (c == '\n')
+	{
+	  /* No more: store the line number and check following line.  */
+	  lineno = l;
+	  return c;
+	}
+
+      /* More follows: it must be a string constant (filename).  */
+
+      /* Read the string constant, but don't treat \ as special.  */
+      ignore_escape_flag = 1;
+      ignore_escape_flag = 0;
+
+      if (c != '\"')
+	{
+	  error ("invalid #line");
+	  goto skipline;
+	}
+
+      for (;;)
+	{
+	  c = getc (finput);
+	  if (c == EOF || c == '\n')
+	    {
+	      error ("invalid #line");
+	      return c;
+	    }
+	  if (c == '\"')
+	    {
+	      obstack_1grow(&permanent_obstack, 0);
+	      input_filename = obstack_finish (&permanent_obstack);
+	      break;
+	    }
+	  obstack_1grow(&permanent_obstack, c);
+	}
+
+      lineno = l;
+
+      /* Each change of file name
+	 reinitializes whether we are now in a system header.  */
+      in_system_header = 0;
+
+      if (main_input_filename == 0)
+	main_input_filename = input_filename;
+
+      /* Is this the last nonwhite stuff on the line?  */
+      c = getlc (finput);
+      while (c == ' ' || c == '\t')
+	c = getlc (finput);
+      if (c == '\n')
+	return c;
+
+      used_up = 0;
+
+      /* `1' after file name means entering new file.
+	 `2' after file name means just left a file.  */
+
+      if (isdigit (c))
+	{
+	  if (c == '1')
+	    {
+	      /* Pushing to a new file.  */
+	      struct file_stack *p
+		= (struct file_stack *) xmalloc (sizeof (struct file_stack));
+	      input_file_stack->line = old_lineno;
+	      p->next = input_file_stack;
+	      p->name = input_filename;
+	      input_file_stack = p;
+	      input_file_stack_tick++;
+#ifdef DWARF_DEBUGGING_INFO
+	      if (debug_info_level == DINFO_LEVEL_VERBOSE
+		  && write_symbols == DWARF_DEBUG)
+		dwarfout_start_new_source_file (input_filename);
+#endif /* DWARF_DEBUGGING_INFO */
+
+	      used_up = 1;
+	    }
+	  else if (c == '2')
+	    {
+	      /* Popping out of a file.  */
+	      if (input_file_stack->next)
+		{
+		  struct file_stack *p = input_file_stack;
+		  input_file_stack = p->next;
+		  free (p);
+		  input_file_stack_tick++;
+#ifdef DWARF_DEBUGGING_INFO
+		  if (debug_info_level == DINFO_LEVEL_VERBOSE
+		      && write_symbols == DWARF_DEBUG)
+		    dwarfout_resume_previous_source_file (input_file_stack->line);
+#endif /* DWARF_DEBUGGING_INFO */
+		}
+	      else
+		error ("#-lines for entering and leaving files don't match");
+
+	      used_up = 1;
+	    }
+	}
+
+      /* If we have handled a `1' or a `2',
+	 see if there is another number to read.  */
+      if (used_up)
+	{
+	  /* Is this the last nonwhite stuff on the line?  */
+	  c = getlc (finput);
+	  while (c == ' ' || c == '\t')
+	    c = getlc (finput);
+	  if (c == '\n')
+	    return c;
+	  used_up = 0;
+	}
+
+      /* `3' after file name means this is a system header file.  */
+
+      if (c == '3')
+	in_system_header = 1;
+    }
+  else
+    error ("invalid #-line");
+
+  /* skip the rest of this line.  */
+ skipline:
+  while (c != '\n' && c != EOF)
+    c = getc (finput);
+  return c;
+}
+
+
+tree
+get_chill_filename ()
+{
+  return (build_chill_string (
+            strlen (input_filename) + 1,  /* +1 to get a zero terminated string */
+	      input_filename));
+}
+
+tree
+get_chill_linenumber ()
+{
+  return build_int_2 ((HOST_WIDE_INT)lineno, 0);
+}
+
+
+/* Assuming '/' and '*' have been read, skip until we've
+   read the terminating '*' and '/'. */
+
+static void
+skip_c_comment ()
+{
+  int c = input();
+  int start_line = lineno;
+
+  inside_c_comment++;
+  for (;;)
+    if (c == EOF)
+      {
+	error_with_file_and_line (input_filename, start_line,
+				  "unterminated comment");
+	break;
+      }
+    else if (c != '*')
+      c = input();
+    else if ((c = input ()) == '/')
+      break;
+  inside_c_comment--;
+}
+
+
+/* Assuming "--" has been read, skip until '\n'. */
+
+static void
+skip_line_comment ()
+{
+  for (;;)
+    {
+      int c = input ();
+
+      if (c == EOF)
+	return;
+      if (c == '\n')
+	break;
+    }
+  unput ('\n');
+}
+
+
+static int
+skip_whitespace ()
+{
+  for (;;)
+    {
+      int c = input ();
+
+      if (c == EOF)
+	return c;
+      if (c == ' ' || c == '\t' || c == '\r' || c == '\n' || c == '\v')
+	continue;
+      if (c == '/')
+	{
+	  c = input ();
+	  if (c == '*')
+	    {
+	      skip_c_comment ();
+	      continue;
+	    }
+	  else
+	    {
+	      unput (c);
+	      return '/';
+	    }
+	}
+      if (c == '-')
+	{
+	  c = input ();
+	  if (c == '-')
+	    {
+	      skip_line_comment ();
+	      continue;
+	    }
+	  else
+	    {
+	      unput (c);
+	      return '-';
+	    }
+	}
+      return c;
+    }
+}
+
+/*
+ * avoid recursive calls to yylex to parse the ' = digits' or
+ * ' = SYNvalue' which are supposed to follow certain compiler
+ * directives.  Read the input stream, and return the value parsed.
+ */
+         /* FIXME: overflow check in here */
+         /* FIXME: check for EOF around here */
+static tree
+equal_number ()
+{
+  int      c, result;
+  char    *tokenbuf;
+  char    *cursor;
+  tree     retval = integer_zero_node;
+  
+  c = skip_whitespace();
+  if ((char)c != '=')
+    {
+      if (pass == 2)
+	error ("missing `=' in compiler directive");
+      return integer_zero_node;
+    }
+  c = skip_whitespace();
+
+  /* collect token into tokenbuf for later analysis */
+  while (TRUE)
+    {
+      if (isspace (c) || c == '<')
+	break;
+      obstack_1grow (&temporary_obstack, c);
+      c = input ();
+    }
+  unput (c);             /* put uninteresting char back */
+  obstack_1grow (&temporary_obstack, '\0');        /* terminate token */
+  tokenbuf = obstack_finish (&temporary_obstack);
+  maybe_downcase (tokenbuf);
+
+  if (*tokenbuf == '-')
+    /* will fail in the next test */
+    result = BITSTRING;
+  else if (maybe_number (tokenbuf))
+    {
+      if (pass == 1)
+	return integer_zero_node;
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+      yylval.ttype = convert_integer (tokenbuf);
+      tokenbuf = 0;  /* Was freed by convert_integer. */
+      result = yylval.ttype ? NUMBER : 0;
+      pop_obstacks ();
+    }
+  else
+    result = 0;
+  
+  if (result  == NUMBER)
+    {
+      retval = yylval.ttype;
+    }
+  else if (result == BITSTRING)
+    {
+      if (pass == 1)
+        error ("invalid value follows `=' in compiler directive");
+      goto finish;
+    }
+  else /* not a number */
+    {
+      cursor = tokenbuf;
+      c = *cursor;
+      if (!isalpha (c) && c != '_')
+	{
+	  if (pass == 1)
+	    error ("invalid value follows `=' in compiler directive");
+	  goto finish;
+	}
+
+      for (cursor = &tokenbuf[1]; *cursor != '\0'; cursor++)
+	if (isalpha (*cursor) || *cursor == '_' || isdigit (*cursor))
+	  continue;
+	else
+	  {
+	    if (pass == 1)
+	      error ("invalid `%c' character in name", *cursor);
+	    goto finish;
+	  }
+      if (pass == 1)
+	goto finish;
+      else
+	{
+	  tree value = lookup_name (get_identifier (tokenbuf));
+	  if (value == NULL_TREE
+	      || TREE_CODE (value) != CONST_DECL
+	      || TREE_CODE (DECL_INITIAL (value)) != INTEGER_CST)
+	    {
+	      if (pass == 2)
+		error ("`%s' not integer constant synonym ",
+		       tokenbuf);
+	      goto finish;
+	    }
+	  obstack_free (&temporary_obstack, tokenbuf);
+	  tokenbuf = 0;
+	  push_obstacks_nochange ();
+	  end_temporary_allocation ();
+	  retval = convert (chill_taskingcode_type_node, DECL_INITIAL (value));
+	  pop_obstacks ();
+	}
+    }
+
+  /* check the value */
+  if (TREE_CODE (retval) != INTEGER_CST)
+    {
+      if (pass == 2)
+	error ("invalid value follows `=' in compiler directive");
+    }
+  else if (TREE_INT_CST_HIGH (retval) != 0 ||
+	   TREE_INT_CST_LOW (retval) > TREE_INT_CST_LOW (TYPE_MAX_VALUE (chill_unsigned_type_node)))
+    {
+      if (pass == 2)
+	error ("value out of range in compiler directive");
+    }
+ finish:
+  if (tokenbuf)
+    obstack_free (&temporary_obstack, tokenbuf);
+  return retval;
+}
+
+/*
+ * add a possible grant-file path to the list
+ */
+void
+register_seize_path (path)
+     char *path;
+{
+  int          pathlen = strlen (path);
+  char        *new_path = (char *)xmalloc (pathlen + 1);
+  STRING_LIST *pl     = (STRING_LIST *)xmalloc (sizeof (STRING_LIST));
+    
+  /* strip off trailing slash if any */
+  if (path[pathlen - 1] == '/')
+    pathlen--;
+
+  memcpy (new_path, path, pathlen);
+  pl->str  = new_path;
+  pl->next = seize_path_list;
+  seize_path_list = pl;
+}
+
+
+/* Used by decode_decl to indicate that a <> use_seize_file NAME <>
+   directive has been written to the grantfile. */
+
+void
+mark_use_seizefile_written (name)
+     tree name;
+{
+  tree node;
+
+  for (node = files_to_seize;  node != NULL_TREE; node = TREE_CHAIN (node))
+    if (TREE_VALUE (node) == name)
+      {
+	TREE_PURPOSE (node) = integer_one_node;
+	break;
+      }
+}
+
+
+static int
+yywrap ()
+{
+  extern char *strchr ();
+  extern char *chill_real_input_filename;
+  tree node;
+
+  close_input_file (input_filename);
+
+  use_seizefile_name = NULL_TREE;
+
+  if (next_file_to_seize && !grant_only_flag)
+    {
+      FILE *grt_in = NULL;
+      char *seizefile_name_chars
+	= IDENTIFIER_POINTER (TREE_VALUE (next_file_to_seize));
+
+      /* find a seize file, open it.  If it's not at the path the
+       * user gave us, and that path contains no slashes, look on
+       * the seize_file paths, specified by the '-I' options.
+       */     
+      grt_in = fopen (seizefile_name_chars, "r");
+      if (grt_in == NULL 
+	  && strchr (seizefile_name_chars, '/') == NULL)
+	{
+	  STRING_LIST *plp;
+	  char      *path;
+
+	  for (plp = seize_path_list; plp != NULL; plp = plp->next)
+	    {
+	      path = (char *)xmalloc (strlen (seizefile_name_chars)
+				      + strlen (plp->str) + 2);
+
+	      sprintf (path, "%s/%s", plp->str, seizefile_name_chars);
+	      grt_in = fopen (path, "r");
+	      if (grt_in == NULL)
+		free (path);
+	      else
+		{
+		  seizefile_name_chars = path;
+		  break;
+		}
+	    }
+	}
+
+      if (grt_in == NULL)
+	pfatal_with_name (seizefile_name_chars);
+
+      finput = grt_in;
+      input_filename = seizefile_name_chars;
+
+      lineno = 0;
+      current_seizefile_name = TREE_VALUE (next_file_to_seize);
+
+      next_file_to_seize = TREE_CHAIN (next_file_to_seize);
+
+      saw_eof = 0;
+      return 0;
+    }
+
+  if (pass == 1)
+    {
+      next_file_to_seize = files_to_seize;
+      current_seizefile_name = NULL_TREE;
+
+      if (strcmp (main_input_filename, "stdin"))
+	finput = fopen (chill_real_input_filename, "r");
+      else
+	finput = stdin;
+      if (finput == NULL)
+	{
+	  error ("can't reopen %s", chill_real_input_filename);
+	  return 1;
+	}
+      input_filename = main_input_filename;
+      ch_lex_init ();
+      lineno = 0;
+      /* Read a line directive if there is one.  */
+      ungetc (check_newline (), finput);
+      starting_pass_2 = 1;
+      saw_eof = 0;
+      if (module_number == 0)
+	warning ("no modules seen");
+      return 0;
+    }
+  return 1;
+}
diff --git a/gcc/ch/nloop.c b/gcc/ch/nloop.c
new file mode 100644
index 0000000..ddd4aad
--- /dev/null
+++ b/gcc/ch/nloop.c
@@ -0,0 +1,1244 @@
+/* Implement looping 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 "config.h"
+#include "tree.h"
+#include "ch-tree.h"
+#include "lex.h"
+#include "flags.h"
+#include "actions.h"
+#include "input.h"
+#include "obstack.h"
+#include "assert.h"
+#include "rtl.h"
+
+/* if the user codes '-flocal-loop-counter' on the command line,
+   ch-actions.c (lang_decode_option) will set this flag. */
+int flag_local_loop_counter = 0;
+
+extern tree chill_truthvalue_conversion PROTO((tree));
+extern rtx  emit_line_note              PROTO((char *, int)); 
+extern void error                       PROTO((char *, ...));
+extern rtx  expand_assignment           PROTO((tree, tree, int, int));
+extern void save_expr_under_name        PROTO((tree, tree));
+extern void stamp_nesting_label         PROTO((tree));
+extern int  int_fits_type_p             PROTO((tree, tree));
+extern void warning                     PROTO((char *, ...));
+
+/* forward declarations */
+static int  classify_loop            PROTO((void));
+static int  declare_temps            PROTO((void));
+static int  initialize_iter_var      PROTO((void));
+static int  maybe_skip_loop          PROTO((void));
+static int  top_loop_end_check       PROTO((void));
+static int  bottom_loop_end_check    PROTO((void));
+static int  increment_temps          PROTO((void));
+static tree build_temporary_variable PROTO((char *, tree));
+static tree maybe_make_for_temp      PROTO((tree, char *, tree));
+static tree chill_unsigned_type      PROTO((tree));
+
+/* In terms of the parameters passed to build_loop_iterator,
+ *   there are several types of loops.  They are encoded by
+ *   the ITER_TYPE enumeration.
+ *
+ *   1) DO FOR EVER; ... OD
+ *      indicated by a NULL_TREE start_exp, step_exp and end_exp,
+ *      condition == NULL, in_flag = 0, and ever_flag == 1 in the
+ *      first ITERATOR.
+ *
+ *   2) DO WHILE cond; ... OD
+ *      indicated by NULL_TREE start_exp, step_exp and end_exp, 
+ *      in_flag = 0, and condition != NULL.
+ *
+ *   3) DO; ... OD
+ *      indicated by NULL_TREEs in start_exp, step_exp and end_exp,
+ *      condition != NULL, in_flag == 0 and ever_flag == 0.  This
+ *      is not really a loop, but a compound statement.
+ *
+ *   4) DO FOR user_var := start_exp 
+ *         [DOWN] TO end_exp BY step_exp; ... DO
+ *      indicated by non-NULL_TREE start_exp, step_exp and end_exp.
+ *
+ *   5) DO FOR user_var [DOWN] IN discrete_mode; ... OD
+ *      indicated by in_flag == 1.  start_exp is a non-NULL_TREE 
+ *      discrete mode, with an optional down_flag.
+ *
+ *   6) DO FOR user_var [DOWN] IN powerset_expr; ... OD
+ *      indicated by in_flag == 1.  start_exp is a non-NULL_TREE 
+ *      powerset mode, with an optional down_flag.
+ *
+ *   7) DO FOR user_var [DOWN] IN location; ... OD
+ *      indicated by in_flag == 1.  start_exp is a non-NULL_TREE 
+ *      location mode, with an optional down_flag.
+ */
+typedef enum 
+{
+   DO_UNUSED,
+   DO_FOREVER,
+   DO_WHILE,
+   DO_OD,
+   DO_STEP,
+   DO_RANGE,
+   DO_POWERSET,
+   DO_LOC,
+   DO_LOC_VARYING 
+} ITER_TYPE;
+
+
+typedef struct iterator 
+{
+/* These variables only have meaning in the first ITERATOR structure. */
+  ITER_TYPE itype;                  /* type of this iterator */
+  int  error_flag;                  /* TRUE if no loop was started due to 
+				       user error */
+  tree condition;                   /* WHILE condition expression */
+  int  down_flag;                   /* TRUE if DOWN was coded */
+
+/* These variables have meaning in every ITERATOR structure. */
+  tree user_var;                    /* user's explicit iteration variable */
+  tree start_exp;                   /* user's start expression
+                                       or IN expression of a FOR .. IN*/
+  tree step_exp;                    /* user's step expression */
+  tree end_exp;                     /* user's end expression */
+  tree start_temp;                  /* temp holding evaluated start_exp */
+  tree end_temp;                    /* temp holding evaluated end_exp */
+  tree step_temp;                   /* temp holding evaluated step_exp */
+  tree powerset_temp;               /* temp holding user's initial powerset expression */
+  tree loc_ptr_temp;                /* temp holding count for LOC enumeration ptr */
+  tree iter_var;                    /* hidden variable for the loop */
+  tree iter_type;                   /* hidden variable's type */
+  tree base_type;                   /* LOC enumeration base type */
+  struct iterator *next;            /* ptr to next iterator for this loop */
+} ITERATOR;
+
+/*
+ * There's an entry like this for each nested DO loop.
+ * The list is maintained by push_loop_block
+ * and pop_loop_block.
+ */
+typedef struct loop {
+  struct loop *nxt_level;   /* pointer to enclosing loop */
+  ITERATOR    *iter_list;   /* iterators for the current loop */
+} LOOP;
+
+static LOOP *loop_stack = (LOOP *)0;
+
+#if 0
+
+Here is a CHILL DO FOR statement:
+
+DO FOR user_var := start_exp BY step_exp [DOWN] TO end_exp 
+   WHILE condition;
+
+For this loop to be 'safe', like a Pascal FOR loop, the start,
+end, and increment expressions are computed once, before the
+assignment to the iteration variable and saved in temporaries,
+before the first assignment of the iteration variable, so the
+following works:
+
+          FOR i := (i+1) TO (i+10) DO
+
+To prevent changes to the start/end/step expressions from
+effecting the loop''s termination, and to make the loop end-check
+as simple as possible, we evaluate the step expression into
+a temporary and compute a hidden iteration count before entering 
+the loop''s body.  User code cannot effect the counter, and the
+end-loop check simply decrements the counter and checks for zero.
+
+The whole phrase FOR iter := ... TO end_exp can be repeated
+multiple times, with different user-iteration variables.  This
+is discussed later.
+
+The loop counter calculations need careful design since a loop
+from MININT TO MAXINT must work, in the precision of integers.
+
+Here''s how it works, in C:
+
+        0) The DO ... OD loop is simply a block with 
+           its own scope.  
+
+	1) The DO FOR EVER is simply implemented:
+
+	   loop_top:
+		.
+		. body of loop
+		.
+		goto loop_top
+	   end_loop:
+
+	2) The DO WHILE is also simple:
+
+
+	   loop_top:
+		if (!condition) goto end_loop
+		.
+		. body of loop
+		.
+		goto loop_top
+	   end_loop:
+
+
+	3) The DO FOR [while condition] loop (no DOWN)
+
+	push a new scope,
+	decl iter_var
+
+		step_temp = step_exp
+                start_temp = start_exp
+                end_temp = end_exp
+		if (end_exp < start_exp) goto end_loop
+                /* following line is all unsigned arithmetic */
+		iter_var = (end_exp - start_exp + step_exp) / step_exp
+                user_var = start_temp
+	   loop_top:
+		if (!condition) goto end_loop
+		.
+		. body of loop
+		.
+                iter_var--
+		if (iter_var == 0) goto end_loop
+                user_var += step_temp
+		goto loop_top
+	end_loop:
+	pop scope
+
+	4) The proposed CHILL for [while condition] loop (with DOWN)
+
+	push a new scope,
+        decl iter
+		step_temp = step_exp
+                start_temp = start_exp
+                end_temp = end_exp
+		if (end_exp > start_exp) goto end_loop
+                /* following line is all unsigned arithmetic */
+		iter_var = (start_exp - end_exp + step_exp) / step_exp
+                user_var = start_temp
+	   loop_top:
+		if (!condition) goto end_loop
+		.
+		. body of loop
+		.
+                iter_var--
+		if (iter_var == 0) goto end_loop
+		user_var -= step_temp
+		goto loop_top
+	    end_loop:
+	pop scope
+
+
+        5) The range loop, which iterates over a mode''s possible
+           values, works just like the above step loops, but with
+           the start and end values taken from the mode''s lower
+           and upper domain values.
+
+
+	6) The FOR IN loop, where a location enumeration is
+           specified (see spec on page 81 of Z.200, bottom
+           of page 186):
+
+	push a new scope,
+        decl iter_var as an unsigned integer
+             loc_ptr_temp as pointer to a composite base type
+        
+               if array is varying
+                   iter_var = array''s length field
+               else
+                   iter_var = sizeof array / sizeof base_type
+	       loc_ptr_temp = &of highest or lowest indexable entry
+	   loop_top:
+		if (!condition) goto end_loop
+		.
+		. body of loop
+		.
+                iter_var--
+                if (iter_var == 0) goto end_loop               
+		loc_ptr_temp +/-= sizeof array base_type
+		goto loop_top
+	   end_loop:
+	pop scope
+
+	7) The DO FOR (DOWN) IN powerset_exp
+
+	push a new scope,
+        decl powerset_temp
+	decl iterator as basetype of powerset
+
+	        powerset_temp := start_exp
+	   loop_top:
+	        /* if DOWN */
+                if (__flsetclrpowerset () == 0) goto end_loop;
+                /* not DOWN */
+                if (__ffsetclrpowerset () == 0) goto end_loop;
+		if (!condition) goto end_loop
+		.
+		. body of loop
+		.
+		goto loop_top
+	   end_loop:
+	pop scope
+
+
+So, here''s the general DO FOR schema, as implemented here:
+
+        classify_loop       -- what type of loop have we?
+                            -- build_iterator does some of this, also
+        expand_start_loop   -- start the loop''s control scope
+        -- start scope for synthesized loop variables
+        declare_temps       -- create, initialize temporary variables
+        maybe_skip_loop     -- skip loop if end conditions unsatisfiable
+        initialize_iter_var -- initialize the iteration counter
+                            -- initialize user''s loop variable
+        expand_start_loop   -- generate top-of-loop label
+        top_loop_end_check  -- generate while code and/or
+                               powerset find-a-bit function call
+        .
+        .
+        .  user''s loop body code
+        .
+        .
+        bottom_loop_end_check  -- exit if counter has become zero
+        increment_temps     -- update temps for next iteration
+        expand_end_loop     -- generate jump back to top of loop
+        expand_end_cond     -- generate label for end of conditional
+        -- end of scope for synthesized loop variables
+        free_iterators      -- free up iterator space
+
+When there are two or more iterator phrases, each of the
+above loop steps must act upon all iterators.  For example,
+the 'increment_temps' step must increment all temporaries
+(associated with all iterators).
+
+ NOTE: Z.200, section 10.1 says that a block is ...
+       "the actions statement list in a do action, including any
+       loop counter and while control".  This means that an exp-
+       ression in a WHILE control can include references to the
+       loop counters created for the loop''s exclusive use.  
+       Example:
+
+             DCL a (1:10) INT;
+             DCL j INT;
+             DO FOR j IN a WHILE j > 0;
+             ...
+             OD;
+       The 'j' referenced in the while is the loc-identity 'j'
+       created inside the loop''s scope, and NOT the 'j' declared
+       before the loop.
+#endif
+
+/*
+ * The following routines are called directly by the
+ * CHILL parser.
+ */
+void
+push_loop_block ()
+{
+  LOOP *temp = (LOOP *)xmalloc (sizeof (LOOP));
+
+  /* push a new loop onto the stack */
+  temp->nxt_level = loop_stack;
+  temp->iter_list = (ITERATOR *)0;
+  loop_stack = temp;
+}
+
+void
+pop_loop_block ()
+{
+  LOOP *do_temp = loop_stack;
+  ITERATOR  *ip;
+
+  /* pop loop block off the list */
+  loop_stack = do_temp->nxt_level;
+
+  /* free the loop's iterator blocks */
+  ip = do_temp->iter_list;
+  while (ip != NULL)
+    {
+      ITERATOR *temp = ip->next;
+      free (ip);
+      ip = temp;
+    }
+  free (do_temp);
+}
+
+void
+begin_loop_scope ()
+{
+  ITERATOR *firstp = loop_stack->iter_list;
+
+  if (pass < 2)
+    return;
+
+  /*
+   * We need to classify the loop and declare its temporaries
+   * here, so as to define them before the WHILE condition
+   * (if any) is parsed.  The WHILE expression may refer to
+   * a temporary.
+   */
+  if (classify_loop ())
+    return;
+
+  if (firstp->itype != DO_OD)
+    declare_temps ();
+  
+  clear_last_expr ();
+  push_momentary ();
+  expand_start_bindings (0);
+}
+
+
+void
+end_loop_scope (opt_label)
+     tree opt_label;
+{
+  if (opt_label)
+    possibly_define_exit_label (opt_label);
+  poplevel (0, 0, 0);
+
+  if (pass < 2)
+    return;
+
+  expand_end_bindings (getdecls (), kept_level_p (), 0);
+  pop_momentary ();
+}
+
+/* The iterator structure records all aspects of a 
+ * 'FOR i := start [DOWN] TO end' clause or
+ * 'FOR i IN modename' or 'FOR i IN powerset' clause.
+ * It's saved on the iter_list of the current LOOP.
+ */
+void
+build_loop_iterator (user_var, start_exp, step_exp, end_exp, 
+		     down_flag, in_flag, ever_flag)
+     tree user_var, start_exp, step_exp, end_exp;
+     int  down_flag, in_flag, ever_flag;
+{
+  ITERATOR *ip = (ITERATOR *)xmalloc (sizeof (ITERATOR));
+
+  /* chain this iterator onto the current loop */
+  if (loop_stack->iter_list == NULL)
+    loop_stack->iter_list = ip;
+  else
+    {
+      ITERATOR *temp = loop_stack->iter_list;
+      while (temp->next != NULL)
+	temp = temp->next;
+      temp->next = ip;
+    }
+
+  ip->itype         = DO_UNUSED;
+  ip->user_var      = user_var;
+  ip->start_exp     = start_exp;
+  ip->step_exp      = step_exp;
+  ip->end_exp       = end_exp;
+  ip->condition     = NULL_TREE;
+  ip->start_temp    = NULL_TREE;
+  ip->end_temp      = NULL_TREE;
+  ip->step_temp     = NULL_TREE;
+  ip->down_flag     = down_flag;
+  ip->powerset_temp = NULL_TREE;
+  ip->iter_var      = NULL_TREE;
+  ip->iter_type     = NULL_TREE;
+  ip->loc_ptr_temp  = NULL_TREE;
+  ip->error_flag    = 1;          /* assume error will be found */
+  ip->next          = (ITERATOR *)0;
+
+  if (ever_flag)
+    ip->itype = DO_FOREVER;
+  else if (in_flag && start_exp != NULL_TREE)
+    {
+      if (TREE_CODE (start_exp) == ERROR_MARK)
+	return;
+      if (TREE_CODE (TREE_TYPE (start_exp)) == SET_TYPE)
+	ip->itype = DO_POWERSET;
+      else if (discrete_type_p (TREE_TYPE (ip->start_exp)))
+	ip->itype = DO_RANGE;
+      else if (TREE_CODE (TREE_TYPE (ip->start_exp)) == ARRAY_TYPE)
+	ip->itype = DO_LOC;
+      else if (chill_varying_type_p (TREE_TYPE (ip->start_exp)))
+	ip->itype = DO_LOC_VARYING;
+      else
+	{
+	  error ("Loop's IN expression is not a composite object");
+	  return;
+	}
+    }
+  else if (start_exp == NULL_TREE && end_exp == NULL_TREE
+	   && step_exp == NULL_TREE && !down_flag)
+    ip->itype = DO_OD;
+  else
+    {
+      /* FIXME: Move this to the lexer? */
+#define CST_FITS_INT(NODE) (TREE_CODE(NODE) == INTEGER_CST &&\
+            int_fits_type_p (NODE, integer_type_node))
+
+      tree max_prec_type = integer_type_node;
+
+      if (! discrete_type_p (TREE_TYPE (ip->start_exp)))
+	{
+	  error ("start expr must have discrete mode");
+	  return;
+	}
+      if (TREE_CODE (TREE_TYPE (ip->start_exp)) == ENUMERAL_TYPE
+	  && CH_ENUM_IS_NUMBERED (TREE_TYPE (ip->start_exp)))
+	{
+	  error ("DO FOR start expression is a numbered SET");
+	  return;
+	}
+      if (TREE_CODE (TREE_TYPE (ip->end_exp)) == ENUMERAL_TYPE
+	  && CH_ENUM_IS_NUMBERED (TREE_TYPE (ip->end_exp)))
+	{
+	  error ("TO expression is a numbered SET");
+	  return;
+	}
+      /* Convert all three expressions to a common precision,
+	 which is the largest precision they exhibit, but
+         INTEGER_CST nodes are built in the lexer as
+	 long_integer_type nodes.  We'll treat convert them to
+	 integer_type_nodes if possible, for faster loop times. */
+
+      if (TYPE_PRECISION (max_prec_type) <
+	    TYPE_PRECISION (TREE_TYPE (ip->start_exp))
+	  && !CST_FITS_INT (ip->start_exp))
+	max_prec_type = TREE_TYPE (ip->start_exp);
+      if (! discrete_type_p (TREE_TYPE (ip->end_exp)))
+	{
+	  error ("TO expr must have discrete mode");
+	  return;
+	}
+      if (! CH_COMPATIBLE (ip->start_exp, 
+			   TREE_TYPE (ip->end_exp)))
+	{
+	  error ("start expr and TO expr must be compatible");
+	  return;
+	}
+      if (TYPE_PRECISION (max_prec_type) <
+	    TYPE_PRECISION (TREE_TYPE (ip->end_exp))
+	  && !CST_FITS_INT (ip->end_exp))
+	max_prec_type = TREE_TYPE (ip->end_exp);
+      if (ip->step_exp != NULL_TREE)
+	{
+	  /* assure that default 'BY 1' gets a useful type */
+	  if (ip->step_exp == integer_one_node)
+	    ip->step_exp = convert (TREE_TYPE (ip->start_exp),
+				    ip->step_exp);
+	  if (! discrete_type_p (TREE_TYPE (ip->step_exp)))
+	    {
+	      error ("BY expr must have discrete mode");
+	      return;
+	    }
+	  if (! CH_COMPATIBLE (ip->start_exp,
+		  TREE_TYPE (ip->step_exp)))
+	    {
+	      error ("start expr and BY expr must be compatible");
+	      return;
+	    }
+	  if (TYPE_PRECISION (max_prec_type) <
+		TYPE_PRECISION (TREE_TYPE (ip->step_exp))
+	      && !CST_FITS_INT (ip->step_exp))
+	    max_prec_type = TREE_TYPE (ip->step_exp);
+	}
+      if (TREE_CODE (ip->start_exp) == INTEGER_CST
+	  && TREE_CODE (ip->end_exp) == INTEGER_CST
+	  && compare_int_csts (ip->down_flag ? LT_EXPR : GT_EXPR,
+			       ip->start_exp, ip->end_exp))
+	warning ("body of DO FOR will never execute");
+
+      ip->start_exp = 
+	convert (max_prec_type, ip->start_exp);
+      ip->end_exp   = 
+	convert (max_prec_type, ip->end_exp);
+
+      if (ip->step_exp != NULL_TREE)
+	{
+	  ip->step_exp =
+	    convert (max_prec_type, ip->step_exp);
+
+	  if (TREE_CODE (ip->step_exp) != INTEGER_CST)
+	    {
+	      /* generate runtime check for negative BY expr */
+	      ip->step_exp = 
+		check_range (ip->step_exp, ip->step_exp,
+			     integer_zero_node, NULL_TREE);
+	    }
+	  else if (compare_int_csts (LE_EXPR, ip->step_exp, integer_zero_node))
+	    {
+	      error ("BY expression is negative or zero");
+	      return;
+	    }
+	}
+      ip->itype = DO_STEP;
+    }
+
+  ip->error_flag = 0;           /* no errors! */
+}
+
+void
+build_loop_start (while_control, start_label)
+     tree while_control, start_label;
+{
+  ITERATOR *firstp = loop_stack->iter_list;
+  
+  firstp->condition = while_control;
+
+  if (firstp->error_flag)
+    return;
+
+  /* We didn't know at begin_loop_scope time about the condition;
+     adjust iterator type now. */
+  if (firstp->itype == DO_OD && firstp->condition)
+    firstp->itype = DO_WHILE;
+
+  if (initialize_iter_var ())
+    return;
+  
+  if (maybe_skip_loop ())
+    return;
+
+  /* use the label as an 'exit' label, 
+     'goto' needs another sort of label */
+  expand_start_loop (start_label != NULL_TREE);
+  
+  if (top_loop_end_check ())
+    return;
+  emit_line_note (input_filename, lineno); 
+}
+
+/*
+ * Called after the last action of the loop body
+ * has been parsed.
+ */
+void
+build_loop_end ()
+{
+  ITERATOR *ip = loop_stack->iter_list;
+
+  emit_line_note (input_filename, lineno);
+
+  if (ip->error_flag)
+    return;
+
+  if (bottom_loop_end_check ())
+    return;
+
+  if (increment_temps ())
+    return;
+
+  if (ip->itype != DO_OD)
+    {
+      expand_end_loop ();
+
+      for (; ip != NULL; ip = ip->next)
+	{
+	  switch (ip->itype)
+	    {
+	    case DO_LOC_VARYING:
+	    case DO_STEP:
+	      expand_end_cond ();
+	      break;
+	    default:
+	      break;
+	    }
+	}
+    }
+}
+
+/*
+ * The rest of the routines in this file are called from
+ * the above three routines.
+ */
+static int
+classify_loop ()
+{
+  ITERATOR *firstp = loop_stack->iter_list, *ip;
+
+  firstp->error_flag = 0;
+  if (firstp->itype == DO_UNUSED || firstp->itype == DO_OD)
+    {
+      /* if we have just DO .. OD, do nothing - this is just a 
+         BEGIN .. END without creating a new scope, and no looping  */
+      if (firstp->condition != NULL_TREE)
+	firstp->itype = DO_WHILE;
+      else
+	firstp->itype = DO_OD;
+    }
+  
+  /* Issue a warning if the any loop counter is mentioned more 
+     than once in the iterator list. */
+  for (ip = firstp; ip != NULL; ip = ip->next)
+    {
+      switch (ip->itype)
+	{
+	case DO_FOREVER:
+	case DO_WHILE:
+	  break;
+	case DO_STEP:
+	case DO_RANGE:
+	case DO_POWERSET:
+	case DO_LOC:
+	case DO_LOC_VARYING:
+	  /* FIXME: check for name uniqueness */
+	  break;
+	default:
+	  ;
+	}
+    }
+  return firstp->error_flag;
+}
+
+/*
+ * Reserve space for any loop-control temporaries, initialize them
+ */
+static int
+declare_temps ()
+{
+  ITERATOR *firstp = loop_stack->iter_list, *ip;
+  tree start_ptr;
+
+  for (ip = firstp; ip != NULL; ip = ip->next)
+    {
+      switch (ip->itype)
+	{
+	case DO_FOREVER:
+	case DO_WHILE:
+	  break;
+	case DO_STEP:
+	  ip->iter_type = chill_unsigned_type (TREE_TYPE (ip->start_exp));
+
+	  /* create, initialize temporaries if expressions aren't constant */
+	  ip->start_temp = maybe_make_for_temp (ip->start_exp, "for_start",
+						ip->iter_type);
+	  ip->end_temp = maybe_make_for_temp (ip->end_exp, "for_end",
+					      ip->iter_type);
+	  /* this is just the step-expression */
+	  ip->step_temp    = maybe_make_for_temp (ip->step_exp, "for_step",
+						  ip->iter_type);
+	  goto do_step_range;
+	  
+	case DO_RANGE:
+	  ip->iter_type = chill_unsigned_type_node;
+	  
+	  ip->start_temp =
+	    (ip->down_flag ? build_chill_upper : build_chill_lower)(TREE_TYPE (ip->start_exp));
+	  ip->end_temp =
+	    (ip->down_flag ? build_chill_lower : build_chill_upper)(TREE_TYPE (ip->start_exp));
+	  
+	  ip->step_temp = integer_one_node;
+	  
+	do_step_range:
+	  if (flag_local_loop_counter)
+	    {
+	      /* (re-)declare the user's iteration variable in the 
+		 loop's scope. */
+	      tree id_node = ip->user_var;
+	      IDENTIFIER_LOCAL_VALUE (id_node) = ip->user_var = 
+		decl_temp1 (id_node, ip->iter_type, 0, NULL_TREE,
+			    0, 0);
+	    }
+	  else
+	    {
+	      /* in this case, it's a previously-declared 
+		 VAR_DECL node, checked in build_loop_iterator. */
+	      if (TREE_CODE (ip->user_var) == IDENTIFIER_NODE)
+		ip->user_var = lookup_name (ip->user_var);
+	      if (ip->user_var == NULL_TREE)
+		{
+		  error ("loop identifier undeclared");
+		  ip->error_flag = 1;
+		  return 1;
+		}
+	    }
+	  ip->iter_var = 
+	    decl_temp1 (get_unique_identifier ("iter_var"),
+			ip->iter_type, 0, NULL_TREE, 0, 0);
+	  break;
+
+	case DO_POWERSET:
+	  ip->iter_type = chill_unsigned_type (
+			    TYPE_DOMAIN (TREE_TYPE (ip->start_exp)));
+	  if (flag_local_loop_counter)
+	    {
+	      /* declare the user's iteration variable in the loop's scope. */
+	      /* in this case, it's just an IDENTIFIER_NODE */
+	      ip->user_var = 
+		decl_temp1 (ip->user_var, ip->iter_type, 0, NULL_TREE, 0, 0);
+	    }
+	  else
+	    {
+	      /* in this case, it's a previously-declared VAR_DECL node */
+	      ip->user_var = lookup_name (ip->user_var);
+	    }
+	  /* the user's powerset-expression, evaluated and saved in a temp */
+	  ip->powerset_temp = maybe_make_for_temp (ip->start_exp, "for_set",
+						 TREE_TYPE (ip->start_exp));
+	  mark_addressable (ip->powerset_temp);
+	  break;
+
+	case DO_LOC:
+	case DO_LOC_VARYING:
+	  ip->iter_type = chill_unsigned_type_node;
+	  /* create the counter temp */
+	  ip->iter_var = 
+	    build_temporary_variable ("iter_var", ip->iter_type);
+
+	  if (!CH_LOCATION_P (ip->start_exp))
+	    ip->start_exp
+	      = decl_temp1 (get_unique_identifier ("iter_loc"),
+			    TREE_TYPE (ip->start_exp), 0,
+			    ip->start_exp, 0, 0);
+
+	  if (ip->itype == DO_LOC)
+	    {
+	      tree array_type = TREE_TYPE (ip->start_exp);
+	      tree ptr_type;
+	      tree temp;
+	      
+	      if (TREE_CODE (TREE_TYPE (array_type)) == BOOLEAN_TYPE)
+		{
+		  error ("Can't iterate through array of BOOL");
+		  ip->error_flag = 1;
+		  return ip->error_flag;
+		}
+	      
+	      /* FIXME: check for array type in ip->start_exp */
+
+	      /* create pointer temporary */
+	      ip->base_type = TREE_TYPE (array_type);
+	      ptr_type = build_pointer_type (ip->base_type);
+	      ip->loc_ptr_temp =
+		build_temporary_variable ("loc_ptr_tmp", ptr_type);
+	      
+	      /* declare the user's iteration variable in 
+		 the loop's scope, as an expression, to be
+		 passed to build_component_ref later */
+	      save_expr_under_name (ip->user_var, 
+		build1 (INDIRECT_REF, ip->base_type, 
+			ip->loc_ptr_temp));
+	      
+	      /* FIXME: see stor_layout */
+	      ip->step_temp = size_in_bytes (ip->base_type);
+	      
+	      temp = TYPE_DOMAIN (array_type);
+
+	      /* pointer to first array entry to look at */
+	      start_ptr = build1 (ADDR_EXPR, ptr_type, ip->start_exp);
+	      mark_addressable (ip->start_exp);
+	      ip->start_temp = ip->down_flag ? 
+		fold (build (PLUS_EXPR, ptr_type, 
+			     start_ptr,
+		  fold (build (MULT_EXPR, integer_type_node, ip->step_temp,
+		    fold (build (MINUS_EXPR, integer_type_node,
+				 TYPE_MAX_VALUE (temp),
+				 TYPE_MIN_VALUE (temp)))))))
+		  : start_ptr;
+	    }
+	  else
+	    {
+	      tree array_length =
+		convert (integer_type_node,
+		  build_component_ref (ip->start_exp, var_length_id));
+	      tree array_type = TREE_TYPE (TREE_CHAIN (
+			TYPE_FIELDS (TREE_TYPE (ip->start_exp))));
+	      tree array_data_ptr = 
+		build_component_ref (ip->start_exp, var_data_id);
+	      tree ptr_type;
+	      
+	      if (TREE_CODE (TREE_TYPE (array_type)) == BOOLEAN_TYPE)
+		{
+		  error ("Can't iterate through array of BOOL");
+		  firstp->error_flag = 1;
+		  return firstp->error_flag;
+		}
+	      
+	      /* create pointer temporary */
+	      ip->base_type = TREE_TYPE (array_type);
+	      ptr_type = build_pointer_type (ip->base_type);
+	      ip->loc_ptr_temp = 
+		build_temporary_variable ("loc_ptr_temp", ptr_type);
+							   
+	      
+	      /* declare the user's iteration variable in 
+		 the loop's scope, as an expression, to be
+		 passed to build_component_ref later */
+	      save_expr_under_name (ip->user_var, 
+		build1 (INDIRECT_REF, ip->base_type, 
+			ip->loc_ptr_temp));
+	      
+	      /* FIXME: see stor_layout */
+	      ip->step_temp = size_in_bytes (ip->base_type);
+	      
+	      /* pointer to first array entry to look at */
+	      start_ptr = build1 (ADDR_EXPR, ptr_type, array_data_ptr);
+	      mark_addressable (array_data_ptr);
+	      ip->start_temp = ip->down_flag ? 
+		fold (build (PLUS_EXPR, ptr_type, 
+                  start_ptr,
+		    fold (build (MULT_EXPR, integer_type_node, ip->step_temp,
+		      fold (build (MINUS_EXPR, integer_type_node,
+				   array_length,
+				   integer_one_node))))))
+		  : start_ptr;
+	    }
+	default:
+	  ;
+	}
+    }
+  return firstp->error_flag;
+}
+
+/*
+ * Initialize the hidden iteration-control variables,
+ * and the user's explicit loop variable.
+ */
+static int
+initialize_iter_var ()
+{
+  ITERATOR *firstp = loop_stack->iter_list, *ip;
+
+  for (ip = firstp; ip != NULL; ip = ip->next)
+    {
+      switch (ip->itype)
+	{
+	case DO_FOREVER:
+	case DO_WHILE:
+	  break;
+	case DO_STEP:
+	case DO_RANGE:
+	  {
+	    tree count =
+	      fold (build (PLUS_EXPR, ip->iter_type, integer_one_node,
+		  fold (build (TRUNC_DIV_EXPR, ip->iter_type, 
+		    convert (ip->iter_type,
+	              fold (build (MINUS_EXPR, ip->iter_type,
+			ip->down_flag ? ip->start_temp : ip->end_temp,
+			ip->down_flag ? ip->end_temp   : ip->start_temp))),
+			       ip->step_temp))));
+	    /* initialize the loop's hidden counter variable */
+	    expand_expr_stmt (
+	      build_chill_modify_expr (ip->iter_var, count));
+
+	    /* initialize user's variable */
+	    expand_expr_stmt (
+	      build_chill_modify_expr (ip->user_var, ip->start_temp));
+	  }
+	  break;
+	case DO_POWERSET:
+	  break;
+	case DO_LOC:
+	  {
+	    tree array_type = TREE_TYPE (ip->start_exp);
+	    tree array_length =
+	      fold (build (TRUNC_DIV_EXPR, integer_type_node,
+			   size_in_bytes (array_type),
+			   size_in_bytes (TREE_TYPE (array_type))));
+
+	    expand_expr_stmt (
+	      build_chill_modify_expr (ip->iter_var, array_length));
+	    goto do_loc_common;
+	  }
+
+	case DO_LOC_VARYING:
+	  expand_expr_stmt (
+	    build_chill_modify_expr (ip->iter_var,
+	      convert (integer_type_node,
+		build_component_ref (ip->start_exp, var_length_id))));
+
+	do_loc_common:
+	  expand_expr_stmt (
+	    build_chill_modify_expr (ip->loc_ptr_temp, 
+				     ip->start_temp));
+	  break;
+
+	default:
+	  ;
+	}
+    }
+  return firstp->error_flag;
+}
+
+/* Generate code to skip the whole loop, if start expression not
+ * <= end expression (or >= for DOWN loops).  This comparison must
+ * *NOT* be done in unsigned mode, or it will fail.
+ *  Also, skip processing an empty VARYING array. 
+ */
+static int
+maybe_skip_loop ()
+{
+  ITERATOR *firstp = loop_stack->iter_list, *ip;
+
+  for (ip = firstp; ip != NULL; ip = ip->next)
+    {
+      switch (ip->itype)
+	{
+	case DO_STEP:
+	  expand_start_cond (
+	    build (ip->down_flag ? GE_EXPR : LE_EXPR, 
+		   TREE_TYPE (ip->start_exp),
+		   ip->start_exp, ip->end_exp), 0);
+	  break;
+    
+	case DO_LOC_VARYING:
+	  { tree array_length =
+	      convert (integer_type_node,
+	        build_component_ref (ip->start_exp, var_length_id));
+	    expand_start_cond (
+	      build (NE_EXPR, TREE_TYPE (array_length),
+		     array_length, integer_zero_node), 0);
+	    break;
+	  }
+	default:
+	  break;
+	}
+    }
+  return 0;
+}  
+
+/*
+ * Check at the top of the loop for a termination
+ */
+static int
+top_loop_end_check ()
+{
+  ITERATOR *firstp = loop_stack->iter_list, *ip;
+
+  /* now, exit the loop if the condition isn't TRUE. */
+  if (firstp->condition)
+    {
+      expand_exit_loop_if_false (0,
+	chill_truthvalue_conversion (firstp->condition));
+    }
+
+  for (ip = firstp; ip != NULL; ip = ip->next)
+    {
+      switch (ip->itype)
+	{
+	case DO_FOREVER:
+	case DO_WHILE:
+	case DO_STEP:
+	case DO_RANGE:
+	  break;
+	case DO_POWERSET:
+	  {
+	    tree temp1;
+	    char *func_name;
+
+	    if (ip->down_flag)
+	      func_name = "__flsetclrpowerset";
+	    else
+	      func_name = "__ffsetclrpowerset";
+	    
+	    temp1 = TYPE_MIN_VALUE
+	      (TYPE_DOMAIN (TREE_TYPE (ip->powerset_temp)));
+	    expand_exit_loop_if_false (0,
+	      build_chill_function_call (lookup_name (get_identifier (func_name)),
+	        tree_cons (NULL_TREE, force_addr_of (ip->powerset_temp),
+                  tree_cons (NULL_TREE, powersetlen (ip->powerset_temp),
+	            tree_cons (NULL_TREE, force_addr_of (ip->user_var),
+                      tree_cons (NULL_TREE, size_in_bytes (TREE_TYPE (ip->user_var)),
+		        tree_cons (NULL_TREE,
+				   convert (long_integer_type_node, temp1),
+				   NULL_TREE)))))));
+	  }
+	  break;
+	case DO_LOC:
+	case DO_LOC_VARYING:
+	  break;
+	default:
+	  ;
+	}
+    }
+  return firstp->error_flag;
+}
+
+/*
+ * Check generated temporaries for loop's end
+ */
+static int
+bottom_loop_end_check ()
+{
+  ITERATOR *firstp = loop_stack->iter_list, *ip;
+
+  emit_line_note (input_filename, lineno);
+
+  /* now, generate code to check each loop counter for termination */
+  for (ip = firstp; ip != NULL; ip = ip->next)
+    {
+      switch (ip->itype)
+	{
+	case DO_FOREVER:
+	case DO_WHILE:
+	  break;
+	case DO_STEP:
+	case DO_RANGE:
+	case DO_LOC:
+	case DO_LOC_VARYING:
+	  /* decrement iteration counter by one */
+	  chill_expand_assignment (ip->iter_var, MINUS_EXPR, integer_one_node);
+	  /* exit if it's zero */
+	  expand_exit_loop_if_false (0,
+	    build (NE_EXPR, boolean_type_node, 
+		   ip->iter_var,
+		   integer_zero_node));
+	  break;
+	case DO_POWERSET:
+	  break;
+	default:
+	  ;
+	}
+    }
+
+  return firstp->error_flag;
+}
+
+/*
+ * increment the loop-control variables.
+ */
+static int
+increment_temps ()
+{
+  ITERATOR *firstp = loop_stack->iter_list, *ip;
+
+  for (ip  = firstp; ip != NULL; ip = ip->next)
+    {
+      switch (ip->itype)
+	{
+	case DO_FOREVER:
+	case DO_WHILE:
+	  break;
+	case DO_STEP:
+	case DO_RANGE:
+	  {
+	    tree delta =
+	      fold (build (ip->down_flag ? MINUS_EXPR : PLUS_EXPR,
+			   TREE_TYPE (ip->user_var), ip->user_var,
+			   ip->step_temp));
+ 	    expand_expr_stmt (
+	      build_chill_modify_expr (ip->user_var, delta));
+	  }
+	  break;
+	case DO_LOC:
+	case DO_LOC_VARYING:
+	  /* This statement uses the C semantics, so that 
+	     the pointer is actually incremented by the 
+	     length of the object pointed to. */
+#if 1
+	  expand_expr_stmt (
+	    build_modify_expr (ip->loc_ptr_temp, 
+			       ip->down_flag ? MINUS_EXPR : PLUS_EXPR,
+			       integer_one_node));
+#else
+	  {
+	    enum tree_code op = ip->down_flag ? MINUS_EXPR : PLUS_EXPR;
+	    tree el_type = TREE_TYPE (TREE_TYPE (ip->loc_ptr_temp));
+	    chill_expand_assignment (ip->loc_ptr_temp, NOP_EXPR,
+				     build (op,
+					    TREE_TYPE (ip->loc_ptr_temp),
+					    ip->loc_ptr_temp,
+					    size_in_bytes (el_type)));
+	  }
+#endif
+	  break;
+	case DO_POWERSET:
+	  break;
+	default:
+	  ;
+	}
+    }
+  return firstp->error_flag;
+}
+
+/*
+ * Generate a (temporary) unique identifier_node of
+ * the form "__tmp_%s_%d"
+ */
+tree
+get_unique_identifier (lead)
+     char *lead;
+{
+  char idbuf [256];
+  static int idcount = 0;
+
+  sprintf (idbuf, "__tmp_%s_%d", lead ? lead : "", idcount++);
+  return get_identifier (idbuf);
+}
+
+/*
+ * build a temporary variable, given its NAME and TYPE.
+ * The name will have a number appended to assure uniqueness.
+ * return its DECL node.
+ */
+static tree
+build_temporary_variable (name, type)
+     char *name;
+     tree type;
+{
+  return decl_temp1 (get_unique_identifier (name), type, 0, NULL_TREE, 0, 0);
+}
+
+
+/*
+ * If the given expression isn't a constant, build a temp for it
+ * and evaluate the expression into the temp.  Return the tree
+ * representing either the original constant expression or the
+ * temp which now contains the expression's value. 
+ */
+static tree
+maybe_make_for_temp (exp, temp_name, exp_type)
+     tree exp;
+     char *temp_name;
+     tree exp_type;
+{
+  tree result = exp;
+
+  if (exp != NULL_TREE)
+    {
+      /* if exp isn't constant, create a temporary for its value */
+      if (TREE_CONSTANT (exp))
+	{
+          /* FIXME: assure that TREE_TYPE (result) == ip->exp_type */
+	  result = convert (exp_type, exp);
+	}
+      else {
+	/* build temp, assign the value */
+	result = decl_temp1 (get_unique_identifier (temp_name), exp_type, 0,
+			     exp, 0, 0);
+      }
+    }
+  return result;
+}
+
+
+/*
+ * Adapt the C unsigned_type function to CHILL - we need to
+ * account for any CHILL-specific integer types here.  So far,
+ * the 16-bit integer type is the only one.
+ */
+static tree
+chill_unsigned_type (type)
+     tree type;
+{
+  extern tree chill_unsigned_type_node;
+  tree type1 = TYPE_MAIN_VARIANT (type);
+
+  if (type1 == chill_integer_type_node)
+    return chill_unsigned_type_node;
+  else
+    return unsigned_type (type);
+}
diff --git a/gcc/ch/parse.h b/gcc/ch/parse.h
new file mode 100644
index 0000000..6b6b159
--- /dev/null
+++ b/gcc/ch/parse.h
@@ -0,0 +1,76 @@
+typedef union {
+  long itype;
+  tree ttype;
+  enum tree_code code;
+  char *filename;
+  int lineno;
+} YYSTYPE;
+extern YYSTYPE yylval;
+
+enum terminal
+{
+  /*EOF = 0,*/
+  last_char_nonterminal = 256,
+  /* Please keep these in alphabetic order, for easier reference and updating.
+   */
+  ABSOLUTE, ACCESS, AFTER, ALL, ALLOCATE, AND, ANDIF, ARRAY, 
+  ARROW, ASGN, ASM_KEYWORD, ASSERT, ASSOCIATION, AT,
+  BASED, BEGINTOKEN, BIN, BIT, BITSTRING, BODY, BOOLS, BUFFER,
+  BUFFERNAME, BUFFER_CODE, BY,
+  CALL, CASE, CAUSE, CDDEL, CHAR, CHARS, COLON, COMMA, CONCAT, CONST,
+  CONTINUE, CYCLE,
+  DCL, DELAY, DIV, DO, DOT, DOWN, DYNAMIC, 
+  ELSE, ELSIF, END, ENTRY, EQL, ESAC, EVENT, EVENT_CODE, EVER,
+  EXCEPTIONS, EXIT,
+  EXPR, /* an expression that has been pushed back */
+  FI, FLOATING, FOR, FORBID,
+  GENERAL, GOTO, GRANT, GT, GTE,
+  HEADEREL,
+  IF, IGNORED_DIRECTIVE, IN, INIT, INOUT, INLINE,
+  LC, LOC, LPC, LPRN, LT, LTE,
+  MOD, MODULE, MUL, 
+  NAME, NE, NEW, NEWMODE, NONREF, NOT, NUMBER,
+  OD, OF, ON, OR, ORIF,
+  PARAMATTR, PERVASIVE, PLUS, POWERSET,
+  PREFIXED, PRIORITY, PROC, PROCESS,
+  RANGE, RC, READ, READTEXT, RECEIVE, RECURSIVE, REF, REGION, REM,
+  RESULT, RETURN, RETURNS, ROUND, ROW, RPC, RPRN, RPRN_COLON,
+  SAME, SC, SEIZE, SEND, SET, SHARED, SIGNAL, SIGNALNAME, SIMPLE,
+  SINGLECHAR, SPEC, START, STATIC, STEP, STOP, STREAM, STRING, 
+  STRUCT, SUB, SYN, SYNMODE,
+  TERMINATE, TEXT, THEN, THIS, TIMEOUT, TO, TRUNC, TYPENAME, 
+  UP, USAGE,
+  VARYING, 
+  WHERE, WHILE, WITH,
+  XOR,
+
+/* These tokens only used within ch-lex.l to process compiler directives */
+  ALL_STATIC_OFF, ALL_STATIC_ON, EMPTY_OFF, EMPTY_ON,
+  GRANT_FILE_SIZE, PROCESS_TYPE_TOKEN, RANGE_OFF, RANGE_ON,
+  SEND_BUFFER_DEFAULT_PRIORITY, SEND_SIGNAL_DEFAULT_PRIORITY,
+  SIGNAL_CODE, SIGNAL_MAX_LENGTH, USE_SEIZE_FILE, USE_SEIZE_FILE_RESTRICTED,
+  USE_GRANT_FILE, 
+
+  /* These tokens are recognized, and reported as errors, by the lexer. */
+  CONTEXT, REMOTE,
+
+  /* These tokens are recognized in the lexer, and completely
+     ignored. They represent unimplemented features in the
+     current version of GNU CHILL. */
+  NOPACK, PACK,
+
+/* These tokens are recognized in the lexer, and returned
+   as reserved tokens, to prevent users from using them
+   accidently (they'll cause a parser syntax error).  They
+   represent unimplemented features in the current version
+   of GNU CHILL. */
+  POS, /*STEP, ROW,*/
+
+/* This token is passed back to the parser when an the main 
+   input file (not a seize file) has  reached end-of-file. */
+  END_PASS_1,
+
+  EMPTY, UMINUS,
+
+  dummy_last_terminal
+};
diff --git a/gcc/ch/runtime/concatstr.c b/gcc/ch/runtime/concatstr.c
new file mode 100644
index 0000000..e4105d6
--- /dev/null
+++ b/gcc/ch/runtime/concatstr.c
@@ -0,0 +1,69 @@
+/* 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))
+
+extern void cause_exception (char *exname, char *file, int lineno);
+
+/*
+ * function __concatstring 
+ *
+ * parameters:
+ *     OUT  - pointer to output string
+ *     S1   - pointer to left string
+ *     LEN1 - length of left string
+ *     S2   - pointer to right string
+ *     LEN2 - length of right string
+ *
+ * returns:
+ *     pointer to OUT string
+ *
+ * exceptions:
+ *     none
+ *
+ * abstract:
+ *     concatenates two character strings into the output string
+ *
+ */
+
+char *
+__concatstring (out, s1, len1, s2, len2)
+     char *out, *s1;
+     int   len1;
+     char *s2;
+     int   len2;
+{
+  if (out)
+    {
+      if (s2 /* Check for overlap between s2 and out. */
+	  && ((s2 >= out && s2 < (out + len1 + len2))
+	      || (s2 + len2 > out && s2 <= out + len1)))
+	{
+	  char *tmp = alloca (len2);
+	  memcpy (tmp, s2, len2);
+	  s2 = tmp;
+	}
+      if (s1)
+	memmove (out, s1, len1);
+      if (s2)
+	memcpy (&out[len1], s2, len2);
+    }
+  return out;
+}
diff --git a/gcc/ch/runtime/continue.c b/gcc/ch/runtime/continue.c
new file mode 100644
index 0000000..76d457d
--- /dev/null
+++ b/gcc/ch/runtime/continue.c
@@ -0,0 +1,83 @@
+/* Implement tasking-related 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.  */
+
+#include "rtltypes.h"
+#include "rts.h"
+
+/*
+ * function __continue
+ *
+ * parameters:
+ *     evaddr     pointer to Eventlocation
+ *     filename   source file name where function gets called
+ *     lineno     linenumber in source file
+ *
+ * returns:
+ *     void
+ *
+ * exceptions:
+ *     none
+ *
+ * abstract:
+ *     implement the CHILL CONTINUE action.
+ */
+
+void
+__continue (evaddr, filename, lineno)
+     Event_Queue   **evaddr;
+     char           *filename;
+     int             lineno;
+{
+  Event_Queue  *ev = *evaddr;
+  Event_Queue  *wrk;
+
+  if (ev == 0)
+    /* nothing to do */
+    return;
+
+  /* search for 1st one is not already continued */
+  while (ev && ev->is_continued)
+    ev = ev->forward;
+  if (!ev)
+    /* all have been continued in that queue, do nothing */
+    return;
+
+  wrk = ev->startlist;
+  while (wrk)
+    {
+      Event_Queue     *tmp = (Event_Queue *)wrk->listhead;
+      
+      while (tmp->forward != wrk)
+	tmp = tmp->forward;
+      tmp->forward = wrk->forward;
+      wrk = wrk->chain;
+    }
+
+  /* so far so good, continue this one */
+  ev->is_continued = 1;
+  ev->who_continued = THIS;
+
+  /* tell the runtime system to activate the process */
+  __continue_that (ev->this, ev->priority, filename, lineno);
+}
+
+/* force function print_event to be linked */
+extern void __print_event ();
+static EntryPoint pev = __print_event;
diff --git a/gcc/ch/runtime/convdurrtstime.c b/gcc/ch/runtime/convdurrtstime.c
new file mode 100644
index 0000000..f56fc3a
--- /dev/null
+++ b/gcc/ch/runtime/convdurrtstime.c
@@ -0,0 +1,52 @@
+/* Implement timing-related 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.  */
+
+#include "rts.h"
+
+/*
+ * function __convert_duration_rtstime
+ *
+ * parameters:
+ *      dur     the duration value
+ *      t       pointer to the duration value converted to RtsTime
+ *
+ * returns:
+ *      void
+ *
+ * exceptions:
+ *      none
+ *
+ * abstract:
+ *      converts a duration value (unsigned long in millisecs) to RtsTime
+ *      format.
+ *
+ */
+
+void
+__convert_duration_rtstime (dur, t)
+     unsigned long  dur;
+     RtsTime       *t;
+{
+  unsigned long tmp;
+    
+  t->secs = dur / 1000;
+  tmp = dur - (t->secs * 1000);
+  t->nanosecs = tmp * 1000000;
+}
diff --git a/gcc/ch/runtime/ffsetclrps.c b/gcc/ch/runtime/ffsetclrps.c
new file mode 100644
index 0000000..bb5b965
--- /dev/null
+++ b/gcc/ch/runtime/ffsetclrps.c
@@ -0,0 +1,102 @@
+/* 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 __ffsetclrpowerset
+ *
+ * parameters:
+ *	ps		powerset
+ *	bitlength	length of powerset
+ *
+ * returns:
+ *	int		-1 .. nothing found
+ *			>=0 .. index of first true bit found
+ * exceptions:
+ *  none
+ */
+
+int
+__ffsetclrpowerset (ps, bitlength, first_bit)
+     SET_WORD      *ps;
+     unsigned long  bitlength;
+     int first_bit;
+{
+  register int bitno;
+
+  if (first_bit >= bitlength)
+    return -1;
+
+#ifndef USE_CHARS
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      for (bitno = first_bit; bitno < bitlength; bitno++)
+	if (GET_BIT_IN_CHAR (*((SET_CHAR *)ps), bitno))
+	  break;
+      return bitno == bitlength ? -1 : bitno;
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      for (bitno = first_bit; bitno < bitlength; bitno++)
+	if (GET_BIT_IN_SHORT (*((SET_SHORT *)ps), bitno))
+	  break;
+      return bitno == bitlength ? -1 : bitno;
+    }
+  else
+#endif
+    {
+      unsigned int words_to_skip = (unsigned) first_bit / SET_WORD_SIZE;
+      unsigned long cnt = words_to_skip * SET_WORD_SIZE;
+      SET_WORD	*p = ps + words_to_skip;
+      SET_WORD	*endp = ps + BITS_TO_WORDS(bitlength);
+      SET_WORD	c;
+      first_bit = (unsigned) first_bit % (unsigned) SET_WORD_SIZE;
+
+      c = *p++;
+      if (c)
+	{
+	  for (bitno = first_bit; bitno < SET_WORD_SIZE; bitno++)
+	    if (GET_BIT_IN_WORD(c, bitno))
+	      goto found;
+	}
+      cnt += SET_WORD_SIZE;
+
+      while (p < endp)
+	{
+	  if ((c = *p++))
+	    {
+	      /* found a bit set .. calculate which */
+	      for (bitno = 0; bitno < SET_WORD_SIZE; bitno++)
+		if (GET_BIT_IN_WORD(c, bitno))
+		  goto found;
+	    }
+	  cnt += SET_WORD_SIZE;
+	}
+      return -1;
+    found:
+      bitno += cnt;
+      return bitno >= bitlength ? -1 : bitno;
+    }
+}
diff --git a/gcc/ch/runtime/flsetclrps.c b/gcc/ch/runtime/flsetclrps.c
new file mode 100644
index 0000000..e768a47
--- /dev/null
+++ b/gcc/ch/runtime/flsetclrps.c
@@ -0,0 +1,99 @@
+/* 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 __flsetclrpowerset
+ *
+ * parameters:
+ *	ps		powerset
+ *	bitlength	length of powerset
+ *
+ * returns:
+ *	int		-1 .. nothing found
+ *			>= 0 .. index of last set bit
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  Find last bit set in a powerset and return the corresponding value
+ *  in *out and clear this bit. Return 0 for no more found, else 1.
+ *
+ */
+int
+__flsetclrpowerset (ps, bitlength, first_bit)
+     SET_WORD      *ps;
+     unsigned long  bitlength;
+     int first_bit;
+{
+  register int bitno;
+
+#ifndef USE_CHARS
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      for (bitno = bitlength - 1; bitno >= first_bit; bitno--)
+	if (GET_BIT_IN_CHAR (*((SET_CHAR *)ps), bitno))
+	  break;
+      return bitno < first_bit ? -1 : bitno;
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      for (bitno = bitlength - 1; bitno >= first_bit; bitno--)
+	if (GET_BIT_IN_SHORT (*((SET_SHORT *)ps), bitno))
+	  break;
+      return bitno < first_bit ? -1 : bitno;
+    }
+  else
+#endif
+    {
+      SET_WORD *p, c;
+      bitno = bitlength - 1;
+      if (bitno < first_bit)
+	return -1;
+      p = &ps[(unsigned) bitno / SET_WORD_SIZE];
+      c = *p;
+      if (((unsigned) bitlength % SET_WORD_SIZE) != 0)
+	MASK_UNUSED_WORD_BITS(&c, (unsigned) bitlength % SET_WORD_SIZE);
+      if (c)
+	goto found;
+      else
+	bitno -= ((unsigned) bitno % SET_WORD_SIZE) + 1;
+      while (bitno >= first_bit)
+	{
+	  c = *--p;
+	  if (c)
+	    goto found;
+	  bitno -= SET_WORD_SIZE;
+	}
+      return -1;
+    found:
+      for (; bitno >= first_bit; bitno--)
+	{
+	  if (GET_BIT_IN_WORD (c, (unsigned) bitno % SET_WORD_SIZE))
+	    return bitno;
+	}
+      return -1;
+    }
+}
diff --git a/gcc/ch/runtime/leps.c b/gcc/ch/runtime/leps.c
new file mode 100644
index 0000000..7c5231a
--- /dev/null
+++ b/gcc/ch/runtime/leps.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 __lepowerset
+ *
+ * parameters:
+ *	left		powerset
+ *	right		powerset
+ *	bitlength	length of powerset
+ *
+ * returns:
+ *	int		1 .. left is included in right
+ *			0 .. not
+ *
+ * abstract:
+ *  check if one powerset is included in another
+ *
+ */
+int
+__lepowerset (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;
+      return 1;
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      if ((*((SET_SHORT *)left) & *((SET_SHORT *)right))
+	  != *((SET_SHORT *)left))
+	return 0;
+      return 1;
+    }
+  else
+    {
+      SET_WORD *endp = left + BITS_TO_WORDS(bitlength);
+    
+      while (left < endp)
+	{
+	  if ((*right & *left) != *left)
+	    return 0;
+	  left++;
+	  right++;
+	}
+      return 1;
+    }
+}
diff --git a/gcc/ch/runtime/powerset.h b/gcc/ch/runtime/powerset.h
new file mode 100644
index 0000000..3ceb776
--- /dev/null
+++ b/gcc/ch/runtime/powerset.h
@@ -0,0 +1,106 @@
+/* Common macros for 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.  */
+
+#ifndef _POWERSET_H
+#define _POWERSET_H
+
+#define USE_CHARS
+
+#ifdef USE_CHARS
+
+#define SET_WORD unsigned char
+#define SET_CHAR  unsigned char
+#define SET_SHORT unsigned char
+
+#else
+
+#ifndef SET_WORD
+#define SET_WORD unsigned int
+#endif
+#define SET_CHAR  unsigned char
+#define SET_SHORT unsigned short
+#endif
+
+#define SET_WORD_SIZE (BITS_PER_UNIT * sizeof (SET_WORD))
+#define SET_SHORT_SIZE (BITS_PER_UNIT * sizeof (SET_SHORT))
+#define SET_CHAR_SIZE BITS_PER_UNIT
+
+/* Powersets and bit strings are stored as arrays of SET_WORD.
+   if they are a word or longer.  Powersets and bit strings whic
+   fit in a byte or short are stored that way by the compiler.
+
+   The order of the bits follows native bit order:
+   If BITS_BIG_ENDIAN, bit 0 is the most significant bit (i.e. 0x80..00);
+   otherwise, bit 0 is the least significant bit (i.e. 0x1).
+
+   MASK_UNUSED_BITS masks out unused bits in powersets and bitstrings.
+   GET_BIT_IN_WORD(W,B) yields 1 (or 0) if the B'th bit if W is set (cleared).
+*/
+
+#if BITS_BIG_ENDIAN
+#define GET_BIT_IN_WORD(w,b) (((w) >> (SET_WORD_SIZE - 1 - (b))) & 1)
+#define GET_BIT_IN_SHORT(w,b) (((w) >> (SET_SHORT_SIZE - 1 - (b))) & 1)
+#define GET_BIT_IN_CHAR(w,b) (((w) >> (SET_CHAR_SIZE - 1 - (b))) & 1)
+
+#define SET_BIT_IN_WORD(w,b) ((w) |= 1 << ((SET_WORD_SIZE) - 1 - (b)))
+#define SET_BIT_IN_SHORT(w,b) ((w) |= 1 << ((SET_SHORT_SIZE) - 1 - (b)))
+#define SET_BIT_IN_CHAR(w,b) ((w) |= 1 << ((SET_CHAR_SIZE) - 1 - (b)))
+
+#define CLEAR_BIT_IN_WORD(w,b) ((w) &= ~(1 << ((SET_WORD_SIZE) - 1 - (b))))
+#define CLEAR_BIT_IN_SHORT(w,b) ((w) &= ~(1 << ((SET_SHORT_SIZE) - 1 - (b))))
+#define CLEAR_BIT_IN_CHAR(w,b) ((w) &= ~(1 << ((SET_CHAR_SIZE) - 1 - (b))))
+#define MASK_UNUSED_WORD_BITS(p,b)		   \
+{ if (b) *(p) &= (~0) << (SET_WORD_SIZE - (b)); }
+#define MASK_UNUSED_SHORT_BITS(p,b)		   \
+{ if (b) *(p) &= (~0) << (SET_SHORT_SIZE - (b)); }
+#define MASK_UNUSED_CHAR_BITS(p,b)                 \
+{ if (b) *(p) &= (~0) << (SET_CHAR_SIZE - (b)); }
+
+#else /* !BITS_BIG_ENDIAN */
+
+#define GET_BIT_IN_WORD(w,b) (((w) >> (b)) & 1)
+#define GET_BIT_IN_SHORT(w,b) GET_BIT_IN_WORD(w,b)
+#define GET_BIT_IN_CHAR(w,b) GET_BIT_IN_WORD(w,b)
+
+#define SET_BIT_IN_WORD(w,b) ((w) |= 1 << (b))
+#define SET_BIT_IN_SHORT(w,b) SET_BIT_IN_WORD(w,b)
+#define SET_BIT_IN_CHAR(w,b) SET_BIT_IN_WORD(w,b)
+
+#define CLEAR_BIT_IN_WORD(w,b) ((w) &= ~(1 << (b)))
+#define CLEAR_BIT_IN_SHORT(w,b) CLEAR_BIT_IN_WORD(w,b)
+#define CLEAR_BIT_IN_CHAR(w,b) CLEAR_BIT_IN_WORD(w,b)
+
+#define MASK_UNUSED_WORD_BITS(p,b)  \
+{ if (b) *(p) &= ~((~0) << (b)); }
+#define MASK_UNUSED_SHORT_BITS(p,b) MASK_UNUSED_WORD_BITS(p,b)
+#define MASK_UNUSED_CHAR_BITS(p,b) MASK_UNUSED_WORD_BITS(p,b)
+
+#endif
+
+
+/* Number of words needed for a bitstring/powerset of size BITLENGTH.
+   This definition handles the (BITLENGTH==0) by yielding 0. */
+
+#define BITS_TO_WORDS(BITLENGTH) \
+  (((BITLENGTH) + (SET_WORD_SIZE-1)) / SET_WORD_SIZE)
+#define BITS_TO_CHARS(BITLENGTH) \
+  (((BITLENGTH) + (SET_CHAR_SIZE-1)) / SET_CHAR_SIZE)
+
+#endif
diff --git a/gcc/ch/runtime/queuelength.c b/gcc/ch/runtime/queuelength.c
new file mode 100644
index 0000000..417d175
--- /dev/null
+++ b/gcc/ch/runtime/queuelength.c
@@ -0,0 +1,79 @@
+/* Implement tasking-related 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.  */
+
+#include "rtltypes.h"
+#include "rts.h"
+
+/*
+ * function __queue_length
+ *
+ * parameters:
+ *     buf_ev      Buffer or event location
+ *     is_event    0 .. buf_ev is a buffer location
+ *                 1 .. buf_ev is an event location
+ *
+ * returns:
+ *     int         number of delayed processeson an event location
+ *                 or number of send delayed processes on a buffer
+ *
+ * exceptions:
+ *     none
+ *
+ * abstract:
+ *     implements the QUEUE_LENGTH built-in.
+ *
+ */
+
+int
+__queue_length (buf_ev, is_event)
+     void  *buf_ev;
+     int    is_event;
+{
+  int            retval = 0;
+  
+  /* if buf_ev == 0 then we don't have anything */
+  if (buf_ev == 0)
+    return 0;
+
+  if (is_event)
+    {
+      /* process an event queue */
+      Event_Queue   *ev = buf_ev;
+
+      while (ev)
+	{
+	  retval++;
+	  ev = ev->forward;
+	}
+    }
+  else
+    {
+      /* process a buffer queue */
+      Buffer_Queue *bq = buf_ev;
+      Buffer_Send_Queue *bsq = bq->sendqueue;
+
+      while (bsq)
+	{
+	  retval++;
+	  bsq = bsq->forward;
+	}
+    }
+  return retval;
+}
diff --git a/gcc/ch/runtime/readrecord.c b/gcc/ch/runtime/readrecord.c
new file mode 100644
index 0000000..03641f9
--- /dev/null
+++ b/gcc/ch/runtime/readrecord.c
@@ -0,0 +1,208 @@
+/* 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>
+#include <stdlib.h>
+#include <errno.h>
+#include <unistd.h>
+
+#include "fileio.h"
+
+#ifdef EOF
+#undef EOF
+#endif
+#define EOF -1
+
+static
+Boolean
+doRead( Access_Mode* the_access, void* buf, size_t nbyte )
+{
+  size_t nread;
+
+  nread = read( the_access->association->handle, buf, nbyte );
+  if( nread == nbyte )
+  {
+    CLR_FLAG( the_access, IO_OUTOFFILE );
+    return True;
+  }
+  if( nread == 0 )
+  {
+    SET_FLAG( the_access, IO_OUTOFFILE );
+    return False;
+  }
+  the_access->association->syserrno = errno;
+  RWEXCEPTION( READFAIL, OS_IO_ERROR );
+  /* no return */
+}
+
+static
+int bgetc( int handle, readbuf_t* rbptr )
+{
+  if( rbptr->cur >= rbptr->len )
+    {
+      rbptr->len = read( handle, rbptr->buf, READBUFLEN );
+      if( rbptr->len == 0 )
+	return EOF;
+      rbptr->cur = 0;
+    }
+  return rbptr->buf[rbptr->cur++];
+}
+
+static
+void bungetc( readbuf_t* rbptr, int c )
+{
+  rbptr->buf[--rbptr->cur] = c;
+}
+
+void*
+__readrecord( Access_Mode*  the_access,
+              signed long   the_index,
+              char*         the_buf_addr,
+              char*         file,
+              int           line )
+{
+  unsigned long  info;
+  char*          actaddr;
+  unsigned short actlen;
+  off_t          filepos;
+  unsigned short reclen;
+  unsigned long  readlen;
+
+  if( !the_access )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ACCESS );
+
+  if( !the_access->association )
+    CHILLEXCEPTION( file, line, NOTCONNECTED, IS_NOT_CONNECTED );
+
+  /* Usage must not be WriteOnly */
+  if( the_access->association->usage == WriteOnly )
+    CHILLEXCEPTION( file, line, READFAIL, BAD_USAGE );
+
+  /* OUTOFFILE must not be True when connected for sequential read */
+  if( !TEST_FLAG( the_access, IO_INDEXED )
+      && TEST_FLAG( the_access, IO_OUTOFFILE ) )
+    CHILLEXCEPTION( file, line, READFAIL, OUT_OF_FILE );
+
+  /*
+   *  Positioning
+   */
+  if( TEST_FLAG( the_access, IO_INDEXED ) )
+  {
+    /* index expression must be within bounds of index mode */
+    if( the_index < the_access->lowindex
+        || the_access->highindex < the_index ) 
+      CHILLEXCEPTION( file, line, RANGEFAIL, BAD_INDEX );
+
+    filepos = the_access->base + 
+              (the_index - the_access->lowindex) * the_access->reclength;
+
+    if( lseek( the_access->association->handle, filepos, SEEK_SET ) == -1L )
+      CHILLEXCEPTION( file, line, READFAIL, LSEEK_FAILS );
+  }
+
+  /* establish store loc */
+  if( !(actaddr = the_buf_addr ))
+  {
+    /* if not yet allocated, do it now */
+    if (!the_access->store_loc)
+      if( !(the_access->store_loc = (char*)malloc( the_access->reclength ) ) )
+	CHILLEXCEPTION( file, line, SPACEFAIL, STORE_LOC_ALLOC );
+    actaddr = the_access->store_loc;
+  }
+  actlen  = the_access->reclength;
+
+  if( (info = setjmp( __rw_exception )) )
+    CHILLEXCEPTION( file, line, info>>16, info & 0xffff );
+
+  if( TEST_FLAG( the_access, IO_TEXTIO ) )
+  {
+    readlen = actlen - 2;
+    if( TEST_FLAG( the_access, IO_INDEXED ) )
+    {
+      if( ! doRead( the_access, &reclen, sizeof(reclen) ) )
+        return NULL;
+      if( reclen > readlen )
+        CHILLEXCEPTION( file, line, RANGEFAIL, RECORD_TOO_LONG );
+      if( ! doRead( the_access, actaddr + 2, reclen ) )
+        CHILLEXCEPTION( file, line, READFAIL, RECORD_TOO_SHORT );
+    }
+    else
+    { 
+      Association_Mode *assoc = the_access->association;
+      int              handle = assoc->handle;
+      readbuf_t*       rbuf   = assoc->bufptr;
+      char* cptr = actaddr+2;
+      int   curr;
+
+      reclen = 0;
+      while( readlen-- )
+      {
+        curr = bgetc( handle, rbuf );
+        if( curr == '\n' )
+          goto end_of_line;
+        if( curr == EOF )
+	{
+          if( !reclen )
+            SET_FLAG( the_access, IO_OUTOFFILE );
+          goto end_of_line;
+	}
+        *cptr++ = curr;
+        reclen++;
+      }
+      if( (curr = bgetc( handle, rbuf )) != '\n' )
+	{
+	  bungetc( rbuf, curr );
+	  CHILLEXCEPTION( file, line, RANGEFAIL, RECORD_TOO_LONG );
+	}
+end_of_line: ;
+    }
+    MOV2(actaddr,&reclen);
+  }
+  else
+  {
+    switch( the_access->rectype )
+    {
+    case Fixed:
+      if( ! doRead( the_access, actaddr, actlen ) )
+        return NULL;
+      break;
+    case VaryingChars:
+      if( TEST_FLAG( the_access->association, IO_VARIABLE ) )
+      {
+        if( ! doRead( the_access, &reclen, sizeof(reclen) ) )
+          return NULL;
+        if( reclen > actlen - 2 )
+          CHILLEXCEPTION( file, line, RANGEFAIL, RECORD_TOO_LONG );
+        readlen = TEST_FLAG( the_access, IO_INDEXED ) ? actlen - 2 : reclen;
+        if( ! doRead( the_access, actaddr + 2, readlen ) )
+          CHILLEXCEPTION( file, line, READFAIL, RECORD_TOO_SHORT );
+      }
+      else
+      {
+        if( ! doRead( the_access, actaddr + 2, reclen = actlen - 2 ) )
+          CHILLEXCEPTION( file, line, READFAIL, RECORD_TOO_SHORT );
+      }
+      MOV2(actaddr,&reclen);
+      break;
+    }
+  }
+
+  return actaddr;
+}
diff --git a/gcc/ch/runtime/rtsdummy.c b/gcc/ch/runtime/rtsdummy.c
new file mode 100644
index 0000000..cff2289
--- /dev/null
+++ b/gcc/ch/runtime/rtsdummy.c
@@ -0,0 +1,65 @@
+/* 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>
+/*#include "gvarargs.h"	Gcc source and runtime libs use gvarargs.h */
+
+#include "rtltypes.h"
+
+typedef void (*init_ptr) ();
+typedef int * tasking_ptr;
+
+/* Dummy functions for rts access. When we come here we have an error. */
+
+typedef char *(*fetch_names) (int number);
+typedef int (*fetch_numbers) (char *name);
+
+static void __rts_main_loop ()
+{
+  /* do nothing in case of no run time system */
+}
+init_ptr	__RTS_MAIN_LOOP__ = __rts_main_loop;
+
+static void __rts_init ()
+{
+  /* do nothing in case of no run time system */
+}
+init_ptr	__RTS_INIT__ = __rts_init;
+
+static char *__fetch_name (int number)
+{
+    fprintf (stderr, "ChillLib: fetch_name: no runtime system library linked.\n");
+    fflush (stderr);
+    abort ();
+}
+fetch_names	__RTS_FETCH_NAMES__ = __fetch_name;
+
+static int __fetch_number (char *name)
+{
+    fprintf (stderr, "ChillLib: fetch_number: no runtime system library linked.\n");
+    fflush (stderr);
+    abort ();
+}
+fetch_numbers	__RTS_FETCH_NUMBERS__ = __fetch_number;
diff --git a/gcc/ch/runtime/sequencible.c b/gcc/ch/runtime/sequencible.c
new file mode 100644
index 0000000..94166ff
--- /dev/null
+++ b/gcc/ch/runtime/sequencible.c
@@ -0,0 +1,32 @@
+/* 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"
+
+Boolean
+__sequencible( 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 );
+  return TEST_FLAG(the_assoc, IO_SEQUENCIBLE) ? True : False;
+}
+
diff --git a/gcc/ch/runtime/setbitps.c b/gcc/ch/runtime/setbitps.c
new file mode 100644
index 0000000..f465548
--- /dev/null
+++ b/gcc/ch/runtime/setbitps.c
@@ -0,0 +1,89 @@
+/* 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 __setbitpowerset
+ *
+ * parameters:
+ *	set		destination set
+ *	bitlength	length of powerset in bits
+ *      minval          lowest valid set value
+ *      bitno           bit number within set
+ *      new_value       zero or one - (new bit value)
+ *
+ * returns:
+ *	int		1 .. found
+ *			0 .. not found
+ *
+ * exceptions:
+ *  rangefail
+ *
+ * abstract:
+ *  checks if a given value is included in a powerset
+ *
+ */
+void
+__setbitpowerset (powerset, bitlength, minval, bitno, new_value, filename, lineno)
+     SET_WORD      *powerset;
+     unsigned long  bitlength;
+     long           minval;
+     long	    bitno;
+     char	    new_value; /* booleans are represented as 8 bit value */
+     char *	    filename;
+     int	    lineno;
+{
+  if (powerset == NULL
+      || bitno < minval 
+      || (bitno - minval) >= bitlength)
+    __cause_ex1 ("rangefail", filename, lineno);
+
+  bitno -= minval;
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      if (new_value & 1)
+	SET_BIT_IN_CHAR (*((SET_CHAR *)powerset), bitno);
+      else
+	CLEAR_BIT_IN_CHAR (*((SET_CHAR *)powerset), bitno);
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      if (new_value & 1)
+	SET_BIT_IN_SHORT (*((SET_SHORT *)powerset), bitno);
+      else
+	CLEAR_BIT_IN_SHORT (*((SET_SHORT *)powerset), bitno);
+    }
+  else
+    {
+      powerset += (bitno/SET_WORD_SIZE);
+      bitno %= SET_WORD_SIZE;
+      if (new_value & 1)
+	SET_BIT_IN_WORD (*powerset, bitno);
+      else
+	CLEAR_BIT_IN_WORD (*powerset, bitno);
+    }
+}
diff --git a/gcc/ch/runtime/setbits.c b/gcc/ch/runtime/setbits.c
new file mode 100644
index 0000000..1e3045c
--- /dev/null
+++ b/gcc/ch/runtime/setbits.c
@@ -0,0 +1,85 @@
+/* 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 __setbits
+ *
+ * parameters:
+ *	out		result
+ *      bitlength       length of bitstring in bits
+ *	startbit	starting bitnumber
+ *	endbit		ending bitnumber
+ *
+ * returns:
+ *	void
+ *
+ * exceptions:
+ *   rangefail
+ *
+ * abstract:
+ *  set all bits from starting bitnumber to ending bitnumber
+ *  in a powerset
+ *
+ */
+void
+__setbits (out, bitlength, startbit, endbit)
+     SET_WORD      *out;
+     unsigned long  bitlength;
+     long  startbit;
+     long  endbit;
+{
+  unsigned long i;
+  
+  if (out == NULL
+      || startbit < 0
+      || startbit >= bitlength 
+      || endbit < 0
+      || endbit >= bitlength 
+      || endbit < startbit)
+    __cause_ex1 ("rangefail", "__setbits", __LINE__);
+  
+  if (bitlength <= SET_CHAR_SIZE)
+    for (i = startbit; i <= endbit; i++)
+      SET_BIT_IN_CHAR (*((SET_CHAR *)out), i);
+  else if (bitlength <= SET_SHORT_SIZE)
+    for (i = startbit; i <= endbit; i++)
+      SET_BIT_IN_SHORT (*((SET_SHORT *)out), i);
+  else
+    {
+      SET_WORD	*p;
+      unsigned long       bitnr;
+      
+      /* FIXME - this is inefficient! */
+      for (i = startbit; i <= endbit; i++)
+	{
+	  p = out + (i / SET_WORD_SIZE);
+	  bitnr = i % SET_WORD_SIZE;
+	  SET_BIT_IN_WORD (*p, bitnr);
+	}
+    }
+} 
diff --git a/gcc/ch/runtime/settextindex.c b/gcc/ch/runtime/settextindex.c
new file mode 100644
index 0000000..94b9266
--- /dev/null
+++ b/gcc/ch/runtime/settextindex.c
@@ -0,0 +1,38 @@
+/* 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"
+
+void
+__settextindex( Text_Mode*  the_text,
+                signed long the_text_index, 
+                char*       file,
+                int         line )
+{
+  if( !the_text )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_TEXT );
+
+  if( the_text_index < 0 
+      || the_text->access_sub->reclength - 2 < the_text_index )
+    CHILLEXCEPTION( file, line, TEXTFAIL, BAD_TEXTINDEX );
+  
+  the_text->actual_index = the_text_index;
+}
+
diff --git a/gcc/ch/runtime/variable.c b/gcc/ch/runtime/variable.c
new file mode 100644
index 0000000..69810b3
--- /dev/null
+++ b/gcc/ch/runtime/variable.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"
+
+Boolean
+__variable( 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 );
+  return TEST_FLAG( the_assoc, IO_VARIABLE ) ? True : False;
+}
diff --git a/gcc/ch/runtime/writeable.c b/gcc/ch/runtime/writeable.c
new file mode 100644
index 0000000..cf0f5cd
--- /dev/null
+++ b/gcc/ch/runtime/writeable.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"
+
+Boolean
+__writeable( 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 );
+  return TEST_FLAG(the_assoc, IO_WRITEABLE) ? True : False;
+}
diff --git a/gcc/ch/tasking.h b/gcc/ch/tasking.h
new file mode 100644
index 0000000..31e0581
--- /dev/null
+++ b/gcc/ch/tasking.h
@@ -0,0 +1,26 @@
+/* Implement process-related declarations 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.  */
+
+#ifndef _CH_TASKING_H
+#define _CH_TASKING_H
+
+/* list of this module's process, buffer, etc. decls */
+extern tree tasking_list;
+
+#endif
diff --git a/gcc/ch/tree.c b/gcc/ch/tree.c
new file mode 100644
index 0000000..b1d0168
--- /dev/null
+++ b/gcc/ch/tree.c
@@ -0,0 +1,293 @@
+/* Language-dependent node constructors for parse phase of GNU 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 "obstack.h"
+#include "tree.h"
+#include "ch-tree.h"
+
+/* Here is how primitive or already-canonicalized types' 
+   hash codes are made.  */
+#define TYPE_HASH(TYPE) ((HOST_WIDE_INT) (TYPE) & 0777777)
+
+extern void error PROTO((char *, ...));
+extern int  get_type_precision PROTO((tree, tree));
+
+extern struct obstack permanent_obstack;
+/* This is special sentinel used to communicate from build_string_type
+   to layout_chill_range_type for the index range of a string. */
+tree string_index_type_dummy;
+
+/* Build a chill string type.
+   For a character string, ELT_TYPE==char_type_node; 
+   for a bit-string, ELT_TYPE==boolean_type_node. */
+
+tree
+build_string_type (elt_type, length)
+     tree elt_type;
+     tree length;
+{
+  register tree t;
+
+  if (TREE_CODE (elt_type) == ERROR_MARK || TREE_CODE (length) == ERROR_MARK)
+    return error_mark_node;
+
+  /* Allocate the array after the pointer type,
+     in case we free it in type_hash_canon.  */
+
+  if (pass > 0 && TREE_CODE (length) == INTEGER_CST
+      && ! tree_int_cst_equal (length, integer_zero_node)
+      && compare_int_csts (LT_EXPR, TYPE_MAX_VALUE (chill_unsigned_type_node),
+			   length))
+    {
+      error ("string length > UPPER (UINT)");
+      length = integer_one_node;
+    }
+
+  /* Subtract 1 from length to get max index value.
+     Note we cannot use size_binop for pass 1 expressions. */
+  if (TREE_CODE (length) == INTEGER_CST || pass != 1)
+    length = size_binop (MINUS_EXPR, length, integer_one_node);
+  else
+    length = build (MINUS_EXPR, sizetype, length, integer_one_node);
+
+  t = make_node (elt_type == boolean_type_node ? SET_TYPE : ARRAY_TYPE);
+  TREE_TYPE (t) = elt_type;
+
+  MARK_AS_STRING_TYPE (t);
+
+  TYPE_DOMAIN (t) = build_chill_range_type (string_index_type_dummy,
+					    integer_zero_node, length);
+  if (pass == 1 && TREE_CODE (length) == INTEGER_CST)
+    TYPE_DOMAIN (t) = layout_chill_range_type (TYPE_DOMAIN (t), 0);
+
+  if (pass != 1
+      || (TREE_CODE (length) == INTEGER_CST && TYPE_SIZE (elt_type)))
+    {
+      if (TREE_CODE (t) == SET_TYPE)
+	t = layout_powerset_type (t);
+      else
+	t = layout_chill_array_type (t);
+    }
+  return t;
+}
+
+tree
+make_powerset_type (domain)
+     tree domain;
+{
+  tree t = make_node (SET_TYPE);
+
+  TREE_TYPE (t) = boolean_type_node;
+  TYPE_DOMAIN (t) = domain;
+  
+  return t;
+}
+
+/* Used to layout both bitstring and powerset types. */
+
+tree
+layout_powerset_type (type)
+     tree type;
+{
+  tree domain = TYPE_DOMAIN (type);
+
+  if (! discrete_type_p (domain))
+    {
+      error ("Can only build a powerset from a discrete mode");
+      return error_mark_node;
+    }
+
+  if (TREE_CODE (TYPE_MAX_VALUE (domain)) == ERROR_MARK ||
+      TREE_CODE (TYPE_MIN_VALUE (domain)) == ERROR_MARK)
+    return error_mark_node;
+
+  if (TREE_CODE (TYPE_MAX_VALUE (domain)) != INTEGER_CST
+      || TREE_CODE (TYPE_MIN_VALUE (domain)) != INTEGER_CST)
+    {
+      if (CH_BOOLS_TYPE_P (type))
+	error ("non-constant bitstring size invalid");
+      else
+	error ("non-constant powerset size invalid");
+      return error_mark_node;
+    }
+
+  if (TYPE_SIZE (type) == 0)
+    layout_type (type);
+  return type;
+}
+
+/* Build a SET_TYPE node whose elements are from the set of values
+   in TYPE.  TYPE must be a discrete mode; we check for that here. */
+tree
+build_powerset_type (type)
+     tree type;
+{
+  tree t = make_powerset_type (type);
+  if (pass != 1)
+    t = layout_powerset_type (t);
+  return t;
+}
+
+tree
+build_bitstring_type (size_in_bits)
+     tree size_in_bits;
+{
+  return build_string_type (boolean_type_node, size_in_bits);
+}
+
+/* Return get_identifier (the concatenations of part1, part2, and part3). */
+
+tree
+get_identifier3 (part1, part2, part3)
+     char *part1, *part2, *part3;
+{
+  char *buf = (char*)
+    alloca (strlen(part1) + strlen(part2) + strlen(part3) + 1);
+  sprintf (buf, "%s%s%s", part1, part2, part3);
+  return get_identifier (buf);
+}
+
+/* Build an ALIAS_DECL for the prefix renamed clause:
+   (OLD_PREFIX -> NEW_PREFIX) ! POSTFIX. */
+
+tree
+build_alias_decl (old_prefix, new_prefix, postfix)
+     tree old_prefix, new_prefix, postfix;
+{
+  tree decl = make_node (ALIAS_DECL);
+
+  char *postfix_pointer = IDENTIFIER_POINTER (postfix);
+  int postfix_length = IDENTIFIER_LENGTH (postfix);
+  int old_length = old_prefix ? IDENTIFIER_LENGTH(old_prefix) : 0;
+  int new_length = new_prefix ? IDENTIFIER_LENGTH(new_prefix) : 0;
+
+  char *buf = (char*) alloca (old_length + new_length + postfix_length + 3);
+
+  /* Convert (OP->NP)!P!ALL to (OP!P->NP!P)!ALL */
+  if (postfix_length > 1 && postfix_pointer[postfix_length-1] == '*')
+    {
+      int chopped_length = postfix_length - 2; /* Without final "!*" */
+      if (old_prefix)
+	sprintf (buf, "%s!%.*s", IDENTIFIER_POINTER (old_prefix),
+		 chopped_length, postfix_pointer);
+      else
+	sprintf (buf, "%.*s", chopped_length, postfix_pointer);
+      old_prefix = get_identifier (buf);
+      if (new_prefix)
+	sprintf (buf, "%s!%.*s", IDENTIFIER_POINTER (new_prefix),
+		 chopped_length, postfix_pointer);
+      else
+	sprintf (buf, "%.*s", chopped_length, postfix_pointer);
+      new_prefix = get_identifier (buf);
+      postfix = ALL_POSTFIX;
+    }
+
+  DECL_OLD_PREFIX (decl) = old_prefix;
+  DECL_NEW_PREFIX (decl) = new_prefix;
+  DECL_POSTFIX (decl) = postfix;
+
+  if (DECL_POSTFIX_ALL (decl))
+    DECL_NAME (decl) = NULL_TREE;
+  else if (new_prefix == NULL_TREE)
+    DECL_NAME (decl) = postfix;
+  else
+    DECL_NAME (decl) = get_identifier3 (IDENTIFIER_POINTER (new_prefix),
+					"!", IDENTIFIER_POINTER (postfix));
+
+  return decl;
+}
+
+/* Return the "old name string" of an ALIAS_DECL. */
+
+tree
+decl_old_name (decl)
+     tree decl;
+{
+  
+  if (DECL_OLD_PREFIX (decl) == NULL_TREE)
+    return DECL_POSTFIX (decl);
+  return get_identifier3 (IDENTIFIER_POINTER (DECL_OLD_PREFIX (decl)),
+			  "!", IDENTIFIER_POINTER (DECL_POSTFIX (decl)));
+}
+
+/* See if OLD_NAME (an identifier) matches the OLD_PREFIX!POSTFIX
+   of ALIAS.  If so, return the corresponding NEW_NEW!POSTFIX. */
+
+tree
+decl_check_rename (alias, old_name)
+     tree alias, old_name;
+{
+  char *old_pointer = IDENTIFIER_POINTER (old_name);
+  int old_len = IDENTIFIER_LENGTH (old_name);
+  if (DECL_OLD_PREFIX (alias))
+    {
+      int old_prefix_len = IDENTIFIER_LENGTH (DECL_OLD_PREFIX (alias));
+      if (old_prefix_len >= old_len
+	  || old_pointer[old_prefix_len] != '!'
+	  || strncmp (old_pointer, IDENTIFIER_POINTER (DECL_OLD_PREFIX (alias)), old_prefix_len) != 0)
+	return NULL_TREE;
+
+      /* Skip the old prefix. */
+      old_pointer += old_prefix_len + 1; /* Also skip the '!', */
+    }
+  if (DECL_POSTFIX_ALL (alias)
+      || strcmp (IDENTIFIER_POINTER (DECL_POSTFIX (alias)), old_pointer) == 0)
+    {
+      if (DECL_NEW_PREFIX (alias))
+	return get_identifier3 (IDENTIFIER_POINTER (DECL_NEW_PREFIX (alias)),
+				"!", old_pointer);
+      else if (old_pointer == IDENTIFIER_POINTER (old_name))
+	return old_name;
+      else
+	return get_identifier (old_pointer);
+    }
+  else
+    return NULL_TREE;
+}
+
+/* 'EXIT foo' is treated like 'GOTO EXIT!foo'.
+    This function converts LABEL into a labal name for EXIT. */
+
+tree
+munge_exit_label (label)
+     tree label;
+{
+  return get_identifier3 ("EXIT", "!", IDENTIFIER_POINTER (label));
+}
+
+/* Make SAVE_EXPRs as needed, but don't turn a location into a non-location. */
+
+tree
+save_if_needed (exp)
+tree exp;
+{
+  return CH_REFERABLE (exp) ? stabilize_reference (exp) : save_expr (exp);
+}
+
+/* Return the number of elements in T, which must be a discrete type. */
+tree
+discrete_count (t)
+     tree t;
+{
+  tree hi = convert (sizetype, TYPE_MAX_VALUE (t));
+  if (TYPE_MIN_VALUE (t))
+    hi = size_binop (MINUS_EXPR, hi, convert (sizetype, TYPE_MIN_VALUE (t)));
+  return size_binop (PLUS_EXPR, hi, integer_one_node);
+}