Skip to content

R
riscv-gcc-1
Commit a2ca17fa by Per Bothner
Options

� 

Migrate from devo/gcc/ch.

From-SVN: r22035
parent 80a093b2
Showing with 7162 additions and 0 deletions
gcc/ch/ChangeLog 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ch/chill.brochure 0 → 100644
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/chill.texi 0 → 100644
@\input texinfo @c -*-texinfo-*-
@setfilename chill.info
@settitle Guide to GNU Chill
@ifinfo
@format
START-INFO-DIR-ENTRY
* Chill:: Chill compiler
END-INFO-DIR-ENTRY
@end format
@end ifinfo
@titlepage
@title GNU Chill
@author William Cox, Per Bothner, Wilfried Moser
@end titlepage
@ifinfo
@node Top
@top
@menu
* Options:: Compiler options
* Missing:: Unimplemented parts of the Chill language
* Enhancements:: GNU-specific enhancements to the Chill language
* Conversions:: Value and location conversions
* Separate compilation:: Separate compilation
* Differences:: Differences between GNUCHILL and Z.200/1988
* Directives:: Implemented Compiler Directives
* References:: Language definition references
@end menu
@end ifinfo
@node Options
@chapter Compiler options
Invoking the compiler:
The @sc{gnu} CHILL compiler supports several new command line options, and
brings a new use to another:
@table @code
@item -lang-chill
This option instructs gcc that the following file is a CHILL source file,
even though its extension is not the default `.ch'.
@item -flocal-loop-counter
The CHILL compiler makes a separate reach, or scope,
for each DO FOR loop. If @code{-flocal-loop-counter} is
specified, the loop counter of value enumeration and location
enumeration is automatically declared inside that reach.
This is the default behavior, required by Z.200.
@item -fno-local-loop-counter
When this option is specified, the above automatic declaration
is not performed, and the user must declare all loop counters
explicitly.
@item -fignore-case
When this option is specified, the compiler ignores case. All
identifiers are converted to lower case. This enables the usage
of C runtime libraries.
@item -fno-ignore-case
Ignoring the case of identifiers is turned off.
@item -fruntime-checking
The CHILL compiler normally generates code to check
the validity of expressions assigned to variables or
expressions passed as parameters to procedures and processes,
if those expressions cannot be checked at compile time.
This is the default behavior, required by Z.200.
This option allows you to re-enable the default behavior
after disabling it with the @code{-fno-runtime-checking}
option.
@item -fno-runtime-checking
The CHILL compiler normally generates code to check
the validity of expressions assigned to variables, or
expressions passed as parameters to procedures and processes.
This option allows you to disable that code generation.
This might be done to reduce the size of a program's
generated code, or to increase its speed of execution.
Compile time range-checking is still performed.
@item -fgrant-only
@itemx -fchill-grant-only
This option causes the compiler to stop successfully
after creating the grant file specified by the source
file (see modular programming in CHILL). No code is
generated, and many categories of errors are not reported.
@item -fold-string
Implement the semantics of Chill 1984 with respect to strings:
String indexing yields a slice of length one; CHAR is similar
to CHAR(1) (or CHARS(1)); and BOOL is similar to BIT(1) (or BOOLS(1)).
@item -fno-old-string
Don't implement 1984 Chill string semantics. This is the default.
@item -I@var{seize_path}
This directive adds the specified seize path to the compiler's
list of paths to search for seize files. When processing a
USE_SEIZE_FILE directive, the compiler normally searches for
the specified seize file only in the current directory. When
one or more seize paths are specified, the compiler also
searches in those directories, in the order of their
specification on the command line, for the seize file.
@item -c
This C-related switch, which normally prevents gcc from
attempting to link, is *not* yet implemented by the @code{chill} command,
but you can use the @code{gcc} command with this flag.
@end table
@node Missing
@chapter Implemented and missing parts of the Chill language
The numbers in parentheses are Z.200(1988) section numbers.
@itemize @bullet
@item The FORBID keyword in a GRANT statement is currently ignored.
@item A CASE action or expression allows only a single expression
in a case selector list (5.3.2, 6.4).
@item ROW modes are not implemented (3.6.3, 3.13.4).
@item Due to the absence of ROW modes, DYNAMIC has no meaning in
connection with access and text modes.
@item Array and structure layout (PACK, POS, NOPACK,
STEP keywords) is ignored (3.12.6).
@item Bit-string slices are not implemented.
@item The support for synchronization modes and concurrent execution
is slightly non-standard.
@item Exception handling is implemented, but exceptions are not
generated in all of the required situations.
@item Dynamic modes are not implemented (though string slices should work).
@item Reach-bound initializations are not implemented (4.1.2).
@end itemize
@node Enhancements
@chapter GNU-specific enhancements to the Chill language
@itemize @bullet
@item Grantfiles. See @xref{Separate compilation}.
@item Precisions. Multiple integer and real precisions are supported,
as well as signed and unsigned variants of the integer modes.
@item DESCR built-in. The new built-in function
DESCR ( <descriptor argument> ) returns a pointer to
STRUCT( addr PTR, length ULONG ) where <descriptor argument> can be
anything the compiler can handle but at least a location of any mode
(except synchronizing modes) and any character string or powerset value.
(A temporary location within the current stack frame may be allocated
if an expression is used.)
CHILL does not permit the writing of procedures with parameters of
any type. Yet some interfaces---in particular those to system
calls---require
the handling of a wide range of modes, e.g. any string mode, any structure
mode, or any powerset mode. This could be handled by specifying two
parameters (PTR, INT for the length) but this is error-prone (no guarantee
the same location is used after in ADDR and LENGTH), and it will not be
possible for expressions.
Caveats: This feature permits the programmer to obtain the address of
a literal (if the compiler takes this shortcut---see 1st example below).
If hardware features protect constant parts of the program, erronous
abuse will be detected.
Examples:
OFFER_HANDLER( descr("dbs"), ->dbs);
SYNMODE m_els = SET( ela, elb, elc );
SYNMODE m_elsel = POWERSET m_els;
DCL user_buf STRUCT( a mx, b my, c mz);
DCL select POWERSET m_elsel;
select := m_elsel[LOWER(m_els) : UPPER(m_els)];
GET_RECORD( relation, recno, descr(user_buf), descr(select) );
PUT_RECORD( relation, recno, descr(user_buf.b), descr(m_elsel[elb]) );
@item LENGTH built-in on left-hand-side. The LENGTH built-in may be
used on the left-hand-side of an assignment, where its argument is a VARYING
character string.
@end itemize
@node Conversions
@chapter Value and location conversions
Value and location conversions are highly dependent on the target machine.
They are also very loosely specified in the 1988 standard.
(The 1992 standard seems an improvement.)
The GNU Chill compiler interprets @code{@var{mode}(@var{exp})} as follows:
@itemize @bullet
@item
If @var{exp} is a referable location,
and the size of (the mode of) @var{exp} is the same as the size of @var{mode},
a location conversion is used.
It is implemented exactly as: @code{(@var{refmode}(-> @var{exp}))->},
where @var{refmode} is a synmode for @code{REF @var{mode}}.
The programmer is responsible for making sure that alignment
restrictions on machine addresses are not violated.
If both @var{mode} and the mode of @var{exp} are discrete modes,
alignment should not be a problem, and we get the same conversion
as a standard value conversion.
@item
If @var{exp} is a constant,
and the size of (the mode of) @var{exp} is the same as the size of @var{mode},
then a value conversion is performed. This conversion is done
at compile time, and it has not been implemented for all types.
Specifically, converting to or from a floating-point type is not implemented.
@item
If both @var{mode} and the mode of @var{exp} are discrete modes,
then a value conversion is performed, as described in Z.200.
@item
If both @var{mode} and the mode of @var{exp} are reference modes,
then a value conversion is allowed.
The same is true is one mode is a reference mode, and the other
is an integral mode of the same size.
@end itemize
@node Separate compilation
@chapter Separate compilation
The GNU CHILL compiler supports modular programming. It
allows the user to control the visibility of variables
and modes, outside of a MODULE, by the use of GRANT
and SEIZE directives. Any location or mode may be made
visible to another MODULE by GRANTing it in the MODULE
where it is defined, and SEIZEing it in another MODULE
which needs to refer to it.
When variables are GRANTed in one or more modules of a
CHILL source file, the compiler outputs a grant file,
with the original source file name as the base name,
and the extension `.grt'. All of the variables and modes
defined in the source file are written to the grant file,
together with any use_seize_file directives, and the
GRANT directives. A grant file is created for every such
source file, except if an identical grant file already
exists. This prevents unnecessary makefile activity.
The referencing source file must:
@enumerate
@item specify the grant file in a use_seize_file directive, and
@item SEIZE each variable or mode definition that it needs.
@end enumerate
An attempt to SEIZE a variable or mode which is not
GRANTed in some seize file is an error.
An attempt to refer to a variable which is defined in
some seize file, but not explicitly granted, is an
error.
An attempt to GRANT a variable or mode which is not
defined in the current MODULE is an error.
Note that the GNU CHILL compiler will *not* write out a
grant file if:
@itemize @bullet
@item there are no GRANT directives in the source file, or
@item the entire grant file already exists, and is
identical to the file which the compiler has just built.
(This latter ``feature'' may be removed at some point.)
@end itemize
Otherwise, a grant file is an automatic, unsuppressable
result of a successful CHILL compilation.
A future release will also support using remote spec modules
in a similar (but more Blue Book-conforming) manner.
@node Differences
@chapter Differences to Z.200/1988
This chapter lists the differences and extensions between GNUCHILL
and the CCITT recommendation Z.200 in its 1988 version (reffered to
as Z.200/1988).
@itemize @bullet
@item 2.2 Vocabulary@*
The definition of @i{<simple name string>} is changed to:
@example
@i{<simple name string> ::=}
@example
@i{@{<letter> | _ @} @{ <letter> | <digit | _ @}}
@end example
@end example
@item 2.6 Compiler Directives@*
Only one directive is allowed between the compiler directive delimiters
`<>' and `<>' or the end-of-line, i.e.
@example
<> USE_SEIZE_FILE "foo.grt" <>
<> ALL_STATIC_OFF
@end example
@item 3.3 Modes and Classes@*
The syntax of @i{<mode>} is changed to:
@example
@i{<mode> ::=}
@example
[@b{READ}] @i{<non-composite-mode>}
| [@b{READ}] @i{composite-mode>}
@end example
@i{<non-composite-mode> ::=}
@example
@i{<discrete mode>}
| @i{<real modes>}
| @i{<powerset modes>}
| @i{<reference mode>}
| @i{<procedure mode>}
| @i{<instance mode>}
| @i{<synchronization mode>}
| @i{<timing mode>}
@end example
@end example
@item 3.4 Discrete Modes@*
The list of discrete modes is enhanced by the following modes:
@example
BYTE 8-bit signed integer
UBYTE 8-bit unsigned integer
UINT 16-bit unsigned integer
LONG 32-bit signed integer
ULONG 32-bit unsigned integer
@end example
@strong{Please note} that INT is implemented as 16-bit signed integer.
@item 3.4.6 Range Modes@*
The mode BIN(n) is not implemented. Using INT(0 : 2 ** n - 1) instead of
BIN(n) makes this mode unneccessary.
@item 3.X Real Modes@*
Note: This is an extension to Z.200/1988, however, it is defined in
Z.200/1992.
@b{syntax:}
@example
@i{<real mode> ::=}
@example
@i{<floating point mode>}
@end example
@end example
@b{semantics:}
@example
A real mode specifies a set of numerical values which approximate a
contiguous range of real numbers.
@end example
@item 3.X.1 Floating point modes@*
@b{syntax:}
@example
@i{<floating point mode> ::=}
@example
@i{<floating point mode name}
@end example
@end example
@b{predefined names:}
The names @i{REAL} and @i{LONG_REAL} are predefined as @b{floating
point mode} names.
@b{semantics:}
A floating point mode defines a set of numeric approximations to a
range of real values, together with their minimum relative accuracy,
between implementation defined bounds, over which the usual ordering
and arithmetic operations are defined. This set contains only the
values which can be represented by the implementation.
@b{examples:}
@example
@i{REAL}
@i{LONG_REAL}
@end example
@item 3.6 Reference Modes@*
Row modes are not implemeted at all.
@item 3.7 Procedure Mode@*
The syntax for procedure modes is changed to:
@example
@i{<procedure mode> ::=}
@example
@b{PROC} @i{([<parameter list>]) [ <result spec> ]}
@i{[}@b{EXCEPTIONS}@i{(<exception list>)] [}@b{RECURSIVE}@i{]}
| @i{<procedure mode name>}
@end example
@i{<parameter list> ::=}
@example
@i{<parameter spec> @{, <parameter spec> @} *}
@end example
@i{<parameter spec> ::=}
@example
@i{<mode> [ <parameter attribute> ]}
@end example
@i{<parameter attribute> ::=}
@example
@b{IN} | @b{OUT} | @b{INOUT} | @b{LOC}
@end example
@i{<result spec> ::=}
@example
@b{RETURNS} @i{( <mode> [}@b{LOC}@i{])}
@end example
@i{<exception list> ::=}
@example
@i{<exception name> @{, <exception name> @} *}
@end example
@end example
@item 3.10 Input-Output Modes@*
Due to the absence of row modes, DYNAMIC has no meaning in an access
or text mode definition.
@item 3.12.2 String Modes@*
As @i{<string modes>} were defined differently in Z.200/1984, the syntax
of @i{<string mode>} is changed to:
@example
@i{<string mode> ::=}
@example
@i{<string type> ( <string length> ) [} @b{VARYING} @i{]}
| @i{<parametrized string mode>}
| @i{<string mode name>}
@end example
@i{<parameterized string mode> ::=}
@example
@i{<origin string mode name> ( <string length> )}
| @i{<parameterized string mode name>}
@end example
@i{<origin string mode name> ::=}
@example
@i{<string mode name>}
@end example
@i{string type}
@example
@b{BOOLS}
| @b{BIT}
| @b{CHARS}
| @b{CHAR}
@end example
@i{<string length> ::=}
@example
@i{<integer literal expression>}
@end example
@end example
@b{VARYING} is not implemented for @i{<string type>} @b{BIT}
and @b{BOOL}.
@item 3.11.1 Duration Modes@*
The predefined mode @i{DURATION} is implemented as a NEWMODE ULONG and
holds the duration value in miliseconds. This gives a maximum duration
of
@example
MILLISECS (UPPER (ULONG)),
SECS (4294967),
MINUTES (71582),
HOURS (1193), and
DAYS (49).
@end example
@item 3.11.2 Absolute Time Modes@*
The predefined mode @i{TIME} is implemented as a NEWMODE ULONG and
holds the absolute time in seconds since Jan. 1st, 1970. This is
equivalent to the mode `time_t' defined on different systems.
@item 3.12.4 Structure Modes@*
Variant fields are allowed, but the CASE-construct may define only one
tag field (one dimensional CASE). OF course, several variant fields may
be specified in one STRUCT mode. The tag field will (both at compile-
and runtime) not be interpreted in any way, however, it must be
interpreted by a debugger. As a consequence, there are no parameterized
STRUCT modes.
@item 3.12.5 Layout description for array and structure modes@*
STEP and POS is not implemeted at all, therefore the syntax of
@i{<element layout} and @i{field layout} is changed to:
@example
@i{<element layout> ::=}
@example
@b{PACK} | @b{NOPACK}
@end example
@i{<field layout> ::=}
@example
@b{PACK} | @b{NOPACK}
@end example
@end example
@item 3.13.4 Dynamic parameterised structure modes@*
Dynamic parameterised structure modes are not implemented.
@item 4.1.2 Location declaration@*
The keyword STATIC is allowed, but has no effect at module level, because
all locations declared there are assumed to be `static' by default. Each
granted location will become `public'. A `static' declaration inside a
block, procedure, etc. places the variable in the data section instead of
the stack section.
@item 4.1.4 Based decleration@*
The based declaration was taken from Z.200/1984 and has the following
syntax:
@b{syntax:}
@example
@i{<based declaration> ::=}
@example
@i{<defining occerrence list> <mode>} @b{BASED}
@i{( <free reference location name> )}
@end example
@end example
@b{semantics:}
A based declaration with @i{<free reference location name>} specifies
as many access names as are defining occerrences in the @i{defining
occurrence list}. Names declared in a base declaration serve as an
alternative way accessing a location by dereferencing a reference
value. This reference value is contained in the location specified by
the @i{free reference location name}. This dereferencing operation is
made each time and only when an access is made via a declared @b{based}
name.
@b{static properties:}
A defining occurrence in a @i{based declaration} with @i{free reference
location name} defines a @b{based} name. The mode attached to a
@b{based} name is the @i{mode} specified in the @i{based declaration}. A
@b{based} name is @b{referable}.
@item 4.2.2 Access names@*
The syntax of access names is changed to:
@example
@i{<access name> ::=}
@example
@i{<location name>}
| @i{<loc-identity name>}
| @i{<based name>}
| @i{<location enumeration name>}
| @i{<location do-with name>}
@end example
@end example
The semantics, static properties and dynamic conditions remain
unchanged except that they are enhanced by @i{base name}.
@item 5.2.4.1 Literals General@*
The syntax of @i{<literal>} is change to:
@example
@i{<literal> ::=}
@example
@i{<integer literal>}
| @i{<boolean literal>}
| @i{<charater literal>}
| @i{<set literal>}
| @i{<emptiness literal>}
| @i{<character string literal>}
| @i{<bit string literal>}
| @i{<floating point literal>}
@end example
@end example
Note: The @i{<floating point literal>} is an extension to Z.200/1988 and
will be described later on.
@item 5.2.4.2 Integer literals@*
The @i{<decimal integer literal>} is changed to:
@example
@i{<decimal integer literal> ::=}
@example
@i{@{ D | d @} ' @{ <digit> | _ @} +}
| @i{<digit> @{ <digit> | _ @} *}
@end example
@end example
@item 5.2.4.4 Character literals@*
A character literal, e.g. 'M', may serve as a charater string literal of
length 1.
@item 5.2.4.7 Character string literals@*
The syntax of a character string literal is:
@example
@i{<character string literal> ::=}
@example
@i{'@{ <non-reserved character> | <single quote> |}
@i{<control sequence> @} * '}
| @i{'@{ <non-reserved character> | <double quote> |}
@i{<control sequence> @} * '}
@end example
@i{<single quote> ::=}
@example
@i{''}
@end example
@i{<double quote> ::=}
@example
@i{""}
@end example
@end example
A character string litaral of length 1, enclosed in apostrophes
(e.g. 'M') may also serve as a charater literal.
@item 5.2.4.9 Floating point literal@*
Note: This is an extension to Z.200/1988 ans was taken from Z.200/1992.
@b{syntax:}
@example
@i{<floating point literal> ::=}
@example
@i{<unsigned floating point literal>}
| @i{<signed floating point literal>}
@end example
@i{<unsigned floating point literal> ::=}
@example
@i{<digit sequence> . [ <digit sequence> ] [ <exponent> ]}
| @i{[ <digit sequence> ] . <digit sequence> [ <exponent> ]}
@end example
@i{<signed floating point literal> ::=}
@example
@i{- <unsigned floating point literal>}
@end example
@i{<digit sequence> ::=}
@example
@i{<digit> @{ <digit> | _ @} *}
@end example
@i{<exponent> ::=}
@example
@i{[ E | D | e | d ] <digit sequence>}
| @i{[ E | D | e | d ] - <digit sequence>}
@end example
@end example
@item 5.2.14 Start Expression@*
The START expression is not implemented.
@item 5.3 Values and Expressions@*
The undefined value, denoted by `*', is not implemented.
@item 5.3.8 Operand-5@*
The @i{<string repetition operator>} is defined as:
@example
@i{<string repetition operator> ::=}
@example
@i{(<integer expression>)}
@end example
@end example
@item 6.4 Case Action@*
There may be only one case selector specified. The optional range list
must not be specified.
@item 6.5 Do Action@*
A Do-Action without control part is not implemented. Grouping of
statements can be achieved via BEGIN and END. A location enumeration is not
allowed for BIT strings, only for (varying) CHAR strings and ARRAYs.
The expression list in a DO WITH must consist of locations only.
@item 6.13 Start Action@*
The syntax of the START action is changed to:
@example
@i{<start action> ::=}
@example
@b{START} @i{<process name> (<copy number> [, <actual parameter list>])}
@i{[} @b{SET} @i{<instance location> ]}
@end example
@i{<copy number> ::=}
@example
@i{<integer expression>}
@end example
@end example
@item 6.16 Delay Action@*
The optional PRIORITY specification need not be a constant.
@item 6.17 Delay Case Action@*
The optional SET branch and the, also optional, PRIORITY branch must be
seperated by `;'.
@item 6.18 Send Action@*
The send action must define a destination instance (via the TO branch),
since undirected signals are not supported. The optional PRIORITY
specification need not be a constant. Additional to the data
transported by the signal, there will be a user defined argument.
The syntax of the @i{<send signal action>} is therefore:
@example
@i{<send signal action> ::=}
@example
@b{SEND} @i{<signal name> [ ( <value> @{, <value> @} * ) ]}
@i{[} @b{WITH} @i{<expression> ]}
@b{TO} @i{<instance primitive value> [ <priority> ]}
@end example
@end example
The default priority can be specified by the compiler directive
SEND_SIGNAL_DEFAULT_PRIORITY. If this also is omitted, the default
priority is 0.
@item 6.20.3 CHILL value built-in calls@*
The CHILL value buit-in calls are enhanced by some calls, and other calls
will have different arguments as described in Z.200/1988. Any call not
mentioned here is the same as described in Z.200/1988.
@b{syntax:}
@example
@i{CHILL value built-in routine call> ::=}
@example
@i{ADDR (<location>)}
| @i{PRED (<pred succ argument>)}
| @i{SUCC (<pred succ argument>)}
| @i{ABS (<numeric expression>)}
| @i{LENGTH (<length argument>)}
| @i{SIN (<floating point expression>)}
| @i{COS (<floating point expression>)}
| @i{TAN (<floating point expression>)}
| @i{ARCSIN (<floating point expression>)}
| @i{ARCCOS (<floating point expression>)}
| @i{ARCTAN (<floating point expression>)}
| @i{EXP (<floating point expression>)}
| @i{LN (<floating point expression>)}
| @i{LOG (<floating point expression>)}
| @i{SQRT (<floating point expression>)}
| @i{QUEUE_LENGTH (<buffer location> | <event location>)}
| @i{GEN_INST (<integer expression> | <process name> ,}
@i{<integer expression>)}
| @i{COPY_NUMBER (<instance expression>)}
| @i{GEN_PTYE (<process name>)}
| @i{PROC_TYPE (<instance expression>)}
| @i{GEN_CODE (<process name> | <signal name>)}
| @i{DESCR (<location>)}
@end example
@i{<pred succ argument> ::=}
@example
@i{<discrete expression>}
| @i{<bound reference expression>}
@end example
@i{<numeric expression> ::=}
@example
@i{<integer expression>}
| @i{floating point expression>}
@end example
@i{<length argument> ::=}
@example
@i{<string location>}
| @i{<string expression>}
| @i{<string mode name>}
| @i{<event location>}
| @i{<event mode name>}
| @i{<buffer location>}
| @i{<buffer mode name>}
| @i{<text location>}
| @i{<text mode name>}
@end example
@end example
@b{semantics:}
@i{ADDR} is derived syntax for -> @i{<location>}.
@i{PRED} and @i{SUCC} delivers respectively, in case of a @i{discrete
expression}, the next lower or higher discrete value of their argument,
in case of @i{bound reference expression} these built-in calls deliver a
pointer to the previous or next element.
@i{ABS} is defined on numeric values, i.e. integer values and floating
point values, delivering the corresponding absolute value.
@i{LENGTH} is defined on
@itemize @bullet
@item string and text locations and string expressions, delivering the
length of them;
@item event locations, delivering the @b{event length} of the mode of the
location;
@item buffer locations, delivering the @b{buffer length} of the mode of
the location;
@item string mode names, delivering the @b{string length} of the mode;
@item text mode names, delivering the @b{text length} of the mode;
@item buffer mode names, delivering the @b{buffer length} of the mode;
@item event mode names, delivering the @b{event length} of the mode;
@item Additionally, @i{LENGTH} also may be used on the left hand
side of an assignment to set a new length of a @i{varying character
string location}. However, to avoid undefined elements in the varying
string, the new length may only be less or equal to the current length.
Otherwise a @b{RANGEFAIL} exception will be generated.
@end itemize
@i{SIN} delivers the sine of its argument (interpreted in radians).
@i{COS} delivers the cosine of its argument (interpreted in radians).
@i{TAN} delivers the tangent of its argument (interpreted in radians).
@i{ARCSIN} delivers the sin -1 function of its argument.
@i{ARCCOS} delivers the cos -1 function of its argument.
@i{ARCTAN} delivers the tan -1 function of its argument.
@i{EXP} delivers the exponential function, where x is the argument.
@i{LN} delivers the natural logarithm of its argument.
@i{LOG} delivers the base 10 logarithm of its argument.
@i{SQRT} delivers the sqare root of its argument.
@i{QUEUE_LENGTH} delivers either the number of sending delayed processes
plus the number of messages in a buffer queue (if the argument is a
@i{buffer location}), or the number of delayed processes (if the
argument specifies an @i{event location}) as @i{integer expression}.
@i{GEN_INST} delivers an @i{instance expression} constructed from the
arguments. Both arguments must have the @i{&INT}-derived class.
@i{COPY_NUMBER} delivers as @i{&INT}-derived class the copy number of an
@i{instance location}.
@i{GEN_PTYPE} delivers as @i{&INT}-derived class the associated number
of the @i{process name}.
@i{PROC_TYPE} delivers as @i{&INT}-derived class the process type of an
@i{instance expression}.
@i{GEN_CODE} delivers as @i{&INT}-derived class the associated number of
the @i{process name} or @i{signal name}.
@i{DESCR} delivers a @i{free reference expression} pointing to a
structure with the following layout describing the @i{location} argument.
@example
SYNMODE __tmp_descr = STRUCT (p PTR, l ULONG);
@end example
@item 7.4.2 Associating an outside world object@*
The syntax of the associate built-in routine call is defined as:
@example
@i{<associate built-in routine call> ::=}
@example
@i{ASSOCIATE ( <association location>, <string expression>,} [@i{, <string expression>} ] @i{)}
@end example
@end example
The ASSOCIATE call has two parameters besides the association location:
a pathname and an optional mode string.
The value of the first string expression must be a pathname according to
the rules of the underlying operating system. (Note that a relative pathname
implies a name relative to the working directory of the process.)
The mode string may contain the value "VARIABLE", which requests
an external representation of records consisting of an UINT record
length followed by as many bytes of data as indicated by the length field.
Such a file with variable records is not indexable.
A file with variable records can be written using any record mode. If the
record mode is CHARS(n) VARYING, the record length is equal to the actual
length of the value written. (Different record may have differing lengths.)
With all other record modes, all records written using the same access mode
will have the same length, but will still be prefixed with the length field.
(Note that by re-connecting with different access modes, the external
representation may ultimately contain records with differing lengths.)
A file with variable records can only be read by using a record mode of
CHARS(n) VARYING.
@item 7.4.2 Accessing association attributes@*
The value of the READABLE and WRITEABLE attributes is determined using
the file status call provided by the operating system. The result will
depend on the device being accessed, or on the file mode.
The INDEXABLE attribute has the value false for files with variable records,
and for files associated with devices not supporting random positioning
(character devices, FIFO special files, etc.).
The variable attribute is true for files associated with the mode sting
"VARIABLE", and false otherwise.
@item 7.4.5 Modifying association attributes@*
The syntax of the MODIFY built-in routine call is defined as:
@example
@i{<modify built-in call> ::=}
@example
@i{MODIFY ( <association location>, <string expression> )}
@end example
@end example
At present, MODIFY accepts a character string containing a pathname
in addition to the association location, which will cause a renaming
of the associated file.
@item 7.4.9 Data transfer operations@*
READRECORD will fail (causing READFAIL) if the number of bytes from the
current position in the file to the end of the file is greater than zero
but less than the size of the record mode, and no data will be transferred.
(If the number of bytes is zero, no error occurs and OUTOFFILE will
return TRUE.)
The number of bytes transferred by READRECORD and WRITERECORD is equal to
the size of the record mode of the access location. Note that the
internal representation of this mode may vary depending on the
record mode being packed or not.
@item 7.5 Text Input Output@*
Sequential text files will be represented so as to be compatible
with the standard representation of texts on the underlying operating
system, where control characters are used to delimit text records on files
as well as to control the movement of a cursor or printing head on a device.
For indexed text files, records of a uniform length (i.e. the size of the
text record, including the length field) are written. All i/o codes cause
an i/o transfer without any carriage control characters being added to the
record, which will be expanded with spaces.
An indexed text file is therefore not compatible with the standard
text representation of the underlying operating system.
@item 7.5.3 Text transfer operations@*
The syntax of @i{<text argument>} is changed to:
@example
@i{<text argument> ::=}
@example
@i{<text location>}
| @i{<predefined text location>}
| @i{<varying string location>}
@end example
@i{<predefined text location> ::=}
@example
STDIN
| STDOUT
| STDERR
@end example
@end example
NOTE: The identifiers STDIN, STDOUT, and STDERR are predefined.
Association and connection with files or devices is done according to
operating system rules.
The effect of using READTEXT or WRITETEXT with a character string location
as a text argument (i.e. the first parameter) where the same location also
appears in the i/o list is undefined.
The current implementation of formatting assumes run-to-completion semantics
of CHILL tasks within an image.
@item 7.5.5 Conversion@*
Due to the implementation of @i{<floating point modes>} the syntax
is changed to:
@example
@i{<conversion clause> ::=}
@example
@i{<conversion code> @{ <conversion qualifier @} *}
@i{[ <clause width> ]}
@end example
@i{<conversion code> ::=}
@example
@i{B} | @i{O} | @i{H} | @i{C} | @i{F}
@end example
@i{<conversion qualifier> ::=}
@example
@i{L} | @i{E} | @i{P<character>}
@end example
@i{<clause width> ::=}
@example
@i{@{ <digit> @} +} | @i{V}
| @i{<real clause width>}
@end example
@i{<real clause width> ::=}
@example
@i{@{ @{ <digit> + | V @} : @{ @{ <digit> @} + | V @}}
@end example
@end example
Note: The @i{<real clause width>} is only valid for @i{<conversion
code>} `C' or `F'.
@item 7.5.7 I/O control@*
To achieve compatibility of text files written with CHILL i/o with
the standard representation of text on the underlying operating system
the interpretation of the i/o control clause of the format
deviates from Z.200. The following table shows the i/o codes together
with the control characters written before and after the text record,
to achieve the indicated function:
@table @samp
@item /
Write next record (record, line feed)
@item +
Write record on next page (form feed, record, line feed)
@item -
Write record on current line (record, carriage return)
@item ?
Write record as a prompt (carriage return, record)
@item !
Emit record (record).
@item =
Force new page for the next line: The control character written before
the next record will be form feed, irrespective of the i/o control used for
transferring the record.
@end table
When reading a text file containing control characters other than line feed,
these characters have to be reckoned with by the format used to read the
text records.
@item 11.2.2 Regionality@*
Regionality is not implemented at all, so there is no difference in the
generated code when REGION is substituted by MODULE in a GNUCHILL
compilation unit.
@item 11.5 Signal definition statement@*
The @i{<signal definition statement>} may only occur at module level.
@item 12.3 Case Selection@*
The syntax of @i{<case label specification>} is changed to:
@example
@i{<case label specification> ::=}
@example
@i{( <case label> @{, <case label> @} * )}
@end example
@i{<case label> ::=}
@example
@i{<discrete literal expression>}
| @i{<literal range>}
| @i{<discrete mode name>}
| @b{ELSE}
@end example
@end example
@end itemize
@node Directives
@chapter Compiler Directives
@itemize @bullet
@item ALL_STATIC_ON, ALL_STATIC_OFF@*
These directives control where procedure local variables are
allocated. ALL_STATIC_ON turns allocation of procedure local variables
in the data space ON, regardless of the keyword STATIC being used or not.
ALL_STATIC_OFF places procedure local variables in the stack space.
The default is ALL_STATIC_OFF.
@item RANGE_ON, RANGE_OFF@*
Turns generation of rangecheck code ON and OFF.
@item USE_SEIZE_FILE <character string literal>@*
Specify the filename (as a character string literal) where
subsequent SEIZE statements are related to. This directive
and the subsequent SEIZEs are written
to a possibly generated grant file for this module.
@example
<> USE_SEIZE_FILE "foo.grt" <>
SEIZE bar;
@end example
@item USE_SEIZE_FILE_RESTRICTED "filename"@*
Same as USE_SEIZE_FILE. The difference is that this directive
and subsequent SEIZEs are *not* written to a possibly generated
grant file.
@item PROCESS_TYPE = <integer expression>@*
Set start value for all PROCESS delclarations. This value automatically
gets incremented after each PROCESS declaration and may be changed with
a new PROCESS_TYPE compiler directive.
@item SIGNAL_CODE = <integer expression>@*
Set start value for all SIGNAL definitions. This value automatically
gets incremented after each SIGNAL definition and may be changed with a
new SIGNAL_CODE compiler directive.
@item SEND_SIGNAL_DEFAULT_PRIORITY = <integer expression>@*
Set default priority for send signal action.
@item SEND_BUFFER_DEFAULT_PRIORITY = <integer expression>@*
Set default priority for send buffer action.
Note: Every <integer expression> in the above mentioned compiler
directives may also be specified by a SYNONYM of an integer type.
@example
SYN first_signal_code = 10;
<> SIGNAL_CODE = first_signal_code <>
SIGNAL s1;
@end example
@end itemize
@node References
@chapter Language Definition References
@itemize @bullet
@item CCITT High Level Language (CHILL) Recommendation Z.200
ISO/IEC 9496, Geneva 1989 ISBN 92-61-03801-8
@item An Analytic Description of CHILL, the CCITT high-level
language, Branquart, Louis & Wodon, Springer-Verlag 1981
ISBN 3-540-11196-4
@item CHILL User's Manual
CCITT, Geneva 1986 ISBN 92-61-02601-X
@item Introduction to CHILL
CCITT, Geneva 1983 ISBN 92-61-017771-1
@item CHILL CCITT High Level Language
Proceedings of the 5th CHILL Conference
North-Holland, 1991 ISBN 0 444 88904 3
@item Introduction to the CHILL programming Language
TELEBRAS, Campinas, Brazil 1990
@end itemize
Z.200 is mostly a language-lawyer's document, but more readable
than most. The User's Guide is more readable by far, but doesn't
cover the whole language. Our copies of these documents came through
Global Engineering Documents, in Irvine, CA, USA. (714)261-1455.
@contents
@bye
gcc/ch/gperf 0 → 100644
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/hash.h 0 → 100644
/* C code produced by gperf version 2.5 (GNU C++ version) */
/* Command-line: gperf -D -E -S1 -p -j1 -i 1 -g -o -t -k* gperf.tmp */
struct resword {
char *name;
short token;
enum rid rid;
enum toktype { RESERVED, DIRECTIVE, PREDEF } flags;
};
extern tree ridpointers [];
/* maximum key range = 2815, duplicates = 6 */
#ifdef __GNUC__
inline
#endif
static unsigned int
hash (str, len)
register char *str;
register int unsigned len;
{
static unsigned short asso_values[] =
{
2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822,
2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822,
2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822,
2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822,
2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822,
2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822, 2822,
2822, 2822, 2822, 2822, 2822, 4, 61, 80, 12, 350,
91, 39, 3, 2, 2822, 4, 129, 155, 64, 46,
65, 2822, 96, 13, 1, 135, 7, 2, 8, 124,
7, 2822, 2822, 2822, 2822, 1, 2822, 94, 40, 127,
21, 1, 81, 1, 1, 7, 2822, 3, 23, 74,
255, 203, 70, 2822, 218, 1, 88, 124, 1, 6,
10, 56, 40, 2822, 2822, 2822, 2822, 2822,
};
register int hval = len;
switch (hval)
{
default:
case 30:
hval += asso_values[str[29]];
case 29:
hval += asso_values[str[28]];
case 28:
hval += asso_values[str[27]];
case 27:
hval += asso_values[str[26]];
case 26:
hval += asso_values[str[25]];
case 25:
hval += asso_values[str[24]];
case 24:
hval += asso_values[str[23]];
case 23:
hval += asso_values[str[22]];
case 22:
hval += asso_values[str[21]];
case 21:
hval += asso_values[str[20]];
case 20:
hval += asso_values[str[19]];
case 19:
hval += asso_values[str[18]];
case 18:
hval += asso_values[str[17]];
case 17:
hval += asso_values[str[16]];
case 16:
hval += asso_values[str[15]];
case 15:
hval += asso_values[str[14]];
case 14:
hval += asso_values[str[13]];
case 13:
hval += asso_values[str[12]];
case 12:
hval += asso_values[str[11]];
case 11:
hval += asso_values[str[10]];
case 10:
hval += asso_values[str[9]];
case 9:
hval += asso_values[str[8]];
case 8:
hval += asso_values[str[7]];
case 7:
hval += asso_values[str[6]];
case 6:
hval += asso_values[str[5]];
case 5:
hval += asso_values[str[4]];
case 4:
hval += asso_values[str[3]];
case 3:
hval += asso_values[str[2]];
case 2:
hval += asso_values[str[1]];
case 1:
hval += asso_values[str[0]];
}
return hval;
}
#ifdef __GNUC__
inline
#endif
struct resword *
in_word_set (str, len)
register char *str;
register unsigned int len;
{
enum
{
TOTAL_KEYWORDS = 300,
MIN_WORD_LENGTH = 2,
MAX_WORD_LENGTH = 30,
MIN_HASH_VALUE = 7,
MAX_HASH_VALUE = 2821,
};
static struct resword wordlist[] =
{
{"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",},
{"AT", AT, NORID, RESERVED},
{"WITH", WITH, NORID, RESERVED},
{"THIS", THIS, NORID, RESERVED},
{"else", ELSE, NORID, RESERVED},
{"while", WHILE, NORID, RESERVED},
{"TO", TO, NORID, RESERVED},
{"seize", SEIZE, NORID, RESERVED},
{"DO", DO, NORID, RESERVED},
{"OD", OD, NORID, RESERVED},
{"BIT", BOOLS, RID_BOOLS, PREDEF},
{"IN", IN, RID_IN, RESERVED},
{"INIT", INIT, NORID, RESERVED},
{"AND", AND, NORID, RESERVED},
{"fi", FI, NORID, RESERVED},
{"if", IF, NORID, RESERVED},
{"set", SET, NORID, RESERVED},
{"FI", FI, NORID, RESERVED},
{"IF", IF, NORID, RESERVED},
{"by", BY, NORID, RESERVED},
{"this", THIS, NORID, RESERVED},
{"with", WITH, NORID, RESERVED},
{"STATIC", STATIC, NORID, RESERVED},
{"exit", EXIT, NORID, RESERVED},
{"ON", ON, NORID, RESERVED},
{"NOT", NOT, NORID, RESERVED},
{"elsif", ELSIF, NORID, RESERVED},
{"START", START, NORID, RESERVED},
{"list", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"POS", POS, NORID, RESERVED},
{"DOWN", DOWN, NORID, RESERVED},
{"STOP", STOP, NORID, RESERVED},
{"BIN", BIN, NORID, RESERVED},
{"GOTO", GOTO, NORID, RESERVED},
{"bit", BOOLS, RID_BOOLS, PREDEF},
{"OF", OF, NORID, RESERVED},
{"all", ALL, NORID, RESERVED},
{"OR", OR, NORID, RESERVED},
{"ROW", ROW, NORID, RESERVED},
{"LIST", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"XOR", XOR, NORID, RESERVED},
{"PACK", PACK, NORID, RESERVED},
{"based", BASED, NORID, RESERVED},
{"step", STEP, NORID, RESERVED},
{"page", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"asm", ASM_KEYWORD, NORID, RESERVED},
{"dcl", DCL, NORID, RESERVED},
{"ASM", ASM_KEYWORD, NORID, RESERVED},
{"ANDIF", ANDIF, NORID, RESERVED},
{"simple", SIMPLE, NORID, RESERVED},
{"at", AT, NORID, RESERVED},
{"OUT", PARAMATTR, RID_OUT, RESERVED},
{"BY", BY, NORID, RESERVED},
{"text", TEXT, NORID, RESERVED},
{"FAR", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"up", UP, NORID, RESERVED},
{"delay", DELAY, NORID, RESERVED},
{"CHARS", CHARS, NORID, RESERVED},
{"UP", UP, NORID, RESERVED},
{"spec", SPEC, NORID, RESERVED},
{"SYN", SYN, NORID, RESERVED},
{"GRANT", GRANT, NORID, RESERVED},
{"MOD", MOD, NORID, RESERVED},
{"small", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"DCL", DCL, NORID, RESERVED},
{"ever", EVER, NORID, RESERVED},
{"do", DO, NORID, RESERVED},
{"od", OD, NORID, RESERVED},
{"case", CASE, NORID, RESERVED},
{"esac", ESAC, NORID, RESERVED},
{"CCITT_OS", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"FOR", FOR, NORID, RESERVED},
{"ORIF", ORIF, NORID, RESERVED},
{"BODY", BODY, NORID, RESERVED},
{"INOUT", PARAMATTR, RID_INOUT, RESERVED},
{"SIGNAL", SIGNAL, NORID, RESERVED},
{"LOC", LOC, NORID, RESERVED},
{"NOLIST", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"even", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"in", IN, RID_IN, RESERVED},
{"ALL", ALL, NORID, RESERVED},
{"NOPACK", NOPACK, NORID, RESERVED},
{"call", CALL, NORID, RESERVED},
{"pos", POS, NORID, RESERVED},
{"end", END, NORID, RESERVED},
{"send", SEND, NORID, RESERVED},
{"of", OF, NORID, RESERVED},
{"PROC", PROC, NORID, RESERVED},
{"to", TO, NORID, RESERVED},
{"rem", REM, NORID, RESERVED},
{"pack", PACK, NORID, RESERVED},
{"BOOLS", BOOLS, RID_BOOLS, RESERVED},
{"mod", MOD, NORID, RESERVED},
{"ref", REF, NORID, RESERVED},
{"use_seize_file", USE_SEIZE_FILE, NORID, DIRECTIVE},
{"bin", BIN, NORID, RESERVED},
{"medium", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"begin", BEGINTOKEN, NORID, RESERVED},
{"FORBID", FORBID, NORID, RESERVED},
{"syn", SYN, NORID, RESERVED},
{"body", BODY, NORID, RESERVED},
{"ARRAY", ARRAY, NORID, RESERVED},
{"STRUCT", STRUCT, NORID, RESERVED},
{"read", READ, RID_READ, RESERVED},
{"cycle", CYCLE, NORID, RESERVED},
{"large", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"VARYING", VARYING, NORID, RESERVED},
{"CALL", CALL, NORID, RESERVED},
{"then", THEN, NORID, RESERVED},
{"event", EVENT, NORID, RESERVED},
{"cause", CAUSE, NORID, RESERVED},
{"loc", LOC, NORID, RESERVED},
{"access", ACCESS, NORID, RESERVED},
{"init", INIT, NORID, RESERVED},
{"receive", RECEIVE, NORID, RESERVED},
{"TEXT", TEXT, NORID, RESERVED},
{"EXIT", EXIT, NORID, RESERVED},
{"stop", STOP, NORID, RESERVED},
{"SET", SET, NORID, RESERVED},
{"and", AND, NORID, RESERVED},
{"signal", SIGNAL, NORID, RESERVED},
{"far", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"assert", ASSERT, NORID, RESERVED},
{"static", STATIC, NORID, RESERVED},
{"debug_types", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"prefixed", PREFIXED, NORID, RESERVED},
{"out", PARAMATTR, RID_OUT, RESERVED},
{"THEN", THEN, NORID, RESERVED},
{"or", OR, NORID, RESERVED},
{"END", END, NORID, RESERVED},
{"row", ROW, NORID, RESERVED},
{"STEP", STEP, NORID, RESERVED},
{"xor", XOR, NORID, RESERVED},
{"SMALL", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"PRIORITY", PRIORITY, NORID, RESERVED},
{"SEND", SEND, NORID, RESERVED},
{"BASED", BASED, NORID, RESERVED},
{"chars", CHARS, NORID, RESERVED},
{"DYNAMIC", DYNAMIC, RID_DYNAMIC, RESERVED},
{"CASE", CASE, NORID, RESERVED},
{"ESAC", ESAC, NORID, RESERVED},
{"module", MODULE, NORID, RESERVED},
{"on", ON, NORID, RESERVED},
{"result", RESULT, NORID, RESERVED},
{"PAGE", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"andif", ANDIF, NORID, RESERVED},
{"READ", READ, RID_READ, RESERVED},
{"bools", BOOLS, RID_BOOLS, RESERVED},
{"ASSERT", ASSERT, NORID, RESERVED},
{"debug_lines", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"after", AFTER, NORID, RESERVED},
{"ALL_STATIC_ON", ALL_STATIC_ON, NORID, DIRECTIVE},
{"down", DOWN, NORID, RESERVED},
{"WHILE", WHILE, NORID, RESERVED},
{"start", START, NORID, RESERVED},
{"optimize", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"goto", GOTO, NORID, RESERVED},
{"for", FOR, NORID, RESERVED},
{"SPEC", SPEC, NORID, RESERVED},
{"orif", ORIF, NORID, RESERVED},
{"BEGIN", BEGINTOKEN, NORID, RESERVED},
{"REF", REF, NORID, RESERVED},
{"OPTIMIZATION_WINDOW", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"ACCESS", ACCESS, NORID, RESERVED},
{"AFTER", AFTER, NORID, RESERVED},
{"not", NOT, NORID, RESERVED},
{"buffer", BUFFER, NORID, RESERVED},
{"inline", INLINE, RID_INLINE, RESERVED},
{"CONTEXT", CONTEXT, NORID, RESERVED},
{"RANGE", RANGE, NORID, RESERVED},
{"newmode", NEWMODE, NORID, RESERVED},
{"range", RANGE, NORID, RESERVED},
{"forbid", FORBID, NORID, RESERVED},
{"nolist", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"CAUSE", CAUSE, NORID, RESERVED},
{"ELSIF", ELSIF, NORID, RESERVED},
{"remote", REMOTE, NORID, RESERVED},
{"timeout", TIMEOUT, NORID, RESERVED},
{"powerset", POWERSET, NORID, RESERVED},
{"debug_symbols", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"general", GENERAL, NORID, RESERVED},
{"REGION", REGION, NORID, RESERVED},
{"REM", REM, NORID, RESERVED},
{"ALL_STATIC_OFF", ALL_STATIC_OFF, NORID, DIRECTIVE},
{"INLINE", INLINE, RID_INLINE, RESERVED},
{"synmode", SYNMODE, NORID, RESERVED},
{"proc", PROC, NORID, RESERVED},
{"LARGE", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"DELAY", DELAY, NORID, RESERVED},
{"process", PROCESS, NORID, RESERVED},
{"OPTIMIZE", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"varying", VARYING, NORID, RESERVED},
{"dynamic", DYNAMIC, RID_DYNAMIC, RESERVED},
{"ccitt_os", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"struct", STRUCT, NORID, RESERVED},
{"grant", GRANT, NORID, RESERVED},
{"empty_off", EMPTY_OFF, NORID, DIRECTIVE},
{"PROCESS", PROCESS, NORID, RESERVED},
{"RANGE_ON", RANGE_ON, NORID, DIRECTIVE},
{"inout", PARAMATTR, RID_INOUT, RESERVED},
{"array", ARRAY, NORID, RESERVED},
{"region", REGION, NORID, RESERVED},
{"TIMEOUT", TIMEOUT, NORID, RESERVED},
{"recursive", RECURSIVE, NORID, RESERVED},
{"event_code", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"NONREF", NONREF, NORID, RESERVED},
{"SIMPLE", SIMPLE, NORID, RESERVED},
{"SEIZE", SEIZE, NORID, RESERVED},
{"RESULT", RESULT, NORID, RESERVED},
{"multiple_data_segs", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"signal_code", SIGNAL_CODE, NORID, DIRECTIVE},
{"RETURN", RETURN, NORID, RESERVED},
{"CONTINUE", CONTINUE, NORID, RESERVED},
{"SIGNAL_CODE", SIGNAL_CODE, NORID, DIRECTIVE},
{"empty_on", EMPTY_ON, NORID, DIRECTIVE},
{"nopack", NOPACK, NORID, RESERVED},
{"RETURNS", RETURNS, NORID, RESERVED},
{"CYCLE", CYCLE, NORID, RESERVED},
{"SYNMODE", SYNMODE, NORID, RESERVED},
{"exceptions", EXCEPTIONS, NORID, RESERVED},
{"EVEN", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"PRINT_O_CODE", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"EVENT", EVENT, NORID, RESERVED},
{"context", CONTEXT, NORID, RESERVED},
{"RANGE_OFF", RANGE_OFF, NORID, DIRECTIVE},
{"EVER", EVER, NORID, RESERVED},
{"EMPTY_ON", EMPTY_ON, NORID, DIRECTIVE},
{"MEDIUM", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"BUFFER", BUFFER, NORID, RESERVED},
{"MODULE", MODULE, NORID, RESERVED},
{"grant_file_size", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"ELSE", ELSE, NORID, RESERVED},
{"process_type", PROCESS_TYPE_TOKEN, NORID, DIRECTIVE},
{"priority", PRIORITY, NORID, RESERVED},
{"buffer_code", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"return", RETURN, NORID, RESERVED},
{"returns", RETURNS, NORID, RESERVED},
{"all_static_off", ALL_STATIC_OFF, NORID, DIRECTIVE},
{"POWERSET", POWERSET, NORID, RESERVED},
{"EMPTY_OFF", EMPTY_OFF, NORID, DIRECTIVE},
{"range_off", RANGE_OFF, NORID, DIRECTIVE},
{"signal_max_length", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"PREFIXED", PREFIXED, NORID, RESERVED},
{"NEWMODE", NEWMODE, NORID, RESERVED},
{"EXCEPTIONS", EXCEPTIONS, NORID, RESERVED},
{"REMOTE", REMOTE, NORID, RESERVED},
{"SHORT_PRED_SUCC", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"all_static_on", ALL_STATIC_ON, NORID, DIRECTIVE},
{"nonref", NONREF, NORID, RESERVED},
{"SIGNAL_MAX_LENGTH", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"REENTRANT", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"range_on", RANGE_ON, NORID, DIRECTIVE},
{"GENERAL", GENERAL, NORID, RESERVED},
{"continue", CONTINUE, NORID, RESERVED},
{"STATE_ROUTINE", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"EXTRA_CONST_SEG", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"use_seize_file_restricted", USE_SEIZE_FILE_RESTRICTED, NORID, DIRECTIVE},
{"ONLY_FOR_TARGET", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"extra_const_seg", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"multiple_const_segs", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"RECURSIVE", RECURSIVE, NORID, RESERVED},
{"DEBUG_SYMBOLS", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"DEBUG_TYPES", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"GRANT_FILE_SIZE", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"DEBUG_LINES", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"ONLY_FOR_SIMULATION", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"state_routine", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"generate_set_names", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"print_o_code", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"PROCESS_TYPE", PROCESS_TYPE_TOKEN, NORID, DIRECTIVE},
{"short_pred_succ", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"reentrant", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"RECEIVE", RECEIVE, NORID, RESERVED},
{"EVENT_CODE", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"optimize_runtime", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"SUPPORT_CAUSING_ADDRESS", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"print_symbol_table", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"REENTRANT_ALL", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"PRINT_SYMBOL_TABLE", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"BUFFER_CODE", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"generate_all_set_names", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"NO_OVERLAP_CHECK", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"no_overlap_check", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"reentrant_all", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"MULTIPLE_DATA_SEGS", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"OPTIMIZE_RUNTIME", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"only_for_target", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"MULTIPLE_CONST_SEGS", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"optimization_window", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"support_causing_address", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"USE_SEIZE_FILE", USE_SEIZE_FILE, NORID, DIRECTIVE},
{"SEND_SIGNAL_DEFAULT_PRIORITY", SEND_SIGNAL_DEFAULT_PRIORITY, NORID, DIRECTIVE},
{"make_publics_for_discrete_syns", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"only_for_simulation", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"send_signal_default_priority", SEND_SIGNAL_DEFAULT_PRIORITY, NORID, DIRECTIVE},
{"send_buffer_default_priority", SEND_BUFFER_DEFAULT_PRIORITY, NORID, DIRECTIVE},
{"GENERATE_SET_NAMES", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"MAKE_PUBLICS_FOR_DISCRETE_SYNS", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"SEND_BUFFER_DEFAULT_PRIORITY", SEND_BUFFER_DEFAULT_PRIORITY, NORID, DIRECTIVE},
{"GENERATE_ALL_SET_NAMES", IGNORED_DIRECTIVE, NORID, DIRECTIVE},
{"USE_SEIZE_FILE_RESTRICTED", USE_SEIZE_FILE_RESTRICTED, NORID, DIRECTIVE},
};
if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH)
{
register int key = hash (str, len);
if (key <= MAX_HASH_VALUE && key >= MIN_HASH_VALUE)
{
{
struct resword *resword;
switch (key)
{
case 7:
resword = &wordlist[7]; break;
case 12:
resword = &wordlist[8]; break;
case 23:
resword = &wordlist[9]; break;
case 30:
resword = &wordlist[10]; break;
case 43:
resword = &wordlist[11]; break;
case 49:
resword = &wordlist[12]; break;
case 55:
resword = &wordlist[13]; break;
case 60:
resword = &wordlist[14];
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1)) return resword;
resword = &wordlist[15];
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1)) return resword;
return 0;
case 67:
resword = &wordlist[16]; break;
case 68:
resword = &wordlist[17]; break;
case 73:
resword = &wordlist[18]; break;
case 83:
resword = &wordlist[19]; break;
case 90:
resword = &wordlist[20];
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1)) return resword;
resword = &wordlist[21];
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1)) return resword;
return 0;
case 93:
resword = &wordlist[22]; break;
case 95:
resword = &wordlist[23];
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1)) return resword;
resword = &wordlist[24];
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1)) return resword;
return 0;
case 98:
resword = &wordlist[25]; break;
case 101:
resword = &wordlist[26]; break;
case 106:
resword = &wordlist[27]; break;
case 107:
resword = &wordlist[28]; break;
case 110:
resword = &wordlist[29]; break;
case 112:
resword = &wordlist[30]; break;
case 114:
resword = &wordlist[31]; break;
case 118:
resword = &wordlist[32]; break;
case 120:
resword = &wordlist[33]; break;
case 123:
resword = &wordlist[34]; break;
case 127:
resword = &wordlist[35]; break;
case 128:
resword = &wordlist[36]; break;
case 129:
resword = &wordlist[37]; break;
case 130:
resword = &wordlist[38]; break;
case 136:
resword = &wordlist[39]; break;
case 138:
resword = &wordlist[40]; break;
case 139:
resword = &wordlist[41]; break;
case 143:
resword = &wordlist[42]; break;
case 144:
resword = &wordlist[43]; break;
case 147:
resword = &wordlist[44]; break;
case 149:
resword = &wordlist[45]; break;
case 153:
resword = &wordlist[46]; break;
case 157:
resword = &wordlist[47]; break;
case 162:
resword = &wordlist[48]; break;
case 164:
resword = &wordlist[49]; break;
case 170:
resword = &wordlist[50]; break;
case 172:
resword = &wordlist[51]; break;
case 174:
resword = &wordlist[52]; break;
case 175:
resword = &wordlist[53]; break;
case 178:
resword = &wordlist[54]; break;
case 182:
resword = &wordlist[55]; break;
case 184:
resword = &wordlist[56]; break;
case 185:
resword = &wordlist[57]; break;
case 187:
resword = &wordlist[58]; break;
case 191:
resword = &wordlist[59]; break;
case 194:
resword = &wordlist[60]; break;
case 196:
resword = &wordlist[61]; break;
case 200:
resword = &wordlist[62]; break;
case 201:
resword = &wordlist[63]; break;
case 202:
resword = &wordlist[64]; break;
case 203:
resword = &wordlist[65]; break;
case 204:
resword = &wordlist[66]; break;
case 209:
resword = &wordlist[67]; break;
case 216:
resword = &wordlist[68]; break;
case 220:
resword = &wordlist[69]; break;
case 224:
resword = &wordlist[70]; break;
case 225:
resword = &wordlist[71]; break;
case 226:
resword = &wordlist[72];
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1)) return resword;
resword = &wordlist[73];
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1)) return resword;
return 0;
case 227:
resword = &wordlist[74];
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1)) return resword;
resword = &wordlist[75];
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1)) return resword;
return 0;
case 232:
resword = &wordlist[76]; break;
case 236:
resword = &wordlist[77]; break;
case 239:
resword = &wordlist[78]; break;
case 247:
resword = &wordlist[79]; break;
case 253:
resword = &wordlist[80]; break;
case 257:
resword = &wordlist[81]; break;
case 258:
resword = &wordlist[82]; break;
case 261:
resword = &wordlist[83]; break;
case 262:
resword = &wordlist[84]; break;
case 264:
resword = &wordlist[85]; break;
case 265:
resword = &wordlist[86]; break;
case 269:
resword = &wordlist[87]; break;
case 271:
resword = &wordlist[88]; break;
case 277:
resword = &wordlist[89]; break;
case 280:
resword = &wordlist[90]; break;
case 282:
resword = &wordlist[91]; break;
case 286:
resword = &wordlist[92]; break;
case 291:
resword = &wordlist[93]; break;
case 293:
resword = &wordlist[94]; break;
case 296:
resword = &wordlist[95]; break;
case 298:
resword = &wordlist[96]; break;
case 300:
resword = &wordlist[97]; break;
case 301:
resword = &wordlist[98]; break;
case 303:
resword = &wordlist[99]; break;
case 304:
resword = &wordlist[100]; break;
case 305:
resword = &wordlist[101]; break;
case 307:
resword = &wordlist[102]; break;
case 309:
resword = &wordlist[103]; break;
case 314:
resword = &wordlist[104]; break;
case 315:
resword = &wordlist[105]; break;
case 324:
resword = &wordlist[106]; break;
case 329:
resword = &wordlist[107]; break;
case 332:
resword = &wordlist[108]; break;
case 338:
resword = &wordlist[109]; break;
case 339:
resword = &wordlist[110]; break;
case 342:
resword = &wordlist[111]; break;
case 343:
resword = &wordlist[112]; break;
case 346:
resword = &wordlist[113]; break;
case 349:
resword = &wordlist[114]; break;
case 351:
resword = &wordlist[115]; break;
case 352:
resword = &wordlist[116]; break;
case 356:
resword = &wordlist[117]; break;
case 357:
resword = &wordlist[118]; break;
case 361:
resword = &wordlist[119]; break;
case 363:
resword = &wordlist[120]; break;
case 364:
resword = &wordlist[121]; break;
case 365:
resword = &wordlist[122]; break;
case 366:
resword = &wordlist[123]; break;
case 367:
resword = &wordlist[124]; break;
case 373:
resword = &wordlist[125]; break;
case 387:
resword = &wordlist[126]; break;
case 396:
resword = &wordlist[127]; break;
case 409:
resword = &wordlist[128]; break;
case 411:
resword = &wordlist[129]; break;
case 415:
resword = &wordlist[130]; break;
case 417:
resword = &wordlist[131]; break;
case 418:
resword = &wordlist[132]; break;
case 422:
resword = &wordlist[133]; break;
case 423:
resword = &wordlist[134]; break;
case 429:
resword = &wordlist[135]; break;
case 430:
resword = &wordlist[136]; break;
case 433:
resword = &wordlist[137]; break;
case 434:
resword = &wordlist[138]; break;
case 435:
resword = &wordlist[139]; break;
case 440:
resword = &wordlist[140]; break;
case 443:
resword = &wordlist[141]; break;
case 445:
resword = &wordlist[142]; break;
case 446:
resword = &wordlist[143]; break;
case 448:
resword = &wordlist[144]; break;
case 451:
resword = &wordlist[145];
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1)) return resword;
resword = &wordlist[146];
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1)) return resword;
return 0;
case 452:
resword = &wordlist[147]; break;
case 460:
resword = &wordlist[148]; break;
case 461:
resword = &wordlist[149]; break;
case 462:
resword = &wordlist[150]; break;
case 463:
resword = &wordlist[151]; break;
case 466:
resword = &wordlist[152]; break;
case 475:
resword = &wordlist[153]; break;
case 483:
resword = &wordlist[154]; break;
case 486:
resword = &wordlist[155]; break;
case 487:
resword = &wordlist[156]; break;
case 488:
resword = &wordlist[157]; break;
case 489:
resword = &wordlist[158]; break;
case 491:
resword = &wordlist[159]; break;
case 494:
resword = &wordlist[160]; break;
case 498:
resword = &wordlist[161]; break;
case 499:
resword = &wordlist[162]; break;
case 505:
resword = &wordlist[163]; break;
case 512:
resword = &wordlist[164]; break;
case 513:
resword = &wordlist[165]; break;
case 521:
resword = &wordlist[166]; break;
case 540:
resword = &wordlist[167]; break;
case 543:
resword = &wordlist[168]; break;
case 546:
resword = &wordlist[169]; break;
case 547:
resword = &wordlist[170]; break;
case 549:
resword = &wordlist[171]; break;
case 551:
resword = &wordlist[172]; break;
case 554:
resword = &wordlist[173]; break;
case 557:
resword = &wordlist[174]; break;
case 558:
resword = &wordlist[175]; break;
case 568:
resword = &wordlist[176]; break;
case 574:
resword = &wordlist[177]; break;
case 576:
resword = &wordlist[178]; break;
case 583:
resword = &wordlist[179]; break;
case 587:
resword = &wordlist[180]; break;
case 590:
resword = &wordlist[181]; break;
case 591:
resword = &wordlist[182]; break;
case 592:
resword = &wordlist[183]; break;
case 596:
resword = &wordlist[184]; break;
case 599:
resword = &wordlist[185]; break;
case 600:
resword = &wordlist[186]; break;
case 603:
resword = &wordlist[187]; break;
case 604:
resword = &wordlist[188]; break;
case 607:
resword = &wordlist[189]; break;
case 617:
resword = &wordlist[190]; break;
case 618:
resword = &wordlist[191]; break;
case 622:
resword = &wordlist[192]; break;
case 623:
resword = &wordlist[193]; break;
case 624:
resword = &wordlist[194]; break;
case 628:
resword = &wordlist[195]; break;
case 636:
resword = &wordlist[196]; break;
case 639:
resword = &wordlist[197]; break;
case 641:
resword = &wordlist[198]; break;
case 650:
resword = &wordlist[199]; break;
case 652:
resword = &wordlist[200]; break;
case 661:
resword = &wordlist[201]; break;
case 664:
resword = &wordlist[202]; break;
case 670:
resword = &wordlist[203]; break;
case 672:
resword = &wordlist[204]; break;
case 682:
resword = &wordlist[205]; break;
case 685:
resword = &wordlist[206]; break;
case 691:
resword = &wordlist[207]; break;
case 697:
resword = &wordlist[208]; break;
case 707:
resword = &wordlist[209]; break;
case 709:
resword = &wordlist[210]; break;
case 717:
resword = &wordlist[211]; break;
case 720:
resword = &wordlist[212]; break;
case 727:
resword = &wordlist[213]; break;
case 730:
resword = &wordlist[214]; break;
case 731:
resword = &wordlist[215]; break;
case 745:
resword = &wordlist[216]; break;
case 748:
resword = &wordlist[217]; break;
case 750:
resword = &wordlist[218]; break;
case 751:
resword = &wordlist[219]; break;
case 756:
resword = &wordlist[220]; break;
case 758:
resword = &wordlist[221]; break;
case 762:
resword = &wordlist[222]; break;
case 768:
resword = &wordlist[223]; break;
case 771:
resword = &wordlist[224]; break;
case 773:
resword = &wordlist[225]; break;
case 775:
resword = &wordlist[226]; break;
case 776:
resword = &wordlist[227]; break;
case 777:
resword = &wordlist[228]; break;
case 779:
resword = &wordlist[229]; break;
case 791:
resword = &wordlist[230]; break;
case 807:
resword = &wordlist[231]; break;
case 814:
resword = &wordlist[232]; break;
case 815:
resword = &wordlist[233]; break;
case 830:
resword = &wordlist[234]; break;
case 833:
resword = &wordlist[235]; break;
case 834:
resword = &wordlist[236]; break;
case 846:
resword = &wordlist[237]; break;
case 849:
resword = &wordlist[238]; break;
case 875:
resword = &wordlist[239]; break;
case 909:
resword = &wordlist[240]; break;
case 910:
resword = &wordlist[241]; break;
case 912:
resword = &wordlist[242]; break;
case 926:
resword = &wordlist[243]; break;
case 931:
resword = &wordlist[244]; break;
case 933:
resword = &wordlist[245]; break;
case 944:
resword = &wordlist[246]; break;
case 947:
resword = &wordlist[247]; break;
case 982:
resword = &wordlist[248]; break;
case 986:
resword = &wordlist[249]; break;
case 989:
resword = &wordlist[250]; break;
case 1004:
resword = &wordlist[251]; break;
case 1007:
resword = &wordlist[252]; break;
case 1018:
resword = &wordlist[253]; break;
case 1019:
resword = &wordlist[254]; break;
case 1023:
resword = &wordlist[255]; break;
case 1035:
resword = &wordlist[256]; break;
case 1036:
resword = &wordlist[257]; break;
case 1039:
resword = &wordlist[258]; break;
case 1068:
resword = &wordlist[259]; break;
case 1077:
resword = &wordlist[260]; break;
case 1082:
resword = &wordlist[261]; break;
case 1086:
resword = &wordlist[262]; break;
case 1104:
resword = &wordlist[263]; break;
case 1105:
resword = &wordlist[264]; break;
case 1109:
resword = &wordlist[265]; break;
case 1138:
resword = &wordlist[266]; break;
case 1152:
resword = &wordlist[267]; break;
case 1162:
resword = &wordlist[268]; break;
case 1165:
resword = &wordlist[269]; break;
case 1167:
resword = &wordlist[270]; break;
case 1168:
resword = &wordlist[271]; break;
case 1182:
resword = &wordlist[272]; break;
case 1194:
resword = &wordlist[273]; break;
case 1207:
resword = &wordlist[274]; break;
case 1216:
resword = &wordlist[275]; break;
case 1217:
resword = &wordlist[276]; break;
case 1227:
resword = &wordlist[277]; break;
case 1242:
resword = &wordlist[278]; break;
case 1271:
resword = &wordlist[279]; break;
case 1274:
resword = &wordlist[280]; break;
case 1283:
resword = &wordlist[281]; break;
case 1301:
resword = &wordlist[282]; break;
case 1302:
resword = &wordlist[283]; break;
case 1321:
resword = &wordlist[284]; break;
case 1324:
resword = &wordlist[285]; break;
case 1339:
resword = &wordlist[286]; break;
case 1342:
resword = &wordlist[287]; break;
case 1345:
resword = &wordlist[288]; break;
case 1372:
resword = &wordlist[289]; break;
case 1422:
resword = &wordlist[290]; break;
case 1448:
resword = &wordlist[291]; break;
case 1546:
resword = &wordlist[292]; break;
case 1606:
resword = &wordlist[293]; break;
case 1654:
resword = &wordlist[294]; break;
case 1765:
resword = &wordlist[295]; break;
case 1808:
resword = &wordlist[296]; break;
case 1875:
resword = &wordlist[297]; break;
case 1877:
resword = &wordlist[298]; break;
case 1936:
resword = &wordlist[299]; break;
case 1989:
resword = &wordlist[300]; break;
case 2153:
resword = &wordlist[301]; break;
case 2224:
resword = &wordlist[302]; break;
case 2383:
resword = &wordlist[303]; break;
case 2448:
resword = &wordlist[304]; break;
case 2491:
resword = &wordlist[305]; break;
case 2821:
resword = &wordlist[306]; break;
default: return 0;
}
if (*str == *resword->name && !strcmp (str + 1, resword->name + 1))
return resword;
return 0;
}
}
}
return 0;
}
gcc/ch/lang-options.h 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
/* 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/format.c 0 → 100644
/* 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 <limits.h>
#include <string.h>
#include <ctype.h>
#include <setjmp.h>
#include <float.h>
#include <math.h>
#include <stdlib.h>
#if _TEXTIO_DEBUG_
#include <stdio.h>
#endif
#include "bitstring.h"
#include "auxtypes.h"
#include "iomodes.h"
#include "format.h"
#include "fileio.h"
#include "ioerror.h"
#define CH_BYTE_MIN 0xffffff80L
#define CH_BYTE_MAX 0x0000007fL
#define CH_UBYTE_MAX 0x000000ffUL
#define CH_INT_MIN 0xffff8000L
#define CH_INT_MAX 0x00007fffL
#define CH_UINT_MAX 0x0000ffffUL
#define CH_LONG_MIN 0x80000000L
#define CH_LONG_MAX 0x7fffffffL
#define CH_ULONG_MAX 0xffffffffUL
#ifndef M_LN2
#define M_LN2 0.69314718055994530942
#endif
#ifndef M_LN10
#define M_LN10 2.30258509299404568402
#endif
#define DMANTDIGS (1 + (int)(DBL_MANT_DIG * M_LN2 / M_LN10))
#define FMANTDIGS (1 + (int)(FLT_MANT_DIG * M_LN2 / M_LN10))
/* float register length */
#define MAXPREC 40
#define LET 0x0001
#define BIN 0x0002
#define DEC 0x0004
#define OCT 0x0008
#define HEX 0x0010
#define USC 0x0020
#define BIL 0x0040
#define SPC 0x0080
#define SCS 0x0100
#define IOC 0x0200
#define EDC 0x0400
#define CVC 0x0800
#define isDEC(c) ( chartab[(c)] & DEC )
#define isCVC(c) ( chartab[(c)] & CVC )
#define isEDC(c) ( chartab[(c)] & EDC )
#define isIOC(c) ( chartab[(c)] & IOC )
#define isUSC(c)
#define isXXX(c,XXX) ( chartab[(c)] & XXX )
/*
* local definitions
*/
static
short int chartab[256] = {
0, 0, 0, 0, 0, 0, 0, 0,
0, SPC, SPC, SPC, SPC, SPC, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
SPC, IOC, 0, 0, 0, 0, 0, 0,
SCS, SCS, SCS, SCS+IOC, SCS, SCS+IOC, SCS, SCS+IOC,
BIN+OCT+DEC+HEX, BIN+OCT+DEC+HEX, OCT+DEC+HEX, OCT+DEC+HEX, OCT+DEC+HEX,
OCT+DEC+HEX, OCT+DEC+HEX, OCT+DEC+HEX,
DEC+HEX, DEC+HEX, SCS, SCS, SCS+EDC, SCS+IOC, SCS+EDC, IOC,
0, LET+HEX+BIL, LET+HEX+BIL+CVC, LET+HEX+BIL+CVC, LET+HEX+BIL, LET+HEX,
LET+HEX+CVC, LET,
LET+BIL+CVC, LET, LET, LET, LET, LET, LET, LET+CVC,
LET, LET, LET, LET, LET+EDC, LET, LET, LET,
LET+EDC, LET, LET, SCS, 0, SCS, 0, USC,
0, LET+HEX, LET+HEX, LET+HEX, LET+HEX, LET+HEX, LET+HEX, LET,
LET, LET, LET, LET, LET, LET, LET, LET,
LET, LET, LET, LET, LET, LET, LET, LET,
LET, LET, LET, 0, 0, 0, 0, 0
};
typedef enum {
FormatText, FirstPercent, RepFact, ConvClause, EditClause, ClauseEnd,
AfterWidth, FractWidth, FractWidthCont, ExpoWidth, ExpoWidthCont,
ClauseWidth, CatchPadding, LastPercent
} fcsstate_t;
#define CONVERSIONCODES "CHOBF"
typedef enum {
DefaultConv, HexConv, OctalConv, BinaryConv, ScientConv
} convcode_t;
static
short int base[4] = { 10, 16, 8, 2 };
static
short int dset[4] = { DEC, HEX, OCT, BIN };
#define EDITCODES "X<>T"
typedef enum {
SpaceSkip, SkipLeft, SkipRight, Tabulation
} editcode_t;
#define IOCODES "/+-?!="
typedef enum {
NextRecord, NextPage, CurrentLine, Prompt, Emit, EndPage
} iocode_t;
typedef enum {
ConvAct, EditAct, IOAct
} acttype_t;
typedef enum {
NormalEnd, EndAtParen, TextFailEnd
} formatexit_t;
static
double ep_1[10] = {
1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9 };
static
double ep_10[10] = {
1e0, 1e10, 1e20, 1e30, 1e40, 1e50, 1e60, 1e70, 1e80, 1e90 };
static
double ep_100 = 1e100;
/* float register */
static
unsigned char floatdig[MAXPREC];
/*
* global io variables
*/
static Text_Mode* textptr = NULL;
static VarString* textrecptr;
static int actual_index;
static int maximum_index;
static int iolist_index;
static __tmp_IO_list* iolistptr;
static int iolistlen;
static char* iostrptr;
static int iostrlen;
static convcode_t convcode;
static editcode_t editcode;
static iocode_t iocode;
static unsigned long repetition;
static Boolean leftadjust;
static Boolean overflowev;
static Boolean dynamicwid;
static Boolean paddingdef;
static char paddingchar;
static Boolean fractiondef;
static unsigned long fractionwidth;
static Boolean exponentdef;
static unsigned long exponentwidth;
static unsigned long clausewidth;
static signed long textindex;
static
__tmp_IO_enum_table_type bool_tab[] =
{ { 0, "FALSE" },
{ 1, "TRUE" },
{ 0 , NULL } };
/*
* case insensitive compare: s1 is zero delimited, s2 has n chars
*/
static
int casncmp( const char* s1, const char* s2, int n )
{
int res = 0;
while( n-- )
{
if( (res = toupper(*s1++) - toupper(*s2++)) )
return res;
}
return *s1;
}
/*
* skip spaces with blank equal to tab
*/
static
int skip_space( int limit )
{
int skipped = 0;
while( actual_index < limit &&
(iostrptr[actual_index] == ' ' || iostrptr[actual_index] == '\t' ) )
{
actual_index++;
skipped++;
}
return skipped;
}
/*
* skip leading pad characters
*/
static
int skip_pad( int limit )
{
int skipped = 0;
while( actual_index < limit && iostrptr[actual_index] == paddingchar )
{
actual_index++;
skipped++;
}
#if _TEXTIO_DEBUG_
printf( "skipping '%c' until %d: %d\n", paddingchar, limit, skipped );
#endif
return skipped;
}
/*
* backup trailing pad characters
*/
static
int piks_pad( int start, int limit )
{
int skipped = 0;
while( start >/***=*/ limit && iostrptr[--start] == paddingchar )
{
skipped++;
}
#if _TEXTIO_DEBUG_
printf( "piksing '%c' from %d until %d: %d\n",
paddingchar, start, limit, skipped );
#endif
return skipped;
}
/*
* parse an integer
*/
static
int parse_int( int limit, int SET, int base,
unsigned long* valptr, int* signptr )
{
int parsed = actual_index;
Boolean digits = False;
unsigned long value = 0;
char curr;
int dig;
if( actual_index >= limit )
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_INT );
*signptr = +1;
if( iostrptr[actual_index] == '+' )
actual_index++;
else
if( iostrptr[actual_index] == '-' )
{ *signptr = -1;
actual_index++;
}
for( ; actual_index < limit; actual_index++ )
{
curr = iostrptr[actual_index];
if( curr == '_' ) continue;
if( isXXX(curr,SET) )
{
digits = True;
dig = curr <= '9' ? curr - '0' : toupper(curr) - 'A' + 10;
if( value > (ULONG_MAX - dig)/base )
IOEXCEPTION( TEXTFAIL, INT_VAL_OVERFLOW );
value = value*base + dig;
continue;
}
break;
}
if( !digits )
IOEXCEPTION( TEXTFAIL, NO_DIGITS_FOR_INT );
*valptr = value;
#if _TEXTIO_DEBUG_
printf( "parsing for int until %d, base %d: %u\n", limit, base, value );
#endif
return actual_index - parsed;
}
static
double
make_float( int dexp, int sign )
{
double value = atof( floatdig );
#if _TEXTIO_DEBUG_
printf( " value = %25.20e, dexp = %d\n", value, dexp );
#endif
while( dexp >= 100 )
value *= ep_100, dexp -= 100;
if( dexp >= 10 )
value *= ep_10[dexp/10], dexp %= 10;
if( dexp > 0 )
value *= ep_1[dexp];
while( dexp <= -100 )
value /= ep_100, dexp += 100;
if( dexp <= -10 )
value /= ep_10[-dexp/10], dexp %= 10;
if( dexp < 0 )
value /= ep_1[-dexp];
return sign ? -value : value;
}
/* %C -> fixed point [+|-]<digit>+[.<digit>*] */
static
int parse_fixedpoint( int limit, double* valptr )
{
int parsed = actual_index;
Boolean digits = False;
int sdig = 0;
double value;
char curr;
int sign = False;
int expo = 0;
if( actual_index >= limit )
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_FLOAT );
if( iostrptr[actual_index] == '+' )
actual_index++;
else
if( iostrptr[actual_index] == '-' )
{
sign = True;
actual_index++;
}
floatdig[0] = '.';
for( ; actual_index < limit; actual_index++ )
{
curr = iostrptr[actual_index];
if( ! isDEC(curr) )
break;
digits = True;
if( sdig < MAXPREC - 1 )
{
if( sdig || curr != '0' )
{
floatdig[++sdig] = curr;
expo++;
}
}
else
if( sdig )
expo++;
}
if( digits && curr == '.' )
{
actual_index++;
for( ; actual_index < limit; actual_index++ )
{
curr = iostrptr[actual_index];
if( !isDEC(curr) )
break;
if( sdig < MAXPREC - 1 )
{
if( sdig || curr != '0' )
floatdig[++sdig] = curr;
else
expo--;
}
}
}
floatdig[++sdig] = '\0';
if( !digits )
IOEXCEPTION( TEXTFAIL, NO_DIGITS_FOR_FLOAT );
*valptr = make_float( expo, sign);
return actual_index - parsed;
}
typedef enum {
s_sign, s_dig, s_period, s_fraca, s_fracb, s_expo, s_exposign,
s_expoa, s_expob }
scient_t;
/* %C -> scientific [+|-]<digit>[.<digit>*]E[=|-]<digit>+ */
static
int parse_scientific( int limit, double* valptr, double dmin, double dmax )
{
int parsed = actual_index;
int sdig = 0;
char curr;
double value;
int sign = False;
int expo = 0;
int expo_sign = +1;
scient_t state = s_sign;
if( actual_index >= limit )
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_FLOAT );
floatdig[0] = '.';
for( ; actual_index < limit; actual_index++ )
{
curr = iostrptr[actual_index];
switch( state )
{
case s_sign:
if( iostrptr[actual_index] == '+' )
{
state = s_dig;
break;
}
if( iostrptr[actual_index] == '-' )
{
sign = True;
state = s_dig;
break;
}
/* fall through - no break */
case s_dig:
if( isDEC(curr) && curr > '0' )
{
floatdig[++sdig] = curr;
state = s_period;
break;
}
IOEXCEPTION( TEXTFAIL, NO_DIGITS_FOR_FLOAT );
case s_period:
if( curr == '.' )
{
state = s_fraca;
break;
}
if( curr == 'E' )
{
state = s_exposign;
break;
}
IOEXCEPTION( TEXTFAIL, NO_EXPONENT );
case s_fraca:
if( isDEC(curr) )
{
floatdig[++sdig] = curr;
state = s_fracb;
break;
}
IOEXCEPTION( TEXTFAIL, NO_DIGITS_FOR_FLOAT );
case s_fracb:
if( isDEC(curr) )
{
if( sdig < MAXPREC - 1 )
floatdig[++sdig] = curr;
break;
}
if( curr == 'E' )
{
state = s_exposign;
break;
}
IOEXCEPTION( TEXTFAIL, NO_EXPONENT );
case s_exposign:
if( iostrptr[actual_index] == '+' )
{
state = s_expoa;
break;
}
if( iostrptr[actual_index] == '-' )
{
expo_sign = -1;
state = s_expoa;
break;
}
case s_expoa:
if( isDEC(curr) )
{
expo = curr - '0';
state = s_expob;
break;
}
IOEXCEPTION( TEXTFAIL, NO_EXPONENT );
case s_expob:
expo = expo*10 + (curr - '0');
if( expo > 1000 )
IOEXCEPTION( TEXTFAIL, REAL_OVERFLOW );
}
}
if( state != s_expob )
IOEXCEPTION( TEXTFAIL, NO_EXPONENT );
expo *= expo_sign;
expo++;
floatdig[++sdig] = '\0';
*valptr = make_float( expo, sign );
return actual_index - parsed;
}
static
int parse_set( int limit, __tmp_IO_enum_table_type* tabptr,
unsigned long* valptr )
{
int parsed = actual_index;
char curr;
__tmp_IO_enum_table_type* etptr;
if( actual_index >= limit )
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_SET );
curr = iostrptr[actual_index];
if( isXXX(curr,LET+USC) )
actual_index++;
else
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_SET );
for( ; actual_index < limit; actual_index++ )
{
if( ! isXXX(iostrptr[actual_index],LET+DEC+USC) )
break;
}
if( tabptr )
while( tabptr->name )
{
if( !casncmp( tabptr->name, &iostrptr[parsed], actual_index-parsed ) )
{
*valptr = tabptr->value;
#if _TEXTIO_DEBUG_
printf( "parsing set value until %d: %u\n", limit, tabptr->value );
#endif
return actual_index - parsed;
}
tabptr++;
}
IOEXCEPTION( TEXTFAIL, SET_CONVERSION_ERROR );
}
static
int parse_bit( int limit, char* bitptr )
{
int parsed = actual_index;
int i = 0;
char curr;
if( actual_index >= limit )
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_BOOLS );
for( ; actual_index < limit; actual_index++ )
{
curr = iostrptr[actual_index] - '0';
if( curr == 0 || curr == 1 )
/* __setbitinset( i++, bitptr, limit, curr ); */
__setbitpowerset (bitptr, limit, 0, i++, curr, __FILE__, __LINE__);
else
break;
}
return actual_index - parsed;
}
static
char* myultoa( unsigned long ul, char* buf, int base )
{
char* res = buf;
unsigned long h = ul/base;
unsigned long q = 1;
while( h >= q ) q *= base;
while( q > 0 )
{
*buf++ = "0123456789ABCDEF"[ul/q];
ul %= q;
q /= base;
}
*buf++ = '\0';
return res;
}
/*
* convert a bit string from src, bit offset up to len
*/
static
char* bitput( char* dst, char* src, int offset, int len )
{
char* res = dst;
int i;
for( i = offset; i < len; i++ )
{
*dst++ = __inpowerset( i, src, len, 0 ) ? '1' : '0';
}
return res;
}
/*
* dround: round decimal register *digptr starting at digit mdigs,
* on carry advance begin of digit sequence and bump exponent
*/
static
char*
dround( char* digptr, int mdigs, int* deptr )
{
int carry;
#if _TEXTIO_DEBUG_
printf( "Rounding from %d\n", mdigs );
#endif
if( digptr[mdigs] >= 5 )
{
carry = 1;
while( carry )
{
digptr[--mdigs]++;
if( digptr[mdigs] >= 10 )
digptr[mdigs] = 0;
else
carry = 0;
}
}
if( mdigs < 0 )
{
digptr[--mdigs] = 1;
(*deptr)++;
return digptr - 1;
}
else
return digptr;
}
/*
* mydtoa: convert val with a precision of mantdigs to a decimal fraction
* first digit is at **fstdiptr, decimal exponent is at *deptr
*/
static
char*
mydtoa( double val, int mantdigs, int* deptr, int* sgnptr )
{
double m;
int be;
int de = -1;
int fstdig = 0;
int idig;
char* digptr = floatdig+2;
floatdig[0] = floatdig[1] = 0;
if( val < 0 )
*sgnptr = -1, val = fabs( val );
else
*sgnptr = +1;
/* split the value */
m = frexp( val, &be ) * 10.0;
/* 5.0 <= m < 10.0 */
while( be > 0 )
{
de++; be--; m /= 5.0;
if( m < 1.0 )
m *= 10.0, de--;
}
while( be < 0 )
{
de--; be++; m *= 5.0;
if( m >= 10.0 )
m /= 10.0, de++;
}
for( idig = 0; idig < mantdigs; idig++ )
{
digptr[idig] = (int)m;
m = (m - digptr[idig])*10.0;
}
digptr[idig] = (int)m;
*deptr = de;
return dround( digptr, mantdigs, deptr );
}
#define PUT(c) \
{ if( ifst <= ++iprt && iprt <= ilst ) *dst++ = c; }
static
char*
fixput( char* dst, char* src,
int ifst, int ilst,
int sign, int fst, int lst,
int nid, int nfd )
{
char* dstsav = dst;
int idig;
int iprt = 0;
if( sign < 0 )
PUT( '-' );
for( idig = nid; idig >= -nfd; idig-- )
{
if (idig == -1)
PUT( '.' );
PUT( idig > fst || lst >= idig ? '0': '0' + *src++ );
}
return dstsav;
}
static
char*
sciput( char* dst, char* src, char* expbeg,
int ifst, int ilst,
int sign, int de, int expwid )
{
char* dstsav = dst;
int iprt = 0;
int nfd = fractionwidth;
int explen = strlen( expbeg );
if( sign < 0 )
PUT( '-' );
PUT( '0' + *src++ );
PUT( '.' );
while( nfd-- )
PUT( '0' + *src++ );
PUT( 'E' );
PUT( de >= 0 ? '+' : '-' );
while( expwid > explen )
{
PUT( '0' );
expwid--;
}
while( explen-- )
PUT( *expbeg++ );
return dstsav;
}
/*
* handle dynamic field width
*/
static
get_field_width( void )
{
unsigned long width;
unsigned long ulongval;
long longval;
__tmp_IO_list io;
if( ++iolist_index > iolistlen )
IOEXCEPTION( TEXTFAIL, IOLIST_EXHAUSTED );
io = *iolistptr++;
/* must be integer, >= 0 */
switch( io.__descr )
{
case __IO_ByteVal:
longval = io.__t.__valbyte;
goto signed_fieldwidth;
case __IO_UByteVal:
width = io.__t.__valubyte;
goto unsigned_fieldwidth;
case __IO_IntVal:
longval = io.__t.__valint;
goto signed_fieldwidth;
case __IO_UIntVal:
width = io.__t.__valuint;
goto unsigned_fieldwidth;
case __IO_LongVal:
longval = io.__t.__vallong;
goto signed_fieldwidth;
case __IO_ULongVal:
width = io.__t.__valulong;
goto unsigned_fieldwidth;
case __IO_ByteLoc:
longval = *(signed char*)io.__t.__locint;
goto signed_fieldwidth;
case __IO_UByteLoc:
width = *(unsigned char*)io.__t.__locint;
goto unsigned_fieldwidth;
case __IO_IntLoc:
longval = *(signed short*)io.__t.__locint;
goto signed_fieldwidth;
case __IO_UIntLoc:
width = *(unsigned short*)io.__t.__locint;
goto unsigned_fieldwidth;
case __IO_LongLoc:
longval = *(signed long*) io.__t.__locint;
goto signed_fieldwidth;
case __IO_ULongLoc:
width = *(unsigned long*)io.__t.__locint;
goto unsigned_fieldwidth;
default:
IOEXCEPTION( TEXTFAIL, NON_INT_FIELD_WIDTH );
}
signed_fieldwidth: ;
if( longval < 0 )
IOEXCEPTION( TEXTFAIL, NEGATIVE_FIELD_WIDTH );
width = longval;
unsigned_fieldwidth: ;
return width;
}
static
void inpconv( void )
{
__tmp_IO_list io;
int width;
int limit;
int skiplim;
int skipped;
int bypass;
int parsed;
Boolean fixedchars;
int fixedlen;
unsigned char curr;
double dval;
float fval;
__tmp_IO_long lval;
int sign;
unsigned long umin;
unsigned long umax;
signed long smin;
signed long smax;
int ilen;
short unsigned slen;
__tmp_IO_enum_table_type* settabptr;
while( repetition-- )
{
if( ++iolist_index > iolistlen )
IOEXCEPTION( TEXTFAIL, IOLIST_EXHAUSTED );
io = *iolistptr++;
if( dynamicwid )
width = get_field_width();
else
width = clausewidth;
bypass = skipped = 0;
if( width )
{
if( actual_index + width > iostrlen )
IOEXCEPTION( TEXTFAIL, NOT_ENOUGH_CHARS );
switch(io.__descr)
{
case __IO_CharLoc:
case __IO_CharRangeLoc:
fixedchars = True;
fixedlen = 1;
break;
case __IO_CharStrLoc:
fixedchars = True;
fixedlen = io.__t.__loccharstring.string_length;
break;
default:
fixedchars = False;
break;
}
if( leftadjust )
{
skiplim = fixedchars ? actual_index + fixedlen
: actual_index;
bypass = skipped = piks_pad( actual_index + width, skiplim );
}
else
{
skiplim = fixedchars ? actual_index + width - fixedlen
: actual_index + width;
skipped = skip_pad( skiplim );
}
width -= skipped;
limit = actual_index + width;
}
else
{ /* free format */
if( paddingdef || !( io.__descr == __IO_CharLoc ||
io.__descr == __IO_CharRangeLoc ||
io.__descr == __IO_CharStrLoc ||
io.__descr == __IO_CharVaryingLoc ) )
if( paddingchar == ' ' || paddingchar == '\t' )
skip_space( iostrlen );
else
skip_pad( iostrlen );
limit = iostrlen;
}
switch( io.__descr )
{
case __IO_ByteLoc:
ilen = 1;
smin = CH_BYTE_MIN;
smax = CH_BYTE_MAX;
goto parse_signed_int;
case __IO_UByteLoc:
ilen = 1;
umin = 0;
umax = CH_UBYTE_MAX;
goto parse_unsigned_int;
case __IO_IntLoc:
ilen = 2;
smin = CH_INT_MIN;
smax = CH_INT_MAX;
goto parse_signed_int;
case __IO_UIntLoc:
ilen = 2;
umin = 0;
umax = CH_UINT_MAX;
goto parse_unsigned_int;
case __IO_LongLoc:
ilen = 4;
smin = CH_LONG_MIN;
smax = CH_LONG_MAX;
goto parse_signed_int;
case __IO_ULongLoc:
ilen = 4;
umin = 0;
umax = CH_ULONG_MAX;
goto parse_unsigned_int;
case __IO_ByteRangeLoc:
ilen = 1;
smin = io.__t.__locintrange.lower.slong;
smax = io.__t.__locintrange.upper.slong;
goto parse_signed_int;
case __IO_UByteRangeLoc:
ilen = 1;
umin = io.__t.__locintrange.lower.ulong;
umax = io.__t.__locintrange.upper.ulong;
goto parse_unsigned_int;
case __IO_IntRangeLoc:
ilen = 2;
smin = io.__t.__locintrange.lower.slong;
smax = io.__t.__locintrange.upper.slong;
goto parse_signed_int;
case __IO_UIntRangeLoc:
ilen = 2;
umin = io.__t.__locintrange.lower.ulong;
umax = io.__t.__locintrange.upper.ulong;
goto parse_unsigned_int;
case __IO_LongRangeLoc:
ilen = 4;
smin = io.__t.__locintrange.lower.slong;
smax = io.__t.__locintrange.upper.slong;
goto parse_signed_int;
case __IO_ULongRangeLoc:
ilen = 4;
umin = io.__t.__locintrange.lower.ulong;
umax = io.__t.__locintrange.upper.ulong;
goto parse_unsigned_int;
case __IO_BoolLoc:
ilen = 1;
umin = 0;
umax = 1;
settabptr = bool_tab;
goto parse_set;
case __IO_BoolRangeLoc:
ilen = 1;
umin = io.__t.__locboolrange.lower;
umax = io.__t.__locboolrange.upper;
settabptr = bool_tab;
goto parse_set;
case __IO_SetLoc:
ilen = io.__t.__locsetrange.length;
settabptr = io.__t.__locsetrange.name_table;
umin = 0;
umax = CH_ULONG_MAX;
goto parse_set;
case __IO_SetRangeLoc:
ilen = io.__t.__locsetrange.length;
settabptr = io.__t.__locsetrange.name_table;
umin = io.__t.__locsetrange.lower;
umax = io.__t.__locsetrange.upper;
goto parse_set;
case __IO_CharLoc:
umin = 0;
umax = 0xff;
goto parse_char;
case __IO_CharRangeLoc:
umin = io.__t.__loccharrange.lower;
umax = io.__t.__loccharrange.upper;
goto parse_char;
case __IO_CharVaryingLoc:
if( convcode != DefaultConv )
IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
slen = io.__t.__loccharstring.string_length;
if( (parsed = limit - actual_index) < slen )
slen = parsed;
else
parsed = slen;
memcpy( io.__t.__loccharstring.string + 2,
&iostrptr[actual_index], parsed );
MOV2(io.__t.__loccharstring.string,&slen);
actual_index += parsed;
goto check_field_complete;
case __IO_CharStrLoc:
if( convcode != DefaultConv )
IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
if( actual_index + io.__t.__loccharstring.string_length > limit )
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_CHARS );
memcpy( io.__t.__loccharstring.string,
&iostrptr[actual_index],
parsed = io.__t.__loccharstring.string_length );
actual_index += parsed;
goto check_field_complete;
case __IO_BitStrLoc:
if( convcode != DefaultConv )
IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
parsed = parse_bit( limit, io.__t.__loccharstring.string );
if( parsed < io.__t.__loccharstring.string_length )
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_BOOLS );
goto check_field_complete;
case __IO_LongRealLoc:
case __IO_RealLoc:
switch( convcode )
{
case ScientConv:
parse_scientific( limit, &dval, DBL_MIN, DBL_MAX );
break;
case DefaultConv:
parse_fixedpoint( limit, &dval );
break;
default:
IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
}
if( io.__descr == __IO_LongRealLoc )
memcpy( io.__t.__loclongreal, &dval, sizeof(double) );
else
{
fval = (float)dval;
MOV4(io.__t.__locreal,&fval);
}
goto check_field_complete;
default:
IOEXCEPTION( TEXTFAIL, INVALID_IO_LIST );
}
parse_signed_int: ;
if( convcode == ScientConv )
IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
parsed = parse_int( limit, dset[convcode], base[convcode],
&lval.ulong, &sign );
if( sign < 0 )
{
if( lval.ulong > (unsigned long)CH_LONG_MIN )
IOEXCEPTION( TEXTFAIL, INTEGER_RANGE_ERROR );
lval.slong = -lval.ulong;
}
else
{
/* not needed: lval.slong = lval.ulong; */
/* Hack: sign extension for bin/oct/dec if no sign present */
if( convcode != DefaultConv && lval.ulong & (1 << (ilen*8-1)) )
{
if( ilen < 4 )
lval.ulong |= 0xFFFFFFFF << ilen*8;
}
else
if( lval.ulong > (unsigned long)CH_LONG_MAX )
IOEXCEPTION( TEXTFAIL, INTEGER_RANGE_ERROR );
}
if( lval.slong < smin || smax < lval.slong )
IOEXCEPTION( TEXTFAIL, INTEGER_RANGE_ERROR );
goto store_int;
parse_unsigned_int: ;
if( convcode == ScientConv )
IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
parsed = parse_int( limit, dset[convcode], base[convcode],
&lval.ulong, &sign );
if( sign < 0 || lval.ulong < umin || umax < lval.ulong )
IOEXCEPTION( TEXTFAIL, INTEGER_RANGE_ERROR );
goto store_int;
parse_set: ;
if( convcode != DefaultConv )
IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
parsed = parse_set( limit, settabptr, &lval.ulong );
if( lval.ulong < umin || umax < lval.ulong )
IOEXCEPTION( TEXTFAIL, SET_RANGE_ERROR );
goto store_int;
store_int: ;
switch( ilen )
{
case 1:
*(unsigned char*)io.__t.__locint = lval.ulong;
break;
case 2:
slen = lval.ulong;
MOV2(io.__t.__locint,&slen);
break;
case 4:
MOV4(io.__t.__locint,&lval.ulong);
break;
default:
IOEXCEPTION( TEXTFAIL, INTERNAL_ERROR );
}
goto check_field_complete;
parse_char: ;
if( convcode != DefaultConv )
IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
if( actual_index >= limit )
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_CHARS );
curr = iostrptr[actual_index++];
parsed = 1;
if( curr < umin || umax < curr )
IOEXCEPTION( TEXTFAIL, CHAR_RANGE_ERROR );
*io.__t.__locchar = curr;
goto check_field_complete;
check_field_complete: ;
actual_index += bypass;
if( width > parsed )
IOEXCEPTION( TEXTFAIL, INVALID_CHAR );
}
}
static
void inpedit( void )
{
int nchars;
if( dynamicwid )
clausewidth = get_field_width();
switch( editcode )
{
case SpaceSkip:
nchars = repetition*clausewidth;
if( actual_index + nchars > iostrlen )
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_EDIT );
for( ; nchars ; nchars-- )
if( iostrptr[actual_index++] != ' ' )
IOEXCEPTION( TEXTFAIL, NO_SPACE_TO_SKIP );
break;
case SkipLeft:
nchars = repetition*clausewidth;
if( (actual_index -= nchars) < 0 )
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_EDIT );
break;
case SkipRight:
nchars = repetition*clausewidth;
if( (actual_index += nchars) > iostrlen )
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_EDIT );
break;
case Tabulation:
if( (actual_index = clausewidth) > iostrlen )
IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
break;
}
}
static
void outconv( void )
{
unsigned long width;
char itembuf[33];
unsigned long ulongval;
long longval;
__tmp_IO_list io;
__tmp_IO_enum_table_type* etptr;
char* itembeg;
unsigned long itemlen;
double doubleval;
int de;
int sign;
int mantdigs;
int nid;
int nfd;
char* expbeg;
int explen;
unsigned int expwid;
while( repetition-- )
{
if( ++iolist_index > iolistlen )
IOEXCEPTION( TEXTFAIL, IOLIST_EXHAUSTED );
io = *iolistptr++;
width = dynamicwid ? get_field_width() : clausewidth;
switch( convcode )
{
case DefaultConv:
switch( io.__descr )
{
case __IO_ByteVal:
longval = io.__t.__valbyte;
goto signed_conversion;
case __IO_UByteVal:
ulongval = io.__t.__valubyte;
goto unsigned_conversion;
case __IO_IntVal:
longval = io.__t.__valint;
goto signed_conversion;
case __IO_UIntVal:
ulongval = io.__t.__valuint;
goto unsigned_conversion;
case __IO_LongVal:
longval = io.__t.__vallong;
goto signed_conversion;
case __IO_ULongVal:
ulongval = io.__t.__valulong;
goto unsigned_conversion;
case __IO_BoolVal:
switch( io.__t.__valbool )
{
case 0:
itembeg = "FALSE";
itemlen = 5;
goto move_item;
case 1:
itembeg = "TRUE";
itemlen = 4;
goto move_item;
default:
IOEXCEPTION( TEXTFAIL, BOOL_CONVERSION_ERROR );
}
case __IO_CharVal:
itembeg = &io.__t.__valchar;
itemlen = 1;
goto move_item;
case __IO_SetVal:
/* locate name string using set mode name table */
itembeg = 0;
if( (etptr = io.__t.__valset.name_table) )
while( etptr->name )
{
if( etptr->value == io.__t.__valset.value )
{
itembeg = etptr->name;
itemlen = strlen( itembeg );
goto move_item;
}
etptr++;
}
IOEXCEPTION( TEXTFAIL, SET_CONVERSION_ERROR );
case __IO_CharVaryingLoc:
{
unsigned short l;
itembeg = (char*)io.__t.__loccharstring.string;
MOV2(&l,itembeg);
itembeg += 2;
itemlen = l;
goto move_item;
}
case __IO_CharStrLoc:
itembeg = io.__t.__loccharstring.string;
itemlen = io.__t.__loccharstring.string_length;
goto move_item;
case __IO_BitStrLoc:
itemlen = io.__t.__loccharstring.string_length;
itembeg = io.__t.__loccharstring.string;
if( !width )
width = itemlen;
/* check remaining space */
if( actual_index + width > iostrlen )
IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
if( itemlen == width )
bitput( iostrptr + actual_index, itembeg, 0, itemlen );
else
if( itemlen < width )
if( leftadjust )
memset( bitput( iostrptr + actual_index, itembeg, 0, itemlen )
+ itemlen,
paddingchar, width - itemlen );
else
bitput( memset( iostrptr + actual_index,
paddingchar, width - itemlen )
+ width - itemlen,
itembeg, itemlen - width, itemlen );
else
if( overflowev )
memset( iostrptr + actual_index, '*', width );
else
if( leftadjust )
bitput( iostrptr + actual_index, itembeg, 0, width );
else
bitput( iostrptr + actual_index, itembeg,
itemlen - width, itemlen );
goto adjust_index;
case __IO_RealVal:
doubleval = io.__t.__valreal;
mantdigs = FMANTDIGS;
goto fixed_point_conversion;
case __IO_LongRealVal:
doubleval = io.__t.__vallongreal;
mantdigs = DBL_DIG;
goto fixed_point_conversion;
break;
default:
IOEXCEPTION( TEXTFAIL, INVALID_IO_LIST );
}
case HexConv:
case OctalConv:
case BinaryConv:
switch( io.__descr )
{
case __IO_ByteVal:
case __IO_UByteVal:
ulongval = io.__t.__valubyte;
break;
case __IO_IntVal:
case __IO_UIntVal:
ulongval = io.__t.__valuint;
break;
case __IO_LongVal:
case __IO_ULongVal:
ulongval = io.__t.__valulong;
break;
default:
IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
}
itembeg = myultoa( ulongval, itembuf, base[convcode] );
itemlen = strlen( itembeg );
goto move_item;
case ScientConv:
switch( io.__descr )
{
case __IO_RealVal:
doubleval = io.__t.__valreal;
mantdigs = FMANTDIGS;
if( !fractiondef )
fractionwidth = FMANTDIGS - 1;
goto scientific_conversion;
case __IO_LongRealVal:
doubleval = io.__t.__vallongreal;
mantdigs = DBL_DIG;
if( !fractiondef )
fractionwidth = DBL_DIG - 1;
goto scientific_conversion;
break;
default:
IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
}
}
fixed_point_conversion: ;
itembeg = mydtoa( doubleval, mantdigs, &de, &sign );
if( fractiondef && de >= -fractionwidth - 1
&& -fractionwidth > de - mantdigs )
itembeg = dround( itembeg, de + fractionwidth + 1, &de );
nid = de >= 0 ? de : 0;
nfd = fractiondef ? fractionwidth
: ( de + 1 - mantdigs > 0 ? 0 : mantdigs - de - 1 );
itemlen = ( sign < 0 ? 1 : 0 ) + 2 + nid + nfd;
#if _TEXTIO_DEBUG_
printf( "fixed item length %d\n", itemlen );
#endif
if( !width )
width = itemlen;
#if _TEXTIO_DEBUG_
printf( "fixed item width %d\n", width );
#endif
/* check remaining space */
if( actual_index + width > iostrlen )
IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
if( itemlen == width )
fixput( iostrptr + actual_index, itembeg,
1, itemlen, sign, de, de - mantdigs, nid, nfd );
else
if( itemlen < width )
if( leftadjust )
memset( fixput( iostrptr + actual_index, itembeg,
1, itemlen, sign, de, de - mantdigs, nid, nfd )
+ itemlen,
paddingchar, width - itemlen );
else
fixput( memset( iostrptr + actual_index,
paddingchar, width - itemlen )
+ width - itemlen,
itembeg, 1, itemlen, sign, de, de - mantdigs, nid, nfd );
else
if( overflowev )
memset( iostrptr + actual_index, '*', width );
else
if( leftadjust )
fixput( iostrptr + actual_index, itembeg,
1, width, sign, de, de - mantdigs, nid, nfd );
else
fixput( iostrptr + actual_index, itembeg,
itemlen - width + 1, itemlen,
sign, de, de - mantdigs, nid, nfd );
goto adjust_index;
scientific_conversion: ;
itembeg = mydtoa( doubleval, mantdigs, &de, &sign );
if( fractiondef && fractionwidth < mantdigs )
itembeg = dround( itembeg, fractionwidth + 1, &de );
expbeg = myultoa( abs(de), itembuf, 10 );
explen = strlen( expbeg );
expwid = explen > exponentwidth ? explen : exponentwidth;
itemlen = ( sign < 0 ? 1 : 0 ) + 2 + fractionwidth + 2 + expwid;
#if _TEXTIO_DEBUG_
printf( "floating item length %d, fraction %d, exponent %d\n",
itemlen, fractionwidth, expwid );
#endif
if( width == 0 )
width = itemlen;
#if _TEXTIO_DEBUG_
printf( "floating item width %d\n", width );
#endif
/* check remaining space */
if( actual_index + width > iostrlen )
IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
if( itemlen == width )
sciput( iostrptr + actual_index, itembeg, expbeg,
1, itemlen, sign, de, expwid );
else
if( itemlen < width )
if( leftadjust )
memset( sciput( iostrptr + actual_index, itembeg, expbeg,
1, itemlen, sign, de, expwid )
+ itemlen,
paddingchar, width - itemlen );
else
sciput( memset( iostrptr + actual_index,
paddingchar, width - itemlen )
+ width - itemlen,
itembeg, expbeg, 1, itemlen, sign, de, expwid );
else
if( overflowev )
memset( iostrptr + actual_index, '*', width );
else
if( leftadjust )
sciput( iostrptr + actual_index, itembeg, expbeg,
1, width, sign, de, expwid );
else
sciput( iostrptr + actual_index, itembeg, expbeg,
itemlen - width + 1, itemlen,
sign, de, expwid );
goto adjust_index;
signed_conversion: ;
if( longval >= 0 )
itembeg = myultoa( longval, itembuf, 10 );
else
{
itembuf[0] = '-';
myultoa( -longval, itembuf+1, 10 );
itembeg = itembuf;
}
itemlen = strlen( itembeg );
goto move_item;
unsigned_conversion: ;
itembeg = myultoa( ulongval, itembuf, 10 );
itemlen = strlen( itembeg );
goto move_item;
move_item: ;
if( !width )
width = itemlen;
/* check remaining space */
if( actual_index + width > iostrlen )
IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
/* move item, filling or truncating or overflow-evidencing */
if( itemlen == width )
memcpy( iostrptr + actual_index, itembeg, itemlen );
else
if( itemlen < width )
if( leftadjust )
memset( memcpy( iostrptr + actual_index, itembeg, itemlen )
+ itemlen,
paddingchar, width - itemlen );
else
memcpy( memset( iostrptr + actual_index,
paddingchar, width - itemlen )
+ width - itemlen,
itembeg, itemlen );
else
if( overflowev )
memset( iostrptr + actual_index, '*', width );
else
if( leftadjust )
memcpy( iostrptr + actual_index, itembeg, width );
else
memcpy( iostrptr + actual_index,
itembeg + itemlen - width, width );
/*
* adjust.
*/
adjust_index: ;
actual_index += width;
if( actual_index > maximum_index )
maximum_index = actual_index;
}
}
static
void outedit( void )
{
int nchars;
if( dynamicwid )
clausewidth = get_field_width();
switch( editcode )
{
case SpaceSkip:
nchars = repetition*clausewidth;
if( actual_index + nchars > iostrlen )
IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
memset( iostrptr + actual_index, ' ', nchars );
actual_index += nchars;
if( actual_index > maximum_index )
maximum_index = actual_index;
break;
case SkipLeft:
nchars = repetition*clausewidth;
if( actual_index - nchars < 0 )
IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
actual_index -= nchars;
break;
case SkipRight:
nchars = repetition*clausewidth;
if( actual_index + nchars > iostrlen )
IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
actual_index += nchars;
if( actual_index > maximum_index )
{
memset( iostrptr + maximum_index, ' ', actual_index - maximum_index );
maximum_index = actual_index;
}
break;
case Tabulation:
if( clausewidth >= iostrlen )
IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
actual_index = clausewidth;
if( actual_index > maximum_index )
{
memset( iostrptr + maximum_index, ' ', actual_index - maximum_index );
maximum_index = actual_index;
}
break;
}
}
static
void inpioctrl( void )
{
unsigned short hlen;
if( !textptr )
IOEXCEPTION( TEXTFAIL, IO_CONTROL_NOT_VALID );
if( iocode != EndPage )
{
jmp_buf ioerror;
unsigned long info;
if (textptr->access_sub->association)
{
if( (info = setjmp( ioerror )) )
IOEXCEPTION( info>>16, info & 0xffff );
while( repetition-- )
{
__readrecord( textptr->access_sub, textindex,
(char*)textptr->text_record,
__FILE__, __LINE__ );
actual_index = 0;
MOV2(&hlen,&textptr->text_record->len);
iostrlen = hlen;
}
}
else
IOEXCEPTION (NOTCONNECTED, IS_NOT_CONNECTED);
}
}
/* specify pre/post in the order "/+-?!" */
static
char* pre_char = "\0\f\0\r\0"; /* Z.200: "\n\f\0\n\0" */
static
char* post_char = "\n\n\r\0\0"; /* Z.200: "\r\r\r\0\0" */
static
void outioctrl( void )
{
Association_Mode* assoc;
unsigned short hlen;
if( !textptr )
IOEXCEPTION( TEXTFAIL, IO_CONTROL_NOT_VALID );
if( (assoc = textptr->access_sub->association) )
{
jmp_buf ioerror;
unsigned long info;
if( (info = setjmp( ioerror )) )
IOEXCEPTION( info>>16, info & 0xffff );
while( repetition-- )
{
if( iocode != EndPage )
{
if( TEST_FLAG( assoc, IO_FIRSTLINE ) )
{
CLR_FLAG( assoc, IO_FIRSTLINE );
assoc->ctl_pre = '\0';
}
else
{
if( TEST_FLAG( assoc, IO_FORCE_PAGE ) )
{
CLR_FLAG( assoc, IO_FORCE_PAGE );
assoc->ctl_pre = '\f';
}
else
assoc->ctl_pre = pre_char[iocode];
}
assoc->ctl_post = post_char[iocode];
hlen = actual_index;
MOV2(&textptr->text_record->len,&hlen);
__writerecord( textptr->access_sub, textindex,
(char*)textptr->text_record,
textptr->text_record->len,
__FILE__, __LINE__ );
hlen = actual_index = 0;
MOV2(&textptr->text_record->len,&hlen);
}
else if( !TEST_FLAG( textptr, IO_FIRSTLINE ) )
SET_FLAG( textptr, IO_FORCE_PAGE );
assoc->ctl_pre = assoc->ctl_post = '\0';
}
}
else
IOEXCEPTION (NOTCONNECTED, IS_NOT_CONNECTED);
}
static
void (**actionptr)( void );
static
void (*readactions[])( void ) = { inpconv, inpedit, inpioctrl };
static
void (*writeactions[])( void ) = { outconv, outedit, outioctrl };
static
void emitstr( char* begtxt, char* endtxt )
{
char c;
int nchars = endtxt - begtxt;
if( actual_index + nchars > iostrlen )
IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
memcpy( iostrptr + actual_index, begtxt, nchars );
actual_index += nchars;
if( actual_index > maximum_index )
maximum_index = actual_index;
}
static
void scanstr( char* begtxt, char* endtxt )
{
int nchars = endtxt - begtxt;
if( actual_index + nchars > iostrlen )
IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_TEXT );
if( strncmp( iostrptr + actual_index, begtxt, nchars ) )
IOEXCEPTION( TEXTFAIL, FORMAT_TEXT_MISMATCH );
actual_index += nchars;
}
void (*ftextptr) ( char*, char* );
static
formatexit_t scanformcont( char* fcs, int len,
char** fcsptr, int* lenptr )
{
char curr;
fcsstate_t state = FormatText;
unsigned long buf;
int dig;
acttype_t action;
char* begtxt = fcs;
while( len-- )
{
curr = *fcs++;
switch( state )
{
case FormatText:
if( curr == '%' )
{
ftextptr( begtxt, fcs-1 );
state = FirstPercent;
}
break;
after_first_percent: ;
case FirstPercent:
if( curr == '%' )
{
state = FormatText;
begtxt = fcs - 1;
break;
}
if( curr == ')' )
{
*lenptr = len;
*fcsptr = fcs;
return EndAtParen;
}
if( isDEC(curr) )
{
state = RepFact;
repetition = curr - '0';
break;
}
repetition = 1;
test_for_control_codes: ;
if( isCVC(curr) )
{
state = ConvClause;
action = ConvAct;
convcode = strchr( CONVERSIONCODES, curr ) - CONVERSIONCODES;
leftadjust = False;
overflowev = False;
dynamicwid = False;
paddingdef = False;
paddingchar = ' ';
fractiondef = False;
/* fractionwidth = 0; default depends on mode ! */
exponentdef = False;
exponentwidth = 3;
clausewidth = 0;
break;
}
if( isEDC(curr) )
{
state = EditClause;
action = EditAct;
editcode = strchr( EDITCODES, curr ) - EDITCODES;
dynamicwid = False;
clausewidth = editcode == Tabulation ? 0 : 1;
break;
}
if( isIOC(curr) )
{
state = ClauseEnd;
action = IOAct;
iocode = strchr( IOCODES, curr ) - IOCODES;
break;
}
if( curr == '(' )
{
unsigned long times = repetition;
int cntlen;
char* cntfcs;
while( times-- )
{
if( scanformcont( fcs, len, &cntfcs, &cntlen ) != EndAtParen )
IOEXCEPTION( TEXTFAIL, UNMATCHED_OPENING_PAREN );
}
fcs = cntfcs;
len = cntlen;
state = FormatText;
begtxt = fcs;
break;
}
IOEXCEPTION( TEXTFAIL, BAD_FORMAT_SPEC_CHAR );
case RepFact:
if( isDEC(curr) )
{
dig = curr - '0';
if( repetition > (ULONG_MAX - dig)/10 )
IOEXCEPTION( TEXTFAIL, REPFAC_OVERFLOW );
repetition = repetition*10 + dig;
break;
}
goto test_for_control_codes;
case ConvClause:
if( isDEC(curr) )
{
state = ClauseWidth;
clausewidth = curr - '0';
break;
}
if( curr == 'L' )
{
if( leftadjust )
IOEXCEPTION( TEXTFAIL, DUPLICATE_QUALIFIER );
leftadjust = True;
break;
}
if( curr == 'E' )
{
if( overflowev )
IOEXCEPTION( TEXTFAIL, DUPLICATE_QUALIFIER );
overflowev = True;
break;
}
if( curr == 'P' )
{
if( paddingdef )
IOEXCEPTION( TEXTFAIL, DUPLICATE_QUALIFIER );
paddingdef = True;
state = CatchPadding;
break;
}
test_for_variable_width: ;
if( curr == 'V' )
{
dynamicwid = True;
state = AfterWidth;
break;
}
goto test_for_fraction_width;
case ClauseWidth:
if( isDEC(curr) )
{
dig = curr - '0';
if( clausewidth > (ULONG_MAX - dig)/10 )
IOEXCEPTION( TEXTFAIL, CLAUSE_WIDTH_OVERFLOW );
clausewidth = clausewidth*10 + dig;
break;
}
/* fall through */
test_for_fraction_width: ;
case AfterWidth:
if( curr == '.' )
{
if( convcode != DefaultConv && convcode != ScientConv )
IOEXCEPTION( TEXTFAIL, NO_FRACTION );
fractiondef = True;
state = FractWidth;
break;
}
goto test_for_exponent_width;
case FractWidth:
if( isDEC( curr ) )
{
state = FractWidthCont;
fractionwidth = curr - '0';
break;
}
else
IOEXCEPTION( TEXTFAIL, NO_FRACTION_WIDTH );
case FractWidthCont:
if( isDEC( curr ) )
{
dig = curr - '0';
if( fractionwidth > (ULONG_MAX - dig)/10 )
IOEXCEPTION( TEXTFAIL, FRACTION_WIDTH_OVERFLOW );
fractionwidth = fractionwidth*10 + dig;
break;
}
test_for_exponent_width: ;
if( curr == ':' )
{
if( convcode != ScientConv )
IOEXCEPTION( TEXTFAIL, NO_EXPONENT );
exponentdef = True;
state = ExpoWidth;
break;
}
goto test_for_final_percent;
case ExpoWidth:
if( isDEC( curr ) )
{
state = ExpoWidthCont;
exponentwidth = curr - '0';
break;
}
else
IOEXCEPTION( TEXTFAIL, NO_EXPONENT_WIDTH );
case ExpoWidthCont:
if( isDEC( curr ) )
{
dig = curr - '0';
if( exponentwidth > (ULONG_MAX - dig)/10 )
IOEXCEPTION( TEXTFAIL, EXPONENT_WIDTH_OVERFLOW );
exponentwidth = exponentwidth*10 + dig;
break;
}
/* fall through */
test_for_final_percent: ;
case ClauseEnd:
if( curr == '%' )
{
state = LastPercent;
break;
}
do_the_action: ;
actionptr[action]();
state = FormatText;
begtxt = fcs - 1;
break;
case CatchPadding:
paddingchar = curr;
state = ConvClause;
break;
case EditClause:
if( isDEC(curr) )
{
state = ClauseWidth;
clausewidth = curr - '0';
break;
}
goto test_for_variable_width;
case LastPercent:
actionptr[action]();
if( curr == '.' )
{
state = FormatText;
begtxt = fcs;
break;
}
goto after_first_percent;
default:
IOEXCEPTION( TEXTFAIL, INTERNAL_ERROR );
}
}
switch( state )
{
case FormatText:
ftextptr( begtxt, fcs );
break;
case FirstPercent:
case LastPercent:
case RepFact:
case FractWidth:
case ExpoWidth:
IOEXCEPTION( TEXTFAIL, BAD_FORMAT_SPEC_CHAR );
case CatchPadding:
IOEXCEPTION( TEXTFAIL, NO_PAD_CHAR );
default:
actionptr[action]();
}
*lenptr = len;
*fcsptr = fcs;
return NormalEnd;
}
static
void
__read_format (char* fmtptr,
int fmtlen,
__tmp_IO_list* ioptr,
int iolen,
void* inpptr,
int inplen )
{
formatexit_t res;
unsigned short l;
iostrptr = (char*)inpptr;
iostrlen = inplen;
/* initialisation */
iolist_index = 0;
iolistptr = ioptr;
iolistlen = iolen;
actionptr = readactions;
ftextptr = scanstr;
if( (res = scanformcont( fmtptr, fmtlen, &fmtptr, &fmtlen )) == EndAtParen )
IOEXCEPTION( TEXTFAIL, UNMATCHED_CLOSING_PAREN );
if( iolist_index != iolen )
IOEXCEPTION( TEXTFAIL, EXCESS_IOLIST_ELEMENTS );
return;
}
void
__readtext_f( Text_Mode* the_text_loc,
signed long the_index,
char* fmtptr,
int fmtlen,
__tmp_IO_list* ioptr,
int iolen,
char* file,
int line )
{
unsigned long info;
if( (info = setjmp( __io_exception )) )
CHILLEXCEPTION( file, line, info>>16, info & 0xffff );
textptr = the_text_loc;
textrecptr = textptr->text_record;
actual_index = textptr->actual_index;
textindex = the_index;
__read_format ( fmtptr, fmtlen, ioptr, iolen,
(char*)textrecptr + 2, textptr->text_record->len );
textptr->actual_index = actual_index;
}
void
__readtext_s( void* string_ptr,
int string_len,
char* fmtptr,
int fmtlen,
__tmp_IO_list* ioptr,
int iolen,
char* file,
int line )
{
int info;
if( (info = setjmp( __io_exception )) )
CHILLEXCEPTION( file, line, info>>16, info & 0xffff );
textptr = NULL;
actual_index = 0;
__read_format ( fmtptr, fmtlen, ioptr, iolen, string_ptr, string_len );
}
static
void
__write_format (char* fmtptr,
int fmtlen,
__tmp_IO_list* ioptr,
int iolen,
void* outptr,
int outlen )
{
formatexit_t res;
unsigned short l;
/* initialisation */
maximum_index = actual_index;
iolist_index = 0;
actionptr = writeactions;
ftextptr = emitstr;
iolistptr = ioptr;
iolistlen = iolen;
iostrptr = (char *)outptr + 2;
iostrlen = outlen;
if( (res = scanformcont( fmtptr, fmtlen, &fmtptr, &fmtlen )) == EndAtParen )
IOEXCEPTION( TEXTFAIL, UNMATCHED_CLOSING_PAREN );
if( iolist_index != iolen )
IOEXCEPTION( TEXTFAIL, EXCESS_IOLIST_ELEMENTS );
/* set length of output string */
#if _TEXTIO_DEBUG_
printf( "maximum index = %d\n", maximum_index );
#endif
l = maximum_index;
MOV2(outptr,&l);
return;
}
void
__writetext_f( Text_Mode* the_text_loc,
signed long the_index,
char* fmtptr,
int fmtlen,
__tmp_IO_list* ioptr,
int iolen,
char* file,
int line )
{
int info;
if( (info = setjmp( __io_exception )) )
CHILLEXCEPTION( file, line, info>>16, info & 0xffff );
textptr = the_text_loc;
textrecptr = the_text_loc->text_record;
textindex = the_index;
iolistptr = ioptr;
iolistlen = iolen;
actual_index = textptr->actual_index;
__write_format ( fmtptr, fmtlen, ioptr, iolen,
textrecptr, textptr->access_sub->reclength - 2 );
textptr->actual_index = actual_index;
}
void
__writetext_s( void* string_ptr,
int string_len,
char* fmtptr,
int fmtlen,
__tmp_IO_list* ioptr,
int iolen,
char* file,
int line )
{
int info;
if( (info = setjmp( __io_exception )) )
CHILLEXCEPTION( file, line, info>>16, info & 0xffff );
textptr = NULL;
actual_index = 0;
__write_format ( fmtptr, fmtlen, ioptr, iolen, string_ptr, string_len );
}
gcc/ch/runtime/gettextindex.c 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
#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/rts.c 0 → 100644
/* 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. */
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <setjmp.h>
#include <signal.h>
#include "rts.h"
/* some allocation/reallocation functions */
static void *
xmalloc (size)
int size;
{
void *tmp = malloc (size);
if (!tmp)
{
fprintf (stderr, "Out of heap space.\n");
exit (1);
}
return (tmp);
}
static void *
xrealloc (ptr, size)
void *ptr;
int size;
{
void *tmp = realloc (ptr, size);
if (!tmp)
{
fprintf (stderr, "Out of heap space.\n");
exit (1);
}
return (tmp);
}
/* the necessary data */
#define MAX_NUMBER 100
typedef char UsedValues[MAX_NUMBER];
#define MAX_COPIES 100
#define MAX_PER_ITEM 20
typedef struct TASKINGSTRUCTLIST
{
struct TASKINGSTRUCTLIST *forward;
int num;
TaskingStruct *data[MAX_PER_ITEM];
char copies[MAX_COPIES];
jmp_buf where;
} TaskingStructList;
static TaskingStructList *task_array[LAST_AND_UNUSED];
static UsedValues used_values[LAST_AND_UNUSED];
static short
get_next_free_number (vals)
UsedValues vals;
{
short i;
for (i = 1; i < MAX_NUMBER; i++)
{
if (!vals[i])
{
vals[i] = 1;
return (i);
}
}
fprintf (stderr, "There are no more free numbers.\n");
exit (1);
}
/* function search for the next available copy number */
static short
get_next_copy_number (p)
TaskingStructList *p;
{
short i;
for (i = 0; i < MAX_COPIES; i++)
{
if (!p->copies[i])
{
p->copies[i] = 1;
return (i);
}
}
fprintf (stderr, "No more copies available for \"%s\".\n",
p->data[0]->name);
exit (1);
}
/* function registers a tasking entry from a module and assign
a value to the type */
void
__register_tasking (t)
TaskingStruct *t;
{
TaskingStructList *p;
/* check first if a value was provided and if it is in range */
if (t->value_defined && *t->value >= MAX_NUMBER)
{
fprintf (stderr, "Value %d out of range.\n", *t->value);
exit (1);
}
/* look for item defined */
p = task_array[t->type];
while (p)
{
if (!strcmp (p->data[0]->name, t->name))
/* have found it */
break;
p = p->forward;
}
if (!p)
{
TaskingStructList *wrk = (TaskingStructList *)&task_array[t->type];
/* this is a new one -- allocate space */
p = xmalloc (sizeof (TaskingStructList));
memset (p->copies, 0, sizeof (p->copies));
p->forward = 0;
p->num = 1;
p->data[0] = t;
/* queue it in */
while (wrk->forward)
wrk = wrk->forward;
wrk->forward = p;
}
else
{
if (p->num >= MAX_PER_ITEM)
{
fprintf (stderr, "Too many registrations of \"%s\".\n", t->name);
exit (1);
}
p->data[p->num++] = t;
}
}
/* define all the entries for the runtime system. They will be
needed by chillrt0.o */
typedef char *(*fetch_names) ();
typedef int (*fetch_numbers) ();
static char tmp_for_fetch_name[100];
char *
__fetch_name (number)
int number;
{
TaskingStructList *p = task_array[Process];
while (p)
{
if (*(p->data[0]->value) == number)
return (p->data[0]->name);
p = p->forward;
}
sprintf (tmp_for_fetch_name, "%d", number);
return (tmp_for_fetch_name);
}
fetch_names __RTS_FETCH_NAMES__ = __fetch_name;
static int
__fetch_number (name)
char *name;
{
TaskingStructList *p = task_array[Process];
while (p)
{
if (!strcmp (p->data[0]->name, name))
return (*(p->data[0]->value));
p = p->forward;
}
return (-1);
}
fetch_numbers __RTS_FETCH_NUMBERS__ = __fetch_number;
/* here we go to check all registered items */
static void
__rts_init ()
{
int i;
TaskingStructList *p;
for (i = Process; i <= Event; i++)
{
p = task_array[i];
while (p)
{
TaskingStruct *t = 0;
int j;
short val;
for (j = 0; j < p->num; j++)
{
if (p->data[j]->value_defined)
{
if (t)
{
if (*(t->value) != *(p->data[j]->value))
{
fprintf (stderr, "Different values (%d & %d) for \"%s\".",
*(t->value), *(p->data[j]->value), t->name);
exit (1);
}
}
else
t = p->data[j];
}
}
if (t)
{
val = *(t->value);
if (used_values[t->type][val])
{
fprintf (stderr, "Value %d for \"%s\" is already used.\n",
val, t->name);
exit (1);
}
used_values[t->type][val] = 1;
}
else
{
/* we have to create a new value */
val = get_next_free_number (used_values[p->data[0]->type]);
}
for (j = 0; j < p->num; j++)
{
p->data[j]->value_defined = 1;
*(p->data[j]->value) = val;
}
p = p->forward;
}
}
}
EntryPoint __RTS_INIT__ = __rts_init;
/* define the start process queue */
typedef struct STARTENTRY
{
struct STARTENTRY *forward;
INSTANCE whoami;
EntryPoint entry;
void *data;
int datalen;
} StartEntry;
static StartEntry *start_queue = 0;
static StartEntry *current_process = 0;
/* the jump buffer for the main loop */
static jmp_buf jump_buffer;
static int jump_buffer_initialized = 0;
/* look for entries in start_queue and start the process */
static void
__rts_main_loop ()
{
StartEntry *s;
while (1)
{
if (setjmp (jump_buffer) == 0)
{
jump_buffer_initialized = 1;
s = start_queue;
while (s)
{
current_process = s;
start_queue = s->forward;
/* call the process */
(*s->entry) (s->data);
s = start_queue;
}
/* when queue empty we have finished */
return;
}
else
{
/* stop executed */
if (current_process->data)
free (current_process->data);
free (current_process);
current_process = 0;
}
}
}
EntryPoint __RTS_MAIN_LOOP__ = __rts_main_loop;
void
__start_process (ptype, pcopy, arg_size, args, ins)
short ptype;
short pcopy;
int arg_size;
void *args;
INSTANCE *ins;
{
TaskingStructList *p = task_array[Process];
EntryPoint pc = 0;
int i;
short this_copy = pcopy;
StartEntry *s, *wrk;
/* search for the process */
while (p)
{
if (*(p->data[0]->value) == ptype)
break;
p = p->forward;
}
if (!p)
{
fprintf (stderr, "Cannot find a process with type %d.\n", ptype);
exit (1);
}
/* search for the entry point */
for (i = 0; i < p->num; i++)
{
if (p->data[i]->entry)
{
pc = p->data[i]->entry;
break;
}
}
if (!pc)
{
fprintf (stderr, "Process \"%s\" doesn't have an entry point.\n",
p->data[0]->name);
exit (1);
}
/* check the copy */
if (pcopy >= MAX_COPIES)
{
fprintf (stderr, "Copy number (%d) out of range.\n", pcopy);
exit (1);
}
if (pcopy == -1)
{
/* search for a copy number */
this_copy = get_next_copy_number (p);
}
else
{
if (p->copies[pcopy])
{
/* FIXME: should be exception 'startfail' */
fprintf (stderr, "Copy number %d already in use for \"%s\".\n",
pcopy, p->data[0]->name);
exit (1);
}
p->copies[this_copy = pcopy] = 1;
}
/* ready to build start_queue entry */
s = xmalloc (sizeof (StartEntry));
s->forward = 0;
s->whoami.pcopy = this_copy;
s->whoami.ptype = ptype;
s->entry = pc;
s->datalen = arg_size;
if (args)
{
s->data = xmalloc (arg_size);
memcpy (s->data, args, arg_size);
}
else
s->data = 0;
/* queue that stuff in */
wrk = (StartEntry *)&start_queue;
while (wrk->forward)
wrk = wrk->forward;
wrk->forward = s;
/* if we have a pointer to ins -- set it */
if (ins)
{
ins->ptype = ptype;
ins->pcopy = this_copy;
}
}
void
__stop_process ()
{
if (!jump_buffer_initialized)
{
fprintf (stderr, "STOP called before START.\n");
exit (1);
}
longjmp (jump_buffer, 1);
}
/* function returns INSTANCE of current process */
INSTANCE
__whoami ()
{
INSTANCE whoami;
if (current_process)
whoami = current_process->whoami;
else
{
whoami.ptype = 0;
whoami.pcopy = 0;
}
return (whoami);
}
typedef struct
{
short *sc;
int data_len;
void *data;
} SignalDescr;
typedef struct SIGNALQUEUE
{
struct SIGNALQUEUE *forward;
short sc;
int data_len;
void *data;
INSTANCE to;
INSTANCE from;
} SignalQueue;
/* define the signal queue */
static SignalQueue *msg_queue = 0;
/* send a signal */
void
__send_signal (s, to, prio, with_len, with)
SignalDescr *s;
INSTANCE to;
int prio;
int with_len;
void *with;
{
SignalQueue *wrk = (SignalQueue *)&msg_queue;
SignalQueue *p;
TaskingStructList *t = task_array[Process];
/* search for process is defined and running */
while (t)
{
if (*(t->data[0]->value) == to.ptype)
break;
t = t->forward;
}
if (!t || !t->copies[to.pcopy])
{
fprintf (stderr, "Can't find instance [%d,%d].\n",
to.ptype, to.pcopy);
exit (1);
}
/* go to the end of the msg_queue */
while (wrk->forward)
wrk = wrk->forward;
p = xmalloc (sizeof (SignalQueue));
p->sc = *(s->sc);
if (p->data_len = s->data_len)
{
p->data = xmalloc (s->data_len);
memcpy (p->data, s->data, s->data_len);
}
else
p->data = 0;
p->to = to;
p->from = __whoami ();
p->forward = 0;
wrk->forward = p;
}
void
start_signal_timeout (i, s, j)
int i;
SignalDescr *s;
int j;
{
__send_signal (s, __whoami (), 0, 0, 0);
}
/* receive a signal */
int
__wait_signal_timed (sig_got, nsigs, sigptr, datap,
datalen, ins, else_branche,
to, filename, lineno)
short *sig_got;
int nsigs;
short *sigptr[];
void *datap;
int datalen;
INSTANCE *ins;
int else_branche;
void *to;
char *filename;
int lineno;
{
INSTANCE me = __whoami ();
SignalQueue *wrk, *p = msg_queue;
int i;
short sc;
/* search for a signal to `me' */
wrk = (SignalQueue *)&msg_queue;
while (p)
{
if (p->to.ptype == me.ptype
&& p->to.pcopy == me.pcopy)
break;
wrk = p;
p = p->forward;
}
if (!p)
{
fprintf (stderr, "No signal for [%d,%d].\n",
me.ptype, me.pcopy);
exit (1);
}
/* queue the message out */
wrk->forward = p->forward;
/* now look for signal in list */
for (i = 0; i < nsigs; i++)
if (*(sigptr[i]) == p->sc)
break;
if (i >= nsigs && ! else_branche)
/* signal not in list and no ELSE in code */
__cause_exception ("signalfail", __FILE__, __LINE__);
if (i >= nsigs)
{
/* signal not in list */
sc = p->sc;
if (ins)
*ins = p->from;
if (p->data)
free (p->data);
free (p);
*sig_got = sc;
return (0);
}
/* we have found a signal in the list */
if (p->data_len)
{
if (datalen >= p->data_len
&& datap)
memcpy (datap, p->data, p->data_len);
else
__cause_exception ("spacefail", __FILE__, __LINE__);
}
sc = p->sc;
if (ins)
*ins = p->from;
if (p->data)
free (p->data);
free (p);
*sig_got = sc;
return (0);
}
/* wait a certain amount of seconds */
int
__sleep_till (abstime, reltime, fname, lineno)
time_t abstime;
int reltime;
char *fname;
int lineno;
{
sleep (reltime);
return 0;
}
/* set up an alarm */
static int timeout_flag = 0;
static void alarm_handler ()
{
timeout_flag = 1;
}
int *
__define_timeout (howlong, filename, lineno)
unsigned long howlong; /* comes in millisecs */
char *filename;
int lineno;
{
unsigned int prev_alarm_value;
signal (SIGALRM, alarm_handler);
prev_alarm_value = alarm ((unsigned int)(howlong / 1000));
return &timeout_flag;
}
/* wait till timeout expires */
void
__wait_timeout (toid, filename, lineno)
volatile int *toid;
char *filename;
int lineno;
{
while (! *toid) ;
*toid = 0;
}
gcc/ch/runtime/terminate.c 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
/* 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 0 → 100644
#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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment