�

Migrate from devo/gcc/ch.

From-SVN: r22038

gcc/ch/README

@@ -0,0 +1,42 @@
+This directory contains the GNU front-end for the Chill language,
+contributed by Cygnus Solutions.
+
+Chill is the "CCITT High-Level Language", where CCITT is the old
+name for what is now ITU, the International Telecommunications Union.
+It is is language in the Modula2 family, and targets many of the
+same applications as Ada (especially large embedded systems).
+Chill was never used much in the United States, but is still
+being used in Europe, Brazil, Korea, and other places.
+
+Chill has been standardized by a series of reports/standards.
+The GNU implementation mostly follows the 1988 version of
+the language, with some backwards compatibility options for
+the 1984 version, and some other extensions.  However, it
+does not implement all of the features of any standard.
+The most recent standard is ?, available from ?.
+
+The GNU Chill implementation is not being actively developed.
+Cygnus has one customer we are maintaining Chill for,
+but we are not planning on putting major work into Chill.
+This Net release is for educational purposes (as an example
+of a different Gcc front-end), and for those who find it useful.
+It is an unsupported hacker release.  Bug reports without
+patches are likely to get ignored.  Questions may get answered or
+ignored depending on our mood!  If you want to try your luck,
+you can send a note to David Brolley <brolley@cygnus.com> or
+Per Bothner <bothner@cygnus.com>.
+
+One known problem is that we only support native builds of GNU Chill.
+If you need a cross-compiler, you will find various problems,
+including the directory structure, and the setjmp-based exception
+handling mechanism.
+
+The Chill run-time system is in the runtime sub-directory.
+Notice rts.c contains a poor main's implementation of Chill
+"processes" (threads).  It is not added to libchill.a.
+We only use it for testing.  (Our customer uses a different
+implementation for product work.)
+
+The GNU Chill implementation was primarily written by
+Per Bothner, along with Bill Cox, Wilfried Moser, Michael
+Tiemann, and David Brolley.

gcc/ch/chill.in

@@ -0,0 +1,130 @@
+#!/bin/sh
+# Compile GNU Chill programs.
+: || exec /bin/sh -f $0 $argv:q
+
+# The compiler name might be different when doing cross-compilation
+# (this should be configured)
+gcc_name=gcc
+whatgcc=gcc
+speclang=-xnone
+startfile=chillrt0
+gnuchill_script_flags=
+gnuchill_version=unknown
+extraflags=
+
+# replace the command name by the name of the new command
+progname=`basename $0`
+case "$0" in
+  */*)
+    gcc=`echo $0 | sed -e "s;/[^/]*$;;"`/$gcc_name
+    ;;
+  *)
+    gcc=$gcc_name
+    ;;
+esac
+
+# $first is yes for first arg, no afterwards.
+first=yes
+# If next arg is the argument of an option, $quote is non-empty.
+# More precisely, it is the option that wants an argument.
+quote=
+# $library is made empty to disable use of libchill.
+library="-lchill"
+libpath=chillrt
+numargs=$#
+
+for arg
+do
+  if [ $first = yes ]
+  then
+    # Need some 1st arg to `set' which does not begin with `-'.
+    # We get rid of it after the loop ends.
+    set gcc
+    first=no
+  fi
+  # If you have to ask what this does, you should not edit this file. :-)
+  # The ``S'' at the start is so that echo -nostdinc does not eat the
+  # -nostdinc.
+  arg=`echo "S$arg" | sed "s/^S//; s/'/'\\\\\\\\''/g"`
+  if [ x$quote != x ]
+  then
+    quote=
+  else
+    quote=
+    case $arg in
+      -nostdlib)
+	# Inhibit linking with -lchill.
+	library=
+	libpath=
+	startfile=
+	;;
+      -B*)
+	gcc=`echo $arg | sed -e "s/^-B//"`$gcc_name
+	;;
+      -[bBVDUoeTuIYmLiA] | -Tdata | -Xlinker)
+	# these switches take following word as argument,
+	# so don't treat it as a file name.
+	quote=$arg
+	;;
+      -[cSEM] | -MM)
+	# Don't specify libraries if we won't link,
+	# since that would cause a warning.
+	library=
+	libpath=
+	startfile=
+	;;
+      -x*)
+	speclang=$arg
+	;;
+      -v)
+	# catch `chill -v'
+	if [ $numargs = 1 ] ; then
+	  library=
+	  libpath=
+	  startfile=
+	fi
+	echo "GNUCHILL version $gnuchill_version"
+	;;
+      -fgrant-only | -fchill-grant-only)
+        #inhibit production of an object file
+        extraflags="-S -o /dev/null"
+	library=
+	libpath=
+	startfile=
+        ;;
+      -*)
+	# Pass other options through; they don't need -x and aren't inputs.
+	;;
+      *)
+	# If file ends in .i, put options around it.
+	# But not if a specified -x option is currently active.
+	case "$speclang $arg" in -xnone\ *.[i])
+	  set "$@" -xchill "'$arg'" -xnone
+	  continue
+	esac
+	;;
+    esac
+  fi
+  set "$@" "'$arg'"
+done
+
+# Get rid of that initial 1st arg
+if [ $first = no ]; then
+  shift
+else
+  echo "$0: No input files specified."
+  exit 1
+fi
+
+if [ x$quote != x ]
+then
+  echo "$0: argument to \`$quote' missing"
+  exit 1
+fi
+
+# The '-ansi' flag prevents cpp from changing this:
+#  NEWMODE x = SET (sun, mon, thu, wed, thu, fri, sat);
+#to this:
+#  NEWMODE x = SET (1, mon, thu, wed, thu, fri, sat);
+#which is a CHILL syntax error.
+eval $whatgcc -ansi $gnuchill_script_flags $startfile "$@" $libpath $library $extraflags

gcc/ch/config-lang.in

@@ -0,0 +1,34 @@
+# Top level configure fragment for GNU CHILL.
+#   Copyright (C) 1994 Free Software Foundation, Inc.
+
+#This file is part of GNU CC.
+
+#GNU CC is free software; you can redistribute it and/or modify
+#it under the terms of the GNU General Public License as published by
+#the Free Software Foundation; either version 2, or (at your option)
+#any later version.
+
+#GNU CC is distributed in the hope that it will be useful,
+#but WITHOUT ANY WARRANTY; without even the implied warranty of
+#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#GNU General Public License for more details.
+
+#You should have received a copy of the GNU General Public License
+#along with GNU CC; see the file COPYING.  If not, write to
+#the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# Configure looks for the existence of this file to auto-config each language.
+# We define several parameters used by configure:
+#
+# language	- name of language as it would appear in $(LANGUAGES)
+# compilers	- value to add to $(COMPILERS)
+# stagestuff	- files to add to $(STAGESTUFF)
+# diff_excludes	- files to ignore when building diffs between two versions.
+
+language="CHILL"
+
+compilers="cc1chill"
+
+stagestuff="chill chill-cross cc1chill"
+
+diff_excludes="-x -x ch/chill.info*"

gcc/ch/configure

@@ -0,0 +1,644 @@
+#!/bin/sh
+# Configuration script for GNU CHILL
+#   Copyright (C) 1994 Free Software Foundation, Inc.
+
+#This file is part of GNU CC.
+
+#GNU CC is free software; you can redistribute it and/or modify
+#it under the terms of the GNU General Public License as published by
+#the Free Software Foundation; either version 2, or (at your option)
+#any later version.
+
+#GNU CC is distributed in the hope that it will be useful,
+#but WITHOUT ANY WARRANTY; without even the implied warranty of
+#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#GNU General Public License for more details.
+
+#You should have received a copy of the GNU General Public License
+#along with GNU CC; see the file COPYING.  If not, write to
+#the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+#
+# Shell script to create proper links to machine-dependent files in
+# preparation for compiling gcc.
+#
+# Options: --srcdir=DIR		specifies directory where sources are.
+# 	   --host=HOST		specifies host configuration.
+#	   --target=TARGET	specifies target configuration.
+#	   --build=TARGET	specifies configuration of machine you are
+#				using to compile GCC.
+#	   --prefix=DIR		specifies directory to install in.
+#	   --local-prefix=DIR	specifies directory to put local ./include in.
+#	   --exec-prefix=DIR	specifies directory to install executables in.
+#	   --with-gnu-ld	arrange to work with GNU ld.
+#	   --with-gnu-as	arrange to work with GAS.
+#	   --with-stabs		arrange to use stabs instead of host debug format.
+#	   --with-elf		arrange to use elf instead of host debug format.
+#	   --nfp		assume system has no FPU.
+#
+# If configure succeeds, it leaves its status in config.status.
+# If configure fails after disturbing the status quo, 
+# 	config.status is removed.
+#
+
+progname=$0
+# Configure the runtime and regression-test directories
+SUBDIRS="runtime utils"
+SUBDIRS="$SUBDIRS testsuite/compile"
+SUBDIRS="$SUBDIRS testsuite/execute"
+SUBDIRS="$SUBDIRS testsuite/execute/telebras"
+SUBDIRS="$SUBDIRS testsuite/noncompile"
+SUBDIRS="$SUBDIRS testsuite/examples"
+SUBDIRS="$SUBDIRS testsuite/execute/oe"
+SUBDIRS="$SUBDIRS testsuite/compile/elektra"
+SUBDIRS="$SUBDIRS testsuite/compile/votrics"
+
+# Default --srcdir to the directory where the script is found, 
+# if a directory was specified.
+# The second sed call is to convert `.//configure' to `./configure'.
+srcdir=`echo $0 | sed 's|//|/|' | sed 's|/[^/]*$||'`
+if [ x$srcdir = x$0 ]
+then
+srcdir=
+fi
+
+host=
+
+# Default prefix to /usr/local.
+prefix=/usr/local
+
+# local_prefix specifies where to find the directory /usr/local/include
+# We don't use $(prefix) for this
+# because we always want GCC to search /usr/local/include
+# even if GCC is installed somewhere other than /usr/local.
+# Think THREE TIMES before specifying any other value for this!
+# DO NOT make this use $prefix!
+local_prefix=/usr/local
+# CYGNUS LOCAL: for our purposes, this must be prefix.  This is apparently
+# only done for the benefit of glibc, and we don't use glibc.
+local_prefix='$(prefix)'
+# Default is to let the Makefile set exec_prefix from $(prefix)
+exec_prefix='$(prefix)'
+
+# CYGNUS LOCAL.  Default to nothing.
+program_transform_name=
+program_transform_set=
+site=
+
+remove=rm
+hard_link=ln
+symbolic_link='ln -s'
+copy=cp
+
+# Record all the arguments, to write them in config.status.
+arguments=$*
+
+#for Test
+#remove="echo rm"
+#hard_link="echo ln"
+#symbolic_link="echo ln -s"
+
+target=
+host=
+build=
+
+for arg in $*;
+do
+  case $next_arg in
+  --srcdir)
+    srcdir=$arg
+    next_arg=
+    ;;
+  --host)
+    host=$arg
+    next_arg=
+    ;;
+  --target)
+    target=$arg
+    next_arg=
+    ;;
+  --build)
+    build=$arg
+    next_arg=
+    ;;
+  --prefix)
+    prefix=$arg
+    next_arg=
+    ;;
+  --local-prefix)
+    local_prefix=$arg
+    next_arg=
+    ;;
+  --exec-prefix)
+    exec_prefix=$arg
+    next_arg=
+    ;;
+  --program-transform-name) # CYGNUS LOCAL
+    # Double any backslashes or dollar signs in the argument.
+    if [ -n "${arg}" ] ; then
+      program_transform_name="${program_transform_name} -e `echo ${arg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`"
+    fi
+    program_transform_set=yes
+    next_arg=
+    ;;    
+  --program-prefix) # CYGNUS LOCAL
+    if [ -n "${arg}" ]; then
+      program_transform_name="${program_transform_name} -e s,^,`echo ${arg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`,"
+    fi
+    program_transform_set=yes
+    next_arg=
+    ;;
+  --program-suffix) # CYGNUS LOCAL
+    if [ -n "${arg}" ]; then
+      program_transform_name="${program_transform_name} -e s,\$\$,`echo ${arg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`,"
+    fi
+    program_transform_set=yes
+    next_arg=
+    ;;
+  --site) # CYGNUS LOCAL
+    site=${arg}
+    next_arg=
+    ;;
+  --x-*)
+    next_arg=
+    ;;
+  *)
+    case $arg in
+     -srcdir | --srcdir | --srcdi | --srcd | --src | --sr | --s)
+	next_arg=--srcdir
+	;;
+     -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=* | --s=*)
+	srcdir=`echo $arg | sed 's/-*s[a-z]*=//'`
+	;;
+     -host | --host | --hos | --ho | --h)
+	next_arg=--host
+	;;
+     -host=* | --host=* | --hos=* | --ho=* | --h=*)
+	host=`echo $arg | sed 's/-*h[a-z]*=//'`
+	;; 
+     -target | --target | --targe | --targ | --tar | --ta | --t)
+	next_arg=--target
+	;;
+     -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+	target=`echo $arg | sed 's/-*t[a-z]*=//'`
+	;; 
+     -build | --build | --buil | --bui | --bu | --b)
+	next_arg=--build
+	;;
+     -build=* | --build=* | --buil=* | --bui=* | --bu=* | --b=*)
+	build=`echo $arg | sed 's/-*b[a-z]*=//'`
+	;; 
+     -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+	next_arg=--prefix
+	;;
+     -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+	prefix=`echo $arg | sed 's/-*p[a-z]*=//'`
+	;;
+     -local-prefix | --local-prefix | --local-prefi | --local-pref | --local-pre \
+	| --local-pr | --local-p | --local- | --local | --loc | --lo | --l)
+	next_arg=--local-prefix
+	;;
+     -local-prefix=* | --local-prefix=* | --local-prefi=* | --local-pref=* \
+	| --local-pre=* | --local-pr=* | --local-p=* | --local-=* | --local=* \
+	| --loc=* | --lo=* | --l=*)
+	local_prefix=`echo $arg | sed 's/-*l[-a-z]*=//'`
+	;;
+     -exec-prefix | --exec-prefix | --exec-prefi | --exec-pref | --exec-pre \
+	| --exec-pr | --exec-p | --exec- | --exec | --exe | --ex | --e)
+	next_arg=--exec-prefix
+	;;
+     -exec-prefix=* | --exec-prefix=* | --exec-prefi=* | --exec-pref=* \
+	| --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* | --exec=* \
+	| --exe=* | --ex=* | --e=*)
+	exec_prefix=`echo $arg | sed 's/-*e[-a-z]*=//'`
+	;;
+     -program-transform-name | --program-transform-name \
+	| --program-transform-nam | --program-transform-na \
+	| --program-transform-n | --program-transform- | --program-transform \
+	| --program-transfor | --program-transfo | --program-transf \
+	| --program-trans | --program-tran | --program-tra \
+	| --program-tr | --program-t)
+	next_arg=--program-transform-name
+	# CYGNUS LOCAL
+	;;
+     -program-transform-name=* | --program-transform-name=* \
+	| --program-transform-nam=* | --program-transform-na=* \
+	| --program-transform-n=* | --program-transform-=* \
+	| --program-transform=* | --program-transfor=* | --program-transfo=* \
+	| --program-transf=* | --program-trans=* | --program-tran=* \
+	| --program-tra=* | --program-tr=* | --program-t=*)
+	# CYGNUS LOCAL
+	arg=`echo ${arg} | sed -e 's/^[-a-z_]*=//'`
+	# Double any \ or $ in the argument.
+	if [ -n "${arg}" ] ; then
+	  program_transform_name="${program_transform_name} -e `echo ${arg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`"
+	fi
+	program_transform_set=yes
+	;;
+     -program-prefix | --program-prefix | --program-prefi \
+	| --program-pref | --program-pre | --program-pr \
+	| --program-p)
+	next_arg=--program-prefix
+	# CYGNUS LOCAL
+	;;
+     -program-prefix=* | --program-prefix=* | --program-prefi=* \
+	| --program-pref=* | --program-pre=* | --program-pr=* \
+	| --program-p=*)
+	# CYGNUS LOCAL
+	arg=`echo ${arg} | sed -e 's/^[-a-z_]*=//'`
+	if [ -n "${arg}" ]; then
+	  program_transform_name="${program_transform_name} -e s,^,`echo ${arg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`,"
+	fi
+	program_transform_set=yes
+	;;
+     -program-suffix | --program-suffix | --program-suffi \
+	| --program-suff | --program-suf | --program-su \
+	| --program-s)
+	next_arg=--program-suffix
+	# CYGNUS LOCAL
+	;;
+     -program-suffix=* | --program-suffix=* | --program-suffi=* \
+	| --program-suff=* | --program-suf=* | --program-su=* \
+	| --program-s=*)
+	# CYGNUS LOCAL
+	arg=`echo ${arg} | sed -e 's/^[-a-z_]*=//'`
+	if [ -n "${arg}" ]; then
+	  program_transform_name="${program_transform_name} -e s,\$\$,`echo ${arg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`,"
+	fi
+	program_transform_set=yes
+	;;
+     -site | --site | --sit) # CYGNUS LOCAL
+	next_arg=--site
+	;;
+     -site=* | --site=* | --sit=* | --si=*) # CYGNUS LOCAL
+	site=`echo ${arg} | sed 's/^[-a-z]*=//'`
+	;;
+     -with-gnu-ld | --with-gnu-ld | --with-gnu-l)
+	gnu_ld=yes
+	;;
+     -gas | --gas | --ga | --g | -with-gnu-as | --with-gnu-as | -with-gnu-a)
+        gas=yes
+	;;
+     -nfp | --nfp | --nf | --n)
+	nfp=yes
+	;;
+     -with-stabs | -with-stab | -with-sta | -with-st | -with-s \
+	| --with-stabs | --with-stab | --with-sta | --with-st | --with-s \
+	| -stabs | -stab | -sta | -st  \
+	| --stabs | --stab | --sta | --st)
+	stabs=yes
+	;;
+     -with-elf | -with-el | -with-se \
+	| --with-elf | --with-el | --with-e \
+	| -elf | -el | -e \
+	|--elf | --el | --e)
+	elf=yes
+	;;
+     -with-* | --with-*) ;; #ignored
+     -without-* | --without-*) ;; #ignored
+     -enable-* | --enable-*) ;; #ignored
+     -x | --x) ;; # ignored
+     -x-*=* | --x-*=*) ;; # ignored
+     -x-* | --x-*)
+	next_arg=--x-ignored # ignored
+	;;
+     --he*) ;; # ignored for now (--help)
+     --vers*) ;; # ignored for now (--version)
+     -v | -verb* | --verb*) ;; # ignored for now (--verbose)
+     --program-*) ;; #ignored (--program-prefix, --program-suffix)
+     --c*) ;; #ignored (--cache-file)
+     --q*) ;; #ignored (--quiet)
+     --si*) ;; #ignored (--silent)
+     -*)
+	echo "Invalid option \`$arg'" 1>&2
+	exit 1
+	;;
+     *)
+# Allow configure HOST TARGET
+	if [ x$host = x ]
+	then
+		host=$target
+	fi
+	target=$arg
+	;;
+    esac
+  esac
+done
+
+# Find the source files, if location was not specified.
+if [ x$srcdir = x ]
+then
+	srcdirdefaulted=1
+	srcdir=.
+	if [ ! -r tree.c ]
+	then
+		srcdir=..
+	fi
+fi
+
+if [ ! -r ${srcdir}/grant.c ]
+then
+	if [ x$srcdirdefaulted = x ]
+	then
+	  echo "$progname: Can't find CHILL frontend sources in \`${srcdir}'" 1>&2
+	else
+	  echo "$progname: Can't find CHILL frontend sources in \`.' or \`..'" 1>&2
+	fi
+	exit 1
+fi
+
+# Make sure that scripts are executable
+[ -w ${srcdir} -a -f ${srcdir}/regression.sh   ] && \
+  chmod +x ${srcdir}/regression.sh 
+[ -w ${srcdir} -a -f ${srcdir}/regression.prpt ] && \
+  chmod +x ${srcdir}/regression.prpt
+[ -w ${srcdir} -a -f ${srcdir}/regression.awk3 ] && \
+  chmod +x ${srcdir}/regression.awk3
+
+if [ -r ${srcdir}/config.status ] && [ x$srcdir != x. ]
+then
+	echo "$progname: \`configure' has been run in \`${srcdir}'" 1>&2
+	exit 1
+fi
+
+host_xmake_file=
+host_truncate_target=
+
+# Complain if an arg is missing
+if [ x$build = x ]
+then
+	# If host was specified, always use it for build also to avoid
+	# confusion.  If someone wants a cross compiler where build != host,
+	# then they must specify build explicitly.  Since this case is
+	# extremely rare, it does not matter that it is slightly inconvenient.
+	if [ x$host != x ]
+	then
+		build=$host
+	
+	# This way of testing the result of a command substitution is
+	# defined by Posix.2 (section 3.9.1) as well as traditional shells.
+	elif build=`${srcdir}/../config.guess`
+	then
+		echo "This appears to be a ${build} system." 1>&2
+
+	elif [ x$target != x ]
+	then
+		echo 'Config.guess failed to determine the host type.  Defaulting to target.'
+		build=$target
+	else
+		echo 'Config.guess failed to determine the host type.  You need to specify one.' 1>&2
+		echo "\
+Usage: `basename $progname` [--host=HOST] [--build=BUILD]
+       [--prefix=DIR] [--gxx-include-dir=DIR] [--local-pref=DIR] [--exec-pref=DIR]
+       [--with-gnu-as] [--with-gnu-ld] [--with-stabs] [--with-elf] [--nfp] TARGET" 1>&2
+	echo "Where HOST, TARGET and BUILD are three-part configuration names " 1>&2
+		if [ -r config.status ]
+		then
+			tail +2 config.status 1>&2
+		fi
+		exit 1
+	fi
+fi
+
+# If $host was not specified, use $build.
+if [ x$host = x ]
+then
+	host=$build
+fi
+
+# If $target was not specified, use $host.
+if [ x$target = x ]
+then
+	target=$host
+fi
+
+# Validate the specs, and canonicalize them.
+canon_build=`/bin/sh $srcdir/../config.sub $build` || exit 1
+canon_host=`/bin/sh $srcdir/../config.sub $host` || exit 1
+canon_target=`/bin/sh $srcdir/../config.sub $target` || exit 1
+
+rm -f config.bak
+if [ -f config.status ]; then mv -f config.status config.bak; fi
+
+#
+# For the current directory and all of the designated SUBDIRS,
+# do the rest of the script...
+#
+if [ ! -d testsuite ] ; then mkdir testsuite; fi
+_SUBDIRS=
+for d in $SUBDIRS; do
+	[ -d $srcdir/$d ] && _SUBDIRS="$_SUBDIRS $d"
+done
+
+savesrcdir=$srcdir
+STARTDIR=`pwd`
+
+for subdir in $_SUBDIRS
+do
+	tmake_file=
+	host_xmake_file=
+	oldsrcdir=$savesrcdir
+
+	# ${invsubdir} is inverse of ${subdir), *with* trailing /, if needed.
+	invsubdir=`echo ${subdir}/ | sed -e 's|\./||g' -e 's|[^/]*/|../|g'`
+
+	# Re-adjust the path
+	# Also create a .gdbinit file which runs the one in srcdir
+	# and tells GDB to look there for source files.
+
+	case $oldsrcdir in
+	".") srcdir=. ;;
+	/*) # absolute path
+               	srcdir=${oldsrcdir}/${subdir}  ;;
+        *) # otherwise relative
+		srcdir=${invsubdir}${oldsrcdir}/${subdir} ;;
+	esac
+
+        if [ -r ${oldsrcdir}/${subdir}/.gdbinit -a ${oldsrcdir} != "." ] ; then
+		cat > ${subdir}/.gdbinit <<EOF
+dir .
+dir ${srcdir}
+source ${srcdir}/.gdbinit
+EOF
+	fi
+
+	case $oldsrcdir in
+	/*)	;;
+	*)	oldsrcdir=${invsubdir}${oldsrcdir} ;;
+	esac
+	mainsrcdir=${oldsrcdir}/..
+	test -d $subdir || mkdir $subdir
+	cd $subdir
+	#
+	# Create Makefile.tem from Makefile.in.
+	# Make it set VPATH if necessary so that the sources are found.
+	# Also change its value of srcdir.
+	rm -f Makefile.tem
+	echo "VPATH = ${srcdir}" \
+	  | cat - ${srcdir}/Makefile.in \
+	  | sed "s@^srcdir = \.@srcdir = ${srcdir}@" > Makefile.tem
+
+	# Conditionalize the makefile for this host machine.
+	if [ -f ${mainsrcdir}/config/${host_xmake_file} ]
+	then
+		rm -f Makefile.xx
+		sed -e "/####host/  r ${mainsrcdir}/config/${host_xmake_file}" Makefile.tem > Makefile.xx
+		echo "Merged ${host_xmake_file}."
+		rm -f Makefile.tem
+		mv Makefile.xx Makefile.tem
+	else
+	# Say in the makefile that there is no host_xmake_file,
+	# by using a name which (when interpreted relative to $srcdir/config)
+	# will duplicate another dependency: $srcdir/Makefile.in.
+		host_xmake_file=../Makefile.in
+	fi
+	
+	# Define variables host_canonical, build_canonical, and target_canonical
+	# because some Cygnus local changes in the Makefile depend on them.
+	echo host_canonical = ${canon_host} > Makefile.xx
+	echo target_canonical = ${canon_target} >> Makefile.xx
+	echo build_canonical = ${canon_build} >> Makefile.xx
+	cat Makefile.tem >> Makefile.xx
+	mv Makefile.xx Makefile.tem
+	
+	# Conditionalize the makefile for this target machine.
+	if [ -f ${mainsrcdir}/config/${tmake_file} ]
+	then
+		rm -f Makefile.xx
+		sed -e "/####target/  r ${mainsrcdir}/config/${tmake_file}" Makefile.tem > Makefile.xx
+		echo "Merged ${tmake_file}."
+		rm -f Makefile.tem
+		mv Makefile.xx Makefile.tem
+	else
+	# Say in the makefile that there is no tmake_file,
+	# by using a name which (when interpreted relative to $srcdir/config)
+	# will duplicate another dependency: $srcdir/Makefile.in.
+		tmake_file=../Makefile.in
+	fi
+	
+	# CYGNUS LOCAL
+	# Conditionalize the makefile for this site.
+	if [ -f ${mainsrcdir}/config/ms-${site} ]
+	then
+		rm -f Makefile.xx
+		sed -e "/####site/  r ${mainsrcdir}/config/ms-${site}" Makefile.tem > Makefile.xx
+		echo "Merged ms-${site}."
+		rm -f Makefile.tem
+		mv Makefile.xx Makefile.tem
+	fi
+	
+	# CYGNUS LOCAL
+	# If this is a cross compilation, and we have newlib in the build
+	# tree, then define inhibit_libc in LIBGCC2_CFLAGS.  This will cause
+	# __eprintf to be left out of libgcc.a, but that's OK because newlib
+	# has its own version of assert.h.
+	if [ x$host != x$target ]; then
+	  sed -e 's/^\(LIBGCC2_CFLAGS[ 	]*=[ 	]*\)/\1-Dinhibit_libc /' Makefile.tem > Makefile.tem2
+	  rm -f Makefile.tem
+	  mv Makefile.tem2 Makefile.tem
+	fi
+	
+	# Remove all formfeeds, since some Makes get confused by them.
+	# Also arrange to give the variables `target', `host_xmake_file',
+	# `tmake_file', `prefix', `local_prefix', `exec_prefix', `FIXINCLUDES'
+	# and `INSTALL_HEADERS_DIR' values in the Makefile from the values
+	# they have in this script.
+	# CYGNUS LOCAL: FLOAT_H, CROSS_FLOAT_H, objdir
+	rm -f Makefile.xx
+	sed -e "s///" -e "s/^target=.*$/target=${target}/" \
+	    -e "s|^xmake_file=.*$|xmake_file=${host_xmake_file}|" \
+	    -e "s|^tmake_file=.*$|tmake_file=${tmake_file}|" \
+	    -e "s|^version=.*$|version=${version}|" \
+	    -e "s|^prefix[ 	]*=.*|prefix = $prefix|" \
+	    -e "s|^local_prefix[ 	]*=.*|local_prefix = $local_prefix|" \
+	    -e "s|^exec_prefix[ 	]*=.*|exec_prefix = $exec_prefix|" \
+	    -e "s|^objdir[ 	]*=.*|objdir=`pwd`|" \
+	    Makefile.tem > Makefile.xx
+	rm -f Makefile.tem
+	mv Makefile.xx Makefile.tem
+	
+	# Install Makefile for real, after making final changes.
+	# Define macro CROSS_COMPILE in compilation if this is a cross-compiler.
+	# Also use all.cross instead of all.internal, and add cross-make to Makefile.
+	if [ x$canon_host = x$canon_target ]
+	then
+		rm -f Makefile
+	  	if [ x$canon_host = x$canon_build ]
+		then
+			mv Makefile.tem Makefile
+		else
+	#		When building gcc with a cross-compiler, we need to fix a
+	#		few things.
+			echo "build= $build" > Makefile
+			sed -e "/####build/  r ${mainsrcdir}/build-make" Makefile.tem >> Makefile
+			rm -f Makefile.tem Makefile.xx
+		fi
+	else
+		rm -f Makefile
+		echo "CROSS=-DCROSS_COMPILE" > Makefile
+		sed -e "/####cross/  r ${mainsrcdir}/cross-make" Makefile.tem >> Makefile
+		rm -f Makefile.tem Makefile.xx
+	fi
+	
+	echo "Created \`$subdir/Makefile'."
+	
+	if [ xx${vint} != xx ]
+	then
+		vintmsg=" (vint)"
+	fi
+	
+	# Describe the chosen configuration in config.status.
+	# Make that file a shellscript which will reestablish the same configuration.
+
+	rm -f config.bak
+	if [ -f config.status ]; then mv -f config.status config.bak; fi
+
+	echo "#!/bin/sh
+	# This directory was configured as follows:
+cd $invsubdir; ${progname}" $arguments > config.new
+	echo echo host=$canon_host target=$canon_target build=$canon_build >> config.new
+	chmod a+x config.new
+
+	# If we aren't executing the configure script in .
+	if [ x$subdir != x. ]
+	then
+		if [ -f $srcdir/configure ]
+		then
+			echo "Running \`${CONFIG_SHELL-sh} $srcdir/configure $arguments\'"
+			${CONFIG_SHELL-sh} $srcdir/configure $arguments
+			echo "${srcdir}/configure" $arguments >> config.new
+			echo echo host=$canon_host target=$canon_target build=$canon_build >> config.new
+		fi
+	fi
+
+	if [ -f config.bak ] && cmp config.bak config.new >/dev/null 2>/dev/null;
+	then
+		mv -f config.bak config.status
+		rm -f config.new
+	else
+		mv -f config.new config.status
+		rm -f config.bak
+	fi
+
+	cd $STARTDIR
+done   # end of current-dir SUBDIRS loop
+	
+srcdir=$savesrcdir
+
+# Describe the chosen configuration in config.status.
+# Make that file a shellscript which will reestablish the same configuration.
+echo "#!/bin/sh
+# This directory was configured as follows:
+${progname}" $arguments > config.new
+echo echo host=$canon_host target=$canon_target build=$canon_build >> config.new
+chmod a+x config.new
+if [ -f config.bak ] && cmp config.bak config.new >/dev/null 2>/dev/null;
+then
+	mv -f config.bak config.status
+	rm -f config.new
+else
+	mv -f config.new config.status
+	rm -f config.bak
+fi
+
+exit 0

gcc/ch/lang-specs.h

@@ -0,0 +1,42 @@
+/* Definitions for specs for GNU CHILL.
+   Copyright (C) 1995 Free Software Foundation, Inc..
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+/* This is the contribution to the `default_compilers' array in gcc.c for
+   CHILL.  */
+
+  {".ch",   "@chill" },
+  {".chi",  "@chill" },
+  {"@chill",
+   "cpp -lang-chill %{nostdinc*} %{C} %{v} %{A*} %{I*} %{P} %I\
+	%{C:%{!E:%eGNU CHILL does not support -C without using -E}}\
+        -undef -D__GNUCHILL__=%v1 -D__GNUC_MINOR__=%v2\
+        %c %{Os:-D__OPTIMIZE_SIZE__} %{O*:-D__OPTIMIZE__} %{traditional} %{ftraditional:-traditional}\
+        %{traditional-cpp:-traditional} %{!undef:%{!ansi:%p} %P} %{trigraphs}\
+	%{g*} %{W*} %{w} %{pedantic*} %{H} %{d*} %C %{D*} %{U*} %{i*} %Z\
+        %i %{!E:%g.i}%{E:%W{o*}} \n",
+   "%{!E:cc1chill %g.i %1 \
+		   %{!Q:-quiet} -dumpbase %b.ch %{d*} %{m*} %{a}\
+		   %{g*} %{O*} %{W*} %{w} %{pedantic*} %{itu} \
+		   %{v:-version} %{pg:-p} %{p} %{f*} %{I*} \
+		   %{aux-info*} %X \
+		   %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
+		   %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\
+              %{!S:as %a %Y \
+		      %{c:%W{o*}%{!o*:-o %w%b%O}}%{!c:-o %d%w%u%O}\
+                      %{!pipe:%g.s} %A\n }}"},

gcc/ch/lang.c

@@ -0,0 +1,306 @@
+/* Language-specific hook definitions for CHILL front end.
+   Copyright (C) 1992, 93, 1994 Free Software Foundation, Inc.
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+
+#include "config.h"
+#include "tree.h"
+#include "ch-tree.h"
+#include "lex.h"
+#include <stdio.h>
+#include "input.h"
+
+/* Type node for boolean types.  */
+
+tree boolean_type_node;
+
+/* True if STRING(INDEX) yields a CHARS(1) (or BOOLS(1)) rather than
+   a CHAR (or BOOL).  Also, makes CHARS(1) similar for CHAR,
+   and BOOLS(1) similar to BOOL.  This is for compatibility
+   for the 1984 version of Z.200.*/
+int flag_old_strings = 0;
+
+/* This is set non-zero to force user input tokens to lower case.
+   This is non-standard.  See Z.200, page 8. */
+int ignore_case = 1;
+
+/* True if reserved and predefined words ('special' words in the Z.200
+   terminology) are in uppercase.  Obviously, this had better not be 
+   true if we're ignoring input case. */
+int special_UC = 0;
+
+/* The actual name of the input file, regardless of any #line directives */
+char* chill_real_input_filename;
+extern FILE* finput;
+
+extern int maximum_field_alignment;
+
+extern void error             PROTO((char *, ...));
+extern void error_with_decl   PROTO((tree, char *, ...));
+extern void fatal             PROTO((char *, ...));
+extern int  floor_log2_wide   PROTO((unsigned HOST_WIDE_INT));
+extern void pedwarn_with_decl PROTO((tree, char *, ...));
+extern void sorry             PROTO((char *, ...));
+extern int  type_hash_list    PROTO((tree));
+
+/* return 1 if the expression tree given has all
+   constant nodes as its leaves; return 0 otherwise. */
+int
+deep_const_expr (exp)
+     tree exp;
+{
+  enum chill_tree_code code;
+  int length;
+  int i;
+
+  if (exp == NULL_TREE)
+    return 0;
+
+  code = TREE_CODE (exp);
+  length = tree_code_length[(int) code];
+
+  /* constant leaf?  return TRUE */
+  if (TREE_CODE_CLASS (code) == 'c')
+    return 1;
+
+  /* recursively check next level down */
+  for (i = 0; i < length; i++)
+    if (! deep_const_expr (TREE_OPERAND (exp, i)))
+      return 0;
+  return 1;      
+}
+
+
+tree
+const_expr (exp)
+     tree exp;
+{
+  if (TREE_CODE (exp) == INTEGER_CST)
+    return exp;
+  if (TREE_CODE (exp) == CONST_DECL)
+    return const_expr (DECL_INITIAL (exp));
+  if (TREE_CODE_CLASS (TREE_CODE (exp)) == 'd'
+      && DECL_INITIAL (exp) != NULL_TREE
+      && TREE_READONLY (exp))
+    return DECL_INITIAL (exp);
+  if (deep_const_expr (exp))
+    return exp;
+  if (TREE_CODE (exp) != ERROR_MARK)
+    error ("non-constant expression");
+  return error_mark_node;
+}
+
+/* Each of the functions defined here
+   is an alternative to a function in objc-actions.c.  */
+   
+/* Used by c-lex.c, but only for objc.  */
+tree
+lookup_interface (arg)
+     tree arg;
+{
+  return 0;
+}
+
+int
+maybe_objc_comptypes (lhs, rhs)
+     tree lhs, rhs;
+{
+  return -1;
+}
+
+tree
+maybe_building_objc_message_expr ()
+{
+  return 0;
+}
+
+int
+recognize_objc_keyword ()
+{
+  return 0;
+}
+
+void
+lang_init_options ()
+{
+}
+
+/* used by print-tree.c */
+
+void
+lang_print_xnode (file, node, indent)
+     FILE *file;
+     tree node;
+     int indent;
+{
+}
+
+void
+GNU_xref_begin ()
+{
+  fatal ("GCC does not yet support XREF");
+}
+
+void
+GNU_xref_end ()
+{
+  fatal ("GCC does not yet support XREF");
+}
+
+/*
+ * process chill-specific compiler command-line options
+ */
+int
+lang_decode_option (argc, argv)
+     int argc;
+     char **argv;
+{
+  char *p = argv[0];
+  static explicit_ignore_case = 0;
+  if (!strcmp(p, "-lang-chill"))
+    ; /* do nothing */
+  else if (!strcmp (p, "-fruntime-checking"))
+    {
+      range_checking = 1;
+      empty_checking = 1;
+    }
+  else if (!strcmp (p, "-fno-runtime-checking"))
+    {
+      range_checking = 0;
+      empty_checking = 0;
+      runtime_checking_flag = 0;
+    }
+  else if (!strcmp (p, "-flocal-loop-counter"))
+    flag_local_loop_counter = 1;
+  else if (!strcmp (p, "-fno-local-loop-counter"))
+    flag_local_loop_counter = 0;
+  else if (!strcmp (p, "-fold-strings"))
+    flag_old_strings = 1;
+  else if (!strcmp (p, "-fno-old-strings"))
+    flag_old_strings = 0;
+  else if (!strcmp (p, "-fignore-case"))
+    {
+      explicit_ignore_case = 1;
+      if (special_UC)
+	{
+	  error ("Ignoring case upon input and");
+	  error ("making special words uppercase wouldn't work.");
+	}
+      else
+	ignore_case = 1;
+    }
+  else if (!strcmp (p, "-fno-ignore-case"))
+    ignore_case = 0;
+  else if (!strcmp (p, "-fspecial_UC"))
+    {
+      if (explicit_ignore_case)
+	{
+	  error ("Making special words uppercase and");
+	  error (" ignoring case upon input wouldn't work.");
+	}
+      else
+	special_UC = 1, ignore_case = 0;
+    }
+  else if (!strcmp (p, "-fspecial_LC"))
+    special_UC = 0;
+  else if (!strcmp (p, "-fpack"))
+    maximum_field_alignment = BITS_PER_UNIT;
+  else if (!strcmp (p, "-fno-pack"))
+    maximum_field_alignment = 0;
+  else if (!strcmp (p, "-fchill-grant-only"))
+    grant_only_flag = 1;
+  else if (!strcmp (p, "-fgrant-only"))
+    grant_only_flag = 1;
+  /* user has specified a seize-file path */
+  else if (p[0] == '-' && p[1] == 'I')
+    register_seize_path (&p[2]);
+  if (!strcmp(p, "-itu"))        /* Force Z.200 semantics */
+    {
+      pedantic = 1;   /* FIXME: new flag name? */
+      flag_local_loop_counter = 1;      
+    }
+  else
+    return c_decode_option (argc, argv);
+
+  return 1;
+}
+
+void
+chill_print_error_function (file)
+     char *file;
+{
+  static tree last_error_function = NULL_TREE;
+  static struct module *last_error_module = NULL;
+
+  if (last_error_function == current_function_decl
+      && last_error_module == current_module)
+    return;
+
+  last_error_function = current_function_decl;
+  last_error_module = current_module;
+
+  if (file)
+    fprintf (stderr, "%s: ", file);
+
+  if (current_function_decl == global_function_decl
+      || current_function_decl == NULL_TREE)
+    {
+      if (current_module == NULL)
+	fprintf (stderr, "At top level:\n");
+      else
+	fprintf (stderr, "In module %s:\n",
+		 IDENTIFIER_POINTER (current_module->name));
+    }
+  else
+    {
+      char *kind = "function";
+      char *name = (*decl_printable_name) (current_function_decl, 2);
+      fprintf (stderr, "In %s `%s':\n", kind, name);
+    }
+}
+
+/* Print an error message for invalid use of an incomplete type.
+   VALUE is the expression that was used (or 0 if that isn't known)
+   and TYPE is the type that was invalid.  */
+
+void
+incomplete_type_error (value, type)
+     tree value;
+     tree type;
+{
+  error ("internal error - use of undefined type");
+}
+
+void
+lang_init ()
+{
+  extern void (*print_error_function) PROTO((char*));
+
+  chill_real_input_filename = input_filename;
+
+  /* the beginning of the file is a new line; check for # */
+  /* With luck, we discover the real source file's name from that
+     and put it in input_filename.  */
+
+  ungetc (check_newline (), finput);
+
+  /* set default grant file */
+  set_default_grant_file ();
+
+  print_error_function = chill_print_error_function;
+}

gcc/ch/runtime/allmem.c

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

gcc/ch/runtime/andps.c

@@ -0,0 +1,76 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __andpowerset
+ *
+ * parameters:
+ *	out		return from __andpowerset
+ *	left		left powerset
+ *	right		right powerset
+ *	bitlength	length of powerset in bits
+ *
+ * returns:
+ *	void
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  and's two powersets
+ *
+ */
+
+void
+__andpowerset (out, left, right, bitlength)
+     SET_WORD      *out;
+     SET_WORD      *left;
+     SET_WORD      *right;
+     unsigned long  bitlength;
+{
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      *((SET_CHAR *)out) = *((SET_CHAR *)left) &
+                           *((SET_CHAR *)right);
+      MASK_UNUSED_CHAR_BITS((SET_CHAR *)out, bitlength);
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      *((SET_SHORT *)out) = *((SET_SHORT *)left) &
+                            *((SET_SHORT *)right);
+      MASK_UNUSED_SHORT_BITS((SET_SHORT *)out, bitlength);
+    }
+  else
+    {
+      unsigned long len = BITS_TO_WORDS (bitlength);
+      register unsigned long i;
+    
+      for (i = 0; i < len; i++)
+	out[i] = left[i] & right[i];
+      MASK_UNUSED_WORD_BITS ((out + len - 1), 
+			     bitlength % SET_WORD_SIZE);
+    }
+}

gcc/ch/runtime/auxtypes.h

@@ -0,0 +1,45 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#ifndef _auxtypes_h_
+#define _auxtypes_h_
+
+
+typedef enum { False, True } Boolean;
+
+#define VARYING_STRING(strlen) \
+  struct { unsigned short len; char body[strlen]; }
+
+typedef struct {
+  unsigned short len;
+  char           body[1];
+} VarString; 
+
+/* Macros for moving an (U)INT and (U)LONG without alignment worries */
+#define MOV2(tgt,src) \
+  *((char*)(tgt)  ) = *((char*)(src)  ), \
+  *((char*)(tgt)+1) = *((char*)(src)+1)
+#define MOV4(tgt,src) \
+  *((char*)(tgt)  ) = *((char*)(src)  ), \
+  *((char*)(tgt)+1) = *((char*)(src)+1), \
+  *((char*)(tgt)+2) = *((char*)(src)+2), \
+  *((char*)(tgt)+3) = *((char*)(src)+3)
+
+#endif

gcc/ch/runtime/basicio.c

@@ -0,0 +1,467 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+   
+   This file is part of GNU CC.
+   
+   GNU CC is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+   
+   GNU CC is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+   
+   You should have received a copy of the GNU General Public License
+   along with GNU CC; see the file COPYING.  If not, write to
+   the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <limits.h>
+#include <errno.h>
+
+#include <string.h>
+#include <stdlib.h>
+
+#include "fileio.h"
+
+#ifndef PATH_MAX
+#define PATH_MAX _POSIX_PATH_MAX
+#endif
+
+static
+void
+GetSetAttributes( Association_Mode* the_assoc )
+{
+  struct stat statbuf;
+  int retco;
+
+  if( (retco = stat( the_assoc->pathname, &statbuf )) )
+    return;
+
+  if( S_ISREG(statbuf.st_mode) )
+    {
+      SET_FLAG( the_assoc, IO_EXISTING );
+      if( !TEST_FLAG( the_assoc, IO_VARIABLE ) )
+        SET_FLAG( the_assoc, IO_INDEXABLE );
+    }
+  else
+    if( S_ISCHR(statbuf.st_mode) || S_ISFIFO(statbuf.st_mode) )
+      {
+	SET_FLAG( the_assoc, IO_EXISTING );
+	CLR_FLAG( the_assoc, IO_INDEXABLE );
+      }
+  SET_FLAG( the_assoc, IO_SEQUENCIBLE );
+
+  /* FIXME: File size and computation of number of records for outoffile ? */
+
+  if( !access( the_assoc->pathname, R_OK ) )
+    SET_FLAG( the_assoc, IO_READABLE );
+  if( !access( the_assoc->pathname, W_OK ) )
+    SET_FLAG( the_assoc, IO_WRITEABLE );
+}
+
+static
+void 
+makeName( Association_Mode* the_assoc, char* the_path, int the_path_len,
+	 char* file, int line)
+{
+  int namlen;
+  if( ! the_assoc->pathname && 
+      ! (the_assoc->pathname = (char*)malloc( PATH_MAX )) )
+    CHILLEXCEPTION( file, line, SPACEFAIL, PATHNAME_ALLOC );
+
+  if( the_path[0] != DIRSEP )
+    {
+      if( !getcwd( the_assoc->pathname, PATH_MAX ) )
+	{
+	  the_assoc->syserrno = errno;
+	  CHILLEXCEPTION( file, line, ASSOCIATEFAIL, GETCWD_FAILS );
+	}
+      namlen = strlen( the_assoc->pathname );
+      the_assoc->pathname[namlen++] = DIRSEP;  
+    }
+  else
+    namlen = 0;
+
+  strncpy( the_assoc->pathname + namlen, the_path, the_path_len );
+  the_assoc->pathname[namlen+the_path_len] = '\0';
+}
+
+/*
+ * ASSOCIATE
+ */
+/* Caution: returns an Association mode location (!) */
+Association_Mode*
+__associate( Association_Mode* the_assoc,
+	     char*             the_path,
+	     int               the_path_len,
+	     char*             the_mode,
+	     int               the_mode_len,
+	     char*             file,
+	     int               line )
+{
+  if( !the_assoc )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ASSOCIATION );
+
+  if( TEST_FLAG(the_assoc, IO_ISASSOCIATED) )
+    CHILLEXCEPTION( file, line, ASSOCIATEFAIL, IS_ASSOCIATED );
+
+  /* clear all flags */
+  the_assoc->flags = 0;
+
+  if( ! the_path_len )
+    CHILLEXCEPTION( file, line, ASSOCIATEFAIL, NO_PATH_NAME );
+
+  makeName( the_assoc, the_path, the_path_len, file, line );
+  GetSetAttributes( the_assoc );
+
+  CLR_FLAG( the_assoc, IO_VARIABLE );
+  if ( the_mode )
+    {
+      if( !strncmp( the_mode, "VARIABLE", 8 ) )
+	{
+	  SET_FLAG( the_assoc, IO_VARIABLE );
+	  CLR_FLAG( the_assoc, IO_INDEXABLE );
+	}
+      else
+	if( strlen( the_mode ) )
+	  CHILLEXCEPTION( file, line, ASSOCIATEFAIL, INVALID_ASSOCIATION_MODE );
+    }
+
+  SET_FLAG( the_assoc, IO_ISASSOCIATED );
+  return the_assoc;
+}
+
+/*
+ *  DISSOCIATE
+ */
+void
+__dissociate( Association_Mode* the_assoc, char* file, int line )
+{
+  if( !the_assoc )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ASSOCIATION );
+
+  if( !TEST_FLAG( the_assoc, IO_ISASSOCIATED ) )
+    CHILLEXCEPTION( file, line, NOTASSOCIATED, IS_NOT_ASSOCIATED );
+
+  if( the_assoc->access )
+    __disconnect( the_assoc->access, file, line );
+
+  the_assoc->access = NULL;
+  CLR_FLAG( the_assoc, IO_ISASSOCIATED );
+
+  /* free allocated memory */
+  if (the_assoc->pathname)
+    {
+      free (the_assoc->pathname);
+      the_assoc->pathname = 0;
+    }
+  if (the_assoc->bufptr)
+    {
+      free (the_assoc->bufptr);
+      the_assoc->bufptr = 0;
+    }
+}
+
+/*
+ * CREATE
+ */
+void __create( Association_Mode* the_assoc, char* file, int line )
+{
+  if( !the_assoc )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ASSOCIATION );
+
+  if( !TEST_FLAG( the_assoc, IO_ISASSOCIATED ) )
+    CHILLEXCEPTION( file, line, NOTASSOCIATED, IS_NOT_ASSOCIATED );
+
+  if( TEST_FLAG( the_assoc, IO_EXISTING ) )
+    CHILLEXCEPTION( file, line, CREATEFAIL, FILE_EXISTING );
+
+  if( (the_assoc->handle = open( the_assoc->pathname, O_CREAT+O_TRUNC+O_WRONLY, 0666 ))
+      == -1 )
+      CHILLEXCEPTION( file, line, CREATEFAIL, CREATE_FAILS );
+
+  the_assoc->usage = ReadWrite;
+  GetSetAttributes( the_assoc );
+
+  close( the_assoc->handle );
+}
+
+/*
+ * MODIFY
+ */
+void
+__modify( Association_Mode* the_assoc,
+	  char*             the_path,
+	  int               the_path_len,
+	  char*             the_mode,
+	  int               the_mode_len,
+	  char*             file,
+	  int               line )
+{
+  if( !the_assoc )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ASSOCIATION );
+
+  if( !TEST_FLAG( the_assoc, IO_ISASSOCIATED ) )
+    CHILLEXCEPTION( file, line, NOTASSOCIATED, IS_NOT_ASSOCIATED );
+
+  if( the_path_len )
+    {
+      char* oldname;
+
+      if( ! (oldname = (char*)malloc( PATH_MAX )) )
+	CHILLEXCEPTION( file, line, SPACEFAIL, PATHNAME_ALLOC );
+      strcpy( oldname, the_assoc->pathname );
+
+      makeName( the_assoc, the_path, the_path_len, file, line );
+
+      if( rename( oldname, the_assoc->pathname ) )
+	{
+	  free( oldname );
+	  CHILLEXCEPTION( file, line, MODIFYFAIL, RENAME_FAILS );
+	}
+      free( oldname );
+    }
+  else
+    {
+      /* FIXME: other options? */
+    }
+}
+
+static
+/*** char* DirMode[] = { "rb", "r+b", "r+b" }; ***/
+int DirMode[] = { O_RDONLY, O_RDWR, O_RDWR };
+
+static
+/*** char* SeqMode [] = { "rb", "r+b", "r+b" }; ***/
+int SeqMode[] = { O_RDONLY, O_RDWR, O_RDWR };
+
+/*
+ * CONNECT
+ */
+void
+__connect( void*             the_transfer,
+	   Association_Mode* the_assoc,
+	   Usage_Mode        the_usage,
+	   Where_Mode        the_where,
+	   Boolean           with_index,
+	   signed long       the_index,
+	   char*             file,
+	   int               line )
+{
+  Access_Mode*  the_access;
+  off_t         filepos;
+  off_t         savepos;
+  char          dummy;
+  unsigned long nbytes;
+  int           oflag;
+
+  if( !the_transfer )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ACCESS );
+  if( !the_assoc )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ASSOCIATION );
+
+  if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ))
+    {
+      if( ! ((Text_Mode*)the_transfer)->access_sub )
+	CHILLEXCEPTION( file, line, EMPTY, NO_ACCESS_SUBLOCATION );
+      the_access = ((Text_Mode*)the_transfer)->access_sub;
+      SET_FLAG( the_access, IO_TEXTIO );
+    }
+  else
+    {
+      the_access = (Access_Mode*)the_transfer;
+      CLR_FLAG( the_access, IO_TEXTIO );
+    }
+
+  /* FIXME: This should be an (implementation-dependent) static check
+     if( with_index && the_access->rectype > Fixed )
+     CHILLEXCEPTION( file, line, CONNECTFAIL, IMPL_RESTRICTION );
+     */
+
+  if( ! TEST_FLAG(the_assoc, IO_ISASSOCIATED) )
+    CHILLEXCEPTION( file, line, NOTASSOCIATED, IS_NOT_ASSOCIATED );
+
+  if( ! TEST_FLAG( the_assoc, IO_EXISTING ) )
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_EXISTING );
+
+  if( ! TEST_FLAG( the_assoc, IO_READABLE ) &&
+      ( the_usage = ReadOnly || the_usage == ReadWrite ) )    
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_READABLE );
+
+  if( ! TEST_FLAG( the_assoc, IO_WRITEABLE ) &&
+      ( the_usage = WriteOnly || the_usage == ReadWrite ) )    
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_WRITEABLE );
+
+  if( ! TEST_FLAG( the_assoc, IO_INDEXABLE ) 
+      && TEST_FLAG( the_access, IO_INDEXED ) )
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_INDEXABLE );
+
+  if( ! TEST_FLAG( the_assoc, IO_SEQUENCIBLE ) 
+      && ! TEST_FLAG( the_access, IO_INDEXED ) )
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_SEQUENCIBLE );
+
+  if( the_where == Same && the_assoc->access == NULL )
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NO_CURRENT_POS );
+
+  /* This dynamic condition is not checked for text connections. */
+  if( ! TEST_FLAG( the_access, IO_TEXTIO ) )
+    if( ! TEST_FLAG( the_assoc, IO_VARIABLE ) 
+	&& the_access->rectype > Fixed 
+	&& ( the_usage == WriteOnly || the_usage == ReadWrite ) )
+      CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_VARIABLE );
+ 
+  if( TEST_FLAG( the_assoc, IO_VARIABLE )
+      && the_access->rectype == Fixed 
+      && ( the_usage == ReadOnly || the_usage == ReadWrite ) )
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_FIXED );
+ 
+  if( ! TEST_FLAG( the_access, IO_INDEXED ) && the_usage == ReadWrite )
+    CHILLEXCEPTION( file, line, CONNECTFAIL, NOT_INDEXED );
+
+  /* Access location may be connected to a different association. */
+  if( the_access->association && the_access->association != the_assoc )
+    __disconnect( the_access, file, line );
+
+  /* Is the association location already connected? */
+  if( the_assoc->access )
+    {
+      /* save position just in case we need it for the_where == Same */
+      if( (savepos = lseek( the_assoc->handle, 0L, SEEK_CUR )) == -1L )
+	CHILLEXCEPTION( file, line, CONNECTFAIL, LSEEK_FAILS );
+
+      /* text: read correction, flush buffer */
+      if( the_assoc->bufptr ){
+	savepos -= the_assoc->bufptr->len - the_assoc->bufptr->cur;
+	the_assoc->bufptr->len = the_assoc->bufptr->cur = 0;
+      }
+
+      /* implicit disconnect */
+      __disconnect( the_assoc->access, file, line );
+    }
+
+  the_assoc->usage = the_usage;
+  CLR_FLAG( the_access, IO_OUTOFFILE );
+ 
+  if( TEST_FLAG( the_access, IO_INDEXED ) )
+    {
+      if( (the_assoc->handle = open( the_assoc->pathname, DirMode[the_usage] )) == -1 )
+	CHILLEXCEPTION( file, line, CONNECTFAIL, OPEN_FAILS );
+
+      /* Set base index. */
+      switch( the_where )
+	{
+	case First: 
+	  filepos = 0;
+	  break;
+	case Same: 
+	  filepos = savepos;
+	  break;
+	case Last: 
+	  if( lseek( the_assoc->handle, 0L, SEEK_END ) == -1L )
+	    CHILLEXCEPTION( file, line, CONNECTFAIL, LSEEK_FAILS );
+	  filepos = lseek( the_assoc->handle, 0L, SEEK_CUR );
+	  break;
+	}
+
+      /* Set current index */
+      if( with_index )
+	{
+	  if( the_index < the_access->lowindex
+	      || the_access->highindex < the_index )
+	    CHILLEXCEPTION( file, line, RANGEFAIL, BAD_INDEX );
+	  filepos += (the_index - the_access->lowindex) * the_access->reclength;
+	}
+      if( lseek( the_assoc->handle, filepos, SEEK_SET ) == -1L )
+	CHILLEXCEPTION( file, line, CONNECTFAIL, LSEEK_FAILS );
+      the_access->base = filepos;
+    }
+  else
+    {
+      /* for association to text for reading: allocate buffer */
+      if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ) &&
+	  the_usage == ReadOnly &&
+	  !the_assoc->bufptr )
+	{
+	  if( ! (the_assoc->bufptr = (readbuf_t*)malloc( sizeof(readbuf_t) )) )
+	    CHILLEXCEPTION( file, line, CONNECTFAIL, BUFFER_ALLOC ); 
+	  memset (the_assoc->bufptr, 0, sizeof (readbuf_t));
+	}
+      if( (the_assoc->handle = open( the_assoc->pathname, SeqMode[the_usage] )) == -1 )
+	CHILLEXCEPTION( file, line, CONNECTFAIL, OPEN_FAILS );
+
+      /* Set base index. */
+      switch( the_where )
+	{
+	case First: 
+	  filepos = 0;
+	  break;
+	case Same: 
+	  filepos = savepos;
+	  break;
+	case Last:
+	  if( lseek( the_assoc->handle, 0L, SEEK_END ) == -1L )
+	    CHILLEXCEPTION( file, line, CONNECTFAIL, LSEEK_FAILS );
+	  filepos = lseek( the_assoc->handle, 0L, SEEK_CUR );
+	  break;
+	}
+
+      /* file truncation for sequential, Write Only */
+      /***************************** FIXME: cannot truncate at Same
+	if( the_usage == WriteOnly )
+	{
+	if( fseek( the_assoc->file_ptr, filepos, SEEK_SET ) == -1L )
+        CHILLEXCEPTION( file, line, CONNECTFAIL, FSEEK_FAILS );
+	fclose( the_assoc->file_ptr );
+	if( !(the_assoc->file_ptr = fopen( the_assoc->pathname, "ab" )) )
+        CHILLEXCEPTION( file, line, CONNECTFAIL, OPEN_FAILS );
+	}
+	else
+	***************************/
+      if( (filepos = lseek( the_assoc->handle, filepos, SEEK_SET )) == -1L )
+	CHILLEXCEPTION( file, line, CONNECTFAIL, LSEEK_FAILS );
+    }
+
+  the_access->association = the_assoc;
+  the_assoc->access = the_access;
+  /* for text: set carriage control default */
+  if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ) ){
+    the_assoc->ctl_pre  = '\0';
+    the_assoc->ctl_post = '\n';
+  }
+}
+
+void
+__disconnect( void* the_transfer, char* file, int line )
+{
+  Access_Mode* the_access;
+
+  if( !the_transfer )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ACCESS );
+
+  if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ))
+    {
+      the_access = ((Text_Mode*)the_transfer)->access_sub;
+      CLR_FLAG( the_access, IO_TEXTIO );
+    }
+  else
+    the_access = (Access_Mode*)the_transfer;
+
+  if( !the_access->association )
+    CHILLEXCEPTION( file, line, NOTCONNECTED, IS_NOT_CONNECTED );
+
+  close( the_access->association->handle );
+  /* FIXME: check result */
+
+  if( the_access->store_loc )
+    free( the_access->store_loc );
+  the_access->store_loc           = NULL;
+  the_access->association->access = NULL;
+  the_access->association         = NULL;
+}

gcc/ch/runtime/bitstring.h

@@ -0,0 +1,29 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#ifndef _bitstring_h_
+#define _bitstring_h_
+
+int __inpowerset( int i, char* string, int strlen, int dummy );
+void __setbitpowerset (char *powerset, unsigned long bitlength,
+		       long minval, long bitno, char newval,
+		       char *filename, int lineno);
+		       
+#endif

gcc/ch/runtime/cause.c

@@ -0,0 +1,48 @@
+/* Implement runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+
+/*
+ * function cause_exception
+ *
+ * parameters:
+ *  exname		exception name
+ *  file		file name
+ *  lineno		line number
+ *   user_arg		user specified argument
+ *
+ * returns:
+ *  void
+ *
+ * abstract:
+ *  dummy for ChillLib but may be overwritten by the user
+ *
+ */
+void
+cause_exception (exname, file, lineno, user_arg)
+     char *exname;
+     char *file;
+     int lineno;
+     int user_arg;
+{
+}

gcc/ch/runtime/concatps.c

@@ -0,0 +1,93 @@
+/* Implement powerset-related runtime actions for CHILL.
+   Copyright (C) 1992, 93, 1994 Free Software Foundation, Inc.
+   Author: Bill Cox
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "powerset.h"
+
+extern void cause_exception (char *exname, char *file, int lineno);
+
+/*
+ * function __concatps
+ *
+ * parameters:
+ *     OUT      - pointer to output PS
+ *     LEFT     - pointer to left PS
+ *     LEFTLEN  - length of left PS in bits
+ *     RIGHT    - pointer to right PS
+ *     RIGHTLEN - length of right PS in bits
+ *
+ * returns:
+ *     void
+ *
+ * exceptions:
+ *     none
+ *
+ * abstract:
+ *     concatenates two powersets into the output powerset.
+ *
+ */
+
+extern void
+__pscpy (SET_WORD      *dps,
+	 unsigned long  dbl,
+	 unsigned long  doffset,
+	 SET_WORD      *sps,
+	 unsigned long  sbl,
+	 unsigned long  start,
+	 unsigned long  length);
+
+void
+__concatps (out, left, leftlen, right, rightlen)
+     SET_WORD      *out;
+     SET_WORD      *left;
+     unsigned long  leftlen;
+     SET_WORD      *right;
+     unsigned long  rightlen;
+{
+  /* allocated sizes for each set involved */
+  unsigned long outall, leftall, rightall;
+
+  if (!out)
+    {
+      /* FIXME: cause an exception */
+    }
+  else if (leftlen == 0 || !left)
+    {
+      if (rightlen == 0 || !right)
+	return;               /* no work to do */
+      __pscpy (out, rightlen, (unsigned long)0,
+	       right, rightlen, (unsigned long)0, rightlen);
+    }
+  else if (rightlen == 0 || !right)
+    {
+      if (leftlen == 0 || !left)
+	return;               /* no work to do */
+      __pscpy (out, leftlen, (unsigned long)0,
+	       left, leftlen, (unsigned long)0, leftlen);
+    }
+  /* copy the left powerset into bits 0..leftlen - 1 */
+  __pscpy (out, leftlen + rightlen, (unsigned long)0,
+	   left, leftlen, (unsigned long)0, leftlen);
+
+  /* copy the right powerset into bits leftlen..leftlen+rightlen-1 */
+  __pscpy (out, leftlen + rightlen, leftlen,
+	   right, rightlen, (unsigned long)0, rightlen);
+}

gcc/ch/runtime/copyps.c

@@ -0,0 +1,111 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __powerset_copy
+ *    This is more general than __psslice, since it
+ *    can be told where in the destination powerset (DOFFSET
+ *    parameter) to start storing the slice.
+ *
+ * parameters:
+ *      dps             dest powerset
+ *      dbl             destination bit length
+ *      doffset         offset bit number (zero origin)
+ *	sps		sourcepowerset
+ *	sbl     	source powerset length in bits
+ *      start           starting bit number
+ *      end             ending bit number
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  Extract into a powerset a slice of another powerset.
+ *
+ */
+void
+__pscpy (dps, dbl, doffset, sps, sbl, start, length)
+     SET_WORD      *dps;
+     unsigned long  dbl;
+     unsigned long  doffset;
+     const SET_WORD*sps;
+     unsigned long  sbl;
+     unsigned long  start;
+     unsigned long  length;
+{
+  unsigned long end = start + length - 1;
+  unsigned long src, dst;
+
+  /* assert end >= start;
+     assert end - start + 1 <= dbl;
+     assert "the sets don't overlap in memory" */
+
+  /* assert doffset >= 0 and < dbl */
+
+  for (src = start, dst = doffset; src <= end; src++, dst++)
+    {
+      char tmp;
+
+      if (sbl <= SET_CHAR_SIZE)                /* fetch a bit */
+	tmp = GET_BIT_IN_CHAR (*((SET_CHAR *)sps), src);
+      else if (sbl <= SET_SHORT_SIZE)
+	tmp = GET_BIT_IN_SHORT (*((SET_SHORT *)sps), src);
+      else
+	tmp = GET_BIT_IN_WORD (sps[src / SET_WORD_SIZE], src % SET_WORD_SIZE);
+
+      if (tmp & 1)
+	{
+	  if (dbl <= SET_CHAR_SIZE)            /* store a 1-bit */
+	    SET_BIT_IN_CHAR (*((SET_CHAR *)dps), dst);
+	  else if (dbl <= SET_SHORT_SIZE)
+	    SET_BIT_IN_SHORT (*((SET_SHORT *)dps), dst);
+	  else
+	    SET_BIT_IN_WORD (dps[dst / SET_WORD_SIZE], dst % SET_WORD_SIZE);
+	}
+      else
+	{
+	  if (dbl <= SET_CHAR_SIZE)            /* store a 0-bit */
+	    CLEAR_BIT_IN_CHAR (*((SET_CHAR *)dps), dst);
+	  else if (dbl <= SET_SHORT_SIZE)
+	    CLEAR_BIT_IN_SHORT (*((SET_SHORT *)dps), dst);
+	  else
+	    CLEAR_BIT_IN_WORD (dps[dst / SET_WORD_SIZE], dst % SET_WORD_SIZE);
+	}
+    }
+  if (dbl <= SET_CHAR_SIZE)         /* clear unused bits in output bitstring */
+    {
+      MASK_UNUSED_CHAR_BITS ((SET_CHAR *)dps, dbl);
+    }
+  else if (dbl <= SET_SHORT_SIZE)
+    {
+      MASK_UNUSED_SHORT_BITS ((SET_SHORT *)dps, dbl);
+    }
+  else
+    {
+      MASK_UNUSED_WORD_BITS ((SET_WORD *)(dps + (dbl/SET_WORD_SIZE)), 
+			     dbl % SET_WORD_SIZE);
+    }
+}

gcc/ch/runtime/eqps.c

@@ -0,0 +1,88 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __eqpowerset
+ *
+ * parameters:
+ *	left		left powerset
+ *	right		right powerset
+ *	bitlength	length of powerset in bits
+ *
+ * returns:
+ *    1 if powersets are equal, bit for bit
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  compares two powersets for equality
+ *
+ */
+int
+__eqpowerset (left, right, bitlength)
+     SET_WORD *left;
+     SET_WORD *right;
+     unsigned long bitlength;
+{
+#ifndef USE_CHARS
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      SET_CHAR c = *(SET_CHAR *)left ^ *(SET_CHAR *)right;
+      MASK_UNUSED_CHAR_BITS (&c, bitlength);
+      return (c == 0) ? 1 : 0;
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      SET_SHORT c = *(SET_SHORT *)left ^ *(SET_SHORT *)right;
+      MASK_UNUSED_SHORT_BITS (&c, bitlength);
+      return (c == 0) ? 1 : 0;
+    }
+  else if (bitlength <= SET_WORD_SIZE)
+    {
+      SET_WORD c = *(SET_WORD *)left ^ *(SET_WORD *)right;
+      MASK_UNUSED_WORD_BITS (&c, bitlength % SET_WORD_SIZE);
+      return (c == 0) ? 1 : 0;
+    }
+  else
+#endif
+    {
+      SET_WORD c;
+      register unsigned long i;
+      unsigned long len = bitlength / SET_WORD_SIZE;
+
+      for (i = 0; i < len; i++) /* a word-oriented memcmp */
+	if (left[i] != right[i])
+	  return 0;
+      /* do the last (possibly partial) word */
+      bitlength %= SET_WORD_SIZE;
+      if (bitlength == 0)
+	return 1;
+      c = left[i] ^ right[i];
+      MASK_UNUSED_WORD_BITS (&c, bitlength);
+      return (c == 0) ? 1 : 0;
+    }
+}

gcc/ch/runtime/fileio.h

@@ -0,0 +1,153 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#ifndef _fileio_h_
+#define _fileio_h_
+
+#include <stdio.h>
+
+#include "auxtypes.h"
+#include "ioerror.h"
+#include "iomodes.h"
+
+#define DIRSEP '/'
+
+#define TEST_FLAG(Xloc,Flag) (((Xloc)->flags) & (Flag))
+#define SET_FLAG(Xloc,Flag)  (Xloc)->flags |= (Flag)
+#define CLR_FLAG(Xloc,Flag)  (Xloc)->flags = ((Xloc)->flags & ~(Flag))
+
+Boolean
+__isassociated( Association_Mode* the_assoc, char* file, int line );
+
+Boolean
+__existing( Association_Mode* the_assoc, char* file, int line );
+
+Boolean
+__readable( Association_Mode* the_assoc, char* file, int line );
+
+Boolean
+__writeable( Association_Mode* the_assoc, char* file, int line );
+
+Boolean
+__indexable( Association_Mode* the_assoc, char* file, int line );
+
+Boolean
+__sequencible( Association_Mode* the_assoc, char* file, int line );
+
+Boolean
+__variable( Association_Mode* the_assoc, char* file, int line );
+
+typedef signed long int Index_t;
+
+Association_Mode*
+__associate( Association_Mode* the_assoc,
+             char*             the_path,
+             int               the_path_len,
+             char*             the_mode,
+             int               the_mode_len,
+             char*             file,
+             int               line );
+
+void
+__dissociate( Association_Mode* the_assoc, char* file, int line );
+
+void
+__create( Association_Mode* the_assoc, char* file, int line );
+
+void
+__delete( Association_Mode* the_assoc, char* file, int line );
+
+void
+__modify( Association_Mode* the_assoc,
+          char*             the_path,
+          int               the_path_len,
+          char*             the_mode,
+          int               the_mode_len,
+          char*             file,
+          int               line );
+
+void
+__connect( void*             the_transfer, 
+           Association_Mode* the_assoc,
+           Usage_Mode        the_usage,
+           Where_Mode        the_where,
+           Boolean           with_index,
+           signed long       the_index,
+           char*             file,
+           int               line );
+
+void
+__disconnect( void* the_transfer, char* file, int line );
+
+Association_Mode*
+__getassociation( void* the_transfer, char* file, int line );
+
+Usage_Mode
+__getusage( void* the_transfer, char* file, int line );
+
+Boolean
+__outoffile( void* the_transfer, char* file, int line );
+
+void*
+__readrecord( Access_Mode*  the_access,
+              signed long   the_index,
+              char*         the_buf_addr,
+              char*         file,
+              int           line );
+
+void
+__writerecord( Access_Mode*  the_access,
+               signed long   the_index,
+               char*         the_val_addr,
+               unsigned long the_val_len,
+               char*         file,
+               int           line );
+
+VarString*
+__gettextrecord( Text_Mode* the_text, char* file, int line );
+
+unsigned long
+__gettextindex( Text_Mode* the_text, char* file, int line );
+
+Access_Mode*
+__gettextaccess( Text_Mode* the_text, char* file, int line );
+
+Boolean
+__eoln( Text_Mode* the_text, char* file, int line );
+
+void
+__settextrecord( Text_Mode* the_text,
+                 VarString* the_text_rec,
+                 char*      file,
+                 int        line );
+
+void
+__settextindex( Text_Mode*  the_text,
+                signed long the_text_index, 
+                char*       file,
+                int         line );
+
+void
+__settextaccess( Text_Mode*   the_text,
+                 Access_Mode* the_access,
+                 char*        file,
+                 int          line );
+
+#endif

gcc/ch/runtime/flsetps.c

@@ -0,0 +1,107 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+extern void __cause_ex1 (char *exname, char *file, int lineno);
+
+/*
+ * function __flsetpowerset
+ *
+ * parameters:
+ *	ps		powerset
+ *	bitlength	length of powerset
+ *      minval          set low bound
+ *      filename        caller's file name
+ *      lineno          caller's line number
+ *
+ * returns:
+ *	int		largest enumeration value
+ * exceptions:
+ *      "empty"         if set is empty
+ *
+ * abstract:
+ *  Find last bit set in a powerset and return the corresponding value.
+ *
+ */
+long
+__flsetpowerset (ps, bitlength, minval, filename, lineno)
+     SET_WORD      *ps;
+     unsigned long  bitlength;
+     long           minval;
+     char          *filename;
+     int            lineno;
+{
+  unsigned long bitno;
+
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      SET_CHAR cset = *((SET_CHAR *)ps);
+      if (cset != 0)
+	{
+	  /* found a bit set .. calculate which */
+	  for (bitno = SET_CHAR_SIZE; bitno >= 1; bitno--)
+	    if (GET_BIT_IN_CHAR (cset, bitno - 1))
+	      break;
+	  /* return its index */
+	  return bitno + minval - 1;
+	}
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      SET_SHORT sset = *((SET_SHORT *)ps);
+      if (sset != 0)
+	{
+	  /* found a bit set .. calculate which */
+	  for (bitno = SET_SHORT_SIZE; bitno >= 1; bitno--)
+	    if (GET_BIT_IN_SHORT (sset, bitno - 1))
+	      break;
+	  /* return its index */
+	  return bitno + minval - 1;
+	}
+    }
+  else /* set composed of array of one or more WORDs */
+    {
+      SET_WORD	*endp = ps;
+      SET_WORD	*p = ps + BITS_TO_WORDS(bitlength) - 1;
+      unsigned long cnt;
+      
+      /* FIXME: bitorder problems? */
+      for (cnt = ((bitlength - 1) / SET_WORD_SIZE) * SET_WORD_SIZE;
+	   p >= endp; p--, cnt -= SET_WORD_SIZE)
+	{
+	  SET_WORD c = *p;
+	  if (c)
+	    {
+	      /* found a bit set .. calculate which */
+	      for (bitno = SET_WORD_SIZE; bitno >= 1; bitno--)
+		if (GET_BIT_IN_WORD (c, bitno - 1))
+		  break;
+	      return cnt + bitno + minval - 1;
+	    }
+	}
+    }
+  /* no bits found - raise exception */
+  __cause_ex1 ("empty", filename, lineno);
+}

gcc/ch/runtime/format.h

@@ -0,0 +1,71 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#ifndef _format_h_
+#define _format_h_
+
+#include "iomodes.h"
+#include "fileio.h"
+
+extern Text_Mode __stdin_text;
+extern Text_Mode __stdout_text;
+extern Text_Mode __stderr_text;
+
+void
+__readtext_f( Text_Mode*      TextLoc,
+              signed long     Index,
+              char*           fmtptr,
+              int             fmtlen,
+              __tmp_IO_list*  ioptr,
+              int             iolen,
+              char*           file,
+              int             line );
+
+void
+__readtext_s( void*           string_ptr,
+              int             string_len,
+              char*           fmtptr,
+              int             fmtlen,
+              __tmp_IO_list*  ioptr,
+              int             iolen,
+              char*           file,
+              int             line );
+
+void
+__writetext_f( Text_Mode*      Text_Loc,
+               signed long     Index,
+               char*           fmtptr,
+               int             fmtlen,
+               __tmp_IO_list*  ioptr,
+               int             iolen,
+               char*           file,
+               int             line );
+
+void
+__writetext_s( void*           string_ptr,
+               int             string_len,
+               char*           fmtptr,
+               int             fmtlen,
+               __tmp_IO_list*  ioptr,
+               int             iolen,
+               char*           file,
+               int             line );
+
+#endif _format_h_

gcc/ch/runtime/getassoc.c

@@ -0,0 +1,37 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include "fileio.h"
+
+Association_Mode*
+__getassociation( void* the_transfer, char* file, int line )
+{
+  Access_Mode* the_access;
+
+  if( !the_transfer )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ACCESS );
+
+  if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ))
+    the_access = ((Text_Mode*)the_transfer)->access_sub;
+  else
+    the_access = (Access_Mode*)the_transfer;
+
+  return the_access->association;
+}

gcc/ch/runtime/gettextaccess.c

@@ -0,0 +1,31 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include "fileio.h"
+
+Access_Mode*
+__gettextaccess( Text_Mode* the_text, char* file, int line )
+{
+  if( !the_text )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_TEXT );
+
+  return the_text->access_sub;
+}
+

gcc/ch/runtime/getusage.c

@@ -0,0 +1,40 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include "fileio.h"
+
+Usage_Mode
+__getusage( void* the_transfer, char* file, int line )
+{
+  Access_Mode* the_access;
+
+  if( !the_transfer )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ACCESS );
+
+  if( TEST_FLAG((Text_Mode*)the_transfer, IO_TEXTLOCATION ))
+    the_access = ((Text_Mode*)the_transfer)->access_sub;
+  else
+    the_access = (Access_Mode*)the_transfer;
+
+  if( !the_access->association )
+    CHILLEXCEPTION( file, line, NOTCONNECTED, IS_NOT_CONNECTED );
+  return the_access->association->usage;
+}
+

gcc/ch/runtime/inps.c

@@ -0,0 +1,65 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __inpowerset
+ *
+ * parameters:
+ *	bitno		bit number within set
+ *	powerset	the powerset
+ *	bitlength	length of powerset in bits
+ *      minval          number of lowest bit stored
+ *
+ * returns:
+ *	int		1 .. found
+ *			0 .. not found
+ *
+ * exceptions:
+ *  rangefail
+ *
+ * abstract:
+ *  checks if a given value is included in a powerset
+ *
+ */
+int
+__inpowerset (bitno, powerset, bitlength, minval)
+     unsigned long  bitno;
+     SET_WORD      *powerset;
+     unsigned long  bitlength;
+     long           minval;
+{
+  if (bitno < minval || (bitno - minval) >= bitlength)
+    return 0;
+    
+  bitno -= minval;
+  if (bitlength <= SET_CHAR_SIZE)
+    return GET_BIT_IN_CHAR (*((SET_CHAR *)powerset), bitno);
+  else if (bitlength <= SET_SHORT_SIZE)
+    return GET_BIT_IN_SHORT (*((SET_SHORT *)powerset), bitno);
+  else
+    return GET_BIT_IN_WORD (powerset[bitno / SET_WORD_SIZE],
+			    bitno % SET_WORD_SIZE);
+}

gcc/ch/runtime/ioerror.c

@@ -0,0 +1,45 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include <setjmp.h>
+
+/* define names of IO-exceptions */
+
+char * __IO_exception_names[] =
+{
+  "UNUSED",
+  "notassociated",
+  "associatefail",
+  "createfail",
+  "deletefail",
+  "modifyfail",
+  "connectfail",
+  "notconnected",
+  "empty",
+  "rangefail",
+  "spacefail",
+  "readfail",
+  "writefail",
+  "textfail",
+};
+
+jmp_buf __io_exception;
+
+jmp_buf __rw_exception;

gcc/ch/runtime/ioerror.h

@@ -0,0 +1,161 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#ifndef _ioerror_h_
+#define _ioerror_h_
+
+#include <setjmp.h>
+
+/* Note: numbers must be in the same order as
+   strings in ioerror.c */
+typedef enum 
+{ NOTASSOCIATED = 1,
+  ASSOCIATEFAIL,
+  CREATEFAIL, 
+  DELETEFAIL,
+  MODIFYFAIL,
+  CONNECTFAIL,
+  NOTCONNECTED,
+  EMPTY,
+  RANGEFAIL,
+  SPACEFAIL,
+  READFAIL,
+  WRITEFAIL,
+  TEXTFAIL
+} io_exceptions_t;
+
+#ifndef FIRST_IO_ERROR_NUMBER
+#define FIRST_IO_ERROR_NUMBER 0
+#endif
+
+typedef enum {
+  FIRST_AND_UNUSED = FIRST_IO_ERROR_NUMBER,
+  INTERNAL_ERROR,
+  INVALID_IO_LIST,
+  REPFAC_OVERFLOW,
+  CLAUSE_WIDTH_OVERFLOW,
+  UNMATCHED_CLOSING_PAREN,
+  UNMATCHED_OPENING_PAREN,
+  BAD_FORMAT_SPEC_CHAR,
+  NO_PAD_CHAR,
+  IO_CONTROL_NOT_VALID,
+  DUPLICATE_QUALIFIER,
+  NO_FRACTION_WIDTH,
+  NO_EXPONENT_WIDTH,
+  FRACTION_WIDTH_OVERFLOW,
+  EXPONENT_WIDTH_OVERFLOW,
+  NO_FRACTION,
+  NO_EXPONENT,
+  NEGATIVE_FIELD_WIDTH,
+  TEXT_LOC_OVERFLOW,
+  IOLIST_EXHAUSTED,
+  CONVCODE_MODE_MISFIT,
+  SET_CONVERSION_ERROR,
+  BOOL_CONVERSION_ERROR,
+  NON_INT_FIELD_WIDTH,
+  EXCESS_IOLIST_ELEMENTS,
+  NOT_ENOUGH_CHARS,
+  NO_CHARS_FOR_INT,
+  NO_CHARS_FOR_FLOAT,
+  NO_EXPONENT_VAL,
+  INT_VAL_OVERFLOW,
+  REAL_OVERFLOW,
+  NO_DIGITS_FOR_INT,
+  NO_DIGITS_FOR_FLOAT,
+  NO_CHARS_FOR_SET,
+  NO_CHARS_FOR_CHAR,
+  NO_CHARS_FOR_BOOLS,
+  NO_CHARS_FOR_CHARS,
+  NO_CHARS_FOR_TEXT,
+  NO_CHARS_FOR_EDIT,
+  NO_SPACE_TO_SKIP,
+  FORMAT_TEXT_MISMATCH,
+  INTEGER_RANGE_ERROR,
+  SET_RANGE_ERROR,
+  CHAR_RANGE_ERROR,
+  INVALID_CHAR,
+/* end of formatting errors */
+  NULL_ASSOCIATION,
+  NULL_ACCESS,
+  NULL_TEXT,
+  IS_NOT_ASSOCIATED,
+  IS_ASSOCIATED,
+  GETCWD_FAILS,
+  INVALID_ASSOCIATION_MODE,
+  FILE_EXISTING,
+  CREATE_FAILS,
+  DELETE_FAILS,
+  RENAME_FAILS,
+  IMPL_RESTRICTION,
+  NOT_EXISTING,
+  NOT_READABLE,
+  NOT_WRITEABLE,
+  NOT_INDEXABLE,
+  NOT_SEQUENCIBLE,
+  NO_CURRENT_POS,
+  NOT_VARIABLE,
+  NOT_FIXED,
+  NOT_INDEXED, 
+  LENGTH_CHANGE,
+  LSEEK_FAILS,
+  BUFFER_ALLOC,
+  OPEN_FAILS,
+  NO_ACCESS_SUBLOCATION, 
+  BAD_INDEX,
+  IS_NOT_CONNECTED,
+  NO_PATH_NAME,
+  PATHNAME_ALLOC,
+  BAD_USAGE,
+  OUT_OF_FILE,
+  NULL_STORE_LOC,
+  STORE_LOC_ALLOC,
+  OS_IO_ERROR,
+  RECORD_TOO_LONG,
+  RECORD_TOO_SHORT,
+  BAD_TEXTINDEX,
+  NULL_TEXTREC
+} io_info_word_t;
+
+
+extern
+char* io_info_text [];
+
+extern
+char* exc_text [];
+ 
+extern 
+jmp_buf __io_exception;
+
+extern 
+jmp_buf __rw_exception;
+
+void __cause_exception (char *ex, char* f, int line, int info);
+extern char * __IO_exception_names[];
+
+#define IOEXCEPTION(EXC,INFO) \
+    longjmp( __io_exception, (EXC<<16) + INFO )
+
+#define RWEXCEPTION(EXC,INFO) \
+    longjmp( __rw_exception, (EXC<<16) + INFO )
+
+#define CHILLEXCEPTION(FILE,LINE,EXC,INFO) \
+    __cause_exception (__IO_exception_names[EXC], FILE, LINE, INFO);
+
+#endif

gcc/ch/runtime/iomodes.h

@@ -0,0 +1,251 @@
+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#ifndef _iomodes_h_
+#define _iomodes_h_
+
+#include "auxtypes.h"
+
+typedef enum { ReadOnly, WriteOnly, ReadWrite
+} Usage_Mode;
+
+typedef enum { First, Same, Last
+} Where_Mode;
+
+typedef enum { None, Fixed, VaryingChars
+} Record_t;
+
+/* association flags */
+#define IO_ISASSOCIATED 0x00000001
+#define IO_EXISTING     0x00000002
+#define IO_READABLE     0x00000004
+#define IO_WRITEABLE    0x00000008
+#define IO_INDEXABLE    0x00000010
+#define IO_SEQUENCIBLE  0x00000020
+#define IO_VARIABLE     0x00000040
+#define IO_FIRSTLINE    0x00000100
+#define IO_FORCE_PAGE   0x00000200
+
+struct Access_Mode;
+
+#define READBUFLEN 512
+typedef struct
+{
+  unsigned long len;
+  unsigned long cur;
+  char buf[READBUFLEN];
+} readbuf_t;
+
+typedef struct Association_Mode {
+  unsigned long       flags;      /* INIT = 0 */
+  char*               pathname;
+  struct Access_Mode* access;
+  int                 handle;
+  readbuf_t*          bufptr;
+  long                syserrno;
+  char                usage;
+  char                ctl_pre;
+  char                ctl_post;
+} Association_Mode;
+
+/*
+   rectype   indexed   max. reclength    act. reclength
+   ---------------------------------------------------
+   None        T/F        0
+   Fixed       T/F     SIZE(recmode)  =  SIZE(recmode)
+   Varying       F     SIZE(recmode) >=  length
+*/
+
+/* access/text flags */
+#define IO_TEXTLOCATION 0x80000000
+#define IO_INDEXED      0x00000001
+#define IO_TEXTIO       0x00000002
+#define IO_OUTOFFILE    0x00010000
+
+typedef struct Access_Mode {
+  unsigned long     flags;     /* INIT */   
+  unsigned long     reclength; /* INIT */
+  signed long       lowindex;  /* INIT */
+  signed long       highindex; /* INIT */
+  Association_Mode* association;
+  unsigned long     base;
+  char*             store_loc;
+  Record_t          rectype;   /* INIT */
+} Access_Mode;
+
+typedef struct Text_Mode {
+  unsigned long flags;         /* INIT */
+  VarString*    text_record;   /* INIT */
+  Access_Mode*  access_sub;    /* INIT */
+  unsigned long actual_index;
+} Text_Mode;
+
+typedef enum
+{
+    __IO_UNUSED,
+
+    __IO_ByteVal,
+    __IO_UByteVal,
+    __IO_IntVal,
+    __IO_UIntVal,
+    __IO_LongVal,
+    __IO_ULongVal,
+
+    __IO_ByteLoc,
+    __IO_UByteLoc,
+    __IO_IntLoc,
+    __IO_UIntLoc,
+    __IO_LongLoc,
+    __IO_ULongLoc,
+
+    __IO_ByteRangeLoc,
+    __IO_UByteRangeLoc,
+    __IO_IntRangeLoc,
+    __IO_UIntRangeLoc,
+    __IO_LongRangeLoc,
+    __IO_ULongRangeLoc,
+
+    __IO_BoolVal,
+    __IO_BoolLoc,
+    __IO_BoolRangeLoc,
+
+    __IO_SetVal,
+    __IO_SetLoc,
+    __IO_SetRangeLoc,
+
+    __IO_CharVal,
+    __IO_CharLoc,
+    __IO_CharRangeLoc,
+
+    __IO_CharStrLoc,
+
+    __IO_CharVaryingLoc,
+
+    __IO_BitStrLoc,
+
+    __IO_RealVal,
+    __IO_RealLoc,
+    __IO_LongRealVal,
+    __IO_LongRealLoc
+} __tmp_IO_enum;
+
+typedef struct
+{
+    long        value;
+    char*       name;
+} __tmp_IO_enum_table_type;
+
+typedef struct
+{
+    long                      value;
+    __tmp_IO_enum_table_type* name_table;
+} __tmp_WIO_set;
+
+typedef struct
+{
+    char*       ptr;
+    long        lower;
+    long        upper;
+} __tmp_IO_charrange;
+
+typedef union
+{
+      signed long  slong;
+    unsigned long  ulong;
+}  __tmp_IO_long;
+
+typedef struct
+{
+    void*         ptr;
+    __tmp_IO_long lower;
+    __tmp_IO_long upper;
+} __tmp_IO_intrange;
+
+typedef struct
+{
+    void*           ptr;
+    unsigned long   lower;
+    unsigned long   upper;
+} __tmp_RIO_boolrange;
+
+typedef struct
+{
+    void*                     ptr;
+    long                      length;
+    __tmp_IO_enum_table_type* name_table;
+} __tmp_RIO_set;
+
+typedef struct
+{
+    void*                      ptr;
+    long                       length;
+    __tmp_IO_enum_table_type*  name_table;
+    unsigned long              lower;
+    unsigned long              upper;
+} __tmp_RIO_setrange;
+
+typedef struct
+{
+    char*       string;
+    long        string_length;
+} __tmp_IO_charstring;
+
+typedef union
+{
+    char                     __valbyte;
+    unsigned char            __valubyte;
+    short                    __valint;
+    unsigned short           __valuint;
+    long                     __vallong;
+    unsigned long            __valulong;
+    void*                    __locint;
+    __tmp_IO_intrange        __locintrange;
+
+    unsigned char            __valbool;
+    unsigned char*           __locbool;
+    __tmp_RIO_boolrange      __locboolrange;
+
+    __tmp_WIO_set            __valset;
+    __tmp_RIO_set            __locset;
+    __tmp_RIO_setrange       __locsetrange;
+
+    unsigned char            __valchar;
+    unsigned char*           __locchar;
+    __tmp_IO_charrange       __loccharrange;
+
+    __tmp_IO_charstring      __loccharstring;
+
+    float                    __valreal;
+    float*                   __locreal;
+    double                   __vallongreal;
+    double*                  __loclongreal;
+} __tmp_IO_union;
+
+/*
+ * CAUTION: The longest variant of __tmp_IO_union is 5 words long.
+ * Together with __descr this caters for double alignment where required.
+ */
+typedef struct
+{
+    __tmp_IO_union    __t;
+    __tmp_IO_enum     __descr;
+} __tmp_IO_list;
+
+#endif

gcc/ch/runtime/ltps.c

@@ -0,0 +1,86 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __ltpowerset
+ *
+ * parameters:
+ *	left		powerset
+ *	right		powerset
+ *	bitlength	length of powerset
+ *
+ * returns:
+ *	int		1 .. left is proper subset of right
+ *                           (excludes case where left == right)
+ *			0 .. not
+ *
+ * abstract:
+ *  check if one powerset is included in another
+ *
+ */
+int
+__ltpowerset (left, right, bitlength)
+     SET_WORD      *left;
+     SET_WORD      *right;
+     unsigned long  bitlength;
+{
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      if ((*((SET_CHAR *)left) & *((SET_CHAR *)right))
+	  != *((SET_CHAR *)left))
+	return 0;
+      if (*((SET_CHAR *)left) != *((SET_CHAR *)right))
+	return 1;
+      return 0;
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      if ((*((SET_SHORT *)left) & *((SET_SHORT *)right))
+	  != *((SET_SHORT *)left))
+	return 0;
+      if (*((SET_SHORT *)left) != *((SET_SHORT *)right))
+	return 1;
+      return 0;
+    }
+  else
+    {
+      SET_WORD	*endp = left + BITS_TO_WORDS(bitlength);
+      int all_equal = 1;              /* assume all bits are equal */
+    
+      while (left < endp)
+	{
+	  if ((*right & *left) != *left)
+	    return 0;
+	  if (*left != *right)
+	    all_equal = 0;
+	  left++;
+	  right++;
+	}
+      if (left == endp && all_equal)    /* exclude TRUE return for == case */
+	return 0;
+      return 1;
+    }
+}

gcc/ch/runtime/ltstr.c

@@ -0,0 +1,55 @@
+/* Implement string-related runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Bill Cox
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define MIN(a, b)  ((a) < (b) ? (a) : (b))
+
+/*
+ * function __ltstring
+ *
+ * parameters:
+ *     S1 - pointer to left string
+ *     LEN1 - length of left string
+ *     S2 - pointer to right string
+ *     LEN2 - length of right string
+ *
+ * returns:
+ *     1 if left string is a proper subset of the right string, 0 otherwise
+ *
+ * exceptions:
+ *     none
+ *
+ * abstract:
+ *     compares two character strings for subset relationship
+ *
+ */
+
+int __ltstring (s1, len1, s2, len2)
+     char *s1;
+     int len1;
+     char *s2;
+     int len2;
+{
+  int i;
+
+  i = memcmp (s1, s2, MIN (len1, len2));
+  if (i)
+    return (i < 0);
+  return (len1 < len2);
+}

gcc/ch/runtime/rts.h

@@ -0,0 +1,52 @@
+/* GNU CHILL compiler regression test file
+ Copyright (C) 1992, 1993 Free Software Foundation, Inc.
+ 
+ This file is part of GNU CC.
+
+ GNU CC is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ GNU CC is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GNU CC; see the file COPYING.  If not, write to
+ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifndef __rts_h_
+#define __rts_h_
+
+typedef enum
+{
+  UNUSED,
+  Process,
+  Signal,
+  Buffer,
+  Event,
+  Synonym,
+  Exception,
+  LAST_AND_UNUSED,
+} TaskingEnum;
+
+typedef void (*EntryPoint) ();
+
+typedef struct
+{
+  char       *name;
+  short      *value;
+  int         value_defined;
+  EntryPoint  entry;
+  unsigned char /*TaskingEnum*/ type;
+} TaskingStruct;
+
+typedef struct
+{
+  short ptype;
+  short pcopy;
+} INSTANCE;
+
+#endif /* __rts_h_ */

gcc/ch/runtime/sliceps.c

@@ -0,0 +1,65 @@
+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __powerset_slice
+ *
+ * parameters:
+ *      dps             dest powerset
+ *      dbl             destination bit length
+ *	sps		sourcepowerset
+ *	sbl     	source powerset length in bits
+ *      start           starting bit number
+ *      end             ending bit number
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  Extract into a powerset a slice of another powerset.
+ *
+ */
+extern void
+__pscpy (SET_WORD      *dps,
+	 unsigned long  dbl,
+	 unsigned long  doffset,
+	 SET_WORD      *sps,
+	 unsigned long  sbl,
+	 unsigned long  start,
+	 unsigned long  length);
+
+void
+__psslice (dps, dbl, sps, sbl, start, length)
+     SET_WORD      *dps;
+     unsigned long  dbl;
+     SET_WORD      *sps;
+     unsigned long  sbl;
+     unsigned long  start;
+     unsigned long  length;
+{
+  /* simply supply a zero destination offset and copy the slice */
+  __pscpy (dps, dbl, (unsigned long)0, sps, sbl, start, length);
+}

gcc/ch/runtime/unhex.c

@@ -0,0 +1,57 @@
+/* Implement runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include <stdlib.h>
+#include <setjmp.h>
+
+/*
+ * function unhandled_exception
+ *
+ * parameter:
+ *  exname		name of exception
+ *  file		filename
+ *  lineno		line number
+ *  user_arg		user specified argument
+ *
+ * returns:
+ *  never
+ *
+ * abstract:
+ *  print an error message about unhandled exception and call abort
+ *
+ */
+
+void
+unhandled_exception (exname, file, lineno, user_arg)
+     char *exname;
+     char *file;
+     int lineno;
+     int user_arg;
+{
+  sleep (1); /* give previous output a chance to finish */
+  fprintf (stderr, "ChillLib: unhandled exception `%s' in file %s at line %d\n",
+	   exname, file, lineno);
+  fflush (stderr);
+  abort ();
+} /* unhandled_exception */

gcc/ch/runtime/unhex1.c

@@ -0,0 +1,58 @@
+/* Implement runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include <stdlib.h>
+#include <setjmp.h>
+
+extern void cause_exception (char *ex, char *file, int lineno, int arg);
+extern void unhandled_exception (char *ex, char *file, int lineno, int arg);
+
+/*
+ * function __unhandled_ex
+ *
+ * parameter:
+ *  exname		name of exception
+ *  file		filename
+ *  lineno		line number
+ *
+ * returns:
+ *  never
+ *
+ * abstract:
+ *  This function gets called by compiler generated code when an unhandled
+ *  exception occures.
+ *  First cause_exception gets called (which may be user defined) and
+ *  then the standard unhandled exception routine gets called.
+ *
+ */
+
+void
+__unhandled_ex (exname, file, lineno)
+     char *exname;
+     char *file;
+     int lineno;
+{
+    cause_exception (exname, file, lineno, 0);
+    unhandled_exception (exname, file, lineno, 0);
+} /* unhandled_exception */

gcc/ch/satisfy.c

@@ -0,0 +1,628 @@
+/* Name-satisfaction for GNU Chill compiler.
+   Copyright (C) 1993 Free Software Foundation, Inc.
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include <stdio.h>
+#include "config.h"
+#include "tree.h"
+#include "flags.h"
+#include "ch-tree.h"
+#include "lex.h"
+
+#define SATISFY(ARG) ((ARG) = satisfy(ARG, chain))
+
+extern void error           PROTO((char *, ...));
+extern void error_with_decl PROTO((tree, char *, ...));
+extern void expand_decl     PROTO((tree));
+extern void layout_enum     PROTO((tree));
+
+struct decl_chain
+{
+  struct decl_chain *prev;
+  /* DECL can be a decl, or a POINTER_TYPE or a REFERENCE_TYPE. */
+  tree decl;
+};
+
+/* forward declaration */
+tree satisfy PROTO((tree, struct decl_chain *));
+
+static struct decl_chain dummy_chain;
+#define LOOKUP_ONLY (chain==&dummy_chain)
+
+/* Recursive helper routine to logically reverse the chain. */
+static void
+cycle_error_print (chain, decl)
+     struct decl_chain *chain;
+     tree decl;
+{
+  if (chain->decl != decl)
+    {
+      cycle_error_print (chain->prev, decl);
+      if (TREE_CODE_CLASS (TREE_CODE (chain->decl)) == 'd')
+	error_with_decl (chain->decl, "  `%s', which depends on ...");
+    }
+}
+
+tree
+safe_satisfy_decl (decl, prev_chain)
+     tree decl;
+     struct decl_chain *prev_chain;
+{
+  struct decl_chain new_link;
+  struct decl_chain *link;
+  struct decl_chain *chain = prev_chain;
+  char *save_filename = input_filename;
+  int save_lineno = lineno;
+  tree result = decl;
+  
+  if (decl == NULL_TREE)
+    return decl;
+
+  if (!LOOKUP_ONLY)
+    {
+      int pointer_type_breaks_cycle = 0;
+      /* Look for a cycle.
+	 We could do this test more efficiently by setting a flag.  FIXME */
+      for (link = prev_chain; link != NULL; link = link->prev)
+	{
+	  if (TREE_CODE_CLASS (TREE_CODE (link->decl)) != 'd')
+	    pointer_type_breaks_cycle = 1;
+	  if (link->decl == decl)
+	    {
+	      if (!pointer_type_breaks_cycle)
+		{
+		  error_with_decl (decl, "Cycle: `%s' depends on ...");
+		  cycle_error_print (prev_chain, decl);
+		  error_with_decl (decl, "  `%s'");
+		  return error_mark_node;
+		}
+	      /* There is a cycle, but it includes a pointer type,
+		 so we're OK.  However, we still have to continue
+		 the satisfy (for example in case this is a TYPE_DECL
+		 that points to a LANG_DECL).  The cycle-check for
+		 POINTER_TYPE/REFERENCE_TYPE should stop the recursion. */
+	      break;
+	    }
+	}
+
+      new_link.decl = decl;
+      new_link.prev = prev_chain;
+      chain = &new_link;
+    }
+
+  input_filename = DECL_SOURCE_FILE (decl);
+  lineno = DECL_SOURCE_LINE (decl);
+
+  switch ((enum chill_tree_code)TREE_CODE (decl))
+    {
+    case ALIAS_DECL:
+      if (!LOOKUP_ONLY && !DECL_POSTFIX_ALL(decl))
+	result = safe_satisfy_decl (DECL_ABSTRACT_ORIGIN (decl), chain);
+      break;
+    case BASED_DECL:
+      SATISFY (TREE_TYPE (decl));
+      SATISFY (DECL_ABSTRACT_ORIGIN (decl));
+      break;
+    case CONST_DECL:
+      SATISFY (TREE_TYPE (decl));
+      SATISFY (DECL_INITIAL (decl));
+      if (!LOOKUP_ONLY)
+	{
+	  if (DECL_SIZE (decl) == 0)
+	    {
+	      tree init_expr = DECL_INITIAL (decl);
+	      tree init_type;
+	      tree specified_mode = TREE_TYPE (decl);
+
+	      if (init_expr == NULL_TREE
+		  || TREE_CODE (init_expr) == ERROR_MARK)
+		goto bad_const;
+	      init_type = TREE_TYPE (init_expr);
+	      if (specified_mode == NULL_TREE)
+		{
+		  if (init_type == NULL_TREE)
+		    {
+		      check_have_mode (init_expr, "SYN without mode");
+		      goto bad_const;
+		    }
+		  TREE_TYPE (decl) = init_type;
+		  CH_DERIVED_FLAG (decl) = CH_DERIVED_FLAG (init_expr);
+		}
+	      else if (CH_IS_ASSOCIATION_MODE (specified_mode) ||
+		       CH_IS_ACCESS_MODE (specified_mode) || CH_IS_TEXT_MODE (specified_mode) ||
+		       CH_IS_BUFFER_MODE (specified_mode) || CH_IS_EVENT_MODE (specified_mode))
+		{
+		  error ("SYN of this mode not allowed");
+		  goto bad_const;
+		}
+	      else if (!CH_COMPATIBLE (init_expr, specified_mode))
+		{
+		  error ("mode of SYN incompatible with value");
+		  goto bad_const;
+		} 
+	      else if (discrete_type_p (specified_mode)
+		       && TREE_CODE (init_expr) == INTEGER_CST
+		       && (compare_int_csts (LT_EXPR, init_expr,
+					     TYPE_MIN_VALUE (specified_mode))
+			   || compare_int_csts (GT_EXPR, init_expr,
+						TYPE_MAX_VALUE(specified_mode))
+			   ))
+		{
+		  error ("SYN value outside range of its mode");
+		  /* set an always-valid initial value to prevent 
+		     other errors. */
+		  DECL_INITIAL (decl) = TYPE_MIN_VALUE (specified_mode);
+		}
+	      else if (CH_STRING_TYPE_P (specified_mode) 
+		       && (init_type && CH_STRING_TYPE_P (init_type))
+		       && integer_zerop (string_assignment_condition (specified_mode, init_expr)))
+		{
+		  error ("INIT string too large for mode");
+		  DECL_INITIAL (decl) = error_mark_node;
+		}
+	      else
+		{
+		  struct ch_class class;
+		  class.mode = TREE_TYPE (decl);
+		  class.kind = CH_VALUE_CLASS;
+		  DECL_INITIAL (decl)
+		    = convert_to_class (class, DECL_INITIAL (decl));
+		}
+	      /* DECL_SIZE is set to prevent re-doing this stuff. */
+	      DECL_SIZE (decl) = TYPE_SIZE (TREE_TYPE (decl));
+	      if (! TREE_CONSTANT (DECL_INITIAL (decl))
+		  && TREE_CODE (DECL_INITIAL (decl)) != ERROR_MARK)
+		{
+		  error_with_decl (decl,
+				   "value of %s is not a valid constant");
+		  DECL_INITIAL (decl) = error_mark_node;
+		}
+	    }
+	  result = DECL_INITIAL (decl);
+	}
+      break;
+    bad_const:
+      DECL_INITIAL (decl) = error_mark_node;
+      TREE_TYPE (decl) = error_mark_node;
+      return error_mark_node;
+    case FUNCTION_DECL:
+      SATISFY (TREE_TYPE (decl));
+      if (CH_DECL_PROCESS (decl))
+	safe_satisfy_decl (DECL_TASKING_CODE_DECL (decl), 
+			   prev_chain);
+      break;
+    case PARM_DECL:
+      SATISFY (TREE_TYPE (decl));
+      break;
+    /* RESULT_DECL doesn't need to be satisfied;  
+       it's only built internally in pass 2 */
+    case TYPE_DECL:
+      SATISFY (TREE_TYPE (decl));
+      if (CH_DECL_SIGNAL (decl))
+	safe_satisfy_decl (DECL_TASKING_CODE_DECL (decl), 
+			   prev_chain);
+      if (!LOOKUP_ONLY)
+	{
+	  if (TYPE_NAME (TREE_TYPE (decl)) == NULL_TREE)
+	    TYPE_NAME (TREE_TYPE (decl)) = decl;
+	  layout_decl (decl, 0);
+	  if (CH_DECL_SIGNAL (decl) && CH_TYPE_NONVALUE_P (TREE_TYPE (decl)))
+	    error ("mode with non-value property in signal definition");
+	  result = TREE_TYPE (decl);
+	}
+      break;
+    case VAR_DECL:
+      SATISFY (TREE_TYPE (decl));
+      if (!LOOKUP_ONLY)
+	{
+	  layout_decl (decl, 0);
+	  if (TREE_READONLY (TREE_TYPE (decl)))
+	    TREE_READONLY (decl) = 1;
+	}
+      break;
+    default:
+      ;
+    }
+
+  /* Now set the DECL_RTL, if needed. */
+  if (!LOOKUP_ONLY && DECL_RTL (decl) == 0
+      && (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL
+	  || TREE_CODE (decl) == CONST_DECL))
+    {
+      if (TREE_CODE (decl) == FUNCTION_DECL && decl_function_context (decl))
+	make_function_rtl (decl);
+      else if (!TREE_STATIC (decl) && !DECL_EXTERNAL (decl))
+	expand_decl (decl);
+      else
+	{ char * asm_name;
+	  if (current_module == 0 || TREE_PUBLIC (decl)
+	      || current_function_decl)
+	    asm_name = NULL;
+	  else
+	    {
+	      asm_name = (char*)
+		alloca (IDENTIFIER_LENGTH (current_module->prefix_name)
+			+ IDENTIFIER_LENGTH (DECL_NAME (decl)) + 3);
+	      sprintf (asm_name, "%s__%s",
+		       IDENTIFIER_POINTER (current_module->prefix_name),
+		       IDENTIFIER_POINTER (DECL_NAME (decl)));
+	    }
+	  make_decl_rtl (decl, asm_name, TREE_PUBLIC (decl));
+	}
+    }
+
+  input_filename = save_filename;
+  lineno = save_lineno;
+
+  return result;
+}
+
+tree
+satisfy_decl (decl, lookup_only)
+     tree decl;
+     int lookup_only;
+{
+  return safe_satisfy_decl (decl, lookup_only ? &dummy_chain : NULL);
+}
+
+static void
+satisfy_list (exp, chain)
+     register tree exp;
+     struct decl_chain *chain;
+{
+  for (; exp != NULL_TREE; exp = TREE_CHAIN (exp))
+    {
+      SATISFY (TREE_VALUE (exp));
+      SATISFY (TREE_PURPOSE (exp));
+    }
+}
+
+static void
+satisfy_list_values (exp, chain)
+     register tree exp;
+     struct decl_chain *chain;
+{
+  for (; exp != NULL_TREE; exp = TREE_CHAIN (exp))
+    {
+      SATISFY (TREE_VALUE (exp));
+    }
+}
+
+tree
+satisfy (exp, chain)
+     tree exp;
+     struct decl_chain *chain;
+{
+  int arg_length;
+  int i;
+  tree decl;
+
+  if (exp == NULL_TREE)
+    return NULL_TREE;
+
+#if 0
+  if (!UNSATISFIED (exp))
+    return exp;
+#endif
+
+  switch (TREE_CODE_CLASS (TREE_CODE (exp)))
+    {
+    case 'd':
+      if (!LOOKUP_ONLY)
+	return safe_satisfy_decl (exp, chain);
+      break;
+    case 'r':
+    case 's':
+    case '<':
+    case 'e':
+      switch ((enum chill_tree_code)TREE_CODE (exp))
+	{
+	case REPLICATE_EXPR:
+	  goto binary_op;
+	case TRUTH_NOT_EXPR:
+	  goto unary_op;
+	case COMPONENT_REF:
+	  SATISFY (TREE_OPERAND (exp, 0));
+	  if (!LOOKUP_ONLY && TREE_TYPE (exp) == NULL_TREE)
+	    return resolve_component_ref (exp);
+	  return exp;
+	case CALL_EXPR:
+	  SATISFY (TREE_OPERAND (exp, 0));
+	  SATISFY (TREE_OPERAND (exp, 1));
+	  if (!LOOKUP_ONLY && TREE_TYPE (exp) == NULL_TREE)
+	    return build_generalized_call (TREE_OPERAND (exp, 0),
+					   TREE_OPERAND (exp, 1));
+	  return exp;
+	case CONSTRUCTOR:
+	  { tree link = TREE_OPERAND (exp, 1);
+	    int expand_needed = TREE_TYPE (exp)
+	      && TREE_CODE_CLASS (TREE_CODE (TREE_TYPE (exp))) != 't';
+	    for (; link != NULL_TREE; link = TREE_CHAIN (link))
+	      {
+		SATISFY (TREE_VALUE (link));
+		if (!TUPLE_NAMED_FIELD (link))
+		  SATISFY (TREE_PURPOSE (link));
+	      }
+	    SATISFY (TREE_TYPE (exp));
+	    if (expand_needed && !LOOKUP_ONLY)
+	      {
+		tree type = TREE_TYPE (exp);
+		TREE_TYPE (exp) = NULL_TREE; /* To force expansion. */
+		return chill_expand_tuple (type, exp);
+	      }
+	    return exp;
+	  }
+	default:
+	  ;
+	}
+      arg_length = tree_code_length[TREE_CODE (exp)];
+      for (i = 0; i < arg_length; i++)
+	SATISFY (TREE_OPERAND (exp, i));
+      return exp;
+    case '1':
+    unary_op:
+      SATISFY (TREE_OPERAND (exp, 0));
+      if ((enum chill_tree_code)TREE_CODE (exp) == PAREN_EXPR)
+	return TREE_OPERAND (exp, 0);
+      if (!LOOKUP_ONLY)
+	return finish_chill_unary_op (exp);
+      break;
+    case '2':
+    binary_op:
+      SATISFY (TREE_OPERAND (exp, 0));
+      SATISFY (TREE_OPERAND (exp, 1));
+      if (!LOOKUP_ONLY && TREE_CODE (exp) != RANGE_EXPR)
+	return finish_chill_binary_op (exp);
+      break;
+    case 'x':
+      switch ((enum chill_tree_code)TREE_CODE (exp))
+	{
+	case IDENTIFIER_NODE:
+	  decl = lookup_name (exp);
+	  if (decl == NULL)
+	    {
+	      if (LOOKUP_ONLY)
+		return exp;
+	      error ("undeclared identifier `%s'", IDENTIFIER_POINTER (exp));
+	      return error_mark_node;
+	    }
+	  if (LOOKUP_ONLY)
+	    return decl;
+	  return safe_satisfy_decl (decl, chain);
+	case TREE_LIST:
+	  satisfy_list (exp, chain);
+	  break;
+	default:
+	  ;
+	}
+      break;
+    case 't':
+      /* If TYPE_SIZE is non-NULL, exp and its subfields has already been
+	 satified and laid out.  The exception is pointer and reference types,
+	 which we layout before we lay out their TREE_TYPE. */
+      if (TYPE_SIZE (exp) && TREE_CODE (exp) != POINTER_TYPE
+	  && TREE_CODE (exp) != REFERENCE_TYPE)
+	return exp;
+      if (TYPE_MAIN_VARIANT (exp) != exp)
+	SATISFY (TYPE_MAIN_VARIANT (exp));
+      switch ((enum chill_tree_code)TREE_CODE (exp))
+	{
+	case LANG_TYPE:
+	  {
+	    tree d = TYPE_DOMAIN (exp);
+	    tree t = satisfy (TREE_TYPE (exp), chain);
+	    SATISFY (d);
+	    /* It is possible that one of the above satisfy calls recursively
+	       caused exp to be satisfied, in which case we're done. */
+	    if (TREE_CODE (exp) != LANG_TYPE)
+	      return exp;
+	    TREE_TYPE (exp) = t;
+	    TYPE_DOMAIN (exp) = d;
+	    if (!LOOKUP_ONLY)
+	      exp = smash_dummy_type (exp);
+	  }
+	  break;
+	case ARRAY_TYPE:
+	  SATISFY (TREE_TYPE (exp));
+	  SATISFY (TYPE_DOMAIN (exp));
+	  SATISFY (TYPE_ATTRIBUTES (exp));
+	  if (!LOOKUP_ONLY)
+	    CH_TYPE_NONVALUE_P (exp) = CH_TYPE_NONVALUE_P (TREE_TYPE (exp));
+	  if (!TYPE_SIZE (exp)  && !LOOKUP_ONLY)
+	    exp = layout_chill_array_type (exp);
+	  break;
+	case FUNCTION_TYPE:
+	  SATISFY (TREE_TYPE (exp));
+	  if (TREE_CODE_CLASS (TREE_CODE (TREE_TYPE (exp))) != 't'
+	      && !LOOKUP_ONLY && TREE_CODE (TREE_TYPE (exp)) != ERROR_MARK)
+	    {
+	      error ("RETURNS spec with invalid mode");
+	      TREE_TYPE (exp) = error_mark_node;
+	    }
+	  satisfy_list_values (TYPE_ARG_TYPES (exp), chain);
+	  if (!TYPE_SIZE (exp)  && !LOOKUP_ONLY)
+	    layout_type (exp);
+	  break;
+	case ENUMERAL_TYPE:
+	  if (TYPE_SIZE (exp) == NULL_TREE && !LOOKUP_ONLY)
+	    { tree pair;
+	      /* FIXME:  Should this use satisfy_decl? */
+	      for (pair = TYPE_VALUES (exp); pair; pair = TREE_CHAIN (pair))
+		SATISFY (DECL_INITIAL (TREE_VALUE (pair)));
+	      layout_enum (exp);
+	    }
+	  break;
+	case INTEGER_TYPE:
+	  SATISFY (TYPE_MIN_VALUE (exp));
+	  SATISFY (TYPE_MAX_VALUE (exp));
+	  if (TREE_TYPE (exp) != NULL_TREE)
+	    { /* A range type */
+	      if (TREE_TYPE (exp) != ridpointers[(int) RID_RANGE]
+		  && TREE_TYPE (exp) != ridpointers[(int) RID_BIN]
+		  && TREE_TYPE (exp) != string_index_type_dummy)
+		SATISFY (TREE_TYPE (exp));
+	      if (!TYPE_SIZE (exp)  && !LOOKUP_ONLY)
+		exp = layout_chill_range_type (exp, 1);
+	    }
+	  break;
+	case POINTER_TYPE:
+	case REFERENCE_TYPE:
+	  if (LOOKUP_ONLY)
+	    SATISFY (TREE_TYPE (exp));
+	  else
+	    {
+	      struct decl_chain *link;
+	      int already_seen = 0;
+	      for (link = chain; ; link = link->prev)
+		{
+		  if (link == NULL)
+		    {	
+		      struct decl_chain new_link;
+		      new_link.decl = exp;
+		      new_link.prev = chain;
+		      TREE_TYPE (exp) = satisfy (TREE_TYPE (exp), &new_link);
+		      break;
+		    }
+		  else if (link->decl == exp)
+		    {
+		      already_seen = 1;
+		      break;
+		    }
+		}
+	      if (!TYPE_SIZE (exp))
+		{
+		  layout_type (exp);
+		  if (TREE_CODE (exp) == REFERENCE_TYPE)
+		    CH_NOVELTY (exp) = CH_NOVELTY (TREE_TYPE (exp));
+		  if (! already_seen)
+		    {
+		      tree valtype = TREE_TYPE (exp);
+		      if (TREE_CODE_CLASS (TREE_CODE (valtype)) != 't')
+			{
+			  if (TREE_CODE (valtype) != ERROR_MARK)
+			    error ("operand to REF is not a mode");
+			  TREE_TYPE (exp) = error_mark_node;
+			  return error_mark_node;
+			}
+		      else if (TREE_CODE (exp) == POINTER_TYPE
+			       && TYPE_POINTER_TO (valtype) == NULL)
+			TYPE_POINTER_TO (valtype) = exp;
+		    }
+		}
+	    }
+	  break;
+	case RECORD_TYPE:
+	  {
+	    /* FIXME: detected errors in here will be printed as
+	       often as this sequence runs. Find another way or
+	       place to print the errors. */
+	    /* if we have an ACCESS or TEXT mode we have to set
+	       maximum_field_alignment to 0 to fit with runtime
+	       system, even when we compile with -fpack. */
+	    extern int maximum_field_alignment;
+	    int save_maximum_field_alignment = maximum_field_alignment;
+
+	    if (CH_IS_ACCESS_MODE (exp) || CH_IS_TEXT_MODE (exp))
+	      maximum_field_alignment = 0;
+
+	    for (decl = TYPE_FIELDS (exp); decl; decl = TREE_CHAIN (decl))
+	      {
+		SATISFY (TREE_TYPE (decl));
+		if (!LOOKUP_ONLY)
+		  {
+		    /* if we have a UNION_TYPE here (variant structure), check for
+		       non-value mode in it. This is not allowed (Z.200/pg. 33) */
+		    if (TREE_CODE (TREE_TYPE (decl)) == UNION_TYPE &&
+			CH_TYPE_NONVALUE_P (TREE_TYPE (decl)))
+		      {
+			error ("field with non-value mode in variant structure not allowed");
+			TREE_TYPE (decl) = error_mark_node;
+		      }
+		    /* RECORD_TYPE gets the non-value property if one of the
+		       fields has the non-value property */
+		    CH_TYPE_NONVALUE_P (exp) |= CH_TYPE_NONVALUE_P (TREE_TYPE (decl));
+		  }
+		if (TREE_CODE (decl) == CONST_DECL)
+		  {
+		    SATISFY (DECL_INITIAL (decl));
+		    if (!LOOKUP_ONLY)
+		      {
+			if (CH_IS_BUFFER_MODE (exp) || CH_IS_EVENT_MODE (exp))
+			  DECL_INITIAL (decl)
+			    = check_queue_size (exp, DECL_INITIAL (decl));
+			else if (CH_IS_TEXT_MODE (exp) &&
+				 DECL_NAME (decl) == get_identifier ("__textlength"))
+			  DECL_INITIAL (decl)
+			    = check_text_length (exp, DECL_INITIAL (decl));
+		      }
+		  }
+		else if (TREE_CODE (decl) == FIELD_DECL)
+		  {
+		    SATISFY (DECL_INITIAL (decl));
+		  }
+	      }
+	    satisfy_list (TYPE_TAG_VALUES (exp), chain);
+	    if (!TYPE_SIZE (exp)  && !LOOKUP_ONLY)
+	      exp = layout_chill_struct_type (exp);
+	    maximum_field_alignment = save_maximum_field_alignment;
+
+	    /* perform some checks on nonvalue modes, they are record_mode's */
+	    if (!LOOKUP_ONLY)
+	      {
+		if (CH_IS_BUFFER_MODE (exp))
+		  {
+		    tree elemmode = buffer_element_mode (exp);
+		    if (elemmode != NULL_TREE && CH_TYPE_NONVALUE_P (elemmode))
+		      {
+			error ("buffer element mode must not have non-value property");
+			invalidate_buffer_element_mode (exp);
+		      }
+		  }
+		else if (CH_IS_ACCESS_MODE (exp))
+		  {
+		    tree recordmode = access_recordmode (exp);
+		    if (recordmode != NULL_TREE && CH_TYPE_NONVALUE_P (recordmode))
+		      {
+			error ("recordmode must not have the non-value property");
+			invalidate_access_recordmode (exp);
+		      }
+		  }
+	      }
+	  }
+	  break;
+	case SET_TYPE:
+	  SATISFY (TYPE_DOMAIN (exp));
+	  if (!TYPE_SIZE (exp)  && !LOOKUP_ONLY)
+	    exp = layout_powerset_type (exp);
+	  break;
+	case UNION_TYPE:
+	  for (decl = TYPE_FIELDS (exp); decl; decl = TREE_CHAIN (decl))
+	    {
+	      SATISFY (TREE_TYPE (decl));
+	      if (!LOOKUP_ONLY)
+		CH_TYPE_NONVALUE_P (exp) |= CH_TYPE_NONVALUE_P (TREE_TYPE (decl));
+	    }
+	  if (!TYPE_SIZE (exp)  && !LOOKUP_ONLY)
+	    exp = layout_chill_variants (exp);
+	  break;
+	default:
+	  ;
+	}
+    }
+  return exp;
+}

gcc/ch/timing.c

@@ -0,0 +1,494 @@
+/* Implement timing-related actions for CHILL.
+   Copyright (C) 1992, 93, 1994 Free Software Foundation, Inc.
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include <stdio.h>
+#include <limits.h>
+#include <string.h>
+#include "config.h"
+#include "tree.h"
+#include "rtl.h"
+#include "ch-tree.h"
+#include "flags.h"
+#include "input.h"
+#include "obstack.h"
+#include "lex.h"
+
+#ifndef LONG_TYPE_SIZE
+#define LONG_TYPE_SIZE BITS_PER_WORD
+#endif
+
+/* set non-zero if input text is forced to lowercase */
+extern int ignore_case;
+
+/* set non-zero if special words are to be entered in uppercase */
+extern int special_UC;
+
+/* timing modes */
+tree abs_timing_type_node;
+tree duration_timing_type_node;
+
+/* rts time type */
+static tree rtstime_type_node = NULL_TREE;
+
+/* the stack for AFTER primval [ DELAY ] IN 
+   and has following layout
+
+   TREE_VALUE (TREE_VALUE (after_stack)) = current time or NULL_TREE (if DELAY specified)
+   TREE_PURPOSE (TREE_VALUE (after_stack)) = the duration location
+   TREE_VALUE (TREE_PURPOSE (after_stack)) = label at TIMEOUT
+   TREE_PURPOSE (TREE_PURPOSE (after_stack)) = label at the end of AFTER action
+*/
+tree after_stack = NULL_TREE;
+
+/* in pass 1 we need a seperate list for the labels */
+static tree after_stack_pass_1 = NULL_TREE;
+static tree after_help;
+
+void
+timing_init ()
+{
+  tree ptr_ftype_durt_ptr_int;
+  tree int_ftype_abst_ptr_int;
+  tree void_ftype_ptr;
+  tree long_ftype_int_int_int_int_int_int_int_ptr_int;
+  tree void_ftype_abstime_ptr;
+  tree int_ftype_ptr_durt_ptr;
+  tree void_ftype_durt_ptr;
+  tree void_ftype_ptr_durt_ptr_int;
+  tree temp;
+  tree endlink;
+  tree ulong_type;
+  
+  ulong_type = TREE_TYPE (lookup_name (
+		          get_identifier ((ignore_case || ! special_UC ) ?
+					  "ulong" : "ULONG")));
+
+  /* build modes for TIME and DURATION */
+  duration_timing_type_node = make_unsigned_type (LONG_TYPE_SIZE);
+  temp = pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_DURATION],
+			       duration_timing_type_node));
+  SET_CH_NOVELTY_NONNIL (duration_timing_type_node, temp);
+  abs_timing_type_node = make_unsigned_type (LONG_TYPE_SIZE);
+  temp = pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_TIME],
+			       abs_timing_type_node));
+  SET_CH_NOVELTY_NONNIL (abs_timing_type_node, temp);
+
+  /* the mode of time the runtimesystem returns */
+  if (rtstime_type_node == NULL_TREE)
+  {
+      tree decl1, decl2, result;
+
+      decl1 = build_decl (FIELD_DECL,
+			  get_identifier ("secs"),
+			  ulong_type);
+      DECL_INITIAL (decl1) = NULL_TREE;
+      decl2 = build_decl (FIELD_DECL,
+			  get_identifier ("nsecs"),
+			  ulong_type);
+      DECL_INITIAL (decl2) = NULL_TREE;
+      TREE_CHAIN (decl2) = NULL_TREE;
+      TREE_CHAIN (decl1) = decl2;
+      
+      result = build_chill_struct_type (decl1);
+      pushdecl (temp = build_decl (TYPE_DECL,
+	get_identifier ("__tmp_rtstime"), result));
+      DECL_SOURCE_LINE (temp) = 0;
+      satisfy_decl (temp, 0);
+      rtstime_type_node = TREE_TYPE (temp);
+  }
+  
+  endlink = void_list_node;
+  
+  ptr_ftype_durt_ptr_int
+    = build_function_type (ptr_type_node,
+         tree_cons (NULL_TREE, duration_timing_type_node,
+             tree_cons (NULL_TREE, ptr_type_node,
+                 tree_cons (NULL_TREE, integer_type_node,
+                     endlink))));
+
+  int_ftype_abst_ptr_int
+    = build_function_type (integer_type_node,
+         tree_cons (NULL_TREE, abs_timing_type_node,
+             tree_cons (NULL_TREE, ptr_type_node,
+                 tree_cons (NULL_TREE, integer_type_node,
+                     endlink))));
+
+  void_ftype_ptr
+     = build_function_type (void_type_node,
+	   tree_cons (NULL_TREE, ptr_type_node,
+	       endlink));
+
+  long_ftype_int_int_int_int_int_int_int_ptr_int
+    = build_function_type (abs_timing_type_node,
+	 tree_cons (NULL_TREE, integer_type_node,
+	    tree_cons (NULL_TREE, integer_type_node,
+	       tree_cons (NULL_TREE, integer_type_node,
+	          tree_cons (NULL_TREE, integer_type_node,
+	             tree_cons (NULL_TREE, integer_type_node,
+	                tree_cons (NULL_TREE, integer_type_node,
+	                   tree_cons (NULL_TREE, integer_type_node,
+	                      tree_cons (NULL_TREE, ptr_type_node,
+	                         tree_cons (NULL_TREE, integer_type_node,
+			            endlink))))))))));
+
+  void_ftype_abstime_ptr
+    = build_function_type (void_type_node,
+          tree_cons (NULL_TREE, abs_timing_type_node,
+              tree_cons (NULL_TREE, ptr_type_node,
+                  endlink)));
+
+  int_ftype_ptr_durt_ptr
+    = build_function_type (integer_type_node,
+          tree_cons (NULL_TREE, ptr_type_node,
+              tree_cons (NULL_TREE, duration_timing_type_node,
+                  tree_cons (NULL_TREE, ptr_type_node,
+                      endlink))));
+
+  void_ftype_durt_ptr
+    = build_function_type (void_type_node,
+          tree_cons (NULL_TREE, duration_timing_type_node,
+              tree_cons (NULL_TREE, ptr_type_node,
+                  endlink)));
+
+  void_ftype_ptr_durt_ptr_int
+    = build_function_type (void_type_node,
+        tree_cons (NULL_TREE, ptr_type_node,
+          tree_cons (NULL_TREE, duration_timing_type_node,
+            tree_cons (NULL_TREE, ptr_type_node,
+              tree_cons (NULL_TREE, integer_type_node,
+                endlink)))));
+
+  builtin_function ("_abstime", long_ftype_int_int_int_int_int_int_int_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__check_cycle", void_ftype_ptr_durt_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__convert_duration_rtstime", void_ftype_durt_ptr,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__define_timeout", ptr_ftype_durt_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("_inttime", void_ftype_abstime_ptr,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__remaintime", int_ftype_ptr_durt_ptr,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__rtstime", void_ftype_ptr,
+		    NOT_BUILT_IN, NULL_PTR);
+  builtin_function ("__wait_until", int_ftype_abst_ptr_int,
+		    NOT_BUILT_IN, NULL_PTR);
+}
+
+#if 0
+ *
+ * build AT action
+ *
+ * AT primval IN
+ *  ok-actionlist
+ * TIMEOUT
+ *  to-actionlist
+ * END;
+ *
+ * gets translated to
+ *
+ * if (__wait_until (primval) == 0)
+ *   ok-actionlist
+ * else
+ *   to-action-list
+ *
+#endif
+
+void
+build_at_action (t)
+     tree t;
+{
+  tree abstime, expr, filename, fcall;
+  
+  if (t == NULL_TREE || TREE_CODE (t) == ERROR_MARK)
+    abstime = convert (abs_timing_type_node, build_int_2 (0, 0));
+  else
+    abstime = t;
+  
+  if (TREE_TYPE (abstime) != abs_timing_type_node)
+    {
+      error ("absolute time value must be of mode TIME.");
+      abstime = convert (abs_timing_type_node, build_int_2 (0, 0));
+    }
+  filename = force_addr_of (get_chill_filename ());
+  fcall = build_chill_function_call (
+	    lookup_name (get_identifier ("__wait_until")),
+	      tree_cons (NULL_TREE, abstime,
+		tree_cons (NULL_TREE, filename,
+		  tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
+  expr = build (EQ_EXPR, integer_type_node, fcall, integer_zero_node);
+  expand_start_cond (expr, 0);
+  emit_line_note (input_filename, lineno);
+}
+
+#if 0
+ *
+ * build CYCLE action
+ *
+ * CYCLE primval IN
+ *  actionlist
+ * END;
+ *
+ * gets translated to
+ *
+ * {
+ *    RtsTime  now; 
+ *  label:
+ *    __rtstime (&now); 
+ *     actionlist
+ *    __check_cycle (&now, primval, filename, lineno); 
+ *    goto label;
+ *  }
+ *
+#endif
+
+tree
+build_cycle_start (t)
+    tree t;
+{
+  tree purpose = build_tree_list (NULL_TREE, NULL_TREE);
+  tree toid = build_tree_list (purpose, NULL_TREE);
+
+  /* define the label. Note: define_label needs to be called in
+     pass 1 and pass 2. */
+  TREE_VALUE (toid) = define_label (input_filename, lineno,
+				    get_unique_identifier ("CYCLE_label"));
+  if (! ignoring)
+    {
+      tree duration_value, now_location;
+      
+      if (t == NULL_TREE || TREE_CODE (t) == ERROR_MARK)
+	duration_value = convert (duration_timing_type_node, build_int_2 (0,0));
+      else
+	duration_value = t;
+      
+      if (TREE_TYPE (duration_value) != duration_timing_type_node)
+	{
+	  error ("duration primitive value must be of mode DURATION.");
+	  duration_value = convert (duration_timing_type_node, build_int_2 (0,0));
+	}
+      TREE_PURPOSE (TREE_PURPOSE (toid)) = duration_value;
+      /* define the variable */
+      now_location = decl_temp1 (get_unique_identifier ("CYCLE_var"),
+				 rtstime_type_node, 0,
+				 NULL_TREE, 0, 0);
+      TREE_VALUE (TREE_PURPOSE (toid)) = force_addr_of (now_location);
+      
+      /* build the call to __rtstime */
+      expand_expr_stmt (
+        build_chill_function_call (lookup_name (get_identifier ("__rtstime")),
+          build_tree_list (NULL_TREE, TREE_VALUE (TREE_PURPOSE (toid)))));
+    }
+
+  return toid;
+}
+
+void
+build_cycle_end (toid)
+     tree toid;
+{
+  tree filename, linenumber;
+  
+  /* here we call __check_cycle and then jump to beginning of this
+     action */
+  filename = force_addr_of (get_chill_filename ());
+  linenumber = get_chill_linenumber ();
+  expand_expr_stmt (
+    build_chill_function_call (
+      lookup_name (get_identifier ("__check_cycle")),
+	tree_cons (NULL_TREE, TREE_VALUE (TREE_PURPOSE (toid)),
+          tree_cons (NULL_TREE, TREE_PURPOSE (TREE_PURPOSE (toid)),
+	    tree_cons (NULL_TREE, filename,
+	      tree_cons (NULL_TREE, linenumber, NULL_TREE))))));
+  expand_goto (TREE_VALUE (toid));
+}
+
+#if 0
+ *
+ * build AFTER ACTION
+ *
+ * AFTER primval [ DELAY ] IN
+ *  action-list
+ * TIMEOUT
+ *  to-action-list
+ * END
+ *
+ * gets translated to
+ *
+ * {
+ *   struct chill_time __now; 
+ *   duration dur = primval; 
+ *   if (! delay_spceified)
+ *     __rts_time (&__now); 
+ *     .
+ *     .
+ *    goto end-label;
+ *   to-label:
+ *     .
+ *     .
+ *   end-label:
+ * }
+ *
+#endif
+
+void
+build_after_start (duration, delay_flag)
+    tree duration;
+    int  delay_flag;
+{
+  tree value, purpose;
+  
+  if (! ignoring)
+    {
+      value = tree_cons (NULL_TREE, NULL_TREE, NULL_TREE);
+      purpose = after_stack_pass_1;
+      after_stack_pass_1 = TREE_CHAIN (after_stack_pass_1);
+      after_stack = tree_cons (purpose, value, after_stack);
+      
+      if (TREE_TYPE (duration) != duration_timing_type_node)
+        {
+	  error ("duration primitive value must be of mode DURATION.");
+	  duration = convert (duration_timing_type_node, build_int_2 (0,0));
+        }
+      TREE_PURPOSE (value) = decl_temp1 (get_identifier ("AFTER_duration"),
+					 duration_timing_type_node, 0,
+					 duration, 0, 0);
+      
+      if (! delay_flag)
+        {
+	  /* in this case we have to get the current time */
+	  TREE_VALUE (value) = decl_temp1 (get_unique_identifier ("AFTER_now"),
+					   rtstime_type_node, 0,
+					   NULL_TREE, 0, 0);
+	  /* build the function call to initialize the variable */
+	  expand_expr_stmt (
+            build_chill_function_call (lookup_name (get_identifier ("__rtstime")),
+              build_tree_list (NULL_TREE, force_addr_of (TREE_VALUE (value)))));
+        }
+    }
+  else
+    {
+      /* in pass 1 we just save the labels */
+      after_help = tree_cons (NULL_TREE, NULL_TREE, after_help);
+      after_stack_pass_1 = chainon (after_stack_pass_1, after_help);
+    }
+}
+
+void
+build_after_timeout_start ()
+{
+  tree label_name, goto_where;
+  
+  if (! ignoring)
+    {
+      /* jump to the end of AFTER action */
+      lookup_and_expand_goto (TREE_PURPOSE (TREE_PURPOSE (after_stack)));
+      label_name = TREE_VALUE (TREE_PURPOSE (after_stack));
+      /* mark we are in TIMEOUT part of AFTER action */
+      TREE_VALUE (TREE_PURPOSE (after_stack)) = NULL_TREE;
+    }
+  else
+    {
+      label_name = get_unique_identifier ("AFTER_tolabel");
+      TREE_VALUE (after_help) = label_name;
+    }
+  define_label (input_filename, lineno, label_name);
+}
+
+void
+build_after_end ()
+{
+  tree label_name;
+    
+  /* define the end label */
+  if (! ignoring)
+    {
+      label_name = TREE_PURPOSE (TREE_PURPOSE (after_stack));
+      after_stack = TREE_CHAIN (after_stack);
+    }
+  else
+    {
+      label_name = get_unique_identifier ("AFTER_endlabel");
+      TREE_PURPOSE (after_help) = label_name;
+      after_help = TREE_CHAIN (after_help);
+    }
+  define_label (input_filename, lineno, label_name);
+}
+
+tree
+build_timeout_preface ()
+{
+  tree timeout_value = null_pointer_node;
+  
+  if (after_stack != NULL_TREE &&
+      TREE_VALUE (TREE_PURPOSE (after_stack)) != NULL_TREE)
+    {
+      tree to_loc;
+      
+      to_loc = decl_temp1 (get_unique_identifier ("TOloc"),
+			   rtstime_type_node, 0, NULL_TREE, 0, 0);
+      timeout_value = force_addr_of (to_loc);
+
+      if (TREE_VALUE (TREE_VALUE (after_stack)) == NULL_TREE)
+        {
+	  /* DELAY specified -- just call __convert_duration_rtstime for
+	     given duration value */
+	  expand_expr_stmt (
+            build_chill_function_call (
+              lookup_name (get_identifier ("__convert_duration_rtstime")),
+                tree_cons (NULL_TREE, TREE_PURPOSE (TREE_VALUE (after_stack)),
+                  tree_cons (NULL_TREE, timeout_value, NULL_TREE))));
+        }
+      else
+        {
+	  /* delay not specified -- call __remaintime which returns the 
+	     remaining time of duration in rtstime format and check the 
+	     result */
+	  tree fcall = 
+            build_chill_function_call (
+              lookup_name (get_identifier ("__remaintime")),
+                tree_cons (NULL_TREE, force_addr_of (TREE_VALUE (TREE_VALUE (after_stack))),
+		  tree_cons (NULL_TREE, TREE_PURPOSE (TREE_VALUE (after_stack)),
+                    tree_cons (NULL_TREE, timeout_value, NULL_TREE))));
+	  tree expr = build (NE_EXPR, integer_type_node,
+			     fcall, integer_zero_node);
+	  expand_start_cond (expr, 0);
+	  lookup_and_expand_goto (TREE_VALUE (TREE_PURPOSE (after_stack)));
+	  expand_end_cond ();
+        }
+    }
+  return timeout_value;
+}
+
+void
+build_timesupervised_call (fcall, to_loc)
+    tree fcall;
+    tree to_loc;
+{
+  if (to_loc == null_pointer_node)
+    expand_expr_stmt (fcall);
+  else
+    {
+      tree expr = build (NE_EXPR, integer_type_node, fcall, integer_zero_node);
+      expand_start_cond (expr, 0);
+      lookup_and_expand_goto (TREE_VALUE (TREE_PURPOSE (after_stack)));
+      expand_end_cond ();
+    }
+}