WebSVN – tendra.SVN – Diff – /branches/tendra5/src/producers/common/parse/literal.c

+/*
+ * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ * 3. Neither the name of The TenDRA Project nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific, prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+ * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * $Id$
+ */
 /*
     		 Crown Copyright (c) 1997, 1998
     This TenDRA(r) Computer Program is subject to Copyright
     owned by the United Kingdom Secretary of State for Defence
     acting through the Defence Evaluation and Research Agency
     (DERA).  It is made available to Recipients with a
     royalty-free licence for its use, reproduction, transfer
     to other parties and amendment for any purpose not excluding
     product development provided that any such use et cetera
     shall be deemed to be acceptance of the following conditions:-
         (1) Its Recipients shall ensure that this Notice is
         reproduced upon any copies or amended versions of it;
         (2) Any amended version of it shall be clearly marked to
         show both the nature of and the organisation responsible
         for the relevant amendment or amendments;
         (3) Its onward transfer from a recipient to another
         party shall be deemed to be that party's acceptance of
         these conditions;
         (4) DERA gives no warranty or assurance as to its
         quality or suitability for any purpose and DERA accepts
         no liability whatsoever in relation to any use to which
         it may be put.
 */
     to be rewritten.  The valid digits are 0-9, A-Z (which evaluate to
 -35) and a-z (which evaluate to 10-35).  Invalid digits are
     indicated by NONE.
 */
-unsigned char digit_values [ NO_CHAR + 1 ] = {
+unsigned char digit_values[NO_CHAR + 1] = {
-#define CHAR_DATA( A, B, C, D )	( B ),
+#define CHAR_DATA(A, B, C, D)	(B),
 #include "char.h"
 #undef CHAR_DATA
-    NONE		/* dummy */
+	NONE		/* dummy */
-} ;
+};
 /*
     TABLE OF ESCAPE SEQUENCES
     indicated by OCTE, hexadecimal escape sequences by HEXE, universal
     character names by UNI4 or UNI8, and illegal escape sequences by
     NONE.
 */
-unsigned char escape_sequences [ NO_CHAR + 1 ] = {
+unsigned char escape_sequences[NO_CHAR + 1] = {
-#define CHAR_DATA( A, B, C, D )	( C ),
+#define CHAR_DATA(A, B, C, D)	(C),
 #include "char.h"
 #undef CHAR_DATA
-    NONE		/* dummy */
+	NONE		/* dummy */
-} ;
+};
 /*
     SET AN ESCAPE SEQUENCE
     This routine sets the character escape value for the character
     literal expression a to be the character literal b, or an illegal
     escape if b is the null expression.
 */
-void set_escape
+void
-    PROTO_N ( ( a, b ) )
-    PROTO_T ( EXP a X EXP b )
+set_escape(EXP a, EXP b)
+{
-    int c = get_char_value ( a ) ;
+	int c = get_char_value(a);
-    int e = NONE ;
+	int e = NONE;
-    if ( !IS_NULL_exp ( b ) ) {
+	if (!IS_NULL_exp(b)) {
-	e = get_char_value ( b ) ;
+		e = get_char_value(b);
-	if ( e == char_illegal ) e = NONE ;
+		if (e == char_illegal) {
+			e = NONE;
-    }
+		}
+	}
-    if ( c >= 0 && c < NO_CHAR ) {
+	if (c >= 0 && c < NO_CHAR) {
-	escape_sequences [c] = ( unsigned char ) e ;
+		escape_sequences[c] = (unsigned char)e;
-    }
+	}
-    return ;
+	return;
+}
 /*
     CHECK A STRING OF DIGITS
     This routine scans the string s for valid digits for the given base.
     It returns a pointer to the first character which is not a valid
     digit.
 */
-static string check_digits
+static string
-    PROTO_N ( ( s, base ) )
-    PROTO_T ( string s X unsigned base )
+check_digits(string s, unsigned base)
+{
-    unsigned b ;
+	unsigned b;
-    character c ;
+	character c;
-    while ( c = *s, c != 0 ) {
+	while (c = *s, c != 0) {
 #if FS_EXTENDED_CHAR
-	if ( IS_EXTENDED ( c ) ) break ;
+		if (IS_EXTENDED(c)) {
+			break;
+		}
 #endif
-	b = ( unsigned ) digit_values [c] ; ;
+		b = (unsigned)digit_values[c];;
-	if ( b >= base ) break ;
+		if (b >= base) {
+			break;
+		}
-	s++ ;
+		s++;
-    }
+	}
-    return ( s ) ;
+	return(s);
 }
 /*
     EVALUATE A STRING OF DIGITS
     This routine evaluates the string of digits starting with s and
     ending with t using the given base (which will be at most 16).  It
     is assumed that all of these digits are in the correct range.
 */
-static NAT eval_digits
+static NAT
-    PROTO_N ( ( s, t, base ) )
-    PROTO_T ( string s X string t X unsigned base )
+eval_digits(string s, string t, unsigned base)
 {
-    NAT n ;
+	NAT n;
-    int m = 0 ;
+	int m = 0;
-    string r = s ;
+	string r = s;
-    unsigned long v = 0 ;
+	unsigned long v = 0;
-    unsigned long b = ( unsigned long ) base ;
+	unsigned long b = (unsigned long)base;
-    while ( r != t && m < 8 ) {
+	while (r != t && m < 8) {
-	/* Evaluate first few digits */
+		/* Evaluate first few digits */
-	unsigned long d = ( unsigned long ) digit_values [ *r ] ;
+		unsigned long d = (unsigned long)digit_values[*r];
-	v = b * v + d ;
+		v = b * v + d;
-	m++ ;
+		m++;
-	r++ ;
+		r++;
-    }
+	}
-    n = make_nat_value ( v ) ;
+	n = make_nat_value(v);
-    while ( r != t ) {
+	while (r != t) {
-	/* Evaluate further digits */
+		/* Evaluate further digits */
-	unsigned d = ( unsigned ) digit_values [ *r ] ;
+		unsigned d = (unsigned)digit_values[*r];
-	n = make_nat_literal ( n, base, d ) ;
+		n = make_nat_literal(n, base, d);
-	r++ ;
+		r++;
-    }
+	}
-    return ( n ) ;
+	return(n);
 }
 /*
     EVALUATE A STRING OF DIGITS
     This routine is the same as eval_digits except that it assumes that
     the result fits inside an unsigned long, and reports an error
     otherwise.
 */
-static unsigned long eval_char_digits
+static unsigned long
-    PROTO_N ( ( s, t, base ) )
-    PROTO_T ( string s X string t X unsigned base )
+eval_char_digits(string s, string t, unsigned base)
+{
-    string r ;
+	string r;
-    int overflow = 0 ;
+	int overflow = 0;
-    unsigned long n = 0 ;
+	unsigned long n = 0;
-    unsigned long b = ( unsigned long ) base ;
+	unsigned long b = (unsigned long)base;
-    for ( r = s ; r != t ; r++ ) {
+	for (r = s; r != t; r++) {
-	unsigned long m = n ;
+		unsigned long m = n;
-	n = b * n + ( unsigned long ) digit_values [ *r ] ;
+		n = b * n + (unsigned long)digit_values[*r];
+		if (n < m) {
-	if ( n < m ) overflow = 1 ;
+			overflow = 1;
-    }
+		}
+	}
+	if (overflow) {
-    if ( overflow ) report ( crt_loc, ERR_lex_ccon_large () ) ;
+		report(crt_loc, ERR_lex_ccon_large());
+	}
-    return ( n ) ;
+	return(n);
+}
 /*
     EVALUATE A LINE NUMBER
     arising are indicated using err.  This is a bit pattern consisting
     of 2 if s is not a simple string of decimal digits, and 1 if its
     value exceeds 32767.
 */
-unsigned long eval_line_digits
+unsigned long
-    PROTO_N ( ( s, err ) )
-    PROTO_T ( string s X unsigned *err )
+eval_line_digits(string s, unsigned *err)
+{
-    string r ;
+	string r;
-    unsigned e = 0 ;
+	unsigned e = 0;
-    unsigned long n = 0 ;
+	unsigned long n = 0;
-    string t = check_digits ( s, ( unsigned ) 10 ) ;
+	string t = check_digits(s, (unsigned)10);
-    if ( *t ) e = 2 ;
+	if (*t) {
+		e = 2;
+	}
-    for ( r = s ; r != t ; r++ ) {
+	for (r = s; r != t; r++) {
-	n = 10 * n + ( unsigned long ) digit_values [ *r ] ;
+		n = 10 * n + (unsigned long)digit_values[*r];
-	if ( n > 0x7fff ) e |= 1 ;
+		if (n > 0x7fff) {
+			e |= 1;
-    }
+		}
+	}
-    *err = e ;
+	*err = e;
-    return ( n ) ;
+	return(n);
+}
 /*
     STRING HASH TABLE
     This variable gives the hash table used in shared string literals.
 */
-static STRING *string_hash_table = NULL ;
+static STRING *string_hash_table = NULL;
-#define HASH_STRING_SIZE	( ( unsigned long ) 256 )
+#define HASH_STRING_SIZE	((unsigned long)256)
 /*
     STRING AND CHARACTER LITERAL TYPES
     The type of a simple character literal is char in C++, but int in C.
     The variable type_char_lit is used to hold the appropriate result
     type.  Other string and character literals have fixed types, however
     for convenience variables are used to identify them.
 */
-static TYPE type_char_lit ;
+static TYPE type_char_lit;
-static TYPE type_mchar_lit ;
+static TYPE type_mchar_lit;
-static TYPE type_wchar_lit ;
+static TYPE type_wchar_lit;
-static TYPE type_string_lit ;
+static TYPE type_string_lit;
-static TYPE type_wstring_lit ;
+static TYPE type_wstring_lit;
-CV_SPEC cv_string = cv_none ;
+CV_SPEC cv_string = cv_none;
 /*
     SET THE CHARACTER LITERAL TYPE
     This routine sets the type of a character literal to be t.  t must be
     an integral type.  Note that only the representation type is set to t,
     the semantic type is always char.
 */
-void set_char_lit
+void
-    PROTO_N ( ( t ) )
-    PROTO_T ( TYPE t )
+set_char_lit(TYPE t)
+{
-    if ( IS_type_integer ( t ) ) {
+	if (IS_type_integer(t)) {
-	INT_TYPE r = DEREF_itype ( type_integer_rep ( t ) ) ;
+		INT_TYPE r = DEREF_itype(type_integer_rep(t));
-	INT_TYPE s = DEREF_itype ( type_integer_rep ( type_char ) ) ;
+		INT_TYPE s = DEREF_itype(type_integer_rep(type_char));
-	type_char_lit = make_itype ( r, s ) ;
+		type_char_lit = make_itype(r, s);
-    } else {
+	} else {
-	report ( preproc_loc, ERR_pragma_char_lit ( t ) ) ;
+		report(preproc_loc, ERR_pragma_char_lit(t));
-    }
+	}
-    return ;
+	return;
+}
 /*
     TABLE OF INTEGER LITERAL SPECIFICATIONS
     literal type specification.  The table int_lit_spec holds the
     specifications for the various combinations of base and suffix.
 */
 typedef struct lit_info_tag {
-    int tag ;
+	int tag;
-    TYPE type ;
+	TYPE type;
-    NAT bound ;
+	NAT bound;
-    IDENTIFIER tok ;
+	IDENTIFIER tok;
-    int tok_no ;
+	int tok_no;
-    int opt ;
+	int opt;
-    struct lit_info_tag *next ;
+	struct lit_info_tag *next;
-} LITERAL_INFO ;
+} LITERAL_INFO;
-static LITERAL_INFO *int_lit_spec [ BASE_NO ] [ SUFFIX_NO ] = {
+static LITERAL_INFO *int_lit_spec[BASE_NO][SUFFIX_NO] = {
-    { NULL, NULL, NULL, NULL, NULL, NULL },
+	{ NULL, NULL, NULL, NULL, NULL, NULL },
-    { NULL, NULL, NULL, NULL, NULL, NULL },
+	{ NULL, NULL, NULL, NULL, NULL, NULL },
-    { NULL, NULL, NULL, NULL, NULL, NULL }
+	{ NULL, NULL, NULL, NULL, NULL, NULL }
-} ;
+};
-static LITERAL_INFO *crt_int_lit = NULL ;
+static LITERAL_INFO *crt_int_lit = NULL;
-static LITERAL_INFO **ptr_int_lit = NULL ;
+static LITERAL_INFO **ptr_int_lit = NULL;
 /*
     TABLE OF BUILT-IN INTEGER LITERAL SPECIFICATIONS
     This table gives the possible types and built-in tokens for the
     various base and suffix combinations.
 */
 static struct {
-    unsigned char type [6] ;
+	unsigned char type[6];
-    int tok ;
+	int tok;
-    LIST ( TYPE ) cases ;
+	LIST(TYPE)cases;
-} int_lit_tok [ BASE_NO ] [ SUFFIX_NO ] = {
+} int_lit_tok[BASE_NO][SUFFIX_NO] = {
-    {
+	{
-	{ { 2, 0, 2, 2, 1, 1 }, TOK_lit_int, NULL_list ( TYPE ) },
+		{ { 2, 0, 2, 2, 1, 1 }, TOK_lit_int, NULL_list(TYPE)},
-	{ { 0, 2, 0, 2, 0, 1 }, TOK_lit_unsigned, NULL_list ( TYPE ) },
+		{ { 0, 2, 0, 2, 0, 1 }, TOK_lit_unsigned, NULL_list(TYPE)},
-	{ { 0, 0, 2, 2, 1, 1 }, TOK_lit_long, NULL_list ( TYPE ) },
+		{ { 0, 0, 2, 2, 1, 1 }, TOK_lit_long, NULL_list(TYPE)},
-	{ { 0, 0, 0, 2, 0, 1 }, TOK_lit_ulong, NULL_list ( TYPE ) },
+		{ { 0, 0, 0, 2, 0, 1 }, TOK_lit_ulong, NULL_list(TYPE)},
-	{ { 0, 0, 0, 0, 2, 2 }, TOK_lit_llong, NULL_list ( TYPE ) },
+		{ { 0, 0, 0, 0, 2, 2 }, TOK_lit_llong, NULL_list(TYPE)},
-	{ { 0, 0, 0, 0, 0, 2 }, TOK_lit_ullong, NULL_list ( TYPE ) }
+		{ { 0, 0, 0, 0, 0, 2 }, TOK_lit_ullong, NULL_list(TYPE)}
-    },
+	},
-    {
+	{
-	{ { 2, 2, 2, 2, 1, 1 }, TOK_lit_hex, NULL_list ( TYPE ) },
+		{ { 2, 2, 2, 2, 1, 1 }, TOK_lit_hex, NULL_list(TYPE)},
-	{ { 0, 2, 0, 2, 0, 1 }, TOK_lit_unsigned, NULL_list ( TYPE ) },
+		{ { 0, 2, 0, 2, 0, 1 }, TOK_lit_unsigned, NULL_list(TYPE)},
-	{ { 0, 0, 2, 2, 1, 1 }, TOK_lit_long, NULL_list ( TYPE ) },
+		{ { 0, 0, 2, 2, 1, 1 }, TOK_lit_long, NULL_list(TYPE)},
-	{ { 0, 0, 0, 2, 0, 1 }, TOK_lit_ulong, NULL_list ( TYPE ) },
+		{ { 0, 0, 0, 2, 0, 1 }, TOK_lit_ulong, NULL_list(TYPE)},
-	{ { 0, 0, 0, 0, 2, 2 }, TOK_lit_llong, NULL_list ( TYPE ) },
+		{ { 0, 0, 0, 0, 2, 2 }, TOK_lit_llong, NULL_list(TYPE)},
-	{ { 0, 0, 0, 0, 0, 2 }, TOK_lit_ullong, NULL_list ( TYPE ) }
+		{ { 0, 0, 0, 0, 0, 2 }, TOK_lit_ullong, NULL_list(TYPE)}
-    },
+	},
-    {
+	{
-	{ { 2, 2, 2, 2, 1, 1 }, TOK_lit_hex, NULL_list ( TYPE ) },
+		{ { 2, 2, 2, 2, 1, 1 }, TOK_lit_hex, NULL_list(TYPE)},
-	{ { 0, 2, 0, 2, 0, 1 }, TOK_lit_unsigned, NULL_list ( TYPE ) },
+		{ { 0, 2, 0, 2, 0, 1 }, TOK_lit_unsigned, NULL_list(TYPE)},
-	{ { 0, 0, 2, 2, 1, 1 }, TOK_lit_long, NULL_list ( TYPE ) },
+		{ { 0, 0, 2, 2, 1, 1 }, TOK_lit_long, NULL_list(TYPE)},
-	{ { 0, 0, 0, 2, 0, 1 }, TOK_lit_ulong, NULL_list ( TYPE ) },
+		{ { 0, 0, 0, 2, 0, 1 }, TOK_lit_ulong, NULL_list(TYPE)},
-	{ { 0, 0, 0, 0, 2, 2 }, TOK_lit_llong, NULL_list ( TYPE ) },
+		{ { 0, 0, 0, 0, 2, 2 }, TOK_lit_llong, NULL_list(TYPE)},
-	{ { 0, 0, 0, 0, 0, 2 }, TOK_lit_ullong, NULL_list ( TYPE ) }
+		{ { 0, 0, 0, 0, 0, 2 }, TOK_lit_ullong, NULL_list(TYPE)}
-    }
+	}
-} ;
+};
 /*
     INITIALISE TABLE OF INTEGER LITERAL TYPES
     This routine initialises the string and character literal types and
     the table int_lit_info.  The initial values for the table are given
     by the following lists of types:
 	decimal:	( int, long, unsigned long ),
     Variants are that characters have type int in C and that string
     literals are not const in pre-ISO C++ and C.
 */
-void init_literal
+void
-    PROTO_Z ()
+init_literal(void)
+{
-    int b, s ;
+	int b, s;
-    BUILTIN_TYPE n ;
+	BUILTIN_TYPE n;
-    OPTION opt = option ( OPT_int_overflow ) ;
+	OPTION opt = option(OPT_int_overflow);
-    ASSERT ( !IS_NULL_type ( type_char ) ) ;
+	ASSERT(!IS_NULL_type(type_char));
-    /* String and character literal types */
+	/* String and character literal types */
-    type_mchar_lit = type_sint ;
+	type_mchar_lit = type_sint;
-    type_wchar_lit = type_wchar_t ;
+	type_wchar_lit = type_wchar_t;
-    type_string_lit = type_char ;
+	type_string_lit = type_char;
-    type_wstring_lit = type_wchar_t ;
+	type_wstring_lit = type_wchar_t;
 #if LANGUAGE_CPP
-    set_char_lit ( type_char ) ;
+	set_char_lit(type_char);
-    set_string_qual ( cv_const ) ;
+	set_string_qual(cv_const);
 #else
-    set_char_lit ( type_sint ) ;
+	set_char_lit(type_sint);
-    set_string_qual ( cv_none ) ;
+	set_string_qual(cv_none);
 #endif
-    /* Set up type lists */
+	/* Set up type lists */
-    for ( b = 0 ; b < BASE_NO ; b++ ) {
+	for (b = 0; b < BASE_NO; b++) {
-	for ( s = 0 ; s < SUFFIX_NO ; s++ ) {
+		for (s = 0; s < SUFFIX_NO; s++) {
-	    LIST ( TYPE ) p = NULL_list ( TYPE ) ;
+			LIST(TYPE)p = NULL_list(TYPE);
-	    begin_literal ( b, s ) ;
+			begin_literal(b, s);
-	    for ( n = 0 ; n < 6 ; n++ ) {
+			for (n = 0; n < 6; n++) {
-		if ( int_lit_tok [b] [s].type [n] == 2 ) {
+				if (int_lit_tok[b][s].type[n] == 2) {
-		    TYPE t = type_builtin [ ntype_sint + n ] ;
+					TYPE t = type_builtin[ntype_sint + n];
-		    add_range_literal ( NULL_exp, 1 ) ;
+					add_range_literal(NULL_exp, 1);
-		    add_type_literal ( t ) ;
+					add_type_literal(t);
-		    CONS_type ( t, p, p ) ;
+					CONS_type(t, p, p);
+				}
+			}
+			add_range_literal(NULL_exp, 0);
+			add_token_literal(NULL_id, (unsigned)opt);
+			p = REVERSE_list(p);
+			int_lit_tok[b][s].cases = uniq_type_set(p);
+		}
+	}
+	/* Set up string hash table */
+	if (string_hash_table == NULL) {
+		unsigned long i;
+		STRING *q = xmalloc_nof(STRING, HASH_STRING_SIZE);
+		for (i = 0; i < HASH_STRING_SIZE; i++) {
+			q[i] = NULL_str;
+		}
-	    }
-	    add_range_literal ( NULL_exp, 0 ) ;
-	    add_token_literal ( NULL_id, ( unsigned ) opt ) ;
-	    p = REVERSE_list ( p ) ;
+		string_hash_table = q;
-	    int_lit_tok [b] [s].cases = uniq_type_set ( p ) ;
+	}
-    }
-    /* Set up string hash table */
-    if ( string_hash_table == NULL ) {
-	unsigned long i ;
-	STRING *q = xmalloc_nof ( STRING, HASH_STRING_SIZE ) ;
-	for ( i = 0 ; i < HASH_STRING_SIZE ; i++ ) q [i] = NULL_str ;
-	string_hash_table = q ;
-    }
-    return ;
+	return;
+}
 /*
     SET THE CV-QUALIFIERS FOR A STRING LITERAL
     This routine sets the string and wide string literal types to be
     cv-qualified.
 */
-void set_string_qual
+void
-    PROTO_N ( ( cv ) )
-    PROTO_T ( CV_SPEC cv )
+set_string_qual(CV_SPEC cv)
+{
-    type_string_lit = qualify_type ( type_string_lit, cv, 0 ) ;
+	type_string_lit = qualify_type(type_string_lit, cv, 0);
-    type_wstring_lit = qualify_type ( type_wstring_lit, cv, 0 ) ;
+	type_wstring_lit = qualify_type(type_wstring_lit, cv, 0);
-    cv_string = cv ;
+	cv_string = cv;
-    return ;
+	return;
+}
 /*
     BEGIN A LITERAL SPECIFICATION DEFINITION
     This routine is called to begin the specification of the integer
     literals of the given base and suffix.
 */
-void begin_literal
+void
-    PROTO_N ( ( base, suff ) )
-    PROTO_T ( int base X int suff )
+begin_literal(int base, int suff)
+{
-    LITERAL_INFO **p = &( int_lit_spec [ base ] [ suff ] ) ;
+	LITERAL_INFO **p = &(int_lit_spec[base][suff]);
-    *p = NULL ;
+	*p = NULL;
-    ptr_int_lit = p ;
+	ptr_int_lit = p;
-    crt_int_lit = NULL ;
+	crt_int_lit = NULL;
-    return ;
+	return;
+}
 /*
     ADD A BOUND TO A LITERAL SPECIFICATION
     is 1 then the bound matches all the values in the following type,
     and if it is 2 then the bound matches all values less than or equal
     to the integer literal expression e.
 */
-void add_range_literal
+void
-    PROTO_N ( ( e, n ) )
-    PROTO_T ( EXP e X int n )
+add_range_literal(EXP e, int n)
+{
-    LITERAL_INFO *p = xmalloc_one ( LITERAL_INFO ) ;
+	LITERAL_INFO *p = xmalloc_one(LITERAL_INFO);
-    p->tag = n ;
+	p->tag = n;
-    if ( !IS_NULL_exp ( e ) && IS_exp_int_lit ( e ) ) {
+	if (!IS_NULL_exp(e) && IS_exp_int_lit(e)) {
-	p->bound = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
+		p->bound = DEREF_nat(exp_int_lit_nat(e));
-    } else {
+	} else {
-	p->bound = small_nat [0] ;
+		p->bound = small_nat[0];
-    }
+	}
-    p->type = NULL_type ;
+	p->type = NULL_type;
-    p->tok = NULL_id ;
+	p->tok = NULL_id;
-    p->tok_no = -1 ;
+	p->tok_no = -1;
-    p->opt = OPT_none ;
+	p->opt = OPT_none;
-    p->next = NULL ;
+	p->next = NULL;
-    *ptr_int_lit = p ;
+	*ptr_int_lit = p;
-    crt_int_lit = p ;
+	crt_int_lit = p;
-    ptr_int_lit = &( p->next ) ;
+	ptr_int_lit = & (p->next);
-    return ;
+	return;
+}
 /*
     ADD A TYPE TO A LITERAL SPECIFICATION
     This routine specifies the type t for all values under the current
     bound in the current literal specification.
 */
-void add_type_literal
+void
-    PROTO_N ( ( t ) )
-    PROTO_T ( TYPE t )
+add_type_literal(TYPE t)
 {
-    NAT n ;
+	NAT n;
-    LITERAL_INFO *p = crt_int_lit ;
+	LITERAL_INFO *p = crt_int_lit;
-    if ( IS_type_integer ( t ) ) {
+	if (IS_type_integer(t)) {
-	if ( !is_arg_promote ( t ) ) {
+		if (!is_arg_promote(t)) {
-	    /* Type should promote to itself */
+			/* Type should promote to itself */
-	    report ( preproc_loc, ERR_pragma_lit_type ( t ) ) ;
+			report(preproc_loc, ERR_pragma_lit_type(t));
-	    t = promote_type ( t ) ;
+			t = promote_type(t);
-	}
+		}
-    } else {
+	} else {
-	/* Type should be integral */
+		/* Type should be integral */
-	if ( !IS_type_error ( t ) ) {
+		if (!IS_type_error(t)) {
-	    report ( preproc_loc, ERR_pragma_lit_type ( t ) ) ;
+			report(preproc_loc, ERR_pragma_lit_type(t));
-	}
+		}
-	t = type_ulong ;
+		t = type_ulong;
-    }
+	}
-    p->type = qualify_type ( t, cv_none, 0 ) ;
+	p->type = qualify_type(t, cv_none, 0);
-    n = p->bound ;
+	n = p->bound;
-    if ( p->tag == 2 ) {
+	if (p->tag == 2) {
-	if ( check_nat_range ( t, n ) != 0 ) {
+		if (check_nat_range(t, n)!= 0) {
-	    /* Given bound should fit into type */
+			/* Given bound should fit into type */
-	    report ( preproc_loc, ERR_pragma_lit_range ( n, t ) ) ;
+			report(preproc_loc, ERR_pragma_lit_range(n, t));
-	    n = max_type_value ( t, 0 ) ;
+			n = max_type_value(t, 0);
+		}
+	} else {
+		n = max_type_value(t, 0);
+	}
-    } else {
-	n = max_type_value ( t, 0 ) ;
-    }
-    p->bound = n ;
+	p->bound = n;
-    return ;
+	return;
+}
 /*
     ADD A TOKEN TO A LITERAL SPECIFICATION
     This routine specifies that the token id should be used to calculate
     the type for all values under the current bound in the current
     literal specification.  An error with severity sev is reported.
 */
-void add_token_literal
+void
-    PROTO_N ( ( id, sev ) )
-    PROTO_T ( IDENTIFIER id X unsigned sev )
+add_token_literal(IDENTIFIER id, unsigned sev)
 {
-    int n = -1 ;
+	int n = -1;
-    LITERAL_INFO *p = crt_int_lit ;
+	LITERAL_INFO *p = crt_int_lit;
-    if ( !IS_NULL_id ( id ) ) {
+	if (!IS_NULL_id(id)) {
-	id = resolve_token ( id, "ZZ", 0 ) ;
+		id = resolve_token(id, "ZZ", 0);
+		if (!IS_NULL_id(id)) {
-	if ( !IS_NULL_id ( id ) ) n = builtin_token ( id ) ;
+			n = builtin_token(id);
-    }
+		}
+	}
-    if ( p->tag == 1 ) {
+	if (p->tag == 1) {
-	report ( preproc_loc, ERR_pragma_lit_question () ) ;
+		report(preproc_loc, ERR_pragma_lit_question());
-	p->tag = 3 ;
+		p->tag = 3;
-    }
+	}
-    p->tok = id ;
+	p->tok = id;
-    p->tok_no = n ;
+	p->tok_no = n;
-    switch ( sev ) {
+	switch (sev) {
+	case OPTION_ON:
-	case OPTION_ON : p->opt = OPT_error ; break ;
+		p->opt = OPT_error;
+		break;
+	case OPTION_WARN:
-	case OPTION_WARN : p->opt = OPT_warning ; break ;
+		p->opt = OPT_warning;
+		break;
+	default:
-	default : p->opt = OPT_none ; break ;
+		p->opt = OPT_none;
+		break;
-    }
+	}
-    return ;
+	return;
+}
 /*
     FIND AN INTEGER LITERAL TYPE
     with base base and suffix suff.  num gives the text used to specify
     the constant for the purposes of error reporting.  fit is set to
     true if lit definitely fits into the result.
 */
-TYPE find_literal_type
+TYPE
-    PROTO_N ( ( lit, base, suff, num, fit ) )
-    PROTO_T ( NAT lit X int base X int suff X string num X int *fit )
+find_literal_type(NAT lit, int base, int suff, string num, int *fit)
+{
-    TYPE t ;
+	TYPE t;
-    int tok ;
+	int tok;
-    INT_TYPE it ;
+	INT_TYPE it;
-    int big = 0 ;
+	int big = 0;
-    int have_tok = 0 ;
+	int have_tok = 0;
-    int opt = OPT_error ;
+	int opt = OPT_error;
-    NAT n = small_nat [0] ;
+	NAT n = small_nat[0];
-    IDENTIFIER tid = NULL_id ;
+	IDENTIFIER tid = NULL_id;
-    LIST ( TYPE ) qt = NULL_list ( TYPE ) ;
+	LIST(TYPE)qt = NULL_list(TYPE);
-    LITERAL_INFO *pt = int_lit_spec [ base ] [ suff ] ;
+	LITERAL_INFO *pt = int_lit_spec[base][suff];
-    /* Deal with calculated literals */
+	/* Deal with calculated literals */
-    switch ( TAG_nat ( lit ) ) {
+	switch (TAG_nat(lit)) {
-	case nat_neg_tag : {
+	case nat_neg_tag:
-	    lit = DEREF_nat ( nat_neg_arg ( lit ) ) ;
+		lit = DEREF_nat(nat_neg_arg(lit));
-	    t = find_literal_type ( lit, base, suff, num, fit ) ;
+		t = find_literal_type(lit, base, suff, num, fit);
+		return(t);
+	case nat_token_tag:
+		t = type_sint;
+		*fit = 1;
+		return(t);
+	case nat_calc_tag: {
+		EXP e = DEREF_exp(nat_calc_value(lit));
+		t = DEREF_type(exp_type(e));
+		*fit = 1;
-	    return ( t ) ;
+		return(t);
+	}
-	case nat_token_tag : {
-	    t = type_sint ;
-	    *fit = 1 ;
-	    return ( t ) ;
+	}
-	case nat_calc_tag : {
-	    EXP e = DEREF_exp ( nat_calc_value ( lit ) ) ;
-	    t = DEREF_type ( exp_type ( e ) ) ;
-	    *fit = 1 ;
-	    return ( t ) ;
-	}
-    }
-    /* Deal with simple literals */
+	/* Deal with simple literals */
-    while ( pt != NULL ) {
+	while (pt != NULL) {
-	int ch = 4 ;
+		int ch = 4;
-	TYPE s = pt->type ;
+		TYPE s = pt->type;
-	switch ( pt->tag ) {
+		switch (pt->tag) {
-	    case 0 : {
+		case 0: {
-		TYPE r = s ;
+			TYPE r = s;
-		if ( IS_NULL_type ( r ) ) r = type_ulong ;
+			if (IS_NULL_type(r)) {
+				r = type_ulong;
+			}
-		ch = check_nat_range ( r, lit ) ;
+			ch = check_nat_range(r, lit);
-		if ( ch == 0 ) *fit = 1 ;
+			if (ch == 0) {
+				*fit = 1;
+			}
-		if ( ch > 4 ) big = ch ;
+			if (ch > 4) {
+				big = ch;
+			}
+			if (big) {
-		if ( big ) n = max_type_value ( NULL_type, 0 ) ;
+				n = max_type_value(NULL_type, 0);
+			}
-		ch = big ;
+			ch = big;
-		break ;
+			break;
-	    }
+		}
-	    case 1 : {
+		case 1:
-		n = pt->bound ;
+			n = pt->bound;
-		ch = check_nat_range ( s, lit ) ;
+			ch = check_nat_range(s, lit);
-		if ( ch == 0 ) *fit = 1 ;
+			if (ch == 0) {
-		break ;
+				*fit = 1;
-	    }
+			}
+			break;
-	    case 2 : {
+		case 2:
-		n = pt->bound ;
+			n = pt->bound;
-		if ( compare_nat ( n, lit ) >= 0 ) {
+			if (compare_nat(n, lit) >= 0) {
-		    if ( !IS_NULL_type ( s ) ) *fit = 1 ;
+				if (!IS_NULL_type(s))*fit = 1;
-		    ch = 0 ;
+				ch = 0;
+			}
+			break;
+		}
+		if (ch == 0) {
+			/* lit definitely fits into bound */
+			if (!IS_NULL_type(s) && IS_NULL_list(qt)) {
+				/* No previous fit */
+				return(s);
+			}
+		}
+		if (ch <= 2) {
+			/* lit may fit into bound */
+			if (!IS_NULL_type(s)) {
+				if (have_tok == 0) {
+					INT_TYPE is =
+					    DEREF_itype(type_integer_rep(s));
+					LIST(TYPE)st =
+					    DEREF_list(itype_cases(is));
+					qt = union_type_set(qt, st);
+					if (ch == 0) {
+						have_tok = 1;
+					}
+				}
+			} else {
+				if (have_tok == 0 && !IS_NULL_id(pt->tok)) {
+					DESTROY_list(qt, SIZE_type);
+					tok = int_lit_tok[base][suff].tok;
+					if (pt->tok_no == tok) {
+						qt = int_lit_tok[base][suff].cases;
+					} else if (suff < SUFFIX_LL) {
+						qt = all_prom_types;
+					} else {
+						qt = all_llong_types;
+					}
+					have_tok = 2;
+				}
+				break;
+			}
+		}
+		if (ch > 4) {
+			big = ch;
+		}
+		pt = pt->next;
+	}
+	/* Tokenised result */
+	if (have_tok != 2) {
+		/* Find list of possible types */
+		if (IS_NULL_list(qt)) {
+			qt = int_lit_tok[base][suff].cases;
+		} else {
+			qt = REVERSE_list(qt);
+			qt = uniq_type_set(qt);
+		}
+	}
+	if (pt) {
+		/* Get token information from table */
+		tid = pt->tok;
+		opt = pt->opt;
+	}
+	if (num && !(*fit)) {
+		/* Report error if necessary */
+		ERROR err = ERR_lex_icon_large(num, n);
+		err = set_severity(err, opt, 0);
+		if (!IS_NULL_err(err)) {
+			report(crt_loc, err);
+		}
-		break ;
-	    }
+	}
-	if ( ch == 0 ) {
+	if (LENGTH_list(qt) == 1) {
-	    /* lit definitely fits into bound */
-	    if ( !IS_NULL_type ( s ) && IS_NULL_list ( qt ) ) {
-		/* No previous fit */
+		/* Only one possible case */
-		return ( s ) ;
-	    }
-	}
-	if ( ch <= 2 ) {
-	    /* lit may fit into bound */
-	    if ( !IS_NULL_type ( s ) ) {
-		if ( have_tok == 0 ) {
-		    INT_TYPE is = DEREF_itype ( type_integer_rep ( s ) ) ;
-		    LIST ( TYPE ) st = DEREF_list ( itype_cases ( is ) ) ;
-		    qt = union_type_set ( qt, st ) ;
+		t = DEREF_type(HEAD_list(qt));
-		    if ( ch == 0 ) have_tok = 1 ;
-		}
-	    } else {
-		if ( have_tok == 0 && !IS_NULL_id ( pt->tok ) ) {
-		    DESTROY_list ( qt, SIZE_type ) ;
+		DESTROY_list(qt, SIZE_type);
-		    tok = int_lit_tok [ base ] [ suff ].tok ;
-		    if ( pt->tok_no == tok ) {
-			qt = int_lit_tok [ base ] [ suff ].cases ;
-		    } else if ( suff < SUFFIX_LL ) {
-			qt = all_prom_types ;
-		    } else {
-			qt = all_llong_types ;
-		    }
-		    have_tok = 2 ;
-		}
-		break ;
+		return(t);
-	    }
-	}
-	if ( ch > 4 ) big = ch ;
-	pt = pt->next ;
-    }
-    /* Tokenised result */
-    if ( have_tok != 2 ) {
-	/* Find list of possible types */
-	if ( IS_NULL_list ( qt ) ) {
-	    qt = int_lit_tok [ base ] [ suff ].cases ;
-	} else {
-	    qt = REVERSE_list ( qt ) ;
-	    qt = uniq_type_set ( qt ) ;
+	}
-    }
-    if ( pt ) {
-	/* Get token information from table */
-	tid = pt->tok ;
-	opt = pt->opt ;
-    }
-    if ( num && !( *fit ) ) {
-	/* Report error if necessary */
-	ERROR err = ERR_lex_icon_large ( num, n ) ;
-	err = set_severity ( err, opt, 0 ) ;
-	if ( !IS_NULL_err ( err ) ) report ( crt_loc, err ) ;
-    }
-    if ( LENGTH_list ( qt ) == 1 ) {
-	/* Only one possible case */
-	t = DEREF_type ( HEAD_list ( qt ) ) ;
-	DESTROY_list ( qt, SIZE_type ) ;
-	return ( t ) ;
-    }
-    tok = int_lit_tok [ base ] [ suff ].tok ;
+	tok = int_lit_tok[base][suff].tok;
-    MAKE_itype_literal ( NULL_type, qt, lit, tok, base, suff, tid, it ) ;
+	MAKE_itype_literal(NULL_type, qt, lit, tok, base, suff, tid, it);
-    t = promote_itype ( it, it ) ;
+	t = promote_itype(it, it);
-    return ( t ) ;
+	return(t);
+}
 /*
     ANALYSE AN INTEGER OR FLOATING LITERAL
     depending on the form of the literal.  Note that str can be an area
     of read-only memory for integer literals, but not for floating
     literals.
 */
-EXP make_literal_exp
+EXP
-    PROTO_N ( ( str, ptok, force ) )
-    PROTO_T ( string str X int *ptok X int force )
+make_literal_exp(string str, int *ptok, int force)
+{
-    EXP e ;
+	EXP e;
-    string r ;
+	string r;
-    int err = 0 ;
+	int err = 0;
-    int flt = 0 ;
+	int flt = 0;
-    string s = str ;
+	string s = str;
-    unsigned base = 10 ;
+	unsigned base = 10;
-    string dot_posn = NULL ;
+	string dot_posn = NULL;
-    string exp_posn = NULL ;
+	string exp_posn = NULL;
-    int form = BASE_DECIMAL ;
+	int form = BASE_DECIMAL;
-    /* Check small literals */
+	/* Check small literals */
-    character c1 = s [0] ;
+	character c1 = s[0];
-    character c2 = 0 ;
+	character c2 = 0;
-    if ( c1 ) c2 = s [1] ;
-    if ( c2 == 0 && ( c1 >= char_zero && c1 <= char_nine ) ) {
-	unsigned etag = exp_int_lit_tag ;
-	int n = ( int ) digit_values [ c1 ] ;
-	NAT lit = small_nat [n] ;
-	if ( IS_NULL_nat ( lit ) ) lit = make_small_nat ( n ) ;
-	if ( n == 0 ) etag = exp_null_tag ;
-	MAKE_exp_int_lit ( type_sint, lit, etag, e ) ;
-	*ptok = lex_integer_Hexp ;
-	return ( e ) ;
-    }
-    if ( c1 == char_zero && ( c2 == char_x || c2 == char_X ) ) {
-	/* Hexadecimal integer */
-	base = 16 ;
-	form = BASE_HEXADECIMAL ;
-	r = s + 2 ;
-	s = check_digits ( r, base ) ;
-	if ( s == r ) err = 1 ;
-    } else {
-	if ( c1 == char_dot ) {
-	    /* Fractional component of floating literal */
-	    dot_posn = s ;
-	    r = s + 1 ;
-	    s = check_digits ( r, base ) ;
-	    if ( s == r ) err = 1 ;
-	    flt = 1 ;
-	} else {
+	if (c1) {
-	    /* Sequence of decimal digits */
-	    r = s ;
-	    s = check_digits ( r, base ) ;
-	    if ( s == r ) {
-		if ( c1 == char_plus || c1 == char_minus ) {
-		    /* Extension to handle signs */
-		    e = make_literal_exp ( str + 1, ptok, force ) ;
-		    if ( c1 == char_minus ) {
-			e = make_uminus_exp ( lex_minus, e ) ;
-		    }
-		    return ( e ) ;
-		}
-		err = 1 ;
-	    }
-	    if ( s [0] == char_dot ) {
-		/* Fractional component of floating literal */
-		dot_posn = s ;
-		s = check_digits ( s + 1, base ) ;
-		flt = 1 ;
-	    }
-	}
-	exp_posn = s ;
-	c2 = s [0] ;
+		c2 = s[1];
-	if ( c2 == char_e || c2 == char_E ) {
-	    /* Exponent component of floating literal */
-	    c2 = s [1] ;
-	    if ( c2 == char_plus || c2 == char_minus ) s++ ;
-	    r = s + 1 ;
-	    s = check_digits ( r, base ) ;
-	    if ( s == r ) err = 1 ;
-	    flt = 1 ;
-	}
-	if ( c1 == char_zero && !flt ) {
-	    /* Octal integer */
-	    base = 8 ;
-	    form = BASE_OCTAL ;
-	    r = check_digits ( str, base ) ;
-	    if ( r != s ) {
-		/* Digits contain 8 or 9 */
-		report ( crt_loc, ERR_lex_icon_octal ( str ) ) ;
-	    }
-	}
-    }
-    if ( flt ) {
-	/* Floating literals */
-	int zero ;
-	NAT expon ;
-	character ep ;
-	string frac_part ;
-	string int_part = str ;
-	string suff_posn = s ;
-	unsigned trail_zero = 0 ;
-	FLOAT lit = NULL_flt ;
-	TYPE t = type_double ;
-	/* Check float suffix */
-	c1 = s [0] ;
-	if ( c1 == char_f || c1 == char_F ) {
-	    /* Suffix F */
-	    t = type_float ;
-	    s++ ;
-	    c1 = s [0] ;
-	} else if ( c1 == char_l || c1 == char_L ) {
-	    /* Suffix L */
-	    t = type_ldouble ;
-	    s++ ;
-	    c1 = s [0] ;
-	}
-	/* Check for end of number */
-	if ( c1 || err ) report ( crt_loc, ERR_lex_literal_bad ( str ) ) ;
-	/* Find number components (involves writing to s)  */
-	while ( int_part [0] == char_zero ) {
-	    /* Remove initial zeros */
-	    int_part++ ;
+	}
-	if ( dot_posn ) {
-	    dot_posn [0] = 0 ;
-	    if ( int_part == dot_posn ) int_part = small_number [0] ;
+	if (c2 == 0 && (c1 >= char_zero && c1 <= char_nine)) {
-	    frac_part = dot_posn + 1 ;
+		unsigned etag = exp_int_lit_tag;
-	    if ( frac_part == exp_posn ) {
+		int n = (int)digit_values[c1];
-		frac_part = small_number [0] ;
+		NAT lit = small_nat[n];
-	    } else {
-		/* Remove trailing zeros */
-		string frac_zero = exp_posn - 1 ;
-		while ( frac_zero [0] == char_zero ) {
-		    frac_zero [0] = 0 ;
+		if (IS_NULL_nat(lit)) {
-		    frac_zero-- ;
-		    trail_zero++ ;
+			lit = make_small_nat(n);
+		}
-		if ( frac_zero == dot_posn ) frac_part = small_number [0] ;
-	    }
-	} else {
-	    if ( int_part == exp_posn ) int_part = small_number [0] ;
-	    frac_part = small_number [0] ;
-	}
-	ep = exp_posn [0] ;
-	exp_posn [0] = 0 ;
-	if ( ep == char_e || ep == char_E ) {
-	    /* Evaluate exponent */
-	    r = exp_posn + 1 ;
-	    c2 = r [0] ;
+		if (n == 0) {
-	    if ( c2 == char_minus || c2 == char_plus ) r++ ;
-	    expon = eval_digits ( r, suff_posn, base ) ;
-	    if ( c2 == char_minus ) expon = negate_nat ( expon ) ;
-	    zero = is_zero_nat ( expon ) ;
-	} else {
-	    expon = small_nat [0] ;
+			etag = exp_null_tag;
-	    zero = 1 ;
-	}
-	if ( zero && ustreq ( frac_part, small_number [0] ) ) {
-	    int i ;
-	    for ( i = 0 ; i < SMALL_FLT_SIZE ; i++ ) {
-		if ( ustreq ( int_part, small_number [i] ) ) {
-		    lit = get_float ( t, i ) ;
-		    break ;
+		}
+		MAKE_exp_int_lit(type_sint, lit, etag, e);
+		*ptok = lex_integer_Hexp;
-	    }
+		return(e);
+	}
-	if ( IS_NULL_flt ( lit ) ) {
-	    int_part = xustrcpy ( int_part ) ;
-	    frac_part = xustrcpy ( frac_part ) ;
-	}
-	if ( trail_zero ) {
-	    /* Restore trailing zeros */
-	    r = exp_posn - 1 ;
-	    do {
-		r [0] = char_zero ;
-		r-- ;
-		trail_zero-- ;
-	    } while ( trail_zero ) ;
-	}
-	if ( dot_posn ) dot_posn [0] = char_dot ;
-	exp_posn [0] = ep ;
+	if (c1 == char_zero && (c2 == char_x || c2 == char_X)) {
+		/* Hexadecimal integer */
+		base = 16;
+		form = BASE_HEXADECIMAL;
+		r = s + 2;
+		s = check_digits(r, base);
+		if (s == r) {
+			err = 1;
+		}
+	} else {
+		if (c1 == char_dot) {
+			/* Fractional component of floating literal */
+			dot_posn = s;
+			r = s + 1;
+			s = check_digits(r, base);
+			if (s == r) {
+				err = 1;
+			}
+			flt = 1;
+		} else {
+			/* Sequence of decimal digits */
+			r = s;
+			s = check_digits(r, base);
+			if (s == r) {
+				if (c1 == char_plus || c1 == char_minus) {
+					/* Extension to handle signs */
+					e = make_literal_exp(str + 1, ptok,
+							     force);
+					if (c1 == char_minus) {
+						e = make_uminus_exp(lex_minus,
+								    e);
+					}
+					return(e);
+				}
+				err = 1;
+			}
+			if (s[0] == char_dot) {
+				/* Fractional component of floating literal */
+				dot_posn = s;
+				s = check_digits(s + 1, base);
+				flt = 1;
+			}
+		}
+		exp_posn = s;
+		c2 = s[0];
+		if (c2 == char_e || c2 == char_E) {
-	/* Construct result - type is as per suffix */
+			/* Exponent component of floating literal */
+			c2 = s[1];
+			if (c2 == char_plus || c2 == char_minus) {
+				s++;
+			}
+			r = s + 1;
+			s = check_digits(r, base);
+			if (s == r) {
+				err = 1;
+			}
+			flt = 1;
+		}
-	if ( IS_NULL_flt ( lit ) ) {
+		if (c1 == char_zero && !flt) {
+			/* Octal integer */
+			base = 8;
+			form = BASE_OCTAL;
+			r = check_digits(str, base);
+			if (r != s) {
+				/* Digits contain 8 or 9 */
-	    MAKE_flt_simple ( int_part, frac_part, expon, lit ) ;
+				report(crt_loc, ERR_lex_icon_octal(str));
+			}
+		}
+	}
-	MAKE_exp_float_lit ( t, lit, e ) ;
-	*ptok = lex_floating_Hexp ;
-    } else {
-	/* Integer literals */
-	TYPE t ;
-	NAT lit ;
-	int ls = 0 ;
-	int us = 0 ;
-	int fit = 0 ;
+	if (flt) {
-	/* Find integer value */
+		/* Floating literals */
+		int zero;
+		NAT expon;
+		character ep;
+		string frac_part;
+		string int_part = str;
+		string suff_posn = s;
+		unsigned trail_zero = 0;
+		FLOAT lit = NULL_flt;
+		TYPE t = type_double;
+		/* Check float suffix */
-	r = str ;
+		c1 = s[0];
+		if (c1 == char_f || c1 == char_F) {
+			/* Suffix F */
+			t = type_float;
+			s++;
+			c1 = s[0];
+		} else if (c1 == char_l || c1 == char_L) {
+			/* Suffix L */
+			t = type_ldouble;
+			s++;
+			c1 = s[0];
+		}
+		/* Check for end of number */
+		if (c1 || err) {
+			report(crt_loc, ERR_lex_literal_bad(str));
+		}
+		/* Find number components (involves writing to s)  */
+		while (int_part[0] == char_zero) {
+			/* Remove initial zeros */
+			int_part++;
+		}
+		if (dot_posn) {
+			dot_posn[0] = 0;
+			if (int_part == dot_posn) {
+				int_part = small_number[0];
+			}
+			frac_part = dot_posn + 1;
+			if (frac_part == exp_posn) {
+				frac_part = small_number[0];
+			} else {
+				/* Remove trailing zeros */
+				string frac_zero = exp_posn - 1;
+				while (frac_zero[0] == char_zero) {
+					frac_zero[0] = 0;
+					frac_zero--;
+					trail_zero++;
+				}
+				if (frac_zero == dot_posn) {
+					frac_part = small_number[0];
+				}
+			}
+		} else {
+			if (int_part == exp_posn) {
+				int_part = small_number[0];
+			}
+			frac_part = small_number[0];
+		}
+		ep = exp_posn[0];
+		exp_posn[0] = 0;
-	if ( form == BASE_HEXADECIMAL ) r += 2 ;
+		if (ep == char_e || ep == char_E) {
+			/* Evaluate exponent */
+			r = exp_posn + 1;
+			c2 = r[0];
+			if (c2 == char_minus || c2 == char_plus) {
+				r++;
+			}
-	lit = eval_digits ( r, s, base ) ;
+			expon = eval_digits(r, suff_posn, base);
+			if (c2 == char_minus) {
+				expon = negate_nat(expon);
+			}
+			zero = is_zero_nat(expon);
+		} else {
+			expon = small_nat[0];
+			zero = 1;
+		}
+		if (zero && ustreq(frac_part, small_number[0])) {
+			int i;
+			for (i = 0; i < SMALL_FLT_SIZE; i++) {
+				if (ustreq(int_part, small_number[i])) {
+					lit = get_float(t, i);
+					break;
+				}
+			}
+		}
+		if (IS_NULL_flt(lit)) {
+			int_part = xustrcpy(int_part);
+			frac_part = xustrcpy(frac_part);
+		}
+		if (trail_zero) {
+			/* Restore trailing zeros */
+			r = exp_posn - 1;
+			do {
+				r[0] = char_zero;
+				r--;
+				trail_zero--;
+			} while (trail_zero);
+		}
+		if (dot_posn) {
+			dot_posn[0] = char_dot;
+		}
+		exp_posn[0] = ep;
+		/* Construct result - type is as per suffix */
+		if (IS_NULL_flt(lit)) {
+			MAKE_flt_simple(int_part, frac_part, expon, lit);
+		}
+		MAKE_exp_float_lit(t, lit, e);
+		*ptok = lex_floating_Hexp;
-	/* Check integer suffix */
-	c1 = s [0] ;
-	if ( c1 == char_u || c1 == char_U ) {
-	    us = 1 ;
-	    s++ ;
-	    c1 = s [0] ;
-	}
-	if ( c1 == char_l || c1 == char_L ) {
-	    ls = 1 ;
-	    if ( s [1] == c1 && basetype_info [ ntype_sllong ].key ) {
-		report ( crt_loc, ERR_lex_icon_llong ( str ) ) ;
-		ls = 2 ;
-		s++ ;
-	    }
-	    s++ ;
-	    c1 = s [0] ;
 	} else {
+		/* Integer literals */
+		TYPE t;
+		NAT lit;
+		int ls = 0;
+		int us = 0;
+		int fit = 0;
+		/* Find integer value */
+		r = str;
+		if (form == BASE_HEXADECIMAL) {
+			r += 2;
+		}
+		lit = eval_digits(r, s, base);
+		/* Check integer suffix */
+		c1 = s[0];
+		if (c1 == char_u || c1 == char_U) {
+			us = 1;
+			s++;
+			c1 = s[0];
+		}
+		if (c1 == char_l || c1 == char_L) {
+			ls = 1;
+			if (s[1] == c1 && basetype_info[ntype_sllong].key) {
+				report(crt_loc, ERR_lex_icon_llong(str));
+				ls = 2;
+				s++;
+			}
+			s++;
+			c1 = s[0];
+		} else {
-	    /* Map 'int' to 'long' in '#if' expressions */
+			/* Map 'int' to 'long' in '#if' expressions */
-	    if ( in_hash_if_exp ) ls = 1 ;
+			if (in_hash_if_exp) {
+				ls = 1;
+			}
-	}
+		}
-	if ( us == 0 && ( c1 == char_u || c1 == char_U ) ) {
+		if (us == 0 && (c1 == char_u || c1 == char_U)) {
-	    us = 1 ;
+			us = 1;
-	    s++ ;
+			s++;
-	    c1 = s [0] ;
+			c1 = s[0];
-	}
+		}
-	/* Check for end of number */
+		/* Check for end of number */
+		if (c1 || err) {
-	if ( c1 || err ) report ( crt_loc, ERR_lex_literal_bad ( str ) ) ;
+			report(crt_loc, ERR_lex_literal_bad(str));
+		}
-	/* Find literal type */
+		/* Find literal type */
-	if ( force ) {
+		if (force) {
-	    t = type_ulong ;
+			t = type_ulong;
-	    fit = 1 ;
+			fit = 1;
-	} else {
+		} else {
-	    int suff = SUFFIX ( us, ls ) ;
+			int suff = SUFFIX(us, ls);
-	    t = find_literal_type ( lit, form, suff, str, &fit ) ;
+			t = find_literal_type(lit, form, suff, str, &fit);
+		}
+		MAKE_exp_int_lit(t, lit, exp_int_lit_tag, e);
+		if (!fit) {
+			/* Force result to be a calculated value */
+			MAKE_exp_cast(t, CONV_INT_INT, e, e);
+			MAKE_nat_calc(e, lit);
+			MAKE_exp_int_lit(t, lit, exp_int_lit_tag, e);
+		}
+		*ptok = lex_integer_Hexp;
+	}
-	MAKE_exp_int_lit ( t, lit, exp_int_lit_tag, e ) ;
-	if ( !fit ) {
-	    /* Force result to be a calculated value */
-	    MAKE_exp_cast ( t, CONV_INT_INT, e, e ) ;
-	    MAKE_nat_calc ( e, lit ) ;
-	    MAKE_exp_int_lit ( t, lit, exp_int_lit_tag, e ) ;
-	}
-	*ptok = lex_integer_Hexp ;
-    }
-    return ( e ) ;
+	return(e);
+}
 /*
     IS A FLOATING LITERAL ZERO?
     This routine checks whether the floating point literal f is zero.
 */
-int is_zero_float
+int
-    PROTO_N ( ( f ) )
-    PROTO_T ( FLOAT f )
+is_zero_float(FLOAT f)
+{
-    string s ;
+	string s;
-    character c ;
+	character c;
-    s = DEREF_string ( flt_simple_int_part ( f ) ) ;
+	s = DEREF_string(flt_simple_int_part(f));
-    while ( c = *( s++ ), c != 0 ) {
+	while (c = *(s++), c != 0) {
-	if ( c != char_zero ) return ( 0 ) ;
+		if (c != char_zero) {
+			return(0);
-    }
+		}
+	}
-    s = DEREF_string ( flt_simple_frac_part ( f ) ) ;
+	s = DEREF_string(flt_simple_frac_part(f));
-    while ( c = *( s++ ), c != 0 ) {
+	while (c = *(s++), c != 0) {
-	if ( c != char_zero ) return ( 0 ) ;
+		if (c != char_zero) {
+			return(0);
-    }
+		}
+	}
-    return ( 1 ) ;
+	return(1);
+}
 /*
     ARE TWO FLOATING LITERALS EQUAL?
     This routine checks whether the floating point literals f and g are
     equal.  Note that this is equality of representation rather than
     equality of the underlying numbers.
 */
-int eq_float_lit
+int
-    PROTO_N ( ( f, g ) )
-    PROTO_T ( FLOAT f X FLOAT g )
+eq_float_lit(FLOAT f, FLOAT g)
+{
-    NAT ef, eg ;
+	NAT ef, eg;
-    ulong nf, ng ;
+	ulong nf, ng;
-    string af, ag ;
+	string af, ag;
-    string bf, bg ;
+	string bf, bg;
-    if ( EQ_flt ( f, g ) ) return ( 1 ) ;
+	if (EQ_flt(f, g)) {
+		return(1);
+	}
-    DECONS_flt_simple ( nf, af, bf, ef, f ) ;
+	DECONS_flt_simple(nf, af, bf, ef, f);
-    DECONS_flt_simple ( ng, ag, bg, eg, g ) ;
+	DECONS_flt_simple(ng, ag, bg, eg, g);
-    if ( !ustreq ( af, ag ) ) return ( 0 ) ;
+	if (!ustreq(af, ag)) {
+		return(0);
+	}
-    if ( !ustreq ( bf, bg ) ) return ( 0 ) ;
+	if (!ustreq(bf, bg)) {
+		return(0);
+	}
-    if ( compare_nat ( ef, eg ) != 0 ) return ( 0 ) ;
+	if (compare_nat(ef, eg)!= 0) {
+		return(0);
+	}
+	if (nf == LINK_NONE) {
-    if ( nf == LINK_NONE ) COPY_ulong ( flt_tok ( f ), ng ) ;
+		COPY_ulong(flt_tok(f), ng);
+	}
+	if (ng == LINK_NONE) {
-    if ( ng == LINK_NONE ) COPY_ulong ( flt_tok ( g ), nf ) ;
+		COPY_ulong(flt_tok(g), nf);
+	}
-    return ( 1 ) ;
+	return(1);
+}
 /*
     DEFAULT ROUNDING MODE
     This variable gives the default rounding mode used for converting
     floating point expressions to integers.
 */
-RMODE crt_round_mode = rmode_to_zero ;
+RMODE crt_round_mode = rmode_to_zero;
 /*
     ROUND A FLOATING POINT LITERAL
     This routine rounds the floating point literal f to an integer
     literal by the rounding mode corresponding to mode.  The null integer
     literal is returned to indicate a target dependent literal.  The
     range of values in which the result is target independent is actually
     rather small - it is given by FLT_DIG.
 /*
     EVALUATE A UNICODE CHARACTER
     This routine evaluates the unicode character with prefix c, consisting
     of n hex digits, given by ps.  ps is advanced to the position following
     the hex digits.
 */
-unsigned long eval_unicode
+unsigned long
-    PROTO_N ( ( c, n, pc, ps, err ) )
-    PROTO_T ( int c X unsigned n X int *pc X string *ps X ERROR *err )
+eval_unicode(int c, unsigned n, int *pc, string *ps, ERROR *err)
 {
-    string r = *ps ;
+	string r = *ps;
-    unsigned long u ;
+	unsigned long u;
-    unsigned base = 16 ;
+	unsigned base = 16;
-    string s = check_digits ( r, base ) ;
+	string s = check_digits(r, base);
-    unsigned m = ( unsigned ) ( s - r ) ;
+	unsigned m = (unsigned)(s - r);
-    if ( m < n ) {
+	if (m < n) {
-	add_error ( err, ERR_lex_charset_len ( c, n ) ) ;
+		add_error(err, ERR_lex_charset_len(c, n));
-    } else {
+	} else {
-	s = r + n ;
+		s = r + n;
-    }
+	}
-    *ps = s ;
+	*ps = s;
-    u = eval_char_digits ( r, s, base ) ;
+	u = eval_char_digits(r, s, base);
-    add_error ( err, ERR_lex_charset_replace ( u ) ) ;
+	add_error(err, ERR_lex_charset_replace(u));
-    if ( u < 0x20 || ( u >= 0x7f && u <= 0x9f ) || is_legal_char ( u ) ) {
+	if (u < 0x20 || (u >= 0x7f && u <= 0x9f) || is_legal_char(u)) {
-	add_error ( err, ERR_lex_charset_bad ( u ) ) ;
+		add_error(err, ERR_lex_charset_bad(u));
-	*pc = CHAR_SIMPLE ;
+		*pc = CHAR_SIMPLE;
-    } else {
+	} else {
-	if ( u <= ( unsigned long ) 0xffff ) *pc = CHAR_UNI4 ;
+		if (u <= (unsigned long)0xffff) {
+			*pc = CHAR_UNI4;
-    }
+		}
+	}
-    return ( u ) ;
+	return(u);
 }
 /*
     GET A MULTI-BYTE CHARACTER FROM A STRING
     This routine returns the multi-byte character pointed to by the
     string s.  It assigns the character type to pc.
 */
-unsigned long get_multi_char
+unsigned long
-    PROTO_N ( ( s, pc ) )
-    PROTO_T ( string s X int *pc )
+get_multi_char(string s, int *pc)
 {
-    int i ;
+	int i;
-    unsigned long n = 0 ;
+	unsigned long n = 0;
-    for ( i = MULTI_WIDTH - 1 ; i >= 1 ; i-- ) {
+	for (i = MULTI_WIDTH - 1; i >= 1; i--) {
-	n = ( n << 8 ) + ( unsigned long ) s [i] ;
+		n = (n << 8) + (unsigned long)s[i];
-    }
+	}
-    *pc = ( int ) s [0] ;
+	*pc = (int)s[0];
-    return ( n ) ;
+	return(n);
 }
 /*
     ADD A MULTI-BYTE CHARACTER TO A STRING
     This routine adds the multi-byte character n of type ch to the
     string s.  A multi-byte character is represented by 5 characters.
     The first is a key describing how the character was described (a
     simple character, a hex or octal escape sequence, a unicode
     character etc.).  The next four characters give the character value.
 */
-void add_multi_char
+void
-    PROTO_N ( ( s, n, ch ) )
-    PROTO_T ( string s X unsigned long n X int ch )
+add_multi_char(string s, unsigned long n, int ch)
+{
-    int i ;
+	int i;
-    s [0] = ( character ) ch ;
+	s[0] = (character)ch;
-    for ( i = 1 ; i < MULTI_WIDTH ; i++ ) {
+	for (i = 1; i < MULTI_WIDTH; i++) {
-	s [i] = ( character ) ( n & 0xff ) ;
+		s[i] = (character)(n & 0xff);
-	n >>= 8 ;
+		n >>= 8;
-    }
+	}
+	if (n) {
-    if ( n ) report ( crt_loc, ERR_lex_ccon_large () ) ;
+		report(crt_loc, ERR_lex_ccon_large());
+	}
-    return ;
+	return;
+}
 /*
     CREATE A MULTI-BYTE STRING
     This routine creates a multi-byte string of length n in s from the
     string t of kind k.
 */
-static void make_multi_string
+static void
-    PROTO_N ( ( s, t, n, k ) )
-    PROTO_T ( string s X string t X unsigned long n X unsigned k )
+make_multi_string(string s, string t, unsigned long n, unsigned k)
+{
-    if ( k & STRING_MULTI ) {
+	if (k & STRING_MULTI) {
-	n *= MULTI_WIDTH ;
+		n *= MULTI_WIDTH;
-	xumemcpy ( s, t, ( gen_size ) n ) ;
+		xumemcpy(s, t, (gen_size)n);
-    } else {
+	} else {
-	unsigned long i ;
+		unsigned long i;
-	for ( i = 0 ; i < n ; i++ ) {
+		for (i = 0; i < n; i++) {
-	    add_multi_char ( s, ( unsigned long ) *t, CHAR_SIMPLE ) ;
+			add_multi_char(s, (unsigned long)*t, CHAR_SIMPLE);
-	    s += MULTI_WIDTH ;
+			s += MULTI_WIDTH;
-	    t++ ;
+			t++;
+		}
+	}
-    }
-    return ;
+	return;
+}
 /*
     GET A MULTIBYTE CHARACTER FROM A STRING
     that single byte.
 */
 #if FS_MULTIBYTE
-static string get_multibyte
+static string
-    PROTO_N ( ( s, se, pc ) )
-    PROTO_T ( string s X string se X unsigned long *pc )
+get_multibyte(string s, string se, unsigned long *pc)
+{
-    wchar_t c ;
+	wchar_t c;
-    int n = mbtowc ( &c, s, ( size_t ) ( se - s ) ) ;
+	int n = mbtowc(&c, s, (size_t)(se - s));
-    if ( n > 0 ) {
+	if (n > 0) {
-	/* Valid multibyte character */
+		/* Valid multibyte character */
-	*pc = ( unsigned long ) c ;
+		*pc = (unsigned long)c;
-	s += n ;
+		s += n;
-    } else if ( n == 0 ) {
+	} else if (n == 0) {
-	/* Null character */
+		/* Null character */
-	*pc = 0 ;
+		*pc = 0;
-	s++ ;
+		s++;
-    } else {
+	} else {
-	/* Invalid multibyte character */
+		/* Invalid multibyte character */
-	report ( crt_loc, ERR_lex_ccon_multibyte () ) ;
+		report(crt_loc, ERR_lex_ccon_multibyte());
-	*pc = ( unsigned long ) *( s++ ) ;
+		*pc = (unsigned long)*(s++);
-    }
+	}
-    return ( s ) ;
+	return(s);
+}
 #endif
 /*
     ANALYSE A STRING OR CHARACTER LITERAL
     This routine analyses the string or character literal given by the
-    string s (which ends at se).  Only characters in the range [0,0xff]
+    string s (which ends at se).  Only characters in the range [0, 0xff]
     are assumed to be valid. Note that this is the routine which should
     do the mapping from the source character set to the execution
     character set (translation phase 5), however this is deferred until
     the string output routines.
 */
-STRING new_string_lit
+STRING
-    PROTO_N ( ( s, se, lex ) )
-    PROTO_T ( string s X string se X int lex )
+new_string_lit(string s, string se, int lex)
+{
-    STRING res ;
+	STRING res;
-    STRING prev ;
+	STRING prev;
-    int multi = 0 ;
+	int multi = 0;
-    int overflow = 0 ;
+	int overflow = 0;
-    unsigned long len = 0 ;
+	unsigned long len = 0;
-    unsigned kind = STRING_NONE ;
+	unsigned kind = STRING_NONE;
 #if FS_MULTIBYTE
-    int multibyte = allow_multibyte ;
+	int multibyte = allow_multibyte;
 #endif
-    gen_size sz = ( gen_size ) ( se - s ) + 1 ;
+	gen_size sz = (gen_size)(se - s) + 1;
-    string str = xustr ( sz ) ;
+	string str = xustr(sz);
-    /* Find string type */
+	/* Find string type */
-    switch ( lex ) {
+	switch (lex) {
-	case lex_char_Hlit :
+	case lex_char_Hlit:
-	case lex_char_Hexp : {
+	case lex_char_Hexp:
-	    kind = STRING_CHAR ;
+		kind = STRING_CHAR;
-	    break ;
+		break;
-	}
-	case lex_wchar_Hlit :
+	case lex_wchar_Hlit:
-	case lex_wchar_Hexp : {
+	case lex_wchar_Hexp:
-	    kind = ( STRING_WIDE | STRING_CHAR ) ;
+		kind = (STRING_WIDE | STRING_CHAR);
-	    break ;
+		break;
+	case lex_string_Hlit:
+	case lex_string_Hexp:
+		kind = STRING_NONE;
-	}
+		break;
-	case lex_string_Hlit :
+	case lex_wstring_Hlit:
-	case lex_string_Hexp : {
+	case lex_wstring_Hexp:
-	    kind = STRING_NONE ;
+		kind = STRING_WIDE;
-	    break ;
+		break;
+	}
+	if (do_string) {
+		dump_string_lit(s, se, kind);
+	}
-	case lex_wstring_Hlit :
-	case lex_wstring_Hexp : {
-	    kind = STRING_WIDE ;
-	    break ;
-	}
-    }
-    if ( do_string ) dump_string_lit ( s, se, kind ) ;
-    /* Scan string replacing escape sequences */
+	/* Scan string replacing escape sequences */
-    while ( s != se ) {
+	while (s != se) {
-	unsigned long c ;
+		unsigned long c;
-	int ch = CHAR_SIMPLE ;
+		int ch = CHAR_SIMPLE;
 #if FS_MULTIBYTE
-	if ( multibyte ) {
-	    s = get_multibyte ( s, se, &c ) ;
-	} else {
-	    c = ( unsigned long ) *( s++ ) ;
-	}
-#else
-	c = ( unsigned long ) *( s++ ) ;
-#endif
-	if ( c == char_backslash ) {
-	    if ( s != se ) {
-		/* Unterminated string literals already reported */
-		character e = NONE ;
-#if FS_MULTIBYTE
-		if ( multibyte ) {
+		if (multibyte) {
-		    s = get_multibyte ( s, se, &c ) ;
+			s = get_multibyte(s, se, &c);
 		} else {
-		    c = ( unsigned long ) *( s++ ) ;
+			c = (unsigned long)*(s++);
+		}
 #else
-		c = ( unsigned long ) *( s++ ) ;
+		c = (unsigned long)*(s++);
 #endif
+		if (c == char_backslash) {
+			if (s != se) {
+				/* Unterminated string literals already
+				 * reported */
+				character e = NONE;
+#if FS_MULTIBYTE
+				if (multibyte) {
+					s = get_multibyte(s, se, &c);
+				} else {
+					c = (unsigned long)*(s++);
+				}
+#else
+				c = (unsigned long)*(s++);
+#endif
+				if (c < NO_CHAR) {
-		if ( c < NO_CHAR ) e = escape_sequences [c] ;
+					e = escape_sequences[c];
+				}
-		switch ( e ) {
+				switch (e) {
-		    case OCTE : {
+				case OCTE: {
-			/* Octal escape sequences */
+					/* Octal escape sequences */
-			unsigned base = 8 ;
+					unsigned base = 8;
-			string r = s - 1 ;
+					string r = s - 1;
-			s = check_digits ( r, base ) ;
+					s = check_digits(r, base);
-			if ( s > r + 3 ) s = r + 3 ;
+					if (s > r + 3) {
+						s = r + 3;
+					}
-			c = eval_char_digits ( r, s, base ) ;
+					c = eval_char_digits(r, s, base);
-			ch = CHAR_OCTAL ;
+					ch = CHAR_OCTAL;
-			break ;
+					break;
-		    }
+				}
-		    case HEXE : {
+				case HEXE: {
-			/* Hexadecimal escape sequences */
+					/* Hexadecimal escape sequences */
-			unsigned base = 16 ;
+					unsigned base = 16;
-			string r = s ;
+					string r = s;
-			s = check_digits ( r, base ) ;
+					s = check_digits(r, base);
-			if ( s == r ) {
+					if (s == r) {
-			    int i = ( int ) c ;
+						int i = (int)c;
+						report(crt_loc,
-			    report ( crt_loc, ERR_lex_ccon_hex ( i ) ) ;
+						       ERR_lex_ccon_hex(i));
-			} else {
+					} else {
-			    c = eval_char_digits ( r, s, base ) ;
+						c = eval_char_digits(r, s,
+								     base);
-			}
+					}
-			ch = CHAR_HEX ;
+					ch = CHAR_HEX;
-			break ;
+					break;
-		    }
+				}
-		    case UNI4 : {
+				case UNI4: {
-			/* Short unicode escape sequences */
+					/* Short unicode escape sequences */
-			if ( allow_unicodes ) {
+					if (allow_unicodes) {
-			    string r = s ;
+						string r = s;
-			    unsigned d = 4 ;
+						unsigned d = 4;
-			    ERROR err = NULL_err ;
+						ERROR err = NULL_err;
-			    c = eval_unicode ( char_u, d, &ch, &r, &err ) ;
+						c = eval_unicode(char_u, d, &ch,
+								 &r, &err);
-			    if ( !IS_NULL_err ( err ) ) {
+						if (!IS_NULL_err(err)) {
-				report ( crt_loc, err ) ;
+							report(crt_loc, err);
-			    }
+						}
-			    ch = CHAR_UNI4 ;
+						ch = CHAR_UNI4;
-			    s = r ;
+						s = r;
-			    break ;
+						break;
-			}
+					}
-			goto illegal_lab ;
+					goto illegal_lab;
-		    }
+				}
-		    case UNI8 : {
+				case UNI8: {
-			/* Long unicode escape sequences */
+					/* Long unicode escape sequences */
-			if ( allow_unicodes ) {
+					if (allow_unicodes) {
-			    string r = s ;
+						string r = s;
-			    unsigned d = 8 ;
+						unsigned d = 8;
-			    ERROR err = NULL_err ;
+						ERROR err = NULL_err;
-			    c = eval_unicode ( char_U, d, &ch, &r, &err ) ;
+						c = eval_unicode(char_U, d, &ch,
+								 &r, &err);
-			    if ( !IS_NULL_err ( err ) ) {
+						if (!IS_NULL_err(err)) {
-				report ( crt_loc, err ) ;
+							report(crt_loc, err);
-			    }
+						}
-			    ch = CHAR_UNI8 ;
+						ch = CHAR_UNI8;
-			    s = r ;
+						s = r;
-			    break ;
+						break;
-			}
+					}
-			goto illegal_lab ;
+					goto illegal_lab;
-		    }
+				}
-		    case NONE :
+				case NONE:
-		    illegal_lab : {
+illegal_lab: {
-			/* Illegal escape sequences */
+					/* Illegal escape sequences */
-			int i = ( int ) c ;
+		     			int i = (int)c;
-			report ( crt_loc, ERR_lex_ccon_escape ( i ) ) ;
+					report(crt_loc, ERR_lex_ccon_escape(i));
-			break ;
+					break;
-		    }
+	     }
-		    default : {
+				default:
-			/* Simple escape sequences */
+					/* Simple escape sequences */
-			c = ( unsigned long ) e ;
+					c = (unsigned long)e;
-			break ;
+					break;
+				}
+			}
+		}
+		if ((ch != CHAR_SIMPLE || c >= 256) && !multi) {
+			/* Convert to multi-character format */
+			string a;
+			sz *= MULTI_WIDTH;
+			a = xustr(sz);
+			make_multi_string(a, str, len, kind);
+			if (len) {
+				len *= MULTI_WIDTH;
+				if (len == 0) {
+					overflow = 1;
+				}
+			}
+			if (c >= 256) {
+				/* Mark fat strings */
+				if (!(kind & STRING_WIDE)) {
+					if (ch == CHAR_UNI4 ||
+					    ch == CHAR_UNI8) {
+						/* EMPTY */
+					} else {
+						report(crt_loc,
+						       ERR_lex_ccon_large());
-		    }
+					}
+				}
+				kind |= STRING_FAT;
+			}
+			kind |= STRING_MULTI;
+			multi = 1;
+			str = a;
+		}
+		if (multi) {
+			add_multi_char(str + len, c, ch);
+			len += MULTI_WIDTH;
+		} else {
+			str[len++] = (character)c;
+		}
+		if (len == 0) {
+			overflow = 1;
+		}
-	    }
-	}
-	if ( ( ch != CHAR_SIMPLE || c >= 256 ) && !multi ) {
-	    /* Convert to multi-character format */
-	    string a ;
-	    sz *= MULTI_WIDTH ;
-	    a = xustr ( sz ) ;
-	    make_multi_string ( a, str, len, kind ) ;
-	    if ( len ) {
-		len *= MULTI_WIDTH ;
-		if ( len == 0 ) overflow = 1 ;
-	    }
-	    if ( c >= 256 ) {
-		/* Mark fat strings */
-		if ( !( kind & STRING_WIDE ) ) {
-		    if ( ch == CHAR_UNI4 || ch == CHAR_UNI8 ) {
-			/* EMPTY */
-		    } else {
-			report ( crt_loc, ERR_lex_ccon_large () ) ;
-		    }
-		}
-		kind |= STRING_FAT ;
-	    }
-	    kind |= STRING_MULTI ;
-	    multi = 1 ;
-	    str = a ;
-	}
-	if ( multi ) {
-	    add_multi_char ( str + len, c, ch ) ;
-	    len += MULTI_WIDTH ;
-	} else {
-	    str [ len++ ] = ( character ) c ;
+	}
-	if ( len == 0 ) overflow = 1 ;
-    }
-    if ( multi ) {
+	if (multi) {
-	add_multi_char ( str + len, ( unsigned long ) 0, CHAR_OCTAL ) ;
+		add_multi_char(str + len, (unsigned long)0, CHAR_OCTAL);
-	len /= MULTI_WIDTH ;
+		len /= MULTI_WIDTH;
-    } else {
-	str [ len ] = 0 ;
-    }
-    if ( overflow ) len = ULONG_MAX ;
-    if ( !check_value ( OPT_VAL_string_length, len ) ) {
-	len = option_value ( OPT_VAL_string_length ) ;
-	if ( multi ) {
-	    unsigned long n = MULTI_WIDTH * len ;
-	    add_multi_char ( str + n, ( unsigned long ) 0, CHAR_OCTAL ) ;
 	} else {
-	    str [ len ] = 0 ;
+		str[len] = 0;
+	}
+	if (overflow) {
+		len = ULONG_MAX;
+	}
+	if (!check_value(OPT_VAL_string_length, len)) {
+		len = option_value(OPT_VAL_string_length);
+		if (multi) {
+			unsigned long n = MULTI_WIDTH * len;
+			add_multi_char(str + n, (unsigned long)0, CHAR_OCTAL);
+		} else {
+			str[len] = 0;
-    }
+		}
+	}
-    MAKE_str_simple ( len, str, kind, res ) ;
+	MAKE_str_simple(len, str, kind, res);
-    prev = share_string_lit ( res ) ;
+	prev = share_string_lit(res);
-    if ( !EQ_str ( prev, res ) ) {
+	if (!EQ_str(prev, res)) {
-	/* Share string literals */
+		/* Share string literals */
-	unsigned long v ;
+		unsigned long v;
-	DESTROY_str_simple ( destroy, res, len, str, kind, v, res ) ;
+		DESTROY_str_simple(destroy, res, len, str, kind, v, res);
-	xufree ( str, sz ) ;
+		xufree(str, sz);
-	UNUSED ( res ) ;
+		UNUSED(res);
-	UNUSED ( len ) ;
+		UNUSED(len);
-	UNUSED ( kind ) ;
+		UNUSED(kind);
-	UNUSED ( v ) ;
+		UNUSED(v);
-	res = prev ;
+		res = prev;
-    }
+	}
-    return ( res ) ;
+	return(res);
+}
 /*
     ARE TWO STRINGS EQUAL?
     This routine checks whether the string literals s and t are equal.
 */
-int eq_string_lit
+int
-    PROTO_N ( ( s, t ) )
-    PROTO_T ( STRING s X STRING t )
+eq_string_lit(STRING s, STRING t)
+{
-    string as, at ;
+	string as, at;
-    unsigned ks, kt ;
+	unsigned ks, kt;
-    unsigned long ns, nt ;
+	unsigned long ns, nt;
-    if ( EQ_str ( s, t ) ) return ( 1 ) ;
+	if (EQ_str(s, t)) {
+		return(1);
+	}
-    ks = DEREF_unsigned ( str_simple_kind ( s ) ) ;
+	ks = DEREF_unsigned(str_simple_kind(s));
-    kt = DEREF_unsigned ( str_simple_kind ( t ) ) ;
+	kt = DEREF_unsigned(str_simple_kind(t));
-    ns = DEREF_ulong ( str_simple_len ( s ) ) ;
+	ns = DEREF_ulong(str_simple_len(s));
-    nt = DEREF_ulong ( str_simple_len ( t ) ) ;
+	nt = DEREF_ulong(str_simple_len(t));
-    if ( ks == kt && ns == nt ) {
+	if (ks == kt && ns == nt) {
-	as = DEREF_string ( str_simple_text ( s ) ) ;
+		as = DEREF_string(str_simple_text(s));
-	at = DEREF_string ( str_simple_text ( t ) ) ;
+		at = DEREF_string(str_simple_text(t));
-	if ( as == at ) return ( 1 ) ;
+		if (as == at) {
+			return(1);
+		}
-	if ( ks & STRING_MULTI ) ns *= MULTI_WIDTH ;
+		if (ks & STRING_MULTI) {
+			ns *= MULTI_WIDTH;
+		}
-	if ( xumemcmp ( as, at, ( gen_size ) ns ) == 0 ) return ( 1 ) ;
+		if (xumemcmp(as, at, (gen_size)ns) == 0) {
+			return(1);
-    }
+		}
+	}
-    return ( 0 ) ;
+	return(0);
+}
 /*
     CONCATENATE TWO STRING LITERALS
     This routine concatenates the string literals s and t.
 */
-STRING concat_string_lit
-    PROTO_N ( ( s, t ) )
-    PROTO_T ( STRING s X STRING t )
-{
-    string c ;
-    STRING res ;
-    STRING prev ;
-    unsigned kc ;
-    gen_size sz ;
-    unsigned long nc ;
-    string a = DEREF_string ( str_simple_text ( s ) ) ;
-    string b = DEREF_string ( str_simple_text ( t ) ) ;
-    unsigned ka = DEREF_unsigned ( str_simple_kind ( s ) ) ;
-    unsigned kb = DEREF_unsigned ( str_simple_kind ( t ) ) ;
-    unsigned long na = DEREF_ulong ( str_simple_len ( s ) ) ;
-    unsigned long nb = DEREF_ulong ( str_simple_len ( t ) ) ;
+STRING
+concat_string_lit(STRING s, STRING t)
+{
+	string c;
+	STRING res;
+	STRING prev;
+	unsigned kc;
+	gen_size sz;
+	unsigned long nc;
+	string a = DEREF_string(str_simple_text(s));
+	string b = DEREF_string(str_simple_text(t));
+	unsigned ka = DEREF_unsigned(str_simple_kind(s));
+	unsigned kb = DEREF_unsigned(str_simple_kind(t));
+	unsigned long na = DEREF_ulong(str_simple_len(s));
+	unsigned long nb = DEREF_ulong(str_simple_len(t));
-    /* Form the result literal */
+	/* Form the result literal */
-    if ( na == 0 ) return ( t ) ;
+	if (na == 0) {
+		return(t);
+	}
-    if ( nb == 0 ) return ( s ) ;
+	if (nb == 0) {
+		return(s);
+	}
-    nc = na + nb ;
+	nc = na + nb;
-    if ( nc < na || nc < nb ) nc = ULONG_MAX ;
+	if (nc < na || nc < nb) {
+		nc = ULONG_MAX;
+	}
-    if ( !check_value ( OPT_VAL_string_length, nc ) ) {
+	if (!check_value(OPT_VAL_string_length, nc)) {
-	nc = option_value ( OPT_VAL_string_length ) ;
+		nc = option_value(OPT_VAL_string_length);
-	nb = nc - na ;
+		nb = nc - na;
-    }
+	}
-    kc = ( ka | kb ) ;
+	kc = (ka | kb);
-    if ( kc & STRING_MULTI ) {
+	if (kc & STRING_MULTI) {
-	/* Multi-byte strings */
+		/* Multi-byte strings */
-	unsigned long sa = MULTI_WIDTH * na ;
+		unsigned long sa = MULTI_WIDTH * na;
-	unsigned long sc = MULTI_WIDTH * nc ;
+		unsigned long sc = MULTI_WIDTH * nc;
-	sz = ( gen_size ) ( sc + MULTI_WIDTH ) ;
+		sz = (gen_size)(sc + MULTI_WIDTH);
-	c = xustr ( sz ) ;
+		c = xustr(sz);
-	make_multi_string ( c, a, na, ka ) ;
+		make_multi_string(c, a, na, ka);
-	make_multi_string ( c + sa, b, nb, kb ) ;
+		make_multi_string(c + sa, b, nb, kb);
-	add_multi_char ( c + sc, ( unsigned long ) 0, CHAR_OCTAL ) ;
+		add_multi_char(c + sc, (unsigned long)0, CHAR_OCTAL);
-    } else {
+	} else {
-	/* Simple strings */
+		/* Simple strings */
-	sz = ( gen_size ) ( nc + 1 ) ;
+		sz = (gen_size)(nc + 1);
-	c = xustr ( sz ) ;
+		c = xustr(sz);
-	xumemcpy ( c, a, ( gen_size ) na ) ;
+		xumemcpy(c, a, (gen_size)na);
-	xumemcpy ( c + na, b, ( gen_size ) nb ) ;
+		xumemcpy(c + na, b, (gen_size)nb);
-	c [ nc ] = 0 ;
+		c[nc] = 0;
-    }
+	}
-    MAKE_str_simple ( nc, c, kc, res ) ;
+	MAKE_str_simple(nc, c, kc, res);
-    prev = share_string_lit ( res ) ;
+	prev = share_string_lit(res);
-    if ( !EQ_str ( prev, res ) ) {
+	if (!EQ_str(prev, res)) {
-	/* Share string literals */
+		/* Share string literals */
-	unsigned long v ;
+		unsigned long v;
-	DESTROY_str_simple ( destroy, res, nc, c, kc, v, res ) ;
+		DESTROY_str_simple(destroy, res, nc, c, kc, v, res);
-	xufree ( c, sz ) ;
+		xufree(c, sz);
-	UNUSED ( res ) ;
+		UNUSED(res);
-	UNUSED ( nc ) ;
+		UNUSED(nc);
-	UNUSED ( kc ) ;
+		UNUSED(kc);
-	UNUSED ( v ) ;
+		UNUSED(v);
-	res = prev ;
+		res = prev;
-    }
+	}
-    return ( res ) ;
+	return(res);
+}
 /*
     FIND THE SHARED COPY OF A STRING LITERAL
     This routine is used to implement shared string literals.  It returns
     the canonical copy of s (i.e. the first string equal to s for which
     the routine was called).
 */
-STRING share_string_lit
+STRING
-    PROTO_N ( ( s ) )
-    PROTO_T ( STRING s )
+share_string_lit(STRING s)
+{
-    string a = DEREF_string ( str_simple_text ( s ) ) ;
+	string a = DEREF_string(str_simple_text(s));
-    unsigned long h = ( hash ( a ) % HASH_STRING_SIZE ) ;
+	unsigned long h = (hash(a)% HASH_STRING_SIZE);
-    STRING p = string_hash_table [h] ;
+	STRING p = string_hash_table[h];
-    STRING t = p ;
+	STRING t = p;
-    while ( !IS_NULL_str ( t ) ) {
+	while (!IS_NULL_str(t)) {
-	if ( eq_string_lit ( t, s ) ) return ( t ) ;
+		if (eq_string_lit(t, s)) {
+			return(t);
+		}
-	t = DEREF_str ( str_next ( t ) ) ;
+		t = DEREF_str(str_next(t));
-    }
+	}
-    COPY_str ( str_next ( s ), p ) ;
+	COPY_str(str_next(s), p);
-    string_hash_table [h] = s ;
+	string_hash_table[h] = s;
-    return ( s ) ;
+	return(s);
+}
 /*
     GET THE NEXT CHARACTER FROM A STRING
     This routine returns the next character from the string s, using
     the tok field as a counter.  The character type is assigned to pc,
     including CHAR_NONE to indicate the end of the string.
 */
-unsigned long get_string_char
+unsigned long
-    PROTO_N ( ( s, pc ) )
-    PROTO_T ( STRING s X int *pc )
+get_string_char(STRING s, int *pc)
+{
-    unsigned long c ;
+	unsigned long c;
-    unsigned long i = DEREF_ulong ( str_simple_tok ( s ) ) ;
+	unsigned long i = DEREF_ulong(str_simple_tok(s));
-    unsigned long n = DEREF_ulong ( str_simple_len ( s ) ) ;
+	unsigned long n = DEREF_ulong(str_simple_len(s));
-    if ( i < n ) {
+	if (i < n) {
-	string text = DEREF_string ( str_simple_text ( s ) ) ;
+		string text = DEREF_string(str_simple_text(s));
-	unsigned kind = DEREF_unsigned ( str_simple_kind ( s ) ) ;
+		unsigned kind = DEREF_unsigned(str_simple_kind(s));
-	if ( kind & STRING_MULTI ) {
+		if (kind & STRING_MULTI) {
-	    c = get_multi_char ( text + MULTI_WIDTH * i, pc ) ;
+			c = get_multi_char(text + MULTI_WIDTH * i, pc);
+		} else {
+			c = (unsigned long)text[i];
+			*pc = CHAR_SIMPLE;
+		}
 	} else {
-	    c = ( unsigned long ) text [i] ;
+		c = 0;
-	    *pc = CHAR_SIMPLE ;
+		*pc = CHAR_NONE;
+	}
-    } else {
-	c = 0 ;
-	*pc = CHAR_NONE ;
-    }
-    COPY_ulong ( str_simple_tok ( s ), i + 1 ) ;
+	COPY_ulong(str_simple_tok(s), i + 1);
-    return ( c ) ;
+	return(c);
+}
 /*
     FIND A CHARACTER LITERAL
     This routine returns the character value corresponding to the character
     literal expression e.
 */
-int get_char_value
+int
-    PROTO_N ( ( e ) )
-    PROTO_T ( EXP e )
+get_char_value(EXP e)
 {
-    int c = char_illegal ;
+	int c = char_illegal;
-    if ( !IS_NULL_exp ( e ) ) {
+	if (!IS_NULL_exp(e)) {
-	if ( IS_exp_int_lit ( e ) ) {
+		if (IS_exp_int_lit(e)) {
-	    NAT n = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
+			NAT n = DEREF_nat(exp_int_lit_nat(e));
-	    if ( IS_nat_calc ( n ) ) {
+			if (IS_nat_calc(n)) {
-		e = DEREF_exp ( nat_calc_value ( n ) ) ;
+				e = DEREF_exp(nat_calc_value(n));
-	    }
+			}
-	}
+		}
-	if ( IS_exp_cast ( e ) ) {
+		if (IS_exp_cast(e)) {
-	    e = DEREF_exp ( exp_cast_arg ( e ) ) ;
+			e = DEREF_exp(exp_cast_arg(e));
-	    if ( IS_exp_int_lit ( e ) ) {
+			if (IS_exp_int_lit(e)) {
-		NAT n = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
+				NAT n = DEREF_nat(exp_int_lit_nat(e));
-		if ( IS_nat_calc ( n ) ) {
+				if (IS_nat_calc(n)) {
-		    e = DEREF_exp ( nat_calc_value ( n ) ) ;
+					e = DEREF_exp(nat_calc_value(n));
-		}
+				}
-	    }
+			}
-	}
+		}
-	if ( IS_exp_char_lit ( e ) ) {
+		if (IS_exp_char_lit(e)) {
-	    STRING s = DEREF_str ( exp_char_lit_str ( e ) ) ;
+			STRING s = DEREF_str(exp_char_lit_str(e));
-	    unsigned kind = DEREF_unsigned ( str_simple_kind ( s ) ) ;
+			unsigned kind = DEREF_unsigned(str_simple_kind(s));
-	    if ( !( kind & STRING_MULTI ) ) {
+			if (!(kind & STRING_MULTI)) {
+				unsigned long len =
-		unsigned long len = DEREF_ulong ( str_simple_len ( s ) ) ;
+				    DEREF_ulong(str_simple_len(s));
-		if ( len == 1 ) {
+				if (len == 1) {
+					string t =
-		    string t = DEREF_string ( str_simple_text ( s ) ) ;
+					    DEREF_string(str_simple_text(s));
-		    c = ( int ) *t ;
+					c = (int)*t;
-		}
+				}
-	    }
+			}
-	}
+		}
-    }
+	}
-    return ( c ) ;
+	return(c);
 }
 /*
     EVALUATE A CHARACTER LITERAL
     This routine evaluates the character literal str by mapping it to
     its ASCII representation.  The value is stored in the tok field
     (the fact that LINK_NONE equals EXTENDED_MAX is convenient, but not
     essential).
 */
-NAT eval_char_lit
+NAT
-    PROTO_N ( ( str ) )
-    PROTO_T ( STRING str )
+eval_char_lit(STRING str)
 {
-    NAT n ;
+	NAT n;
-    unsigned long v = DEREF_ulong ( str_simple_tok ( str ) ) ;
+	unsigned long v = DEREF_ulong(str_simple_tok(str));
-    if ( v == LINK_NONE ) {
+	if (v == LINK_NONE) {
-	unsigned long i ;
+		unsigned long i;
-	string s = DEREF_string ( str_simple_text ( str ) ) ;
+		string s = DEREF_string(str_simple_text(str));
-	unsigned long len = DEREF_ulong ( str_simple_len ( str ) ) ;
+		unsigned long len = DEREF_ulong(str_simple_len(str));
-	unsigned kind = DEREF_unsigned ( str_simple_kind ( str ) ) ;
+		unsigned kind = DEREF_unsigned(str_simple_kind(str));
-	if ( kind & STRING_MULTI ) {
+		if (kind & STRING_MULTI) {
-	    NAT b = make_small_nat ( 256 ) ;
+			NAT b = make_small_nat(256);
-	    n = small_nat [0] ;
+			n = small_nat[0];
-	    for ( i = 0 ; i < len ; i++ ) {
+			for (i = 0; i < len; i++) {
-		NAT d ;
+				NAT d;
-		int ch = CHAR_SIMPLE ;
+				int ch = CHAR_SIMPLE;
-		unsigned long c = get_multi_char ( s, &ch ) ;
+				unsigned long c = get_multi_char(s, &ch);
-		if ( ch == CHAR_SIMPLE ) c = to_ascii ( c, &ch ) ;
+				if (ch == CHAR_SIMPLE) {
+					c = to_ascii(c, &ch);
+				}
-		d = make_nat_value ( c ) ;
+				d = make_nat_value(c);
-		n = binary_nat_op ( exp_mult_tag, n, b ) ;
+				n = binary_nat_op(exp_mult_tag, n, b);
-		n = binary_nat_op ( exp_plus_tag, n, d ) ;
+				n = binary_nat_op(exp_plus_tag, n, d);
-		s += MULTI_WIDTH ;
+				s += MULTI_WIDTH;
+			}
+		} else {
+			n = small_nat[0];
+			for (i = 0; i < len; i++) {
+				int ch = CHAR_SIMPLE;
+				unsigned long c = (unsigned long)*s;
+				c = to_ascii(c, &ch);
+				n = make_nat_literal(n, (unsigned)256,
+						     (unsigned)c);
+				s++;
-	    }
+			}
+		}
+		v = get_nat_value(n);
+		if (v != EXTENDED_MAX) {
+			/* Store calculated value */
+			COPY_ulong(str_simple_tok(str), v);
+		}
 	} else {
-	    n = small_nat [0] ;
-	    for ( i = 0 ; i < len ; i++ ) {
-		int ch = CHAR_SIMPLE ;
-		unsigned long c = ( unsigned long ) *s ;
-		c = to_ascii ( c, &ch ) ;
+		/* Use stored value */
-		n = make_nat_literal ( n, ( unsigned ) 256, ( unsigned ) c ) ;
-		s++ ;
-	    }
-	}
-	v = get_nat_value ( n ) ;
+		n = make_nat_value(v);
-	if ( v != EXTENDED_MAX ) {
-	    /* Store calculated value */
-	    COPY_ulong ( str_simple_tok ( str ), v ) ;
+	}
-    } else {
-	/* Use stored value */
-	n = make_nat_value ( v ) ;
-    }
-    return ( n ) ;
+	return(n);
+}
 /*
     FIND A CHARACTER REPRESENTATION TYPE
     In the case where a character literal type doesn't fit into its type
     then this routine gives a type in which the literal value can be
     constructed and then converted into its underlying type.
 */
-TYPE find_char_type
+TYPE
-    PROTO_N ( ( n ) )
-    PROTO_T ( NAT n )
+find_char_type(NAT n)
+{
-    TYPE t ;
+	TYPE t;
-    int fit = 0 ;
+	int fit = 0;
-    string str = NULL_string ;
+	string str = NULL_string;
-    t = find_literal_type ( n, BASE_OCTAL, SUFFIX_NONE, str, &fit ) ;
+	t = find_literal_type(n, BASE_OCTAL, SUFFIX_NONE, str, &fit);
-    return ( t ) ;
+	return(t);
+}
 /*
     CREATE A STRING OR CHARACTER LITERAL EXPRESSION
     (where it is a char cast to an int) and C++ (where it stays as a
     char), and also that a string, or wide string, literal is an lvalue
     of array type.
 */
-EXP make_string_exp
+EXP
-    PROTO_N ( ( s ) )
-    PROTO_T ( STRING s )
+make_string_exp(STRING s)
+{
-    EXP e ;
+	EXP e;
-    string text = DEREF_string ( str_simple_text ( s ) ) ;
+	string text = DEREF_string(str_simple_text(s));
-    unsigned long len = DEREF_ulong ( str_simple_len ( s ) ) ;
+	unsigned long len = DEREF_ulong(str_simple_len(s));
-    unsigned kind = DEREF_unsigned ( str_simple_kind ( s ) ) ;
+	unsigned kind = DEREF_unsigned(str_simple_kind(s));
-    if ( kind & STRING_CHAR ) {
+	if (kind & STRING_CHAR) {
-	int fits = 0 ;
+		int fits = 0;
-	int digit = -1 ;
+		int digit = -1;
-	TYPE t0, t1, t2 ;
+		TYPE t0, t1, t2;
-	NAT n = NULL_nat ;
+		NAT n = NULL_nat;
-	ERROR err = NULL_err ;
+		ERROR err = NULL_err;
-	if ( kind & STRING_WIDE ) {
+		if (kind & STRING_WIDE) {
-	    t0 = type_wchar_lit ;
+			t0 = type_wchar_lit;
-	    t1 = t0 ;
+			t1 = t0;
-	    t2 = t0 ;
+			t2 = t0;
-	} else if ( len <= 1 ) {
+		} else if (len <= 1) {
-	    t0 = type_char ;
+			t0 = type_char;
-	    t1 = t0 ;
+			t1 = t0;
-	    t2 = type_char_lit ;
+			t2 = type_char_lit;
-	} else {
+		} else {
-	    report ( crt_loc, ERR_lex_ccon_multi ( s ) ) ;
+			report(crt_loc, ERR_lex_ccon_multi(s));
-	    t0 = type_mchar_lit ;
+			t0 = type_mchar_lit;
-	    t1 = t0 ;
+			t1 = t0;
-	    t2 = t0 ;
+			t2 = t0;
-	}
+		}
-	if ( len == 0 ) {
+		if (len == 0) {
-	    fits = 1 ;
+			fits = 1;
-	    n = small_nat [0] ;
+			n = small_nat[0];
-	    COPY_ulong ( str_simple_tok ( s ), 0 ) ;
+			COPY_ulong(str_simple_tok(s), 0);
-	} else if ( len == 1 ) {
+		} else if (len == 1) {
-	    if ( kind & STRING_MULTI ) {
+			if (kind & STRING_MULTI) {
-		if ( !( kind & STRING_FAT ) ) {
+				if (!(kind & STRING_FAT)) {
-		    /* Simple octal or hex escape sequence */
+					/* Simple octal or hex escape
+					 * sequence */
+					unsigned long v =
-		    unsigned long v = DEREF_ulong ( str_simple_tok ( s ) ) ;
+					    DEREF_ulong(str_simple_tok(s));
-		    if ( v == LINK_NONE ) {
+					if (v == LINK_NONE) {
-			int ch = CHAR_SIMPLE ;
+						int ch = CHAR_SIMPLE;
-			v = get_multi_char ( text, &ch ) ;
+						v = get_multi_char(text, &ch);
+						if (ch == CHAR_OCTAL ||
-			if ( ch == CHAR_OCTAL || ch == CHAR_HEX ) {
+						    ch == CHAR_HEX) {
-			    if ( v < 128 ) fits = 1 ;
+							if (v < 128)fits = 1;
-			    n = make_nat_value ( v ) ;
+							n = make_nat_value(v);
-			    COPY_ulong ( str_simple_tok ( s ), v ) ;
+							COPY_ulong(str_simple_tok(s), v);
-			}
+						}
-		    } else {
+					} else {
-			if ( v < 128 ) fits = 1 ;
+						if (v < 128)fits = 1;
+						n = make_nat_value(v);
+					}
+				}
+			} else {
+				/* Single character */
+				character c = text[0];
+				if (in_hash_if_exp) {
+					/* Evaluate character value
+					 * immediately */
+					unsigned long v =
+					    DEREF_ulong(str_simple_tok(s));
+					if (v == LINK_NONE) {
+						int ch = CHAR_SIMPLE;
+						v = (unsigned long)c;
+						v = to_ascii(v, &ch);
+						COPY_ulong(str_simple_tok(s),
+							   v);
+					}
+					if (v < 128) {
+						fits = 1;
+					}
-			n = make_nat_value ( v ) ;
+					n = make_nat_value(v);
+				} else {
+					if (c >= char_zero && c <= char_nine) {
+						/* Allow for digits */
+						digit = (int)(c - char_zero);
-		    }
+					}
+				}
+			}
+		}
+		if (IS_NULL_nat(n)) {
+			/* Make character literal expression */
+			MAKE_exp_char_lit(t0, s, digit, e);
+			MAKE_nat_calc(e, n);
-	    } else {
+		} else {
+			if (!fits && check_nat_range(t0, n)!= 0) {
-		/* Single character */
+				/* Value doesn't fit into t0 */
-		character c = text [0] ;
+				t0 = find_char_type(n);
+			}
+		}
+		MAKE_exp_int_lit(t0, n, exp_char_lit_tag, e);
-		if ( in_hash_if_exp ) {
+		if (!EQ_type(t0, t1)) {
-		    /* Evaluate character value immediately */
+			/* Convert from t0 to t1 */
-		    unsigned long v = DEREF_ulong ( str_simple_tok ( s ) ) ;
+			e = make_cast_nat(t1, e, &err, CAST_STATIC);
+		}
-		    if ( v == LINK_NONE ) {
+		if (!EQ_type(t1, t2)) {
-			int ch = CHAR_SIMPLE ;
+			/* Convert from t1 to t2 */
-			v = ( unsigned long ) c ;
+			e = make_cast_nat(t2, e, &err, CAST_IMPLICIT);
+		}
-			v = to_ascii ( v, &ch ) ;
+		if (!IS_NULL_err(err)) {
-			COPY_ulong ( str_simple_tok ( s ), v ) ;
+			report(crt_loc, err);
-		    }
+		}
+	} else {
-		    if ( v < 128 ) fits = 1 ;
+		/* String literals */
+		TYPE t;
-		    n = make_nat_value ( v ) ;
+		NAT n = make_nat_value(len + 1);
+		if (kind & STRING_WIDE) {
+			t = type_wstring_lit;
 		} else {
-		    if ( c >= char_zero && c <= char_nine ) {
-			/* Allow for digits */
+			t = type_string_lit;
-			digit = ( int ) ( c - char_zero ) ;
-		    }
+		}
+		MAKE_type_array(cv_lvalue, t, n, t);
-	    }
+		MAKE_exp_string_lit(t, s, e);
+	}
-	if ( IS_NULL_nat ( n ) ) {
-	    /* Make character literal expression */
-	    MAKE_exp_char_lit ( t0, s, digit, e ) ;
-	    MAKE_nat_calc ( e, n ) ;
-	} else {
-	    if ( !fits && check_nat_range ( t0, n ) != 0 ) {
-		/* Value doesn't fit into t0 */
-		t0 = find_char_type ( n ) ;
-	    }
-	}
-	MAKE_exp_int_lit ( t0, n, exp_char_lit_tag, e ) ;
-	if ( !EQ_type ( t0, t1 ) ) {
-	    /* Convert from t0 to t1 */
-	    e = make_cast_nat ( t1, e, &err, CAST_STATIC ) ;
-	}
-	if ( !EQ_type ( t1, t2 ) ) {
-	    /* Convert from t1 to t2 */
-	    e = make_cast_nat ( t2, e, &err, CAST_IMPLICIT ) ;
-	}
-	if ( !IS_NULL_err ( err ) ) report ( crt_loc, err ) ;
-    } else {
-	/* String literals */
-	TYPE t ;
-	NAT n = make_nat_value ( len + 1 ) ;
-	if ( kind & STRING_WIDE ) {
-	    t = type_wstring_lit ;
-	} else {
-	    t = type_string_lit ;
-	}
-	MAKE_type_array ( cv_lvalue, t, n, t ) ;
-	MAKE_exp_string_lit ( t, s, e ) ;
-    }
-    return ( e ) ;
+	return(e);
 }
 /*
     CREATE A BOOLEAN LITERAL EXPRESSION
     This routine creates a boolean literal expression given by the boolean
     value b (which should be one of the values BOOL_FALSE and BOOL_TRUE
     defined in literal.h).
 */
-EXP make_bool_exp
+EXP
-    PROTO_N ( ( b, tag ) )
-    PROTO_T ( unsigned b X unsigned tag )
+make_bool_exp(unsigned b, unsigned tag)
 {
-    EXP e ;
+	EXP e;
-    NAT n = small_nat [b] ;
+	NAT n = small_nat[b];
-    MAKE_exp_int_lit ( type_bool, n, tag, e ) ;
+	MAKE_exp_int_lit(type_bool, n, tag, e);
-    return ( e ) ;
+	return(e);
 }
 /*
     TEST A BOOLEAN LITERAL EXPRESSION
     This routine is the reverse of the one above.  It returns the boolean
     value (BOOL_FALSE, BOOL_TRUE or BOOL_UNKNOWN) corresponding to the
     expression e.
 */
-unsigned test_bool_exp
+unsigned
-    PROTO_N ( ( e ) )
-    PROTO_T ( EXP e )
+test_bool_exp(EXP e)
+{
-    NAT n = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
+	NAT n = DEREF_nat(exp_int_lit_nat(e));
-    if ( IS_nat_small ( n ) ) {
+	if (IS_nat_small(n)) {
-	unsigned b = DEREF_unsigned ( nat_small_value ( n ) ) ;
+		unsigned b = DEREF_unsigned(nat_small_value(n));
-	if ( b == BOOL_FALSE ) return ( BOOL_FALSE ) ;
+		if (b == BOOL_FALSE) {
+			return(BOOL_FALSE);
+		}
-	if ( b == BOOL_TRUE ) return ( BOOL_TRUE ) ;
+		if (b == BOOL_TRUE) {
+			return(BOOL_TRUE);
-    }
+		}
+	}
-    return ( BOOL_UNKNOWN ) ;
+	return(BOOL_UNKNOWN);
+}

Subversion Repositories tendra.SVN

(root)/branches/tendra5/src/producers/common/parse/literal.c – Rev 5 → 6