�

Migrate from devo/gcc/ch.

From-SVN: r22036

gcc/ch/Make-lang.in

+# Top level Makefile fragment for GNU CHILL.
+#   Copyright (C) 1994 Free Software Foundation, Inc.
+
+#This file is part of GNU CC.
+
+#GNU CC is free software; you can redistribute it and/or modify
+#it under the terms of the GNU General Public License as published by
+#the Free Software Foundation; either version 2, or (at your option)
+#any later version.
+
+#GNU CC is distributed in the hope that it will be useful,
+#but WITHOUT ANY WARRANTY; without even the implied warranty of
+#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#GNU General Public License for more details.
+
+#You should have received a copy of the GNU General Public License
+#along with GNU CC; see the file COPYING.  If not, write to
+#the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# This file provides the language dependent support in the main Makefile.
+# Each language makefile fragment must provide the following targets:
+#
+# foo.all.build, foo.all.cross, foo.start.encap, foo.rest.encap,
+# foo.info, foo.dvi,
+# foo.install-normal, foo.install-common, foo.install-info, foo.install-man,
+# foo.uninstall, foo.distdir,
+# foo.mostlyclean, foo.clean, foo.distclean, foo.extraclean,
+# foo.maintainer-clean, foo.stage1, foo.stage2, foo.stage3, foo.stage4
+#
+# where `foo' is the name of the language.
+#
+# It should also provide rules for:
+#
+# - making any compiler driver (eg: g++)
+# - the compiler proper (eg: cc1plus)
+# - define the names for selecting the language in LANGUAGES.
+
+# define version of GNUCHILL compiler. Note: maybe we have to change the
+# mechanism
+GNUCHILL_VERSION = 1.5.2
+
+# Actual names to use when installing a native compiler.
+# (Cygnus configure overrides these when using -program-transform-name).
+CHILL_INSTALL_NAME = chill
+
+# Actual names to use when installing a cross-compiler.
+# (Cygnus configure overrides these when using -program-transform-name).
+CHILL_CROSS_NAME = $(target_alias)-chill
+
+CHILL_SRCS = $(srcdir)/ch/actions.c $(srcdir)/ch/convert.c \
+ $(srcdir)/ch/decl.c $(srcdir)/ch/except.c $(srcdir)/ch/expr.c \
+ $(srcdir)/ch/grant.c $(srcdir)/ch/inout.c $(srcdir)/ch/lang.c \
+ $(srcdir)/ch/lex.c $(srcdir)/ch/loop.c \
+ $(srcdir)/ch/parse.c $(srcdir)/ch/satisfy.c \
+ $(srcdir)/ch/tasking.c $(srcdir)/ch/timing.c $(srcdir)/ch/tree.c \
+ $(srcdir)/ch/typeck.c
+
+# Extra flags to pass to recursive makes.
+CHILL_FLAGS_TO_PASS = \
+	"CHILLFLAGS=$(CHILLFLAGS)" \
+	"CHILL_FOR_TARGET=$(CHILL_FOR_TARGET)" \
+	"CHILL_LIB=$(CHILL_LIB)" \
+	"CC=$(CC)" \
+	"GNUCHILL_VERSION=$(GNUCHILL_VERSION)"
+
+# Define the names for selecting languages in LANGUAGES.
+CHILL: chill cc1chill chill-runtime
+
+# handle startfile in chill script and build script to install
+chill: $(srcdir)/ch/chill.in Makefile
+	thisdir=`pwd` ; \
+	sed -e "s:startfile=chillrt0:startfile=$${thisdir}/ch/runtime/chillrt0.o:" \
+	    -e "s:libpath=chillrt:libpath=-L$${thisdir}/ch/runtime/:" \
+	    -e "s:whatgcc=gcc:whatgcc=\"$${thisdir}/xgcc -B$${thisdir}/\":" \
+	    -e "s:gnuchill_version=unknown:gnuchill_version=$(GNUCHILL_VERSION):" \
+	    -e "s:gnuchill_script_flags=:gnuchill_script_flags=\"$(GNUCHILL_SCRIPT_FLAGS)\":" $(srcdir)/ch/chill.in > chill ; \
+	chmod a+x chill ; \
+	if [ -f ../gcc-cross$(exeext) ]; then \
+	  whatgcc=$(GCC_CROSS_NAME) ; \
+	else \
+	  whatgcc=$(GCC_INSTALL_NAME) ; \
+	fi; \
+	sed -e "s:startfile=chillrt0:startfile=$(libsubdir)/chillrt0.o:" \
+	    -e "s:whatgcc=gcc:whatgcc=$(bindir)/$${whatgcc}:" \
+	    -e "s:gnuchill_version=unknown:gnuchill_version=$(GNUCHILL_VERSION):" \
+	    -e "s:libpath=chillrt:libpath=:" \
+	    -e "s:gnuchill_script_flags=:gnuchill_script_flags=\"$(GNUCHILL_SCRIPT_FLAGS)\":" $(srcdir)/ch/chill.in > chill.install ; \
+	chmod a+x chill.install
+
+# Don't depend on cc1chill, because chill-cross is always built for cross,
+# and thus a cc1chill dependence would force cc1chill to always be built.
+# Note that gcc-cross and g++-cross do not have cc1 or cc1plus dependencies.
+chill-cross: $(srcdir)/ch/chill.in
+	touch $@
+
+cc1chill: $(P) $(CHILL_SRCS) $(LIBDEPS) stamp-objlist \
+	insn-config.h insn-flags.h insn-attr.h insn-codes.h \
+	c-typeck.o c-aux-info.o c-common.o c-iterate.o
+	cd ch; $(MAKE) $(FLAGS_TO_PASS) $(CHILL_FLAGS_TO_PASS) ../cc1chill
+
+chill-runtime: stmp-headers $(GCC_PASSES)
+	case "$(LANGUAGES)" in \
+	*CHILL*) if [ -f ch/runtime/Makefile -a -z "$(CROSS)" ] ; then \
+		   thisdir1=`pwd`; \
+		   cd ch/runtime; $(MAKE) $(FLAGS_TO_PASS) $(CHILL_FLAGS_TO_PASS) GCC_FOR_TARGET="$${thisdir1}/xgcc -B$${thisdir1}/" all ; \
+		 else true; fi ;; \
+	esac
+
+# Build hooks:
+
+CHILL.all.build: chill
+CHILL.all.cross: chill-cross
+CHILL.start.encap: chill
+CHILL.rest.encap:
+
+CHILL.info: $(srcdir)/ch/chill.texi
+	$(MAKEINFO) -I$(srcdir)/ch $(srcdir)/ch/chill.texi -o chill.info
+
+chill.dvi: $(srcdir)/ch/chill.texi $(srcdir)/extend.texi $(srcdir)/invoke.texi $(srcdir)/md.texi $(srcdir)/rtl.texi $(srcdir)/tm.texi
+	cd ch ; \
+	TEXINPUTS=${texidir}:$(srcdir):$$TEXINPUTS tex chill.texi ; \
+	texindex chill.?? ; \
+	TEXINPUTS=${texidir}:$(srcdir):$$TEXINPUTS tex chill.texi
+# FIXME: Not sure languages should do this.
+	cp ch/chill.dvi chill.dvi
+
+# Install hooks:
+# cc1chill is installed elsewhere as part of $(COMPILERS).
+
+CHILL.install-normal: install-libchill
+
+# Install the CHILL run time library.
+install-libchill: chill-runtime
+	if [ -f ch/runtime/libchill.a ] ; then \
+	  $(INSTALL_DATA) ch/runtime/libchill.a $(libsubdir)/libchill.a; \
+	  if $(RANLIB_TEST) ; then \
+	    (cd $(libsubdir); $(RANLIB) libchill.a); else true; fi; \
+	  chmod a-x $(libsubdir)/libchill.a; \
+	  $(INSTALL_DATA) ch/runtime/chillrt0.o $(libsubdir)/chillrt0.o; \
+	else true; fi
+
+# Install the driver program
+CHILL.install-common:
+	-if [ -f cc1chill ] ; then \
+	  if [ -f chill.install ] ; then \
+	    if [ -f gcc-cross$(exeext) ]; then \
+	      rm -f $(bindir)/$(CHILL_CROSS_NAME); \
+	      $(INSTALL_PROGRAM) chill.install $(bindir)/$(CHILL_CROSS_NAME); \
+	      chmod a+x $(bindir)/$(CHILL_CROSS_NAME); \
+	    else \
+	      rm -f $(bindir)/$(CHILL_INSTALL_NAME); \
+	      $(INSTALL_PROGRAM) chill.install $(bindir)/$(CHILL_INSTALL_NAME); \
+	      chmod a+x $(bindir)/$(CHILL_INSTALL_NAME); \
+	    fi ; \
+	  fi ; \
+	fi
+
+CHILL.install-info:
+	-for i in chill.info*; do \
+	  rm -f $(infodir)/$$i; \
+	  $(INSTALL_DATA) $$i $(infodir)/$$i; \
+	done
+
+CHILL.install-man:
+
+CHILL.uninstall:
+	-rm -rf $(bindir)/$(CHILL_INSTALL_NAME)
+	-rm -rf $(bindir)/$(CHILL_CROSS_NAME)
+
+# Clean hooks:
+# A lot of the ancillary files are deleted by the main makefile.
+# We just have to delete files specific to us.
+
+CHILL.mostlyclean:
+	-rm -f chill.install ch/*.o ch/ch-version.c
+	-cd ch/runtime && $(MAKE) mostlyclean
+CHILL.clean:
+CHILL.distclean:
+	-rm -f ch/config.status ch/Makefile
+CHILL.extraclean:
+CHILL.maintainer-clean:
+	-rm -f ch/TAGS
+	-rm -f ch/chill.info* ch/chill.dvi ch/chill.??s ch/chill.*aux
+# CYGNUS LOCAL: Delete locally created file.
+	-rm -f ch/hash.h
+
+# Stage hooks:
+# The main makefile has already created stage?/ch.
+
+CHILL.stage1:
+	-mv ch/*.o stage1/ch
+CHILL.stage2:
+	-mv ch/*.o stage2/ch
+CHILL.stage3:
+	-mv ch/*.o stage3/ch
+CHILL.stage4:
+	-mv ch/*.o stage4/ch
+
+# Maintenance hooks:
+
+# This target creates the files that can be rebuilt, but go in the
+# distribution anyway.  It then copies the files to the distdir directory.
+CHILL.distdir:
+	mkdir tmp/ch
+	cd ch ; $(MAKE) $(FLAGS_TO_PASS) $(CXX_FLAGS_TO_PASS) hash.h
+	cd ch; \
+	for file in *[0-9a-zA-Z+]; do \
+	  ln $$file ../tmp/ch >/dev/null 2>&1 || cp $$file ../tmp/ch; \
+	done

gcc/ch/ch-tree.def

+/* This file contains the definitions and documentation for the
+   additional tree codes used in the CHILL front end (see tree.def
+   for the standard codes).
+   Copyright (C) 1992, 1993 Free Software Foundation, Inc.
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+
+/* 
+ * CHILL types.
+ */
+DEFTREECODE (GRANT_TYPE, "grant_type", 't', 0)
+DEFTREECODE (SEIZE_TYPE, "seize_type", 't', 0)
+/* 
+ * CHILL decls.
+ */
+DEFTREECODE (KEYWORD_DECL, "keyword_decl", 'd', 0)
+DEFTREECODE (INSTANCE_METHOD_DECL, "instance_method_decl", 'd', 0)
+DEFTREECODE (CLASS_METHOD_DECL, "class_method_decl", 'd', 0)
+
+/* A 'SEIZE (OLD->NEW)!POSTFIX' or 'GRANT (OLD->NEW)!POSTFIX' is
+   represented as an ALIAS_DECL where DECL_OLD_PREFIX, DECL_NEW_PREFIX,
+   and DECL_POSTFIX points to OLD, NEW, and POSTFIX, repectively.
+   These are IDENTIFIER_NODEs, or NULL if empty.
+   DECL_NAME is NEW!POSTFIX.  After binding, DECL_ABSTRACT_ORIGIN
+   (if not an error_mark) points to a decl whose DECL_NAME is OLD!POSTFIX.
+   and which this name is linked to.
+   For SEIZE, DECL_SEIZEFILE names the most recent use_seize_file directive.
+   For GRANT, DECL_SEIZEFILE names the seizefile doing the granting. */
+DEFTREECODE (ALIAS_DECL, "alias_decl", 'd', 0)
+
+/* A variable, which is BASED on a pointer variable in DECL_ABSTRACT_ORIGIN. */
+DEFTREECODE (BASED_DECL, "based_decl", 'd', 0)
+
+/* A pseudo-variable declared by a DO WITH. */
+DEFTREECODE (WITH_DECL, "with_decl", 'd', 0)
+
+/*
+ * CHILL exprs.
+ */
+DEFTREECODE (CONCAT_EXPR, "concat_expr", '2', 2)
+
+/* A slice (sub-array or sub-string) of operand 0, where
+   operand 1 is the start of the slice, and operand 2 is its length.
+   Currently, only used for bitstring sclices. */
+DEFTREECODE (SLICE_EXPR, "slice_expr", 'e', 3)
+
+/* Later, SET_IN_EXPR might be replaced by BIT_FIELD_REF or IN_EXPR. */
+DEFTREECODE (SET_IN_EXPR, "set_in_expr", '2', 2)
+
+/* A CASE_EXPR EX implements Chill CASE expression.
+   TREE_OPERAND (EX, 0) is a TREE_LIST representing the <case selector list>,
+   with one node for each expression.  (Only one is supported by the
+   current implementation.)
+   TREE_OPERAND (EX, 1) is also a TREE_LIST, with one node for each
+   <value case alternative>.   The TREE_VALUE of these node is the
+   <sub expression> (case element body); the TREE_PURPOSE contains
+   the <case label specification>.  (The TREE_PURPOSE for the
+   optional ELSE (default) branch is NULL_TREE.)  Each <case label
+   specification> is also represented as a list with one TREE_LIST
+   node for each <case label list> (though only length==1 is currently
+   supported).  And finally: each <case label list> is again a list
+   with one TREE_LIST node for each <case label>. */
+DEFTREECODE (CASE_EXPR, "case_expr", 'e', 2)
+
+/* Powerset and static bit array operations.
+   Operands have same mode as result.  */
+DEFTREECODE (SET_NOT_EXPR,  "set_not_expr",  '1', 1)
+DEFTREECODE (SET_IOR_EXPR,  "set_ior_expr",  '2', 2)
+DEFTREECODE (SET_XOR_EXPR,  "set_xor_expr",  '2', 2)
+DEFTREECODE (SET_AND_EXPR,  "set_and_expr",  '2', 2)
+DEFTREECODE (SET_DIFF_EXPR, "set_diff_expr", '2', 2)
+DEFTREECODE (PAREN_EXPR,  "paren_expr",  '1', 1)
+
+DEFTREECODE (STRING_EQ_EXPR, "string_eq_expr", '2', 2)
+DEFTREECODE (STRING_LT_EXPR, "string_lt_expr", '2', 2)
+
+/* Used to represent a string repetition expression, until
+   we have a type for it;  a SET_TYPE replicator needs a
+   TYPE_DOMAIN even if it represents the empty set */
+DEFTREECODE (REPLICATE_EXPR, "replicate_expr", 'e', 2)
+
+/* An undefined value.  Used for the Chill operator '*',
+   and sometimes for padding. */
+DEFTREECODE (UNDEFINED_EXPR, "undefined_expr", 'e', 0)
+
+/* Used to represent a process instance */
+DEFTREECODE (INSTANCE_TYPE, "instance_type", 't', 0)
+
+/* Used to represent a reference to an array of bitfields. Currently restricted
+   to fields which are 1 bit wide.  */
+DEFTREECODE (PACKED_ARRAY_REF, "packed_array_ref", 'r', 2)
+
+/* ALSO NOTE:  LANG_TYPE is used for two things during pass 1;
+   such a node is converted to some other type node during satisfy.
+   If CH_NOVELTY_FLAG is set, then this node is a logical copy of
+   its TREE_TYPE, but with a different novelty.
+   If TYPE_READONLY is set, then the node stands for 'READ M'
+   where M is the TREE_TYPE.  */

gcc/ch/runtime/abstime.c

+/* 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 <time.h>
+#include "rtltypes.h"
+
+EXCEPTION (rangefail);
+
+#define SECOND_VALID         1
+#define MINUTE_VALID         2
+#define HOUR_VALID           4
+#define DAY_VALID            8
+#define MONTH_VALID         16
+#define YEAR_VALID          32
+
+extern void __cause_ex1 (char *ex, char *file, int lineno);
+
+#define CAUSE_RANGEFAIL     __cause_ex1 ("rangefail", filename, lineno)
+
+/*
+ * function _abstime
+ *
+ * parameters:
+ *     mask - mask of valid values
+ *     year
+ *     month
+ *     day
+ *     hour
+ *     minute
+ *     second
+ *
+ * returns:
+ *     unsigned long
+ *
+ * exceptions:
+ *     rangefail
+ *
+ * abstract:
+ *     perform the ABSTIME builtin call
+ *
+ */
+
+unsigned long
+_abstime (mask, year, month, day, hour, minute, second,
+	  filename, lineno)
+     int  mask, year, month, day, hour, minute, second;
+     char *filename;
+     int  lineno;
+{
+  struct tm   *time_str;
+  time_t      result, current_time;
+
+  /* first of all get current time */
+  if ((current_time = time (0)) == (time_t)-1)
+    /* FIXME: what excpetion ?? */
+    CAUSE_RANGEFAIL;
+
+  /* if we just have to determine the current time, we are ready.
+     This is shown by mask == 0. */
+  if (mask == 0)
+    return (unsigned long)current_time;
+
+  /* convert current time to struct tm */
+  time_str = localtime (&current_time);
+
+  if (mask & YEAR_VALID)
+    {
+      if (year < 1900)
+	CAUSE_RANGEFAIL;
+      time_str->tm_year = year - 1900;
+    }
+
+  if (mask & MONTH_VALID)
+    {
+      if (month < 1 || month > 12)
+	CAUSE_RANGEFAIL;
+      time_str->tm_mon = month - 1;
+    }
+
+  if (mask & DAY_VALID)
+    {
+      if (day < 1 || day > 31)
+	CAUSE_RANGEFAIL;
+      time_str->tm_mday = day;
+    }
+
+  if (mask & HOUR_VALID)
+    {
+      if (hour < 0 || hour > 23)
+	CAUSE_RANGEFAIL;
+      time_str->tm_hour = hour;
+    }
+
+  if (mask & MINUTE_VALID)
+    {
+      if (minute < 0 || minute > 59)
+	CAUSE_RANGEFAIL;
+      time_str->tm_min = minute;
+    }
+
+  if (mask & SECOND_VALID)
+    {
+      if (second < 0 || second > 59)
+	CAUSE_RANGEFAIL;
+      time_str->tm_sec = second;
+    }
+
+  /* do it */
+  time_str->tm_isdst = -1;
+  if ((result = mktime (time_str)) == (time_t)-1)
+    CAUSE_RANGEFAIL;
+
+  return (unsigned long)result;
+}

gcc/ch/runtime/allocate.c

+/* Implement runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include <stdlib.h>
+#include "config.h"
+#include "rtltypes.h"
+
+extern void __cause_ex1 (char *exname, char *file, int lineno);
+
+/* define needed exceptions */
+EXCEPTION (allocatefail)
+EXCEPTION (rangefail)
+
+/*
+ * function __allocate
+ *
+ * parameters:
+ *  size		number of bytes to allocate
+ *  filename            source file which issued the call
+ *  linenumber          line number within that source file
+ *
+ * returns:
+ *  void *
+ *
+ * exceptions:
+ *  allocatefail
+ *  rangefail
+ *
+ * abstract:
+ *  allocate memory from heap
+ *
+*/
+
+void *
+__allocate (size, filename, linenumber)
+     int size;
+     char *filename;
+     int   linenumber;
+{
+  void	*tmp;
+    
+  if (size < 0)
+    __cause_ex1 ("rangefail", filename, linenumber);
+  tmp = malloc (size);
+  if (!tmp)
+    __cause_ex1 ("allocatefail", filename, linenumber);
+  return tmp;
+}

gcc/ch/runtime/chillrt0.c

+/* 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.  */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <string.h>
+
+#include "rtltypes.h"
+#include "iomodes.h"
+
+/* type definitions */
+typedef void (*init_ptr) ();
+typedef void (*rts_init_ptr) (int *argc, char *argv []);
+
+typedef struct INIT_LIST
+{
+  init_ptr             code;
+  struct INIT_LIST     *forward;
+} InitList;
+
+InitList    *_ch_init_list = 0;
+
+/* force linker to get correct RTS functions */
+extern rts_init_ptr	__RTS_INIT__;
+extern init_ptr		__RTS_MAIN_LOOP__;
+extern init_ptr		__RTS_FETCH_NUMBERS__;
+extern init_ptr		__RTS_FETCH_NAMES__;
+static init_ptr		*rts_dummies[4] = 
+{
+  &__RTS_INIT__,
+  &__RTS_MAIN_LOOP__,
+  &__RTS_FETCH_NUMBERS__,
+  &__RTS_FETCH_NAMES__,
+};
+
+/* chill argc and argv */
+int			chill_argc = 0;
+TVaryingCharType	**chill_argv = NULL;
+
+/* the program name for debugging purpose */
+char 			*progname = 0;
+
+extern void *__xmalloc_ ();
+
+/*
+ * function __xrealloc_
+ *
+ * parameter:
+ *   ptr		pointer to reallocate
+ *   size		new number of bytes
+ *
+ * returns:
+ *  void*
+ *
+ * abstract:
+ *  This is the general reallocation routine for libchill
+ *
+ */
+
+void *
+__xrealloc_ (ptr, size)
+void *ptr;
+int size;
+{
+  void	*tmp = realloc (ptr, size);
+  
+  if (!tmp)
+    {
+      fprintf (stderr, "ChillLib: Out of heap space.\n");
+      fflush (stderr);
+      exit (ENOMEM);
+    }
+  return (tmp);
+} /* __xrealloc_ */
+
+static void
+setup_argc_argv (argc, argv)
+int argc;
+char *argv[];
+{
+  int		i;
+  
+  chill_argv = __xmalloc_ ((argc + 1) * sizeof (TVaryingCharType *));
+  for (i = 0; i < argc; i++)
+    {
+      chill_argv[i] = __xmalloc_ (sizeof (TVaryingCharType) + strlen (argv[i]) + 1);
+      chill_argv[i]->len = strlen (argv[i]);
+      strcpy (chill_argv[i]->body, argv[i]);
+    }
+  chill_argv[chill_argc = argc] = NULL;
+  
+  if ((progname = strrchr (argv[0], '/')) == 0)
+    progname = argv[0];
+  else
+    progname++;
+  
+} /* setup_argc_argv */
+
+extern void __setexceptionStack ();
+
+/*--------- main entry for each CHILL - program ----------*/
+int
+main (argc, argv)
+     int argc;
+     char *argv [];
+{
+  /* call look up for tasking */
+  (*__RTS_INIT__) (&argc, argv);
+
+  /* setup argc and argv */
+  setup_argc_argv (argc, argv);
+
+  /* clear exception stack */
+  __setexceptionStack (0);
+
+  /* now call code at module level */
+  while (_ch_init_list)
+    {
+      if (_ch_init_list->code)
+	(*(_ch_init_list->code)) ();
+      _ch_init_list = _ch_init_list->forward;
+    }
+
+  /* if we have rts linked, something will be done, else just return */
+  (*__RTS_MAIN_LOOP__) ();
+  
+  return (0);
+  
+} /* main */

gcc/ch/runtime/chillstdio.c

+/* 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.  */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <string.h>
+
+#include "iomodes.h"
+
+/* predefined associations, accesses, and text for stdin, stdout, stderr */
+/* stdin */
+#define STDIO_TEXT_LENGTH 1024
+#define STDIN_TEXT_LENGTH STDIO_TEXT_LENGTH
+
+static Access_Mode stdin_access;
+
+#ifndef STDIN_FILENO
+#define STDIN_FILENO 0
+#endif
+
+static
+Association_Mode stdin_association =
+{
+  IO_EXISTING | IO_READABLE | IO_SEQUENCIBLE | IO_ISASSOCIATED,
+  NULL,
+  &stdin_access,
+  STDIN_FILENO,
+  NULL,
+  0,
+  ReadOnly
+};
+
+static Access_Mode stdin_access = 
+{
+  IO_TEXTIO,
+  STDIN_TEXT_LENGTH + 2,
+  0,
+  0,
+  &stdin_association,
+  0,
+  NULL,
+  VaryingChars
+};
+
+static
+VARYING_STRING(STDIN_TEXT_LENGTH) stdin_text_record;
+
+Text_Mode chill_stdin =
+{
+  IO_TEXTLOCATION,
+  (VarString *)&stdin_text_record,
+  &stdin_access,
+  0
+};
+
+/* stdout */
+#define STDOUT_TEXT_LENGTH STDIO_TEXT_LENGTH
+#ifndef STDOUT_FILENO
+#define STDOUT_FILENO 1
+#endif
+
+static Access_Mode stdout_access;
+
+static
+Association_Mode stdout_association =
+{
+  IO_EXISTING | IO_WRITEABLE | IO_SEQUENCIBLE | IO_ISASSOCIATED,
+  NULL,
+  &stdout_access,
+  STDOUT_FILENO,
+  NULL,
+  0,
+  WriteOnly
+};
+
+static Access_Mode stdout_access = 
+{
+  IO_TEXTIO,
+  STDOUT_TEXT_LENGTH + 2,
+  0,
+  0,
+  &stdout_association,
+  0,
+  NULL,
+  VaryingChars
+};
+
+static
+VARYING_STRING(STDOUT_TEXT_LENGTH) stdout_text_record;
+
+Text_Mode chill_stdout =
+{
+  IO_TEXTLOCATION,
+  (VarString *)&stdout_text_record,
+  &stdout_access,
+  0
+};
+
+/* stderr */
+#define STDERR_TEXT_LENGTH STDIO_TEXT_LENGTH
+#ifndef STDERR_FILENO
+#define STDERR_FILENO 2
+#endif
+
+static Access_Mode stderr_access;
+
+static
+Association_Mode stderr_association =
+{
+  IO_EXISTING | IO_WRITEABLE | IO_SEQUENCIBLE | IO_ISASSOCIATED,
+  NULL,
+  &stderr_access,
+  STDERR_FILENO,
+  NULL,
+  0,
+  WriteOnly
+};
+
+static Access_Mode stderr_access = 
+{
+  IO_TEXTIO,
+  STDERR_TEXT_LENGTH + 2,
+  0,
+  0,
+  &stderr_association,
+  0,
+  NULL,
+  VaryingChars
+};
+
+static
+VARYING_STRING(STDIN_TEXT_LENGTH) stderr_text_record;
+
+Text_Mode chill_stderr =
+{
+  IO_TEXTLOCATION,
+  (VarString *)&stderr_text_record,
+  &stderr_access,
+  0
+};
+
+/*
+ * function __xmalloc_
+ *
+ * parameter:
+ *   size		number of bytes to allocate
+ *
+ * returns:
+ *  void*
+ *
+ * abstract:
+ *  This is the general allocation routine for libchill
+ *
+ */
+
+void *
+__xmalloc_ (size)
+int size;
+{
+  void	*tmp = malloc (size);
+  
+  if (!tmp)
+    {
+      fprintf (stderr, "ChillLib: Out of heap space.\n");
+      fflush (stderr);
+      exit (ENOMEM);
+    }
+  return (tmp);
+} /* __xmalloc_ */
+
+static char *
+newstring (char *str)
+{
+  char *tmp = __xmalloc_ (strlen (str) + 1);
+  strcpy (tmp, str);
+  return tmp;
+}
+
+static void setup_stdinout (void) __attribute__((constructor));
+
+static void
+setup_stdinout ()
+{
+  /* allocate the names */
+  stdin_association.pathname = newstring ("stdin");
+  stdout_association.pathname = newstring ("stdout");
+  stderr_association.pathname = newstring ("stderr");
+
+  /* stdin needs a readbuffer */
+  stdin_association.bufptr = __xmalloc_ (sizeof (readbuf_t));
+  memset (stdin_association.bufptr, 0, sizeof (readbuf_t));
+}

gcc/ch/runtime/delete.c

+/* 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 <unistd.h>
+
+#include "fileio.h"
+
+void __delete( 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 );
+
+  /* forced dissociate */
+  if( the_assoc->access )
+    __disconnect( the_assoc->access, file, line );
+
+  /* delete */
+  if( unlink( the_assoc->pathname ) )
+    CHILLEXCEPTION( file, line, DELETEFAIL, DELETE_FAILS );
+
+  CLR_FLAG( the_assoc, IO_EXISTING );
+}

gcc/ch/runtime/diffps.c

+/* 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 __diffpowerset
+ *
+ * parameters:
+ *     out		result of __diffpowerset
+ *	left		powerset
+ *	right		powerset
+ *	bitlength	length of powerset
+ *
+ * returns:
+ *	void
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  makes a difference of 2 powersets (out = left - right)
+ *
+ */
+void
+__diffpowerset (out, left, right, bitlength)
+     SET_WORD      *out;
+     SET_WORD      *left;
+     SET_WORD      *right;
+     unsigned long  bitlength;
+{
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      *((SET_CHAR *)out) = *((SET_CHAR *)left) & ~
+                           *((SET_CHAR *)right);
+      MASK_UNUSED_CHAR_BITS ((SET_CHAR *)out, bitlength);
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      *((SET_SHORT *)out) = *((SET_SHORT *)left) & ~
+                            *((SET_SHORT *)right);
+      MASK_UNUSED_SHORT_BITS ((SET_SHORT *)out, bitlength);
+    }
+  else
+    {
+      unsigned long len = BITS_TO_WORDS(bitlength);
+      register unsigned long i;
+    
+      for (i = 0; i < len; i++)
+	out[i] = left[i] & ~right[i];
+      MASK_UNUSED_WORD_BITS ((out + len - 1), bitlength % SET_WORD_SIZE);
+    }
+}

gcc/ch/runtime/inbitstr.c

+/* 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 __inbitstring
+ *
+ * parameters:
+ *	bitno		bit number within set
+ *	powerset	the powerset
+ *	bitlength	length of powerset in bits
+ *      minval          number of lowest bit stored
+ *	fname		filename of caller
+ *	lineno		linenumber of caller
+ *
+ * returns:
+ *	int		1 .. found
+ *			0 .. not found
+ *
+ * exceptions:
+ *  rangefail
+ *
+ * abstract:
+ *  checks if a given value is included in a bitstring
+ *
+ */
+int
+__inbitstring (bitno, powerset, bitlength, minval, fname, lineno)
+     unsigned long  bitno;
+     SET_WORD      *powerset;
+     unsigned long  bitlength;
+     long           minval;
+     char          *fname;
+     int            lineno;
+    
+{
+  if (powerset == NULL
+      || bitno < minval 
+      || (bitno - minval) >= bitlength)
+    __cause_ex1 ("rangefail", fname, lineno);
+
+  bitno -= minval;
+  if (bitlength <= SET_CHAR_SIZE)
+    return GET_BIT_IN_CHAR (*((SET_CHAR *)powerset), bitno);
+  else if (bitlength <= SET_SHORT_SIZE)
+    return GET_BIT_IN_SHORT (*((SET_SHORT *)powerset), bitno);
+  else
+    return GET_BIT_IN_WORD (powerset[bitno / SET_WORD_SIZE],
+			    bitno % SET_WORD_SIZE);
+}

gcc/ch/runtime/indexable.c

+/* 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
+__indexable( 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_INDEXABLE) ? True : False;
+}

gcc/ch/runtime/memmove.c

+/* Implement string-related runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Bill Cox
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define MIN(a, b)  ((a) < (b) ? (a) : (b))
+
+
+/*
+ * function memmove
+ *
+ * parameters:
+ *     S1 - pointer to destination string
+ *     S2 - pointer to source string
+ *     LEN - length of string
+ *
+ * returns:
+ *     pointer to destination string
+ *
+ * exceptions:
+ *     none
+ *
+ * abstract:
+ *     copies a string safely, where the source and dest areas may overlap.
+ *
+ */
+
+void *
+memmove (s1, s2, n)
+     void *s1;
+     const void *s2;
+     int n;
+{
+  char *sc1 = s1;
+  const char *sc2 = s2;
+
+  if (sc2 < sc1 && (sc1 < sc2 + n))
+    for (sc1 += n, sc2 += n; 0 < n; --n)
+      *--sc1 = *--sc2;
+  else
+#if 0
+    for (; 0 < n; --n)
+      *sc1++ = *sc2++;
+#else
+    memcpy (sc1, sc2, n);
+#endif
+  return s1;
+}

gcc/ch/runtime/orps.c

+/* 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 __orpowerset
+ *
+ * parameters:
+ *	out		return from __orpowerset
+ *	left		left powerset
+ *	right		right powerset
+ *	bitlength	length of powerset in bits
+ *
+ * returns:
+ *	void
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  or's two powersets.
+ *
+ */
+
+void
+__orpowerset (out, left, right, bitlength)
+     SET_WORD      *out;
+     SET_WORD      *left;
+     SET_WORD      *right;
+     unsigned long  bitlength;
+{
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      *((SET_CHAR *)out) = *((SET_CHAR *)left) |
+                           *((SET_CHAR *)right);
+      MASK_UNUSED_CHAR_BITS((SET_CHAR *)out, bitlength);
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      *((SET_SHORT *)out) = *((SET_SHORT *)left) |
+                            *((SET_SHORT *)right);
+      MASK_UNUSED_SHORT_BITS((SET_SHORT *)out, bitlength);
+    }
+  else
+    {
+      register unsigned long i;
+      unsigned long len = BITS_TO_WORDS(bitlength);
+    
+      for (i = 0; i < len; i++)
+	out[i] = left[i] | right[i];
+      MASK_UNUSED_WORD_BITS ((out + len - 1), bitlength % SET_WORD_SIZE);
+    }
+}

gcc/ch/runtime/outoffile.c

+/* 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
+__outoffile( void* the_transfer, char* file, int line )
+{
+  Access_Mode* the_access;
+
+  if( !the_transfer )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ACCESS );
+
+  if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ))
+    the_access = ((Text_Mode*)the_transfer)->access_sub;
+  else
+    the_access = (Access_Mode*)the_transfer;
+
+  if( !the_access->association )
+    CHILLEXCEPTION( file, line, NOTCONNECTED, IS_NOT_CONNECTED );
+
+  return TEST_FLAG( the_access, IO_OUTOFFILE ) ? True : False;
+}

gcc/ch/runtime/readable.c

+/* 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
+__readable( 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_READABLE) ? True : False;
+}
+

gcc/ch/runtime/remaintime.c

+/* 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 __remaintime
+ *
+ * parameters:
+ *      since   pointer to the  initial RtsTime
+ *      dur     the duration value
+ *      t       pointer to the remaining RtsTime
+ *
+ * returns:
+ *      int     0 .. there is a remaining time
+ *              1 .. there is no remaining time
+ *
+ * exceptions:
+ *      none
+ *
+ * abstract:
+ *      This function writes to t the remaining duration value in RtsTime format
+ *      from a given start (since) and the current RtsTime.
+ *
+ */
+
+extern void __convert_duration_rtstime (unsigned long dur, RtsTime *t);
+
+int
+  __remaintime (since, dur, t)
+RtsTime       *since;
+unsigned long  dur;
+RtsTime       *t;
+{
+  RtsTime now, dur_in_rtstime, tmp, diff;
+  
+  __rtstime (&now);
+  __convert_duration_rtstime (dur, &dur_in_rtstime);
+  
+  tmp.secs = since->secs;
+  tmp.nanosecs = since->nanosecs;
+  
+  /* calculate the difference of absolute times */
+  if (tmp.nanosecs > now.nanosecs)
+    {
+      tmp.secs--;
+      tmp.nanosecs += 1000000000;
+    }
+  diff.secs = now.secs - tmp.secs;
+  diff.nanosecs = now.nanosecs - tmp.nanosecs;
+  
+  /* substract diff from duration */
+  if (diff.nanosecs > dur_in_rtstime.nanosecs)
+    {
+      dur_in_rtstime.secs--;
+      dur_in_rtstime.nanosecs += 1000000000;
+    }
+  
+  t->secs = dur_in_rtstime.secs - diff.secs;
+  t->nanosecs = dur_in_rtstime.nanosecs - diff.nanosecs;
+  
+  if (t->secs > dur_in_rtstime.secs)
+    return 1;
+  else
+    return 0;
+}

gcc/ch/runtime/settextrecord.c

+/* 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
+__settextrecord( Text_Mode* the_text,
+                 VarString* the_text_rec,
+                 char*      file,
+                 int        line )
+{
+  if( !the_text )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_TEXT );
+
+  if( !the_text_rec )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_TEXTREC );  
+
+  the_text->text_record = the_text_rec;
+}
+

gcc/ch/runtime/waitbuffer.c

+/* 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"
+
+extern void __cause_ex1 (char *ex, char *file, int lineno);
+
+EXCEPTION (bufferinconsistency)
+#define CAUSE_BUFFINCONS  __cause_ex1 ("bufferinconsistency", filename, lineno)
+EXCEPTION (spacefail);
+#define CAUSE_SPACEFAIL   __cause_ex1 ("spacefail", filename, lineno)
+    
+/*
+ * function __wait_buffer
+ *
+ * parameters:
+ *     buf_got	   pointer to location for writing the received buffer address
+ *     nbuf        number of buffers in RECEIVE CASE
+ *     bufptr      array of pointers to buffer descriptor
+ *     datap       pointer where to store data
+ *     datalen     length of data
+ *     ins         pointer to instance location or 0
+ *     else_clause else specified or not
+ *     to_loc      pointer to timesupervision value
+ *     filename    source file name where function gets called
+ *     lineno      linenumber in source file
+ *
+ * returns:
+ *     int	   0 .. success
+ *                 1 .. timed out
+ *
+ * exceptions:
+ *     bufferinconsistency  if something's wrong in the buffer queue's
+ *     spacefail            out of heap space of datalength of receiver
+ *                          less then data avilable.
+ *
+ * abstract:
+ *     implement the CHILL RECEIVE buffer CASE action.
+ */
+
+int
+__wait_buffer (buf_got, nbuf, bufptr, datap, datalen, ins,
+               else_clause, to, filename, lineno)
+     void           **buf_got;
+     int              nbuf;
+     Buffer_Descr    *bufptr[];
+     void            *datap;
+     int              datalen;
+     INSTANCE        *ins;
+     int              else_clause;
+     void            *to;
+     char            *filename;
+     int              lineno;
+{
+  int i;
+  Buffer_Wait_Queue     *start_list;
+  Buffer_Queue         **retval;
+  Buffer_Queue         **highprio;
+  int                    timed_out;
+  
+  /* look if there is a buffer already sent */
+  highprio = 0;
+  for (i = 0; i < nbuf; i++)
+    {
+      Buffer_Queue      *bq;
+
+      memcpy (&bq, bufptr[i]->buf, sizeof (Buffer_Queue *));
+      if (bq != 0 && bq->sendqueue != 0)
+        {
+          if (highprio != 0)
+            {
+              Buffer_Queue      *bsq = *highprio;
+              
+              if (bq->sendqueue->priority > bsq->sendqueue->priority)
+                highprio = bufptr[i]->buf;
+            }
+          else
+            highprio = bufptr[i]->buf;
+        }
+    }
+  
+  if (highprio != 0)
+    {
+      Buffer_Queue      *bq;
+
+      memcpy (&bq, highprio, sizeof (Buffer_Queue *));
+      if (bq != 0 && bq->sendqueue != 0)
+        {
+          Buffer_Send_Queue *bsq = bq->sendqueue;
+          Buffer_Send_Queue *tmp;
+
+          /* check data length */
+          if (datalen < bsq->datalen)
+            /* something's totaly wrong. Raise exception */
+            CAUSE_SPACEFAIL;
+
+          /* copy data out */
+          memcpy (datap, bsq->dataptr, bsq->datalen);
+
+          /* update instance, if present */
+          if (ins != 0)
+            memcpy (ins, &bsq->this, sizeof (INSTANCE));
+
+          /* dequeue entry */
+          tmp = bsq;
+          bq->sendqueue = tmp->forward;
+
+          if (tmp->is_delayed)
+            {
+              /* there is an instance delayed on a send,
+                 continue it. */
+              __continue_that (tmp->this, tmp->priority, filename, lineno);
+              FREE (tmp);
+
+              /* return the buffer we have received from */
+	      *buf_got = (void *)highprio;
+              return 0;
+            }
+
+          /* just decrease sendqueue length */
+          bq->sendqueuelength--;
+
+          FREE (tmp);
+
+          /* as we got an entry free, we should continue
+             an INSTANCE which is delayed on a send at this
+             buffer */
+          bsq = bq->sendqueue;
+          while (bsq != 0)
+            {
+              if (bsq->is_delayed)
+                {
+                  bq->sendqueuelength++;
+                  bsq->is_delayed = 0;
+                  __continue_that (bsq->this, bsq->priority, filename, lineno);
+                  break;
+                }
+              bsq = bsq->forward;
+            }
+          /* return the buffer we have received from */
+          *buf_got = (void *)highprio;
+	  return 0;
+        }
+      }
+
+  /* if we come here, there is no buffer already sent */
+  if (else_clause != 0)
+    {
+      /* in that case we return immediately */
+      *buf_got = 0;
+      return 0;
+    }
+  
+  /* now we have to queue ourself to the wait queue(s) */
+  start_list = 0;
+  for (i = 0; i < nbuf; i++)
+    {
+      Buffer_Queue      *bq;
+      Buffer_Wait_Queue *wrk;
+      Buffer_Wait_Queue *bwq;
+      Buffer_Wait_Queue *prev_queue_entry = 0;
+      Buffer_Wait_Queue *prev_list_entry;
+      int                j, have_done = 0;
+      
+      for (j = 0; j < i; j++)
+        {
+          if (bufptr[i]->buf == bufptr[j]->buf)
+            {
+              have_done = 1;
+              break;
+            }
+        }
+      if (have_done)
+        continue;
+      
+      memcpy (&bq, bufptr[i]->buf, sizeof (Buffer_Queue *));
+      if (bq == 0)
+        {
+          MALLOC (bq, sizeof (Buffer_Queue));
+          memset (bq, 0, sizeof (Buffer_Queue));
+          /* *(bufptr[i]->buf) = bq; may be unaligned */
+	  memcpy (bufptr[i]->buf, &bq, sizeof (Buffer_Queue *));
+        }
+      MALLOC (wrk, sizeof (Buffer_Wait_Queue));
+      memset (wrk, 0, sizeof (Buffer_Wait_Queue));
+      bwq = (Buffer_Wait_Queue *)&bq->waitqueue;
+      
+      wrk->this = THIS;
+      wrk->datalen = datalen;
+      wrk->dataptr = datap;
+      wrk->bufferaddr = bufptr[i]->buf;
+
+      /* queue it at the end of buffer wait queue */
+      while (bwq->forward != 0)
+          bwq = bwq->forward;
+      wrk->forward = bwq->forward;
+      bwq->forward = wrk;
+      
+      /* queue it into list */
+      wrk->startlist = start_list;
+      if (! start_list)
+        {
+          start_list = wrk;
+          prev_list_entry = wrk;
+          wrk->startlist = start_list;
+        }
+      else
+        {
+          prev_list_entry->chain = wrk;
+          prev_list_entry = wrk;
+        }
+      
+      /* increment wait queue count */
+      bq->waitqueuelength++;
+    }
+
+  /* tell runtime system to delay this process */
+  timed_out = __delay_this (wait_buffer_receive, to, filename, lineno);
+  if (timed_out)
+    {
+      /* remove all entries from buffer queues */
+      Buffer_Wait_Queue *listentry = start_list;
+      
+      while (listentry != 0)
+        {
+	  Buffer_Queue *bq = *(listentry->bufferaddr);
+	  Buffer_Wait_Queue *prev_entry = (Buffer_Wait_Queue *)&bq->waitqueue;
+	  Buffer_Wait_Queue *bwq = bq->waitqueue;
+	  
+	  while (bwq != listentry)
+	    {
+	      prev_entry = bwq;
+	      bwq = bwq->forward;
+	    }
+	  /* dequeue it */
+	  prev_entry->forward = bwq->forward;
+	  bq->waitqueuelength--;
+	  listentry = listentry->chain;
+        }
+    }
+  
+  /* someone has continued us, find which buffer got ready */
+  retval = 0;
+
+  while (start_list != 0)
+    {
+      Buffer_Wait_Queue *tmp = start_list->chain;
+      
+      if (start_list->is_sent)
+        {
+          /* this one has been sent */
+          /* save return value */
+          if (retval == 0)
+              retval = start_list->bufferaddr;
+          else
+              /* more then one has been sent, that's wrong */
+              CAUSE_BUFFINCONS;
+          
+          /* update instance, if present */
+          if (ins != 0)
+            memcpy (ins, &start_list->who_sent, sizeof (INSTANCE));
+        }
+      FREE (start_list);
+      start_list = tmp;
+    }
+
+  /* now check if there was really a buffer got */
+  if (retval == 0 && !timed_out)
+    /* something's totally wrong, raise an exception  */
+    CAUSE_BUFFINCONS;
+
+  if (!timed_out)
+    *buf_got = (void *)retval;
+  return timed_out;
+}
+
+/* force function __print_buffer to be linked */
+extern void __print_buffer ();
+static EntryPoint pev = __print_buffer;

gcc/ch/runtime/waituntil.c

+/* 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 "rtltypes.h"
+#include "rts.h"
+
+EXCEPTION (timerfail);
+
+/*
+ * function __wait_until
+ *
+ * parameters:
+ *     abstime   absolute time value
+ *     filename
+ *     linenumber
+ *
+ * returns:
+ *     int   0 on success, 1 on failure
+ *
+ * exceptions:
+ *     timerfail
+ *
+ * abstract:
+ *     check for given argument is valid, calculate how long to wait in
+ *     seconds and call os to do it.
+ *
+ */
+
+int
+__wait_until (abstime, filename, linenumber)
+     unsigned long  abstime;
+     char          *filename;
+     int            linenumber;
+{
+  RtsTime	now, delta, abs_rtstime;
+    
+  /* get current time */
+  __rtstime (&now);
+    
+  abs_rtstime.secs = abstime;
+  abs_rtstime.nanosecs = 0;
+  
+  if (abs_rtstime.nanosecs < now.nanosecs)
+    {
+      abs_rtstime.secs--;
+      abs_rtstime.nanosecs += 1000000000;
+    }
+  
+  delta.secs = abs_rtstime.secs - now.secs;
+  delta.nanosecs = abs_rtstime.nanosecs - now.nanosecs;
+  
+  if (delta.secs > abs_rtstime.secs)
+    /* cannot wait into past */
+    return 1;
+  
+  return __delay_this (wait_wait, &delta, filename, linenumber) == 1 ? 0 : 1;
+}