�

Migrate from devo/gcc/ch.

From-SVN: r22035

gcc/ch/chill.brochure

+              GNU CHILL: A Complete CHILL Implementation
+
+CHILL (the CCITT High Level Language) is a strongly-typed, block
+structured language designed primarily for the implementation of large
+and complex embedded systems.  Tens of millions of lines of CHILL code
+exist, and about 15,000 programmers world-wide use CHILL.  Many
+central-office telephone switching systems use CHILL for their control
+software.
+
+CHILL was designed to
+
+  - enhance reliability and run time efficiency by means of extensive
+    compile time checking;
+  - provide sufficient flexibility and power to encompass the required 
+    range of applications and to exploit a variety of hardware;
+  _ provide facilities that encourage piecewise and modular development
+    of large systems;
+  - cater to real-time implementations by providing built-in concurrency
+    and time supervision primitives;
+  - permit the generation of highly efficient object code;
+  - facilitate ease of use and a short learning curve.
+
+CHILL is specified in the "Blue Book":
+	CCITT High Level Language (CHILL) Recommendation Z.200
+	ISO/IEC 9496, Geneva 1989           ISBN 92-61-03801-8
+
+Cygnus Support has completed the first level implementation of the 
+GNU CHILL compiler.  Our compiler now supports the core features of
+the CHILL language.  Our goal is a fully retargetable, complete
+implementation of the Z.200 specification.  The next phase of
+implementation will include:
+
+	. a minimal real-time kernel for demonstration use
+	. more rigorous type checking
+	. retargetable input/output
+	. interprocess communications
+	. fully compliant exception handling.
+
+The State of the Implementation
+
+The GNU CHILL compiler is in early beta state, performing correct
+compilation and execution of correctly coded programs.  Like most
+CHILL compilers, the GNU compiler implements a large subset of the
+language (as described below).
+
+Since it uses the same compiler back-ends as the GNU C and C++
+compilers, GNU CHILL is almost instantly available on all
+platforms supported by GNU C, including the following:
+
+	m680xx, i960, i80x86, AMD29K, R3000, R4000, SPARClite,
+	Hitachi H8 and SH families, Z8001/2
+
+It has been specifically tested under SunOS on SPARCs and under
+SCO Unix on 80386s.
+
+All of the GCC optimizations apply to CHILL as well, including 
+function inlining, dead code elimination, jump-to-jump elimination, 
+cross-jumping (tail-merging), constant propagation, common 
+subexpression elimination, loop-invariant code motion, strength 
+reduction, loop unrolling, induction variable elimination, flow
+analysis (copy propagation, dead store elimination and elimination
+of unreachable code), dataflow-driven instruction scheduling, and
+many others.
+
+I/O statements are parsed. The anticipated timeframe for I/O code
+generation is Q1 1994.
+
+What's Next
+
+The multi-tasking functions require a small real time kernel.
+A free implementation of such a kernel is not yet available.
+We plan to offer a productized P-threads interface in Q2 1994.
+Other runtime functions involving strings and powersets are 
+working.
+
+GDB, the GNU Debugger, has been modified to provide simple CHILL
+support.  Some CHILL expressions are not yet recognized.
+
+For those who aren't familiar with CHILL, here's a small but
+useful example program:
+
+--
+-- Convert binary integers to decimal-coded ASCII string
+--
+vary1: MODULE
+
+  -- include declarations so we can output the test results
+  <> USE_SEIZE_FILE 'chprintf.grt' <>
+  SEIZE chprintf;
+
+  -- create a new name for the CHAR array mode
+  SYNMODE dec_string = CHAR (6) VARYING;
+
+  int_to_dec_char: PROC (decimal_num INT IN)
+                   RETURNS (dec_string);
+
+    DCL neg_num BOOL := FALSE;        -- save sign of parameter
+    DCL out_string dec_string;
+
+    IF decimal_num < 0 THEN           -- positive numbers are easier
+      decimal_num := -decimal_num;
+      neg_num := TRUE;
+    FI
+
+    IF decimal_num = 0 THEN
+      out_string := '0';                 /* handle zero */
+    ELSE
+      out_string := '';
+      DO WHILE decimal_num /= 0;         -- loop until number is zero
+	-- concatenate a new digit in front of the output string
+        out_string := CHAR (ABS (decimal_num REM D'10) + H'30) 
+		      // out_string;
+        decimal_num := decimal_num / D'10;
+      OD;
+      IF neg_num THEN
+	-- prepend a hyphen for numbers < zero
+        out_string := '-' // out_string;   -- restore sign
+      FI;
+    FI;
+    RESULT out_string;               -- remember result
+
+    decimal_num := 0;                -- reset for next call
+    neg_num := FALSE;
+    out_string := '      ';
+
+  END int_to_dec_char;
+
+  /* Try some test cases */
+  chprintf (int_to_dec_char (123456), 0);
+  chprintf ("^J", 0);
+
+  chprintf (int_to_dec_char (-654321), 0);
+  chprintf ("^J", 0);
+
+  chprintf (int_to_dec_char (0), 0);
+  chprintf ("^J", 0);
+
+END vary1;
+
+Completeness
+
+GNU CHILL currently supports the following features.  This outline
+generally follows the structure of the Blue Book specification:
+
+	CCITT High Level Language (CHILL) Recommendation Z.200
+	ISO/IEC 9496, Geneva 1989           ISBN 92-61-03801-8
+
+
+  Modes (types)
+	no DYNAMIC modes yet
+	discrete modes
+		integer, boolean, character, real
+		multiple integer/real precisions (an extension)
+	set modes, range modes
+	powersets
+	references
+	  (no ROW modes)	
+	procedure modes
+	instance modes
+	event modes
+	buffer modes
+	(no input/output modes yet)
+	(no timing modes yet)
+	composite modes
+	  strings
+	  arrays
+	  structures
+	VARYING string/array modes
+	(type-checking is not fully rigorous yet)
+	forward references
+
+  Expressions
+	literals
+	tuples
+	slices, ranges
+	the standard operators
+
+  Actions (statements)
+	assignments
+	if .. then .. else .. fi
+	cases
+	do action
+	do .. with
+	exits
+	calls
+	results/returns
+	gotos
+	assertions
+	cause exception
+	start/stop/continue process
+
+  Input/Output
+	(not yet)
+
+  Exception handling
+	fully compiled, but exceptions aren't
+	generated in all of the required situations
+
+  Time Supervision
+	(syntax only)
+
+  Inter-process communications
+	delay/delay case actions
+	send signal/receive case actions
+	send buffer/receive case actions
+
+  Multi-module programming
+	Seize/grant processing
+	multiple modules per source file
+
+
+Bibliography
+
+This list is included as an invitation.  We'd appreciate hearing 
+of CHILL-related documents (with ISBN if possible) which aren't
+described here.  We're particularly interested in getting copies
+of other conference Proceedings.
+
+	CCITT High Level Language (CHILL) Recommendation Z.200
+	ISO/IEC 9496, Geneva 1989                ISBN 92-61-03801-8
+	(The "blue book". The formal language definition; mostly a
+	 language-lawyer's document, but more readable than most.)
+
+	Study Group X - Report R 34
+	This is the May 1992 revision of Z.200.
+
+	An Analytic Description of CHILL, the CCITT high-level
+	language, Branquart, Louis & Wodon, Springer-Verlag 1981
+                                                 ISBN 3-540-11196-4
+
+	CHILL User's Manual
+	CCITT, Geneva 1986                       ISBN 92-61-02601-X
+	(Most readable, but doesn't cover the whole language).  
+
+	Introduction to CHILL
+	CCITT, Geneva 1983                       ISBN 92-61-017771-1
+
+	CHILL CCITT High Level Language
+	Proceedings of the 5th CHILL Conference
+	North-Holland, 1991                      ISBN 0 444 88904 3
+
+	Introduction to the CHILL programming Language
+	TELEBRAS, Campinas, Brazil 1990
+
+	CHILL: A Self-Instruction Manual
+	Telecommunication Institute - PITTC
+	Available from KVATRO A/S, N-7005 Trondheim, Norway
+	Phone: +47 7 52 00 90
+	(Great discussion of novelty.)
+
+Some of these documents are available from Global Engineering
+Documents, in Irvine, CA, USA.  +1 714 261 1455.

gcc/ch/gperf

+struct resword {
+  char        *name;
+  short        token;
+  enum rid     rid;
+  enum toktype { RESERVED, DIRECTIVE, PREDEF } flags;
+};
+extern tree ridpointers [];
+%%
+access,			ACCESS,			NORID,	RESERVED
+after,			AFTER,			NORID,	RESERVED
+all,			ALL,			NORID,	RESERVED
+all_static_off,		ALL_STATIC_OFF,		NORID,  DIRECTIVE
+all_static_on,		ALL_STATIC_ON,		NORID,	DIRECTIVE
+and,			AND,			NORID,	RESERVED
+andif,			ANDIF,			NORID,	RESERVED
+array,			ARRAY,			NORID,	RESERVED
+asm,			ASM_KEYWORD,		NORID,	RESERVED
+assert,			ASSERT,			NORID,	RESERVED
+at,			AT,			NORID,	RESERVED
+based,			BASED,			NORID,	RESERVED
+begin,			BEGINTOKEN,		NORID,	RESERVED
+bin,			BIN,			NORID,	RESERVED
+bit,			BOOLS,			RID_BOOLS,	PREDEF
+body,			BODY,			NORID,	RESERVED
+bools,			BOOLS,			RID_BOOLS,	RESERVED
+buffer,			BUFFER,			NORID,	RESERVED
+buffer_code,		IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+by,			BY,			NORID,	RESERVED
+call,			CALL,			NORID,	RESERVED
+case,			CASE,			NORID,	RESERVED
+cause,			CAUSE,			NORID,	RESERVED
+ccitt_os,		IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+chars,			CHARS,			NORID,	RESERVED
+context,		CONTEXT,		NORID,	RESERVED
+continue,		CONTINUE,		NORID,	RESERVED
+cycle,			CYCLE,			NORID,	RESERVED
+dcl,			DCL,			NORID,	RESERVED
+debug_lines,		IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+debug_symbols,		IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+debug_types,		IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+delay,			DELAY,			NORID,	RESERVED
+do,			DO,			NORID,	RESERVED
+down,			DOWN,			NORID,	RESERVED
+dynamic,		DYNAMIC,		RID_DYNAMIC,	RESERVED
+else,			ELSE,			NORID,	RESERVED
+elsif,			ELSIF,			NORID,	RESERVED
+empty_off,		EMPTY_OFF,		NORID,	DIRECTIVE
+empty_on,		EMPTY_ON,		NORID,	DIRECTIVE
+end,			END,			NORID,	RESERVED
+esac,			ESAC,			NORID,	RESERVED
+even,			IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+event,			EVENT,			NORID,	RESERVED
+event_code,		IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+ever,			EVER,			NORID,	RESERVED
+exceptions,		EXCEPTIONS,		NORID,	RESERVED
+exit,			EXIT,			NORID,	RESERVED
+extra_const_seg,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+far,			IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+fi,			FI,			NORID,	RESERVED
+for,			FOR,			NORID,	RESERVED
+forbid,			FORBID,			NORID,	RESERVED
+general,		GENERAL,		NORID,	RESERVED
+generate_all_set_names,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+generate_set_names,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+goto,			GOTO,			NORID,	RESERVED
+grant,			GRANT,			NORID,	RESERVED
+grant_file_size,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+if,			IF,			NORID,	RESERVED
+in,			IN,			RID_IN,	RESERVED
+init,			INIT,			NORID,	RESERVED
+inline,			INLINE,			RID_INLINE,	RESERVED
+inout,			PARAMATTR,		RID_INOUT,	RESERVED
+large,			IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+list,			IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+loc,			LOC,			NORID,	RESERVED
+make_publics_for_discrete_syns,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+medium,			IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+mod,			MOD,			NORID,	RESERVED
+module,			MODULE,			NORID,	RESERVED
+multiple_const_segs,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+multiple_data_segs,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+newmode,		NEWMODE,		NORID,	RESERVED
+nolist,			IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+no_overlap_check,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+nonref,			NONREF,			NORID,	RESERVED
+nopack,			NOPACK,			NORID,	RESERVED
+not,			NOT,			NORID,	RESERVED
+od,			OD,			NORID,	RESERVED
+of,			OF,			NORID,	RESERVED
+on,			ON,			NORID,	RESERVED
+only_for_simulation,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+only_for_target,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+optimize,		IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+optimize_runtime,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+optimization_window,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+or,			OR,			NORID,	RESERVED
+orif,			ORIF,			NORID,	RESERVED
+out,			PARAMATTR,		RID_OUT,	RESERVED
+pack,			PACK,			NORID,	RESERVED
+page,			IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+pos,			POS,			NORID,	RESERVED
+powerset,		POWERSET,		NORID,	RESERVED
+prefixed,		PREFIXED,		NORID,	RESERVED
+print_o_code,		IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+print_symbol_table,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+priority,		PRIORITY,		NORID,	RESERVED
+proc,			PROC,			NORID,	RESERVED
+process,		PROCESS,		NORID,	RESERVED
+process_type,		PROCESS_TYPE_TOKEN,	NORID,	DIRECTIVE
+range,			RANGE,			NORID,	RESERVED
+range_off,		RANGE_OFF,		NORID,	DIRECTIVE
+range_on,		RANGE_ON,		NORID,	DIRECTIVE
+read,			READ,			RID_READ,	RESERVED
+receive,		RECEIVE,		NORID,	RESERVED
+recursive,		RECURSIVE,		NORID,	RESERVED
+reentrant,		IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+reentrant_all,		IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+ref,			REF,			NORID,	RESERVED
+region,			REGION,			NORID,	RESERVED
+rem,			REM,			NORID,	RESERVED
+remote,			REMOTE,			NORID,	RESERVED
+result,			RESULT,			NORID,	RESERVED
+return,			RETURN,			NORID,	RESERVED
+returns,		RETURNS,		NORID,	RESERVED
+row,			ROW,			NORID,	RESERVED
+seize,			SEIZE,			NORID,	RESERVED
+send,			SEND,			NORID,	RESERVED
+send_buffer_default_priority,	SEND_BUFFER_DEFAULT_PRIORITY,	NORID,	DIRECTIVE
+send_signal_default_priority,	SEND_SIGNAL_DEFAULT_PRIORITY,	NORID,	DIRECTIVE
+set,			SET,			NORID,	RESERVED
+short_pred_succ,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+signal,			SIGNAL,			NORID,	RESERVED
+signal_code,		SIGNAL_CODE,		NORID,	DIRECTIVE
+signal_max_length,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+simple,			SIMPLE,			NORID,	RESERVED
+small,			IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+spec,			SPEC,			NORID,	RESERVED
+start,			START,			NORID,	RESERVED
+state_routine,		IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+static,			STATIC,			NORID,	RESERVED
+step,			STEP,			NORID,	RESERVED
+stop,			STOP,			NORID,	RESERVED
+struct,			STRUCT,			NORID,	RESERVED
+support_causing_address,	IGNORED_DIRECTIVE,	NORID,	DIRECTIVE
+syn,			SYN,			NORID,	RESERVED
+synmode,		SYNMODE,		NORID,	RESERVED
+text,			TEXT,			NORID,	RESERVED
+then,			THEN,			NORID,	RESERVED
+this,			THIS,			NORID,	RESERVED
+timeout,		TIMEOUT,		NORID,	RESERVED
+to,			TO,			NORID,	RESERVED
+up,			UP,			NORID,	RESERVED
+use_seize_file,		USE_SEIZE_FILE,		NORID,	DIRECTIVE
+use_seize_file_restricted,	USE_SEIZE_FILE_RESTRICTED,	NORID,	DIRECTIVE
+varying,		VARYING,		NORID,	RESERVED
+while,			WHILE,			NORID,	RESERVED
+with,			WITH,			NORID,	RESERVED
+xor,			XOR,			NORID,	RESERVED

gcc/ch/lang-options.h

+/* Definitions for switches for GNU CHILL.
+   Copyright (C) 1995, 1998 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 `lang_options' array in gcc.c for
+   CHILL.  */
+
+/* CYGNUS LOCAL - the format of this file has been changed to
+   allow cc1 to implement --help.  nickc/--help */
+
+DEFINE_LANG_NAME ("Chill")
+     
+  { "-lang-chill", "" },
+  { "-flocal-loop-counter", "" },
+  { "-fno-local-loop-counter", "Do not make seperate scopes for every 'for' loop"},
+  { "-fgrant-only", "Stop after successfully generating a grant file" },
+  { "-fchill-grant-only", "" },
+  { "-fold-strings", "Implement the 1984 Chill string semantics" },
+  { "-fno-old-strings", "" },
+  { "-fignore-case", "convert all idenitifers to lower case" },
+  { "-fno-ignore-case", "" },
+  { "-fpack", "Pack structures into available space"},
+  { "-fno-pack", "" },
+  { "-fspecial_UC", "Make special words be in uppercase" },
+  { "-fspecial_LC", "" },
+  { "-fruntime-checking", "" },
+  { "-fno-runtime-checking", "Disable runtime checking of parameters" },

gcc/ch/lex.h

+/* Define constants for communication with the CHILL parser.
+   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.  */
+
+
+
+enum rid
+{
+  RID_UNUSED,  /* keep this one first, please */
+  RID_ALL,
+  RID_ASSERTFAIL,
+  RID_ASSOCIATION,
+  RID_BIN,
+  RID_BIT,
+  RID_BOOL,
+  RID_BOOLS,
+  RID_BYTE,
+  RID_CHAR,
+  RID_CHARS,
+  RID_DOUBLE,
+  RID_DURATION,
+  RID_DYNAMIC,
+  RID_ELSE,
+  RID_EMPTY,
+  RID_FALSE,
+  RID_FLOAT,
+  RID_GENERAL,
+  RID_IN,
+  RID_INLINE,
+  RID_INOUT,
+  RID_INSTANCE,
+  RID_INT,
+  RID_LOC,
+  RID_LONG,
+  RID_LONG_REAL,
+  RID_NULL,
+  RID_OUT,
+  RID_OVERFLOW,
+  RID_PTR,
+  RID_RANGE,
+  RID_RANGEFAIL,
+  RID_READ,
+  RID_REAL,
+  RID_RECURSIVE,
+  RID_SHORT,
+  RID_SIMPLE,
+  RID_TIME,
+  RID_TRUE,
+  RID_UBYTE,
+  RID_UINT,
+  RID_ULONG,
+  RID_UNSIGNED,
+  RID_USHORT,
+  RID_VOID,
+  RID_MAX /* Last element */
+};
+
+#define NORID RID_UNUSED
+
+#define RID_FIRST_MODIFIER RID_UNSIGNED
+
+/* The elements of `ridpointers' are identifier nodes
+   for the reserved type names and storage classes.
+   It is indexed by a RID_... value.  */
+extern tree ridpointers[(int) RID_MAX];
+
+extern char *token_buffer;	/* Pointer to token buffer.  */
+
+extern tree make_pointer_declarator PROTO((tree, tree));
+extern void reinit_parse_for_function PROTO((void));
+extern int yylex PROTO((void));
+
+extern tree default_grant_file;
+extern tree current_grant_file;
+
+extern tree current_seize_file;
+
+extern int chill_at_module_level;
+extern tree chill_initializer_name;
+
+extern void finish_chill_seizes ();
+
+extern void prepare_paren_colon PROTO((void));

gcc/ch/runtime/cardps.c

+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+
+/*
+ * function __cardpowerset
+ *
+ * parameters:
+ *	ps		powerset
+ *	bitlength	length of powerset
+ *
+ * returns:
+ *	long		number of set bits
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  returns the number of set bit's in a powerset
+ *
+ */
+
+/* bit_count[I] is number of '1' bits in I. */
+static
+const unsigned char __four_bit_count[16] = {
+    0, 1, 1, 2,
+    1, 2, 2, 3,
+    1, 2, 2, 3,
+    2, 3, 3, 4 };
+
+long
+__cardpowerset (ps, bitlength)
+     SET_WORD      *ps;
+     unsigned long  bitlength;
+{
+  unsigned long	count = 0;
+  if (bitlength <= SET_CHAR_SIZE)
+    {
+      register SET_CHAR	c = *((SET_CHAR *)ps);
+      /* count 4 bits at a time. */
+      while (c > 0)
+	{
+	  count += __four_bit_count[c & 15];
+	  c >>= 4;
+	}
+      return count;
+    }
+  else if (bitlength <= SET_SHORT_SIZE)
+    {
+      register SET_SHORT c = *((SET_SHORT *)ps);
+      /* count 4 bits at a time. */
+      while (c > 0)
+	{
+	  count += __four_bit_count[c & 15];
+	  c >>= 4;
+	}
+      return count;
+    }
+  else
+    {
+      register SET_WORD	*p = ps;
+      SET_WORD *endp = p + BITS_TO_WORDS(bitlength);
+    
+      while (p < endp)
+	{
+	  register SET_WORD c = *p++;
+	  /* count 4 bits at a time. */
+	  while (c > 0)
+	    {
+	      count += __four_bit_count[c & 15];
+	      c >>= 4;
+	    }
+	}
+      return (count);
+    }
+}

gcc/ch/runtime/delaycase.c

+/* Implement tasking-related runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include "rtltypes.h"
+#include "rts.h"
+
+extern void __cause_ex1 (char *ex, char *file, int lineno);
+
+EXCEPTION (delayfail);
+#define CAUSE_DELAYFAIL     __cause_ex1 ("delayfail", filename, lineno)
+
+EXCEPTION (notyetimplemented);
+#define CAUSE_NOTIMPLEMENTED   __cause_ex1 ("notyetimplemeyed", filename, lineno)
+
+/*
+ * function __delay_event
+ *
+ * parameters:
+ *     ev_got      pointer to location where to write the event got.
+ *     nevents     number of events in list
+ *     evptrs      array of event descriptors
+ *     priority    specified priority
+ *     insloc      pointer to resulting instance location
+ *     to          timeout value
+ *     filename    filename of caller
+ *     lineno      linenumber of caller
+ *
+ * returns:
+ *     int         0 .. success
+ *                 1 .. timed out
+ *
+ * exceptions:
+ *     delayfail
+ *
+ * abstract:
+ *     implement the CHILL DELAY and DELAY CASE actions.
+ *
+ */
+
+int
+__delay_event (ev_got, nevents, evptrs, priority, to, insloc, filename, lineno)
+     void         **ev_got;
+     int            nevents;
+     Event_Descr   *evptrs;
+     int            priority;
+     void          *to;
+     INSTANCE      *insloc;
+     char          *filename;
+     int            lineno;
+{
+  int             i, already_done = 0;
+  Event_Queue    *start_list = 0;
+  Event_Queue   **retval = 0;
+  Event_Queue    *wrk;
+  int		  timed_out = 0;
+  
+  /* check if all specified event queues have enough space left
+     to perform the delay */
+  for (i = 0; i < nevents; i++)
+    {
+      Event_Queue  *e;
+      unsigned long cnt = 0;
+      int j, have_done = 0;
+
+      if (evptrs[i].maxqueuelength == 0)
+	CAUSE_DELAYFAIL;
+      else if (evptrs[i].maxqueuelength == (unsigned long)-1L)
+	/* infinite length */
+	continue;
+
+      /* check if we already have processed this one, that means, this
+         event is mentioned more then once */
+      for (j = 0; j < i; j++)
+        {
+          if (evptrs[i].ev == evptrs[j].ev)
+	    {
+              have_done = 1;
+              break;
+	    }
+        }
+      if (have_done)
+	continue;
+      
+      memcpy (&e, evptrs[i].ev, sizeof (Event_Queue *));
+      while (e)
+	{
+	  cnt++;
+	  e = e->forward;
+	}
+      if (cnt >= evptrs[i].maxqueuelength)
+	CAUSE_DELAYFAIL;
+    }
+
+  for (i = 0; i < nevents; i++)
+    {
+      /* queue that stuff on each event */
+      Event_Queue      *wrk;
+      Event_Queue      *ev;
+      Event_Queue      *prev_queue_entry = 0;
+      Event_Queue      *prev_list_entry;
+      int               j, have_done = 0;
+      
+      /* check for this event already processed */
+      for (j = 0; j < i; j++)
+	{
+          if (evptrs[i].ev == evptrs[j].ev)
+	    {
+              have_done = 1;
+              break;
+	    }
+	}
+      if (have_done)
+	continue;
+
+      memcpy (&ev, &evptrs[i].ev, sizeof (Event_Queue *));
+      MALLOC (wrk, sizeof (Event_Queue));
+      memset (wrk, 0, sizeof (Event_Queue));
+
+      wrk->priority = priority;
+      wrk->this = THIS;
+      wrk->listhead = evptrs[i].ev;
+
+      /* search for the place to queue this entry in */
+      while (ev->forward != 0 && ev->priority >= priority)
+	{
+	  prev_queue_entry = ev;
+	  ev = ev->forward;
+	}
+
+      /* ready to put entry into queue */
+      if (ev->forward == 0 || prev_queue_entry == 0)
+	{
+	  /* beginning or end of the list */
+	  wrk->forward = ev->forward;
+	  ev->forward = wrk;
+	}
+      else
+	{
+	  /* this is somewhere in the middle */
+	  wrk->forward = prev_queue_entry->forward;
+	  prev_queue_entry->forward = wrk;
+	}
+
+      /* queue it into list */
+      wrk->startlist = start_list;
+      if (! start_list)
+	{
+	  /* we are the first in the list */
+	  start_list = wrk;
+	  prev_list_entry = wrk;
+	  wrk->startlist = start_list;
+	}
+      else
+	{
+	  prev_list_entry->chain = wrk;
+	  prev_list_entry = wrk;
+	}
+    }
+
+  /* tell runtime system to delay that process */
+  timed_out = __delay_this (wait_event_delay, to, filename, lineno);
+  if (timed_out)
+    {
+      /* we have to remove the entries from the queue's */
+      wrk = start_list;
+      while (wrk)
+        {
+	  Event_Queue *tmp = (Event_Queue *)wrk->listhead;
+	  
+	  while (tmp->forward != wrk)
+	    tmp = tmp->forward;
+	  tmp->forward = wrk->forward;
+	  wrk = wrk->chain;
+        }
+    }
+  
+  wrk = start_list;
+  while (wrk)
+    {
+      Event_Queue  *tmp;
+
+      if (wrk->is_continued && ! already_done)
+	{
+	  already_done = 1;
+	  retval = wrk->listhead;
+	  if (insloc && !timed_out)
+	    {
+	      insloc->ptype = wrk->who_continued.ptype;
+	      insloc->pcopy = wrk->who_continued.pcopy;
+	    }
+	}
+      tmp = wrk->chain;
+      FREE (wrk);
+      wrk = tmp;
+    }
+  if (!timed_out && ev_got)
+    *ev_got = (void *)retval;
+  return timed_out;
+}
+
+/* force function print_event to be linked */
+extern void __print_event ();
+static EntryPoint pev = __print_event;

gcc/ch/runtime/eoln.c

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

gcc/ch/runtime/eqstr.c

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

gcc/ch/runtime/existing.c

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

gcc/ch/runtime/gettextindex.c

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

gcc/ch/runtime/isassociated.c

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

gcc/ch/runtime/neps.c

+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __nepowerset
+ *
+ * parameters:
+ *	left		left powerset
+ *	right		right powerset
+ *	bitlength	length of powerset in bits
+ *
+ * returns:
+ *    1 if powersets are not equal, bit for bit
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  compares two powersets for inequality
+ *
+ */
+int
+__nepowerset (left, right, bitlength)
+     SET_WORD *left;
+     SET_WORD *right;
+     unsigned long bitlength;
+{
+  return ! __eqpowerset (left, right, bitlength);
+}

gcc/ch/runtime/notps.c

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

gcc/ch/runtime/printbuffer.c

+/* Implement tasking-related runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include <stdio.h>
+#include "rtltypes.h"
+#include "rts.h"
+
+typedef char *(*fetch_names) (int number);
+extern fetch_names	__RTS_FETCH_NAMES__;
+
+/*
+ * function print_instance
+ *
+ */
+
+static char *print_instance (ins)
+     INSTANCE ins;
+{
+  static char  buf[256];
+  char *f;
+
+  if (!__RTS_FETCH_NAMES__)
+    f = 0;
+  else
+    f = (*__RTS_FETCH_NAMES__) (ins.ptype);
+  if (!f)
+    sprintf (buf, "[%u;%u]", ins.ptype, ins.pcopy);
+  else
+    sprintf (buf, "[%s;%u]", f, ins.pcopy);
+  return buf;
+}
+
+/*
+ * function __print_buffer
+ *
+ * parameters:
+ *     buffer      buffer location
+ *
+ * returns:
+ *     void
+ *
+ * exceptions:
+ *     none
+ *
+ * abstract:
+ *     Function is used for debugging purposes only to print a
+ *     buffer queue
+ */
+
+void
+__print_buffer (buffer, name)
+     Buffer_Queue   **buffer;
+     char            *name;
+{
+  Buffer_Queue      *bq;
+  int                bsqcnt = 0, bwqcnt = 0;
+  Buffer_Send_Queue *bsq;
+  Buffer_Wait_Queue *bwq;
+
+  if (name)
+    printf ("Buffer %s:\n", name);
+  else
+    printf ("Buffer at address H'%X:\n", buffer);
+
+  memcpy (&bq, buffer, sizeof (Buffer_Queue *));
+  if (bq == 0)
+    {
+      printf ("EMPTY\n");
+      return;
+    }
+
+  bsq = bq->sendqueue;
+  if (bsq != 0)
+      printf ("Send Queue:\n");
+  while (bsq)
+    {
+      printf (" %3d: ", ++bsqcnt);
+      printf ("Process %s, ", print_instance (bsq->this));
+      printf ("Priority %d", bsq->priority);
+      if (bsq->is_delayed)
+	printf (", Delayed");
+      printf ("\n");
+      bsq = bsq->forward;
+    }
+  bwq = bq->waitqueue;
+  if (bwq != 0)
+      printf ("Wait Queue:\n");
+  while (bwq)
+    {
+      printf (" %3d: ", ++bwqcnt);
+      printf ("Process %s, ", print_instance (bwq->this));
+      if (bwq->is_sent)
+	printf (", Send by %s", print_instance (bwq->who_sent));
+      printf ("\n");
+      bwq = bwq->forward;
+    }
+  if (bsqcnt == 0 && bwqcnt == 0)
+    printf ("EMPTY\n");
+}

gcc/ch/runtime/printevent.c

+/* Implement tasking-related runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include <stdio.h>
+#include "rtltypes.h"
+#include "rts.h"
+
+typedef char *(*fetch_names) (int number);
+extern fetch_names	__RTS_FETCH_NAMES__;
+
+/*
+ * function print_instance
+ *
+ */
+
+static char *print_instance (ins)
+     INSTANCE ins;
+{
+  static char  buf[256];
+  char *f;
+
+  if (!__RTS_FETCH_NAMES__)
+    f = 0;
+  else
+    f = (*__RTS_FETCH_NAMES__) (ins.ptype);
+  if (!f)
+    sprintf (buf, "[%u;%u]", ins.ptype, ins.pcopy);
+  else
+    sprintf (buf, "[%s;%u]", f, ins.pcopy);
+  return buf;
+}
+
+/*
+ * function __print_event
+ *
+ * parameters:
+ *     event      event location
+ *
+ * returns:
+ *     void
+ *
+ * exceptions:
+ *     none
+ *
+ * abstract:
+ *     Function is used for debugging purposes only to print an
+ *     event queue
+ */
+
+void
+__print_event (evaddr, name)
+     Event_Queue   **evaddr;
+     char           *name;
+{
+  Event_Queue    *ev;
+  int            cnt = 0;
+
+  if (name)
+    printf ("Event %s:\n", name);
+  else
+    printf ("Event at address H'%X:\n", evaddr);
+
+  memcpy (&ev, evaddr, sizeof (Event_Queue *));
+  while (ev)
+    {
+      printf (" %3d: ", ++cnt);
+      printf ("Process %s, ", print_instance (ev->this));
+      printf ("Priority %d", ev->priority);
+      if (ev->is_continued)
+	printf (" ,Continued by %s", print_instance (ev->who_continued));
+      printf ("\n");
+      ev = ev->forward;
+    }
+  if (!cnt)
+    printf ("EMPTY\n");
+}

gcc/ch/runtime/retmem.c

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

gcc/ch/runtime/rtltypes.h

+#ifndef __rtltypes_h__
+#define __rtltypes_h__
+
+#include <setjmp.h>
+
+/* Add prototype support.  */
+#ifndef PROTO
+#if defined (USE_PROTOTYPES) ? USE_PROTOTYPES : defined (__STDC__)
+#define PROTO(ARGS) ARGS
+#else
+#define PROTO(ARGS) ()
+#endif
+#endif
+
+/* argc, argv */
+typedef struct
+{
+    unsigned short	len;
+    char		body[0];
+} TVaryingCharType;
+
+#ifndef __CHILL_LIB__
+extern TVaryingCharType	**chill_argv;
+extern int		chill_argc;
+#endif
+
+/* definitions for exceptions */
+typedef struct
+{
+    char	*exname;
+    short	exnumber;
+} TExceptionDefinition;
+
+#if 1
+typedef char *__ch_exception;
+#define EX_EQ(e1, e2) (strcmp(e1, e2)==0)
+#else
+typedef void *__ch_exception;
+#define EX_EQ(e1, e2) (e1 == e2)
+#endif
+#define __ch_else_except ((__ch_exception)0)
+
+struct __ch_handled_excepts
+{
+  /* List is ended by a code==0, or ex==__ch_else_except (ELSE handler). */
+  __ch_exception ex;
+  int code; /* Positive number indicating ordinal in handler list. */
+};
+
+/* definitions for exception handlers */
+typedef struct  __ch_handler
+{
+  struct __ch_handler *prev;
+  struct __ch_handled_excepts *handlers;
+  jmp_buf jbuf;
+} TExceptionHandlerStack;
+
+/* exceptions */
+#define EXCEPTION(x)	/* nothing */
+
+#endif /* __rtltypes_h__ */

gcc/ch/runtime/terminate.c

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

gcc/ch/runtime/writerecord.c

+/* Implement Input/Output runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include <setjmp.h>
+#include <errno.h>
+#include <string.h>
+#include <unistd.h>
+#include <sys/types.h>
+
+#include "fileio.h"
+
+static
+void
+doWrite( Access_Mode* the_access, void* buf, size_t nbyte )
+{
+  size_t nwrit;
+
+  nwrit = write( the_access->association->handle, buf, nbyte );
+
+  if( nwrit < nbyte )
+  {
+    the_access->association->syserrno = errno;
+    RWEXCEPTION( WRITEFAIL, OS_IO_ERROR );
+  }
+}
+
+
+void
+__writerecord( Access_Mode*  the_access,
+               signed long   the_index,
+               char*         the_val_addr,
+               unsigned long the_val_len,
+               char*         file,
+               int           line )
+
+{
+  Association_Mode* the_assoc;
+  unsigned long  info;
+  char*          actaddr;
+  unsigned short actlen;
+  off_t          filepos;
+
+  if( !the_access )
+    CHILLEXCEPTION( file, line, EMPTY, NULL_ACCESS );
+
+  if( !(the_assoc = the_access->association) )
+    CHILLEXCEPTION( file, line, NOTCONNECTED, IS_NOT_CONNECTED );
+
+  /* Usage must no be ReadOnly */
+  if( the_assoc->usage == ReadOnly )
+    CHILLEXCEPTION( file, line, WRITEFAIL, BAD_USAGE );
+
+  /*
+   *  Positioning
+   */
+  if( TEST_FLAG( the_access, IO_INDEXED ) )
+  {
+    /* index expression must be within bounds of index mode */
+    if( the_index < the_access->lowindex
+        || the_access->highindex < the_index )
+      CHILLEXCEPTION( file, line, RANGEFAIL, BAD_INDEX );
+    filepos = the_access->base + 
+              (the_index - the_access->lowindex) * the_access->reclength;
+
+    if( lseek( the_assoc->handle, filepos, SEEK_SET ) == -1L )
+      CHILLEXCEPTION( file, line, WRITEFAIL, LSEEK_FAILS );
+  }
+
+  if( (info = setjmp( __rw_exception )) )
+    CHILLEXCEPTION( file, line, info>>16, info & 0xffff );
+
+  if( TEST_FLAG( the_access, IO_TEXTIO ) )
+  {
+    if( TEST_FLAG( the_access, IO_INDEXED ) )
+    {
+      int nspace = the_access->reclength - the_val_len;
+      memset( the_val_addr + 2 + the_val_len, ' ', nspace );
+      actlen = the_access->reclength - 2;
+      MOV2(the_val_addr,&actlen);
+      doWrite( the_access, the_val_addr, the_access->reclength );
+    }
+    else
+    { 
+      if( the_assoc->ctl_pre )
+	write( the_assoc->handle, &the_assoc->ctl_pre, 1 );
+      MOV2(&actlen,the_val_addr);
+      write( the_assoc->handle, the_val_addr + 2, actlen );
+      if( the_assoc->ctl_post )
+	write( the_assoc->handle, &the_assoc->ctl_post, 1 );
+      the_assoc->ctl_pre  = '\0';
+      the_assoc->ctl_post = '\n';
+    }
+  }
+  else
+  {
+    switch( the_access->rectype )
+    {
+    case Fixed:
+      if( TEST_FLAG( the_assoc, IO_VARIABLE ) )
+      {
+        actlen = the_access->reclength;
+        doWrite( the_access, &actlen, sizeof(actlen) );
+      }
+      doWrite( the_access, the_val_addr, the_val_len );
+      break;
+    case VaryingChars:
+      MOV2(&actlen,the_val_addr);
+      if( actlen > the_access->reclength - 2 )
+        CHILLEXCEPTION( file, line, RANGEFAIL, RECORD_TOO_LONG );
+      actlen = TEST_FLAG( the_access, IO_INDEXED ) 
+               ? the_access->reclength : actlen + 2;
+      doWrite( the_access, the_val_addr, actlen );
+      break;
+    }
+  }
+}

gcc/ch/runtime/xorps.c

+/* Implement POWERSET runtime actions for CHILL.
+   Copyright (C) 1992,1993 Free Software Foundation, Inc.
+   Author: Wilfried Moser, et al
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#define __CHILL_LIB__
+
+#include "config.h"
+#include <stdio.h>
+#include "powerset.h"
+
+/*
+ * function __xorpowerset
+ *
+ * parameters:
+ *	out		return from __xorpowerset
+ *	left		left powerset
+ *	right		right powerset
+ *	bitlength	length of powerset in bits
+ *
+ * returns:
+ *	void
+ *
+ * exceptions:
+ *  none
+ *
+ * abstract:
+ *  xor's 2 powersets
+ *
+ */
+
+void
+__xorpowerset (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/xtypeck.c

+
+#if 0
+tree
+build_component_ref (datum, field_name)
+  tree datum, field_name;
+{
+  return build_chill_component_ref (datum, field_name);
+}
+
+/* Mark EXP saying that we need to be able to take the
+   address of it; it should not be allocated in a register.
+   Value is 1 if successful.  */
+
+int
+mark_addressable (exp)
+     tree exp;
+{
+  register tree x = exp;
+  while (1)
+    switch (TREE_CODE (x))
+      {
+      case ADDR_EXPR:
+      case COMPONENT_REF:
+      case ARRAY_REF:
+      case REALPART_EXPR:
+      case IMAGPART_EXPR:
+/* start-sanitize-chill */
+      case TRUTH_ANDIF_EXPR:
+      case TRUTH_ORIF_EXPR:
+      case COMPOUND_EXPR:
+/* end-sanitize-chill */
+	x = TREE_OPERAND (x, 0);
+	break;
+/* start-sanitize-chill */
+
+      case COND_EXPR:
+	return mark_addressable (TREE_OPERAND (x, 1))
+	  & mark_addressable (TREE_OPERAND (x, 2));
+/* end-sanitize-chill */
+
+      case CONSTRUCTOR:
+	TREE_ADDRESSABLE (x) = 1;
+	return 1;
+
+      case VAR_DECL:
+      case CONST_DECL:
+      case PARM_DECL:
+      case RESULT_DECL:
+	if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x)
+	    && DECL_NONLOCAL (x))
+	  {
+	    if (TREE_PUBLIC (x))
+	      {
+		error ("global register variable `%s' used in nested function",
+		       IDENTIFIER_POINTER (DECL_NAME (x)));
+		return 0;
+	      }
+	    pedwarn ("register variable `%s' used in nested function",
+		     IDENTIFIER_POINTER (DECL_NAME (x)));
+	  }
+	else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x))
+	  {
+	    if (TREE_PUBLIC (x))
+	      {
+		error ("address of global register variable `%s' requested",
+		       IDENTIFIER_POINTER (DECL_NAME (x)));
+		return 0;
+	      }
+
+	    /* If we are making this addressable due to its having
+	       volatile components, give a different error message.  Also
+	       handle the case of an unnamed parameter by not trying
+	       to give the name.  */
+
+	    else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x)))
+	      {
+		error ("cannot put object with volatile field into register");
+		return 0;
+	      }
+
+	    pedwarn ("address of register variable `%s' requested",
+		     IDENTIFIER_POINTER (DECL_NAME (x)));
+	  }
+	put_var_into_stack (x);
+
+	/* drops in */
+      case FUNCTION_DECL:
+	TREE_ADDRESSABLE (x) = 1;
+#if 0  /* poplevel deals with this now.  */
+	if (DECL_CONTEXT (x) == 0)
+	  TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (x)) = 1;
+#endif
+
+      default:
+	return 1;
+    }
+}
+
+/* Return an unsigned type the same as TYPE in other respects.  */
+
+tree
+unsigned_type (type)
+     tree type;
+{
+  tree type1 = TYPE_MAIN_VARIANT (type);
+  if (type1 == signed_char_type_node || type1 == char_type_node)
+    return unsigned_char_type_node;
+  if (type1 == integer_type_node)
+    return unsigned_type_node;
+  if (type1 == short_integer_type_node)
+    return short_unsigned_type_node;
+  if (type1 == long_integer_type_node)
+    return long_unsigned_type_node;
+  if (type1 == long_long_integer_type_node)
+    return long_long_unsigned_type_node;
+  return type;
+}
+
+/* Return a signed type the same as TYPE in other respects.  */
+
+tree
+signed_type (type)
+     tree type;
+{
+  tree type1 = TYPE_MAIN_VARIANT (type);
+  if (type1 == unsigned_char_type_node || type1 == char_type_node)
+    return signed_char_type_node;
+  if (type1 == unsigned_type_node)
+    return integer_type_node;
+  if (type1 == short_unsigned_type_node)
+    return short_integer_type_node;
+  if (type1 == long_unsigned_type_node)
+    return long_integer_type_node;
+  if (type1 == long_long_unsigned_type_node)
+    return long_long_integer_type_node;
+  return type;
+}
+
+/* Return a type the same as TYPE except unsigned or
+   signed according to UNSIGNEDP.  */
+
+tree
+signed_or_unsigned_type (unsignedp, type)
+     int unsignedp;
+     tree type;
+{
+  if (! INTEGRAL_TYPE_P (type))
+    return type;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (signed_char_type_node))
+    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (integer_type_node)) 
+    return unsignedp ? unsigned_type_node : integer_type_node;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (short_integer_type_node)) 
+    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (long_integer_type_node)) 
+    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (long_long_integer_type_node)) 
+    return (unsignedp ? long_long_unsigned_type_node
+	    : long_long_integer_type_node);
+  return type;
+}
+
+extern tree intHI_type_node;
+extern tree intSI_type_node;
+extern tree intDI_type_node;
+
+extern tree unsigned_intHI_type_node;
+extern tree unsigned_intSI_type_node;
+extern tree unsigned_intDI_type_node;
+
+/* Return an integer type with BITS bits of precision,
+   that is unsigned if UNSIGNEDP is nonzero, otherwise signed.  */
+
+tree
+type_for_size (bits, unsignedp)
+     unsigned bits;
+     int unsignedp;
+{
+  if (bits == TYPE_PRECISION (signed_char_type_node))
+    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+
+  if (bits == TYPE_PRECISION (short_integer_type_node))
+    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+
+  if (bits == TYPE_PRECISION (integer_type_node))
+    return unsignedp ? unsigned_type_node : integer_type_node;
+
+  if (bits == TYPE_PRECISION (long_integer_type_node))
+    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+
+  if (bits == TYPE_PRECISION (long_long_integer_type_node))
+    return (unsignedp ? long_long_unsigned_type_node
+	    : long_long_integer_type_node);
+
+  if (bits <= TYPE_PRECISION (intHI_type_node))
+    return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
+
+  if (bits <= TYPE_PRECISION (intSI_type_node))
+    return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
+
+  if (bits <= TYPE_PRECISION (intDI_type_node))
+    return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
+
+  return 0;
+}
+
+/* Return a data type that has machine mode MODE.
+   If the mode is an integer,
+   then UNSIGNEDP selects between signed and unsigned types.  */
+
+tree
+type_for_mode (mode, unsignedp)
+     enum machine_mode mode;
+     int unsignedp;
+{
+  if (mode == TYPE_MODE (signed_char_type_node))
+    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+
+  if (mode == TYPE_MODE (short_integer_type_node))
+    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+
+  if (mode == TYPE_MODE (integer_type_node))
+    return unsignedp ? unsigned_type_node : integer_type_node;
+
+  if (mode == TYPE_MODE (long_integer_type_node))
+    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+
+  if (mode == TYPE_MODE (long_long_integer_type_node))
+    return unsignedp ? long_long_unsigned_type_node : long_long_integer_type_node;
+
+  if (mode == TYPE_MODE (intHI_type_node))
+    return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
+
+  if (mode == TYPE_MODE (intSI_type_node))
+    return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
+
+  if (mode == TYPE_MODE (intDI_type_node))
+    return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
+
+  if (mode == TYPE_MODE (float_type_node))
+    return float_type_node;
+
+  if (mode == TYPE_MODE (double_type_node))
+    return double_type_node;
+
+  if (mode == TYPE_MODE (long_double_type_node))
+    return long_double_type_node;
+
+  if (mode == TYPE_MODE (build_pointer_type (char_type_node)))
+    return build_pointer_type (char_type_node);
+
+  if (mode == TYPE_MODE (build_pointer_type (integer_type_node)))
+    return build_pointer_type (integer_type_node);
+
+  return 0;
+}
+
+tree
+truthvalue_conversion (expr)
+     tree expr;
+{
+  return chill_truthvalue_conversion (expr);
+}
+#endif