�

Migrate from devo/gcc/ch.

From-SVN: r22034

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));

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);
+}

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
+};

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;
+}

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;

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;
+}

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;
+    }
+}

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;
+    }
+}

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;
+    }
+}

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

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;
+}

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;
+}

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;

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;
+}
+

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);
+    }
+}

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);
+	}
+    }
+} 

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;
+}
+

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;
+}

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;
+}

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

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);
+}