| 2 |
7u83 |
1 |
/*
|
|
|
2 |
Crown Copyright (c) 1997, 1998
|
|
|
3 |
|
|
|
4 |
This TenDRA(r) Computer Program is subject to Copyright
|
|
|
5 |
owned by the United Kingdom Secretary of State for Defence
|
|
|
6 |
acting through the Defence Evaluation and Research Agency
|
|
|
7 |
(DERA). It is made available to Recipients with a
|
|
|
8 |
royalty-free licence for its use, reproduction, transfer
|
|
|
9 |
to other parties and amendment for any purpose not excluding
|
|
|
10 |
product development provided that any such use et cetera
|
|
|
11 |
shall be deemed to be acceptance of the following conditions:-
|
|
|
12 |
|
|
|
13 |
(1) Its Recipients shall ensure that this Notice is
|
|
|
14 |
reproduced upon any copies or amended versions of it;
|
|
|
15 |
|
|
|
16 |
(2) Any amended version of it shall be clearly marked to
|
|
|
17 |
show both the nature of and the organisation responsible
|
|
|
18 |
for the relevant amendment or amendments;
|
|
|
19 |
|
|
|
20 |
(3) Its onward transfer from a recipient to another
|
|
|
21 |
party shall be deemed to be that party's acceptance of
|
|
|
22 |
these conditions;
|
|
|
23 |
|
|
|
24 |
(4) DERA gives no warranty or assurance as to its
|
|
|
25 |
quality or suitability for any purpose and DERA accepts
|
|
|
26 |
no liability whatsoever in relation to any use to which
|
|
|
27 |
it may be put.
|
|
|
28 |
*/
|
|
|
29 |
|
|
|
30 |
|
|
|
31 |
#include "config.h"
|
|
|
32 |
#include <limits.h>
|
|
|
33 |
#include "c_types.h"
|
|
|
34 |
#include "exp_ops.h"
|
|
|
35 |
#include "flt_ops.h"
|
|
|
36 |
#include "id_ops.h"
|
|
|
37 |
#include "itype_ops.h"
|
|
|
38 |
#include "nat_ops.h"
|
|
|
39 |
#include "str_ops.h"
|
|
|
40 |
#include "type_ops.h"
|
|
|
41 |
#include "error.h"
|
|
|
42 |
#include "catalog.h"
|
|
|
43 |
#include "option.h"
|
|
|
44 |
#include "basetype.h"
|
|
|
45 |
#include "cast.h"
|
|
|
46 |
#include "char.h"
|
|
|
47 |
#include "chktype.h"
|
|
|
48 |
#include "constant.h"
|
|
|
49 |
#include "convert.h"
|
|
|
50 |
#include "dump.h"
|
|
|
51 |
#include "exception.h"
|
|
|
52 |
#include "expression.h"
|
|
|
53 |
#include "hash.h"
|
|
|
54 |
#include "inttype.h"
|
|
|
55 |
#include "lex.h"
|
|
|
56 |
#include "literal.h"
|
|
|
57 |
#include "preproc.h"
|
|
|
58 |
#include "syntax.h"
|
|
|
59 |
#include "tok.h"
|
|
|
60 |
#include "token.h"
|
|
|
61 |
#include "ustring.h"
|
|
|
62 |
#include "xalloc.h"
|
|
|
63 |
|
|
|
64 |
|
|
|
65 |
/*
|
|
|
66 |
SPECIAL TABLE VALUES
|
|
|
67 |
|
|
|
68 |
These macros are used in the tables of digits and escape sequences
|
|
|
69 |
to indicate special values.
|
|
|
70 |
*/
|
|
|
71 |
|
|
|
72 |
#define NONE 0xff
|
|
|
73 |
#define OCTE 0xfe
|
|
|
74 |
#define HEXE 0xfd
|
|
|
75 |
#define UNI4 0xfc
|
|
|
76 |
#define UNI8 0xfb
|
|
|
77 |
|
|
|
78 |
|
|
|
79 |
/*
|
|
|
80 |
TABLE OF DIGITS
|
|
|
81 |
|
|
|
82 |
This table gives the mapping of characters to digits. The default
|
|
|
83 |
table assumes the ASCII character set, for other codesets it needs
|
|
|
84 |
to be rewritten. The valid digits are 0-9, A-Z (which evaluate to
|
|
|
85 |
10-35) and a-z (which evaluate to 10-35). Invalid digits are
|
|
|
86 |
indicated by NONE.
|
|
|
87 |
*/
|
|
|
88 |
|
|
|
89 |
unsigned char digit_values [ NO_CHAR + 1 ] = {
|
|
|
90 |
#define CHAR_DATA( A, B, C, D ) ( B ),
|
|
|
91 |
#include "char.h"
|
|
|
92 |
#undef CHAR_DATA
|
|
|
93 |
NONE /* dummy */
|
|
|
94 |
} ;
|
|
|
95 |
|
|
|
96 |
|
|
|
97 |
/*
|
|
|
98 |
TABLE OF ESCAPE SEQUENCES
|
|
|
99 |
|
|
|
100 |
This table gives the mapping of characters to escape sequences. The
|
|
|
101 |
default table assumes the ASCII character set, for other codesets it
|
|
|
102 |
needs to be rewritten. The valid escape sequences are \', \", \?,
|
|
|
103 |
\\, \a, \b, \f, \n, \r, \t and \v. Octal escape sequences are
|
|
|
104 |
indicated by OCTE, hexadecimal escape sequences by HEXE, universal
|
|
|
105 |
character names by UNI4 or UNI8, and illegal escape sequences by
|
|
|
106 |
NONE.
|
|
|
107 |
*/
|
|
|
108 |
|
|
|
109 |
unsigned char escape_sequences [ NO_CHAR + 1 ] = {
|
|
|
110 |
#define CHAR_DATA( A, B, C, D ) ( C ),
|
|
|
111 |
#include "char.h"
|
|
|
112 |
#undef CHAR_DATA
|
|
|
113 |
NONE /* dummy */
|
|
|
114 |
} ;
|
|
|
115 |
|
|
|
116 |
|
|
|
117 |
/*
|
|
|
118 |
SET AN ESCAPE SEQUENCE
|
|
|
119 |
|
|
|
120 |
This routine sets the character escape value for the character
|
|
|
121 |
literal expression a to be the character literal b, or an illegal
|
|
|
122 |
escape if b is the null expression.
|
|
|
123 |
*/
|
|
|
124 |
|
|
|
125 |
void set_escape
|
|
|
126 |
PROTO_N ( ( a, b ) )
|
|
|
127 |
PROTO_T ( EXP a X EXP b )
|
|
|
128 |
{
|
|
|
129 |
int c = get_char_value ( a ) ;
|
|
|
130 |
int e = NONE ;
|
|
|
131 |
if ( !IS_NULL_exp ( b ) ) {
|
|
|
132 |
e = get_char_value ( b ) ;
|
|
|
133 |
if ( e == char_illegal ) e = NONE ;
|
|
|
134 |
}
|
|
|
135 |
if ( c >= 0 && c < NO_CHAR ) {
|
|
|
136 |
escape_sequences [c] = ( unsigned char ) e ;
|
|
|
137 |
}
|
|
|
138 |
return ;
|
|
|
139 |
}
|
|
|
140 |
|
|
|
141 |
|
|
|
142 |
/*
|
|
|
143 |
CHECK A STRING OF DIGITS
|
|
|
144 |
|
|
|
145 |
This routine scans the string s for valid digits for the given base.
|
|
|
146 |
It returns a pointer to the first character which is not a valid
|
|
|
147 |
digit.
|
|
|
148 |
*/
|
|
|
149 |
|
|
|
150 |
static string check_digits
|
|
|
151 |
PROTO_N ( ( s, base ) )
|
|
|
152 |
PROTO_T ( string s X unsigned base )
|
|
|
153 |
{
|
|
|
154 |
unsigned b ;
|
|
|
155 |
character c ;
|
|
|
156 |
while ( c = *s, c != 0 ) {
|
|
|
157 |
#if FS_EXTENDED_CHAR
|
|
|
158 |
if ( IS_EXTENDED ( c ) ) break ;
|
|
|
159 |
#endif
|
|
|
160 |
b = ( unsigned ) digit_values [c] ; ;
|
|
|
161 |
if ( b >= base ) break ;
|
|
|
162 |
s++ ;
|
|
|
163 |
}
|
|
|
164 |
return ( s ) ;
|
|
|
165 |
}
|
|
|
166 |
|
|
|
167 |
|
|
|
168 |
/*
|
|
|
169 |
EVALUATE A STRING OF DIGITS
|
|
|
170 |
|
|
|
171 |
This routine evaluates the string of digits starting with s and
|
|
|
172 |
ending with t using the given base (which will be at most 16). It
|
|
|
173 |
is assumed that all of these digits are in the correct range.
|
|
|
174 |
*/
|
|
|
175 |
|
|
|
176 |
static NAT eval_digits
|
|
|
177 |
PROTO_N ( ( s, t, base ) )
|
|
|
178 |
PROTO_T ( string s X string t X unsigned base )
|
|
|
179 |
{
|
|
|
180 |
NAT n ;
|
|
|
181 |
int m = 0 ;
|
|
|
182 |
string r = s ;
|
|
|
183 |
unsigned long v = 0 ;
|
|
|
184 |
unsigned long b = ( unsigned long ) base ;
|
|
|
185 |
while ( r != t && m < 8 ) {
|
|
|
186 |
/* Evaluate first few digits */
|
|
|
187 |
unsigned long d = ( unsigned long ) digit_values [ *r ] ;
|
|
|
188 |
v = b * v + d ;
|
|
|
189 |
m++ ;
|
|
|
190 |
r++ ;
|
|
|
191 |
}
|
|
|
192 |
n = make_nat_value ( v ) ;
|
|
|
193 |
while ( r != t ) {
|
|
|
194 |
/* Evaluate further digits */
|
|
|
195 |
unsigned d = ( unsigned ) digit_values [ *r ] ;
|
|
|
196 |
n = make_nat_literal ( n, base, d ) ;
|
|
|
197 |
r++ ;
|
|
|
198 |
}
|
|
|
199 |
return ( n ) ;
|
|
|
200 |
}
|
|
|
201 |
|
|
|
202 |
|
|
|
203 |
/*
|
|
|
204 |
EVALUATE A STRING OF DIGITS
|
|
|
205 |
|
|
|
206 |
This routine is the same as eval_digits except that it assumes that
|
|
|
207 |
the result fits inside an unsigned long, and reports an error
|
|
|
208 |
otherwise.
|
|
|
209 |
*/
|
|
|
210 |
|
|
|
211 |
static unsigned long eval_char_digits
|
|
|
212 |
PROTO_N ( ( s, t, base ) )
|
|
|
213 |
PROTO_T ( string s X string t X unsigned base )
|
|
|
214 |
{
|
|
|
215 |
string r ;
|
|
|
216 |
int overflow = 0 ;
|
|
|
217 |
unsigned long n = 0 ;
|
|
|
218 |
unsigned long b = ( unsigned long ) base ;
|
|
|
219 |
for ( r = s ; r != t ; r++ ) {
|
|
|
220 |
unsigned long m = n ;
|
|
|
221 |
n = b * n + ( unsigned long ) digit_values [ *r ] ;
|
|
|
222 |
if ( n < m ) overflow = 1 ;
|
|
|
223 |
}
|
|
|
224 |
if ( overflow ) report ( crt_loc, ERR_lex_ccon_large () ) ;
|
|
|
225 |
return ( n ) ;
|
|
|
226 |
}
|
|
|
227 |
|
|
|
228 |
|
|
|
229 |
/*
|
|
|
230 |
EVALUATE A LINE NUMBER
|
|
|
231 |
|
|
|
232 |
This routine evaluates the sequence of decimal digits s as a line
|
|
|
233 |
number in a #line, or similar, preprocessing directive. Any errors
|
|
|
234 |
arising are indicated using err. This is a bit pattern consisting
|
|
|
235 |
of 2 if s is not a simple string of decimal digits, and 1 if its
|
|
|
236 |
value exceeds 32767.
|
|
|
237 |
*/
|
|
|
238 |
|
|
|
239 |
unsigned long eval_line_digits
|
|
|
240 |
PROTO_N ( ( s, err ) )
|
|
|
241 |
PROTO_T ( string s X unsigned *err )
|
|
|
242 |
{
|
|
|
243 |
string r ;
|
|
|
244 |
unsigned e = 0 ;
|
|
|
245 |
unsigned long n = 0 ;
|
|
|
246 |
string t = check_digits ( s, ( unsigned ) 10 ) ;
|
|
|
247 |
if ( *t ) e = 2 ;
|
|
|
248 |
for ( r = s ; r != t ; r++ ) {
|
|
|
249 |
n = 10 * n + ( unsigned long ) digit_values [ *r ] ;
|
|
|
250 |
if ( n > 0x7fff ) e |= 1 ;
|
|
|
251 |
}
|
|
|
252 |
*err = e ;
|
|
|
253 |
return ( n ) ;
|
|
|
254 |
}
|
|
|
255 |
|
|
|
256 |
|
|
|
257 |
/*
|
|
|
258 |
STRING HASH TABLE
|
|
|
259 |
|
|
|
260 |
This variable gives the hash table used in shared string literals.
|
|
|
261 |
*/
|
|
|
262 |
|
|
|
263 |
static STRING *string_hash_table = NULL ;
|
|
|
264 |
#define HASH_STRING_SIZE ( ( unsigned long ) 256 )
|
|
|
265 |
|
|
|
266 |
|
|
|
267 |
/*
|
|
|
268 |
STRING AND CHARACTER LITERAL TYPES
|
|
|
269 |
|
|
|
270 |
The type of a simple character literal is char in C++, but int in C.
|
|
|
271 |
The variable type_char_lit is used to hold the appropriate result
|
|
|
272 |
type. Other string and character literals have fixed types, however
|
|
|
273 |
for convenience variables are used to identify them.
|
|
|
274 |
*/
|
|
|
275 |
|
|
|
276 |
static TYPE type_char_lit ;
|
|
|
277 |
static TYPE type_mchar_lit ;
|
|
|
278 |
static TYPE type_wchar_lit ;
|
|
|
279 |
static TYPE type_string_lit ;
|
|
|
280 |
static TYPE type_wstring_lit ;
|
|
|
281 |
CV_SPEC cv_string = cv_none ;
|
|
|
282 |
|
|
|
283 |
|
|
|
284 |
/*
|
|
|
285 |
SET THE CHARACTER LITERAL TYPE
|
|
|
286 |
|
|
|
287 |
This routine sets the type of a character literal to be t. t must be
|
|
|
288 |
an integral type. Note that only the representation type is set to t,
|
|
|
289 |
the semantic type is always char.
|
|
|
290 |
*/
|
|
|
291 |
|
|
|
292 |
void set_char_lit
|
|
|
293 |
PROTO_N ( ( t ) )
|
|
|
294 |
PROTO_T ( TYPE t )
|
|
|
295 |
{
|
|
|
296 |
if ( IS_type_integer ( t ) ) {
|
|
|
297 |
INT_TYPE r = DEREF_itype ( type_integer_rep ( t ) ) ;
|
|
|
298 |
INT_TYPE s = DEREF_itype ( type_integer_rep ( type_char ) ) ;
|
|
|
299 |
type_char_lit = make_itype ( r, s ) ;
|
|
|
300 |
} else {
|
|
|
301 |
report ( preproc_loc, ERR_pragma_char_lit ( t ) ) ;
|
|
|
302 |
}
|
|
|
303 |
return ;
|
|
|
304 |
}
|
|
|
305 |
|
|
|
306 |
|
|
|
307 |
/*
|
|
|
308 |
TABLE OF INTEGER LITERAL SPECIFICATIONS
|
|
|
309 |
|
|
|
310 |
The type LITERAL_INFO is used to represent an item in an integer
|
|
|
311 |
literal type specification. The table int_lit_spec holds the
|
|
|
312 |
specifications for the various combinations of base and suffix.
|
|
|
313 |
*/
|
|
|
314 |
|
|
|
315 |
typedef struct lit_info_tag {
|
|
|
316 |
int tag ;
|
|
|
317 |
TYPE type ;
|
|
|
318 |
NAT bound ;
|
|
|
319 |
IDENTIFIER tok ;
|
|
|
320 |
int tok_no ;
|
|
|
321 |
int opt ;
|
|
|
322 |
struct lit_info_tag *next ;
|
|
|
323 |
} LITERAL_INFO ;
|
|
|
324 |
|
|
|
325 |
static LITERAL_INFO *int_lit_spec [ BASE_NO ] [ SUFFIX_NO ] = {
|
|
|
326 |
{ NULL, NULL, NULL, NULL, NULL, NULL },
|
|
|
327 |
{ NULL, NULL, NULL, NULL, NULL, NULL },
|
|
|
328 |
{ NULL, NULL, NULL, NULL, NULL, NULL }
|
|
|
329 |
} ;
|
|
|
330 |
|
|
|
331 |
static LITERAL_INFO *crt_int_lit = NULL ;
|
|
|
332 |
static LITERAL_INFO **ptr_int_lit = NULL ;
|
|
|
333 |
|
|
|
334 |
|
|
|
335 |
/*
|
|
|
336 |
TABLE OF BUILT-IN INTEGER LITERAL SPECIFICATIONS
|
|
|
337 |
|
|
|
338 |
This table gives the possible types and built-in tokens for the
|
|
|
339 |
various base and suffix combinations.
|
|
|
340 |
*/
|
|
|
341 |
|
|
|
342 |
static struct {
|
|
|
343 |
unsigned char type [6] ;
|
|
|
344 |
int tok ;
|
|
|
345 |
LIST ( TYPE ) cases ;
|
|
|
346 |
} int_lit_tok [ BASE_NO ] [ SUFFIX_NO ] = {
|
|
|
347 |
{
|
|
|
348 |
{ { 2, 0, 2, 2, 1, 1 }, TOK_lit_int, NULL_list ( TYPE ) },
|
|
|
349 |
{ { 0, 2, 0, 2, 0, 1 }, TOK_lit_unsigned, NULL_list ( TYPE ) },
|
|
|
350 |
{ { 0, 0, 2, 2, 1, 1 }, TOK_lit_long, NULL_list ( TYPE ) },
|
|
|
351 |
{ { 0, 0, 0, 2, 0, 1 }, TOK_lit_ulong, NULL_list ( TYPE ) },
|
|
|
352 |
{ { 0, 0, 0, 0, 2, 2 }, TOK_lit_llong, NULL_list ( TYPE ) },
|
|
|
353 |
{ { 0, 0, 0, 0, 0, 2 }, TOK_lit_ullong, NULL_list ( TYPE ) }
|
|
|
354 |
},
|
|
|
355 |
{
|
|
|
356 |
{ { 2, 2, 2, 2, 1, 1 }, TOK_lit_hex, NULL_list ( TYPE ) },
|
|
|
357 |
{ { 0, 2, 0, 2, 0, 1 }, TOK_lit_unsigned, NULL_list ( TYPE ) },
|
|
|
358 |
{ { 0, 0, 2, 2, 1, 1 }, TOK_lit_long, NULL_list ( TYPE ) },
|
|
|
359 |
{ { 0, 0, 0, 2, 0, 1 }, TOK_lit_ulong, NULL_list ( TYPE ) },
|
|
|
360 |
{ { 0, 0, 0, 0, 2, 2 }, TOK_lit_llong, NULL_list ( TYPE ) },
|
|
|
361 |
{ { 0, 0, 0, 0, 0, 2 }, TOK_lit_ullong, NULL_list ( TYPE ) }
|
|
|
362 |
},
|
|
|
363 |
{
|
|
|
364 |
{ { 2, 2, 2, 2, 1, 1 }, TOK_lit_hex, NULL_list ( TYPE ) },
|
|
|
365 |
{ { 0, 2, 0, 2, 0, 1 }, TOK_lit_unsigned, NULL_list ( TYPE ) },
|
|
|
366 |
{ { 0, 0, 2, 2, 1, 1 }, TOK_lit_long, NULL_list ( TYPE ) },
|
|
|
367 |
{ { 0, 0, 0, 2, 0, 1 }, TOK_lit_ulong, NULL_list ( TYPE ) },
|
|
|
368 |
{ { 0, 0, 0, 0, 2, 2 }, TOK_lit_llong, NULL_list ( TYPE ) },
|
|
|
369 |
{ { 0, 0, 0, 0, 0, 2 }, TOK_lit_ullong, NULL_list ( TYPE ) }
|
|
|
370 |
}
|
|
|
371 |
} ;
|
|
|
372 |
|
|
|
373 |
|
|
|
374 |
/*
|
|
|
375 |
INITIALISE TABLE OF INTEGER LITERAL TYPES
|
|
|
376 |
|
|
|
377 |
This routine initialises the string and character literal types and
|
|
|
378 |
the table int_lit_info. The initial values for the table are given
|
|
|
379 |
by the following lists of types:
|
|
|
380 |
|
|
|
381 |
decimal: ( int, long, unsigned long ),
|
|
|
382 |
octal/hex: ( int, unsigned, long, unsigned long ),
|
|
|
383 |
U suffix: ( unsigned, unsigned long ),
|
|
|
384 |
L suffix: ( long, unsigned long ),
|
|
|
385 |
UL suffix: ( unsigned long ),
|
|
|
386 |
LL suffix: ( long long, unsigned long long ),
|
|
|
387 |
ULL suffix: ( unsigned long long ).
|
|
|
388 |
|
|
|
389 |
Each integer literal is checked against each type in the list
|
|
|
390 |
indicated by the form of the literal. If it fits into a type then
|
|
|
391 |
that is the type of the literal. If it does not fit into any type
|
|
|
392 |
then an error is raised. If whether it fits into a particular type
|
|
|
393 |
is target dependent then a literal integer type, giving the literal
|
|
|
394 |
value and a list of possible types, is constructed to express the
|
|
|
395 |
result type.
|
|
|
396 |
|
|
|
397 |
The string and character types are:
|
|
|
398 |
|
|
|
399 |
character: char,
|
|
|
400 |
multi-character: int,
|
|
|
401 |
wide character: wchar_t,
|
|
|
402 |
string: const char [n],
|
|
|
403 |
wide string: const wchar_t [n].
|
|
|
404 |
|
|
|
405 |
Variants are that characters have type int in C and that string
|
|
|
406 |
literals are not const in pre-ISO C++ and C.
|
|
|
407 |
*/
|
|
|
408 |
|
|
|
409 |
void init_literal
|
|
|
410 |
PROTO_Z ()
|
|
|
411 |
{
|
|
|
412 |
int b, s ;
|
|
|
413 |
BUILTIN_TYPE n ;
|
|
|
414 |
OPTION opt = option ( OPT_int_overflow ) ;
|
|
|
415 |
ASSERT ( !IS_NULL_type ( type_char ) ) ;
|
|
|
416 |
|
|
|
417 |
/* String and character literal types */
|
|
|
418 |
type_mchar_lit = type_sint ;
|
|
|
419 |
type_wchar_lit = type_wchar_t ;
|
|
|
420 |
type_string_lit = type_char ;
|
|
|
421 |
type_wstring_lit = type_wchar_t ;
|
|
|
422 |
#if LANGUAGE_CPP
|
|
|
423 |
set_char_lit ( type_char ) ;
|
|
|
424 |
set_string_qual ( cv_const ) ;
|
|
|
425 |
#else
|
|
|
426 |
set_char_lit ( type_sint ) ;
|
|
|
427 |
set_string_qual ( cv_none ) ;
|
|
|
428 |
#endif
|
|
|
429 |
|
|
|
430 |
/* Set up type lists */
|
|
|
431 |
for ( b = 0 ; b < BASE_NO ; b++ ) {
|
|
|
432 |
for ( s = 0 ; s < SUFFIX_NO ; s++ ) {
|
|
|
433 |
LIST ( TYPE ) p = NULL_list ( TYPE ) ;
|
|
|
434 |
begin_literal ( b, s ) ;
|
|
|
435 |
for ( n = 0 ; n < 6 ; n++ ) {
|
|
|
436 |
if ( int_lit_tok [b] [s].type [n] == 2 ) {
|
|
|
437 |
TYPE t = type_builtin [ ntype_sint + n ] ;
|
|
|
438 |
add_range_literal ( NULL_exp, 1 ) ;
|
|
|
439 |
add_type_literal ( t ) ;
|
|
|
440 |
CONS_type ( t, p, p ) ;
|
|
|
441 |
}
|
|
|
442 |
}
|
|
|
443 |
add_range_literal ( NULL_exp, 0 ) ;
|
|
|
444 |
add_token_literal ( NULL_id, ( unsigned ) opt ) ;
|
|
|
445 |
p = REVERSE_list ( p ) ;
|
|
|
446 |
int_lit_tok [b] [s].cases = uniq_type_set ( p ) ;
|
|
|
447 |
}
|
|
|
448 |
}
|
|
|
449 |
|
|
|
450 |
/* Set up string hash table */
|
|
|
451 |
if ( string_hash_table == NULL ) {
|
|
|
452 |
unsigned long i ;
|
|
|
453 |
STRING *q = xmalloc_nof ( STRING, HASH_STRING_SIZE ) ;
|
|
|
454 |
for ( i = 0 ; i < HASH_STRING_SIZE ; i++ ) q [i] = NULL_str ;
|
|
|
455 |
string_hash_table = q ;
|
|
|
456 |
}
|
|
|
457 |
return ;
|
|
|
458 |
}
|
|
|
459 |
|
|
|
460 |
|
|
|
461 |
/*
|
|
|
462 |
SET THE CV-QUALIFIERS FOR A STRING LITERAL
|
|
|
463 |
|
|
|
464 |
This routine sets the string and wide string literal types to be
|
|
|
465 |
cv-qualified.
|
|
|
466 |
*/
|
|
|
467 |
|
|
|
468 |
void set_string_qual
|
|
|
469 |
PROTO_N ( ( cv ) )
|
|
|
470 |
PROTO_T ( CV_SPEC cv )
|
|
|
471 |
{
|
|
|
472 |
type_string_lit = qualify_type ( type_string_lit, cv, 0 ) ;
|
|
|
473 |
type_wstring_lit = qualify_type ( type_wstring_lit, cv, 0 ) ;
|
|
|
474 |
cv_string = cv ;
|
|
|
475 |
return ;
|
|
|
476 |
}
|
|
|
477 |
|
|
|
478 |
|
|
|
479 |
/*
|
|
|
480 |
BEGIN A LITERAL SPECIFICATION DEFINITION
|
|
|
481 |
|
|
|
482 |
This routine is called to begin the specification of the integer
|
|
|
483 |
literals of the given base and suffix.
|
|
|
484 |
*/
|
|
|
485 |
|
|
|
486 |
void begin_literal
|
|
|
487 |
PROTO_N ( ( base, suff ) )
|
|
|
488 |
PROTO_T ( int base X int suff )
|
|
|
489 |
{
|
|
|
490 |
LITERAL_INFO **p = &( int_lit_spec [ base ] [ suff ] ) ;
|
|
|
491 |
*p = NULL ;
|
|
|
492 |
ptr_int_lit = p ;
|
|
|
493 |
crt_int_lit = NULL ;
|
|
|
494 |
return ;
|
|
|
495 |
}
|
|
|
496 |
|
|
|
497 |
|
|
|
498 |
/*
|
|
|
499 |
ADD A BOUND TO A LITERAL SPECIFICATION
|
|
|
500 |
|
|
|
501 |
This routine is used to specify a bound in the current literal
|
|
|
502 |
specification. If n is 0 then the bound matches all values, if it
|
|
|
503 |
is 1 then the bound matches all the values in the following type,
|
|
|
504 |
and if it is 2 then the bound matches all values less than or equal
|
|
|
505 |
to the integer literal expression e.
|
|
|
506 |
*/
|
|
|
507 |
|
|
|
508 |
void add_range_literal
|
|
|
509 |
PROTO_N ( ( e, n ) )
|
|
|
510 |
PROTO_T ( EXP e X int n )
|
|
|
511 |
{
|
|
|
512 |
LITERAL_INFO *p = xmalloc_one ( LITERAL_INFO ) ;
|
|
|
513 |
p->tag = n ;
|
|
|
514 |
if ( !IS_NULL_exp ( e ) && IS_exp_int_lit ( e ) ) {
|
|
|
515 |
p->bound = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
|
|
|
516 |
} else {
|
|
|
517 |
p->bound = small_nat [0] ;
|
|
|
518 |
}
|
|
|
519 |
p->type = NULL_type ;
|
|
|
520 |
p->tok = NULL_id ;
|
|
|
521 |
p->tok_no = -1 ;
|
|
|
522 |
p->opt = OPT_none ;
|
|
|
523 |
p->next = NULL ;
|
|
|
524 |
*ptr_int_lit = p ;
|
|
|
525 |
crt_int_lit = p ;
|
|
|
526 |
ptr_int_lit = &( p->next ) ;
|
|
|
527 |
return ;
|
|
|
528 |
}
|
|
|
529 |
|
|
|
530 |
|
|
|
531 |
/*
|
|
|
532 |
ADD A TYPE TO A LITERAL SPECIFICATION
|
|
|
533 |
|
|
|
534 |
This routine specifies the type t for all values under the current
|
|
|
535 |
bound in the current literal specification.
|
|
|
536 |
*/
|
|
|
537 |
|
|
|
538 |
void add_type_literal
|
|
|
539 |
PROTO_N ( ( t ) )
|
|
|
540 |
PROTO_T ( TYPE t )
|
|
|
541 |
{
|
|
|
542 |
NAT n ;
|
|
|
543 |
LITERAL_INFO *p = crt_int_lit ;
|
|
|
544 |
if ( IS_type_integer ( t ) ) {
|
|
|
545 |
if ( !is_arg_promote ( t ) ) {
|
|
|
546 |
/* Type should promote to itself */
|
|
|
547 |
report ( preproc_loc, ERR_pragma_lit_type ( t ) ) ;
|
|
|
548 |
t = promote_type ( t ) ;
|
|
|
549 |
}
|
|
|
550 |
} else {
|
|
|
551 |
/* Type should be integral */
|
|
|
552 |
if ( !IS_type_error ( t ) ) {
|
|
|
553 |
report ( preproc_loc, ERR_pragma_lit_type ( t ) ) ;
|
|
|
554 |
}
|
|
|
555 |
t = type_ulong ;
|
|
|
556 |
}
|
|
|
557 |
p->type = qualify_type ( t, cv_none, 0 ) ;
|
|
|
558 |
n = p->bound ;
|
|
|
559 |
if ( p->tag == 2 ) {
|
|
|
560 |
if ( check_nat_range ( t, n ) != 0 ) {
|
|
|
561 |
/* Given bound should fit into type */
|
|
|
562 |
report ( preproc_loc, ERR_pragma_lit_range ( n, t ) ) ;
|
|
|
563 |
n = max_type_value ( t, 0 ) ;
|
|
|
564 |
}
|
|
|
565 |
} else {
|
|
|
566 |
n = max_type_value ( t, 0 ) ;
|
|
|
567 |
}
|
|
|
568 |
p->bound = n ;
|
|
|
569 |
return ;
|
|
|
570 |
}
|
|
|
571 |
|
|
|
572 |
|
|
|
573 |
/*
|
|
|
574 |
ADD A TOKEN TO A LITERAL SPECIFICATION
|
|
|
575 |
|
|
|
576 |
This routine specifies that the token id should be used to calculate
|
|
|
577 |
the type for all values under the current bound in the current
|
|
|
578 |
literal specification. An error with severity sev is reported.
|
|
|
579 |
*/
|
|
|
580 |
|
|
|
581 |
void add_token_literal
|
|
|
582 |
PROTO_N ( ( id, sev ) )
|
|
|
583 |
PROTO_T ( IDENTIFIER id X unsigned sev )
|
|
|
584 |
{
|
|
|
585 |
int n = -1 ;
|
|
|
586 |
LITERAL_INFO *p = crt_int_lit ;
|
|
|
587 |
if ( !IS_NULL_id ( id ) ) {
|
|
|
588 |
id = resolve_token ( id, "ZZ", 0 ) ;
|
|
|
589 |
if ( !IS_NULL_id ( id ) ) n = builtin_token ( id ) ;
|
|
|
590 |
}
|
|
|
591 |
if ( p->tag == 1 ) {
|
|
|
592 |
report ( preproc_loc, ERR_pragma_lit_question () ) ;
|
|
|
593 |
p->tag = 3 ;
|
|
|
594 |
}
|
|
|
595 |
p->tok = id ;
|
|
|
596 |
p->tok_no = n ;
|
|
|
597 |
switch ( sev ) {
|
|
|
598 |
case OPTION_ON : p->opt = OPT_error ; break ;
|
|
|
599 |
case OPTION_WARN : p->opt = OPT_warning ; break ;
|
|
|
600 |
default : p->opt = OPT_none ; break ;
|
|
|
601 |
}
|
|
|
602 |
return ;
|
|
|
603 |
}
|
|
|
604 |
|
|
|
605 |
|
|
|
606 |
/*
|
|
|
607 |
FIND AN INTEGER LITERAL TYPE
|
|
|
608 |
|
|
|
609 |
This routine finds the type of the integer constant lit specified
|
|
|
610 |
with base base and suffix suff. num gives the text used to specify
|
|
|
611 |
the constant for the purposes of error reporting. fit is set to
|
|
|
612 |
true if lit definitely fits into the result.
|
|
|
613 |
*/
|
|
|
614 |
|
|
|
615 |
TYPE find_literal_type
|
|
|
616 |
PROTO_N ( ( lit, base, suff, num, fit ) )
|
|
|
617 |
PROTO_T ( NAT lit X int base X int suff X string num X int *fit )
|
|
|
618 |
{
|
|
|
619 |
TYPE t ;
|
|
|
620 |
int tok ;
|
|
|
621 |
INT_TYPE it ;
|
|
|
622 |
int big = 0 ;
|
|
|
623 |
int have_tok = 0 ;
|
|
|
624 |
int opt = OPT_error ;
|
|
|
625 |
NAT n = small_nat [0] ;
|
|
|
626 |
IDENTIFIER tid = NULL_id ;
|
|
|
627 |
LIST ( TYPE ) qt = NULL_list ( TYPE ) ;
|
|
|
628 |
LITERAL_INFO *pt = int_lit_spec [ base ] [ suff ] ;
|
|
|
629 |
|
|
|
630 |
/* Deal with calculated literals */
|
|
|
631 |
switch ( TAG_nat ( lit ) ) {
|
|
|
632 |
case nat_neg_tag : {
|
|
|
633 |
lit = DEREF_nat ( nat_neg_arg ( lit ) ) ;
|
|
|
634 |
t = find_literal_type ( lit, base, suff, num, fit ) ;
|
|
|
635 |
return ( t ) ;
|
|
|
636 |
}
|
|
|
637 |
case nat_token_tag : {
|
|
|
638 |
t = type_sint ;
|
|
|
639 |
*fit = 1 ;
|
|
|
640 |
return ( t ) ;
|
|
|
641 |
}
|
|
|
642 |
case nat_calc_tag : {
|
|
|
643 |
EXP e = DEREF_exp ( nat_calc_value ( lit ) ) ;
|
|
|
644 |
t = DEREF_type ( exp_type ( e ) ) ;
|
|
|
645 |
*fit = 1 ;
|
|
|
646 |
return ( t ) ;
|
|
|
647 |
}
|
|
|
648 |
}
|
|
|
649 |
|
|
|
650 |
/* Deal with simple literals */
|
|
|
651 |
while ( pt != NULL ) {
|
|
|
652 |
int ch = 4 ;
|
|
|
653 |
TYPE s = pt->type ;
|
|
|
654 |
switch ( pt->tag ) {
|
|
|
655 |
case 0 : {
|
|
|
656 |
TYPE r = s ;
|
|
|
657 |
if ( IS_NULL_type ( r ) ) r = type_ulong ;
|
|
|
658 |
ch = check_nat_range ( r, lit ) ;
|
|
|
659 |
if ( ch == 0 ) *fit = 1 ;
|
|
|
660 |
if ( ch > 4 ) big = ch ;
|
|
|
661 |
if ( big ) n = max_type_value ( NULL_type, 0 ) ;
|
|
|
662 |
ch = big ;
|
|
|
663 |
break ;
|
|
|
664 |
}
|
|
|
665 |
case 1 : {
|
|
|
666 |
n = pt->bound ;
|
|
|
667 |
ch = check_nat_range ( s, lit ) ;
|
|
|
668 |
if ( ch == 0 ) *fit = 1 ;
|
|
|
669 |
break ;
|
|
|
670 |
}
|
|
|
671 |
case 2 : {
|
|
|
672 |
n = pt->bound ;
|
|
|
673 |
if ( compare_nat ( n, lit ) >= 0 ) {
|
|
|
674 |
if ( !IS_NULL_type ( s ) ) *fit = 1 ;
|
|
|
675 |
ch = 0 ;
|
|
|
676 |
}
|
|
|
677 |
break ;
|
|
|
678 |
}
|
|
|
679 |
}
|
|
|
680 |
if ( ch == 0 ) {
|
|
|
681 |
/* lit definitely fits into bound */
|
|
|
682 |
if ( !IS_NULL_type ( s ) && IS_NULL_list ( qt ) ) {
|
|
|
683 |
/* No previous fit */
|
|
|
684 |
return ( s ) ;
|
|
|
685 |
}
|
|
|
686 |
}
|
|
|
687 |
if ( ch <= 2 ) {
|
|
|
688 |
/* lit may fit into bound */
|
|
|
689 |
if ( !IS_NULL_type ( s ) ) {
|
|
|
690 |
if ( have_tok == 0 ) {
|
|
|
691 |
INT_TYPE is = DEREF_itype ( type_integer_rep ( s ) ) ;
|
|
|
692 |
LIST ( TYPE ) st = DEREF_list ( itype_cases ( is ) ) ;
|
|
|
693 |
qt = union_type_set ( qt, st ) ;
|
|
|
694 |
if ( ch == 0 ) have_tok = 1 ;
|
|
|
695 |
}
|
|
|
696 |
} else {
|
|
|
697 |
if ( have_tok == 0 && !IS_NULL_id ( pt->tok ) ) {
|
|
|
698 |
DESTROY_list ( qt, SIZE_type ) ;
|
|
|
699 |
tok = int_lit_tok [ base ] [ suff ].tok ;
|
|
|
700 |
if ( pt->tok_no == tok ) {
|
|
|
701 |
qt = int_lit_tok [ base ] [ suff ].cases ;
|
|
|
702 |
} else if ( suff < SUFFIX_LL ) {
|
|
|
703 |
qt = all_prom_types ;
|
|
|
704 |
} else {
|
|
|
705 |
qt = all_llong_types ;
|
|
|
706 |
}
|
|
|
707 |
have_tok = 2 ;
|
|
|
708 |
}
|
|
|
709 |
break ;
|
|
|
710 |
}
|
|
|
711 |
}
|
|
|
712 |
if ( ch > 4 ) big = ch ;
|
|
|
713 |
pt = pt->next ;
|
|
|
714 |
}
|
|
|
715 |
|
|
|
716 |
/* Tokenised result */
|
|
|
717 |
if ( have_tok != 2 ) {
|
|
|
718 |
/* Find list of possible types */
|
|
|
719 |
if ( IS_NULL_list ( qt ) ) {
|
|
|
720 |
qt = int_lit_tok [ base ] [ suff ].cases ;
|
|
|
721 |
} else {
|
|
|
722 |
qt = REVERSE_list ( qt ) ;
|
|
|
723 |
qt = uniq_type_set ( qt ) ;
|
|
|
724 |
}
|
|
|
725 |
}
|
|
|
726 |
if ( pt ) {
|
|
|
727 |
/* Get token information from table */
|
|
|
728 |
tid = pt->tok ;
|
|
|
729 |
opt = pt->opt ;
|
|
|
730 |
}
|
|
|
731 |
if ( num && !( *fit ) ) {
|
|
|
732 |
/* Report error if necessary */
|
|
|
733 |
ERROR err = ERR_lex_icon_large ( num, n ) ;
|
|
|
734 |
err = set_severity ( err, opt, 0 ) ;
|
|
|
735 |
if ( !IS_NULL_err ( err ) ) report ( crt_loc, err ) ;
|
|
|
736 |
}
|
|
|
737 |
if ( LENGTH_list ( qt ) == 1 ) {
|
|
|
738 |
/* Only one possible case */
|
|
|
739 |
t = DEREF_type ( HEAD_list ( qt ) ) ;
|
|
|
740 |
DESTROY_list ( qt, SIZE_type ) ;
|
|
|
741 |
return ( t ) ;
|
|
|
742 |
}
|
|
|
743 |
tok = int_lit_tok [ base ] [ suff ].tok ;
|
|
|
744 |
MAKE_itype_literal ( NULL_type, qt, lit, tok, base, suff, tid, it ) ;
|
|
|
745 |
t = promote_itype ( it, it ) ;
|
|
|
746 |
return ( t ) ;
|
|
|
747 |
}
|
|
|
748 |
|
|
|
749 |
|
|
|
750 |
/*
|
|
|
751 |
ANALYSE AN INTEGER OR FLOATING LITERAL
|
|
|
752 |
|
|
|
753 |
This routine analyses the integer or floating literal given by the
|
|
|
754 |
string str, constructing the corresponding expression. The location
|
|
|
755 |
given by ptok is assigned with lex_integer_Hexp or lex_floating_Hexp
|
|
|
756 |
depending on the form of the literal. Note that str can be an area
|
|
|
757 |
of read-only memory for integer literals, but not for floating
|
|
|
758 |
literals.
|
|
|
759 |
*/
|
|
|
760 |
|
|
|
761 |
EXP make_literal_exp
|
|
|
762 |
PROTO_N ( ( str, ptok, force ) )
|
|
|
763 |
PROTO_T ( string str X int *ptok X int force )
|
|
|
764 |
{
|
|
|
765 |
EXP e ;
|
|
|
766 |
string r ;
|
|
|
767 |
int err = 0 ;
|
|
|
768 |
int flt = 0 ;
|
|
|
769 |
string s = str ;
|
|
|
770 |
unsigned base = 10 ;
|
|
|
771 |
string dot_posn = NULL ;
|
|
|
772 |
string exp_posn = NULL ;
|
|
|
773 |
int form = BASE_DECIMAL ;
|
|
|
774 |
|
|
|
775 |
/* Check small literals */
|
|
|
776 |
character c1 = s [0] ;
|
|
|
777 |
character c2 = 0 ;
|
|
|
778 |
if ( c1 ) c2 = s [1] ;
|
|
|
779 |
if ( c2 == 0 && ( c1 >= char_zero && c1 <= char_nine ) ) {
|
|
|
780 |
unsigned etag = exp_int_lit_tag ;
|
|
|
781 |
int n = ( int ) digit_values [ c1 ] ;
|
|
|
782 |
NAT lit = small_nat [n] ;
|
|
|
783 |
if ( IS_NULL_nat ( lit ) ) lit = make_small_nat ( n ) ;
|
|
|
784 |
if ( n == 0 ) etag = exp_null_tag ;
|
|
|
785 |
MAKE_exp_int_lit ( type_sint, lit, etag, e ) ;
|
|
|
786 |
*ptok = lex_integer_Hexp ;
|
|
|
787 |
return ( e ) ;
|
|
|
788 |
}
|
|
|
789 |
|
|
|
790 |
if ( c1 == char_zero && ( c2 == char_x || c2 == char_X ) ) {
|
|
|
791 |
/* Hexadecimal integer */
|
|
|
792 |
base = 16 ;
|
|
|
793 |
form = BASE_HEXADECIMAL ;
|
|
|
794 |
r = s + 2 ;
|
|
|
795 |
s = check_digits ( r, base ) ;
|
|
|
796 |
if ( s == r ) err = 1 ;
|
|
|
797 |
} else {
|
|
|
798 |
if ( c1 == char_dot ) {
|
|
|
799 |
/* Fractional component of floating literal */
|
|
|
800 |
dot_posn = s ;
|
|
|
801 |
r = s + 1 ;
|
|
|
802 |
s = check_digits ( r, base ) ;
|
|
|
803 |
if ( s == r ) err = 1 ;
|
|
|
804 |
flt = 1 ;
|
|
|
805 |
} else {
|
|
|
806 |
/* Sequence of decimal digits */
|
|
|
807 |
r = s ;
|
|
|
808 |
s = check_digits ( r, base ) ;
|
|
|
809 |
if ( s == r ) {
|
|
|
810 |
if ( c1 == char_plus || c1 == char_minus ) {
|
|
|
811 |
/* Extension to handle signs */
|
|
|
812 |
e = make_literal_exp ( str + 1, ptok, force ) ;
|
|
|
813 |
if ( c1 == char_minus ) {
|
|
|
814 |
e = make_uminus_exp ( lex_minus, e ) ;
|
|
|
815 |
}
|
|
|
816 |
return ( e ) ;
|
|
|
817 |
}
|
|
|
818 |
err = 1 ;
|
|
|
819 |
}
|
|
|
820 |
if ( s [0] == char_dot ) {
|
|
|
821 |
/* Fractional component of floating literal */
|
|
|
822 |
dot_posn = s ;
|
|
|
823 |
s = check_digits ( s + 1, base ) ;
|
|
|
824 |
flt = 1 ;
|
|
|
825 |
}
|
|
|
826 |
}
|
|
|
827 |
exp_posn = s ;
|
|
|
828 |
c2 = s [0] ;
|
|
|
829 |
if ( c2 == char_e || c2 == char_E ) {
|
|
|
830 |
/* Exponent component of floating literal */
|
|
|
831 |
c2 = s [1] ;
|
|
|
832 |
if ( c2 == char_plus || c2 == char_minus ) s++ ;
|
|
|
833 |
r = s + 1 ;
|
|
|
834 |
s = check_digits ( r, base ) ;
|
|
|
835 |
if ( s == r ) err = 1 ;
|
|
|
836 |
flt = 1 ;
|
|
|
837 |
}
|
|
|
838 |
if ( c1 == char_zero && !flt ) {
|
|
|
839 |
/* Octal integer */
|
|
|
840 |
base = 8 ;
|
|
|
841 |
form = BASE_OCTAL ;
|
|
|
842 |
r = check_digits ( str, base ) ;
|
|
|
843 |
if ( r != s ) {
|
|
|
844 |
/* Digits contain 8 or 9 */
|
|
|
845 |
report ( crt_loc, ERR_lex_icon_octal ( str ) ) ;
|
|
|
846 |
}
|
|
|
847 |
}
|
|
|
848 |
}
|
|
|
849 |
|
|
|
850 |
if ( flt ) {
|
|
|
851 |
/* Floating literals */
|
|
|
852 |
int zero ;
|
|
|
853 |
NAT expon ;
|
|
|
854 |
character ep ;
|
|
|
855 |
string frac_part ;
|
|
|
856 |
string int_part = str ;
|
|
|
857 |
string suff_posn = s ;
|
|
|
858 |
unsigned trail_zero = 0 ;
|
|
|
859 |
FLOAT lit = NULL_flt ;
|
|
|
860 |
TYPE t = type_double ;
|
|
|
861 |
|
|
|
862 |
/* Check float suffix */
|
|
|
863 |
c1 = s [0] ;
|
|
|
864 |
if ( c1 == char_f || c1 == char_F ) {
|
|
|
865 |
/* Suffix F */
|
|
|
866 |
t = type_float ;
|
|
|
867 |
s++ ;
|
|
|
868 |
c1 = s [0] ;
|
|
|
869 |
} else if ( c1 == char_l || c1 == char_L ) {
|
|
|
870 |
/* Suffix L */
|
|
|
871 |
t = type_ldouble ;
|
|
|
872 |
s++ ;
|
|
|
873 |
c1 = s [0] ;
|
|
|
874 |
}
|
|
|
875 |
|
|
|
876 |
/* Check for end of number */
|
|
|
877 |
if ( c1 || err ) report ( crt_loc, ERR_lex_literal_bad ( str ) ) ;
|
|
|
878 |
|
|
|
879 |
/* Find number components (involves writing to s) */
|
|
|
880 |
while ( int_part [0] == char_zero ) {
|
|
|
881 |
/* Remove initial zeros */
|
|
|
882 |
int_part++ ;
|
|
|
883 |
}
|
|
|
884 |
if ( dot_posn ) {
|
|
|
885 |
dot_posn [0] = 0 ;
|
|
|
886 |
if ( int_part == dot_posn ) int_part = small_number [0] ;
|
|
|
887 |
frac_part = dot_posn + 1 ;
|
|
|
888 |
if ( frac_part == exp_posn ) {
|
|
|
889 |
frac_part = small_number [0] ;
|
|
|
890 |
} else {
|
|
|
891 |
/* Remove trailing zeros */
|
|
|
892 |
string frac_zero = exp_posn - 1 ;
|
|
|
893 |
while ( frac_zero [0] == char_zero ) {
|
|
|
894 |
frac_zero [0] = 0 ;
|
|
|
895 |
frac_zero-- ;
|
|
|
896 |
trail_zero++ ;
|
|
|
897 |
}
|
|
|
898 |
if ( frac_zero == dot_posn ) frac_part = small_number [0] ;
|
|
|
899 |
}
|
|
|
900 |
} else {
|
|
|
901 |
if ( int_part == exp_posn ) int_part = small_number [0] ;
|
|
|
902 |
frac_part = small_number [0] ;
|
|
|
903 |
}
|
|
|
904 |
ep = exp_posn [0] ;
|
|
|
905 |
exp_posn [0] = 0 ;
|
|
|
906 |
if ( ep == char_e || ep == char_E ) {
|
|
|
907 |
/* Evaluate exponent */
|
|
|
908 |
r = exp_posn + 1 ;
|
|
|
909 |
c2 = r [0] ;
|
|
|
910 |
if ( c2 == char_minus || c2 == char_plus ) r++ ;
|
|
|
911 |
expon = eval_digits ( r, suff_posn, base ) ;
|
|
|
912 |
if ( c2 == char_minus ) expon = negate_nat ( expon ) ;
|
|
|
913 |
zero = is_zero_nat ( expon ) ;
|
|
|
914 |
} else {
|
|
|
915 |
expon = small_nat [0] ;
|
|
|
916 |
zero = 1 ;
|
|
|
917 |
}
|
|
|
918 |
if ( zero && ustreq ( frac_part, small_number [0] ) ) {
|
|
|
919 |
int i ;
|
|
|
920 |
for ( i = 0 ; i < SMALL_FLT_SIZE ; i++ ) {
|
|
|
921 |
if ( ustreq ( int_part, small_number [i] ) ) {
|
|
|
922 |
lit = get_float ( t, i ) ;
|
|
|
923 |
break ;
|
|
|
924 |
}
|
|
|
925 |
}
|
|
|
926 |
}
|
|
|
927 |
if ( IS_NULL_flt ( lit ) ) {
|
|
|
928 |
int_part = xustrcpy ( int_part ) ;
|
|
|
929 |
frac_part = xustrcpy ( frac_part ) ;
|
|
|
930 |
}
|
|
|
931 |
if ( trail_zero ) {
|
|
|
932 |
/* Restore trailing zeros */
|
|
|
933 |
r = exp_posn - 1 ;
|
|
|
934 |
do {
|
|
|
935 |
r [0] = char_zero ;
|
|
|
936 |
r-- ;
|
|
|
937 |
trail_zero-- ;
|
|
|
938 |
} while ( trail_zero ) ;
|
|
|
939 |
}
|
|
|
940 |
if ( dot_posn ) dot_posn [0] = char_dot ;
|
|
|
941 |
exp_posn [0] = ep ;
|
|
|
942 |
|
|
|
943 |
/* Construct result - type is as per suffix */
|
|
|
944 |
if ( IS_NULL_flt ( lit ) ) {
|
|
|
945 |
MAKE_flt_simple ( int_part, frac_part, expon, lit ) ;
|
|
|
946 |
}
|
|
|
947 |
MAKE_exp_float_lit ( t, lit, e ) ;
|
|
|
948 |
*ptok = lex_floating_Hexp ;
|
|
|
949 |
|
|
|
950 |
} else {
|
|
|
951 |
/* Integer literals */
|
|
|
952 |
TYPE t ;
|
|
|
953 |
NAT lit ;
|
|
|
954 |
int ls = 0 ;
|
|
|
955 |
int us = 0 ;
|
|
|
956 |
int fit = 0 ;
|
|
|
957 |
|
|
|
958 |
/* Find integer value */
|
|
|
959 |
r = str ;
|
|
|
960 |
if ( form == BASE_HEXADECIMAL ) r += 2 ;
|
|
|
961 |
lit = eval_digits ( r, s, base ) ;
|
|
|
962 |
|
|
|
963 |
/* Check integer suffix */
|
|
|
964 |
c1 = s [0] ;
|
|
|
965 |
if ( c1 == char_u || c1 == char_U ) {
|
|
|
966 |
us = 1 ;
|
|
|
967 |
s++ ;
|
|
|
968 |
c1 = s [0] ;
|
|
|
969 |
}
|
|
|
970 |
if ( c1 == char_l || c1 == char_L ) {
|
|
|
971 |
ls = 1 ;
|
|
|
972 |
if ( s [1] == c1 && basetype_info [ ntype_sllong ].key ) {
|
|
|
973 |
report ( crt_loc, ERR_lex_icon_llong ( str ) ) ;
|
|
|
974 |
ls = 2 ;
|
|
|
975 |
s++ ;
|
|
|
976 |
}
|
|
|
977 |
s++ ;
|
|
|
978 |
c1 = s [0] ;
|
|
|
979 |
} else {
|
|
|
980 |
/* Map 'int' to 'long' in '#if' expressions */
|
|
|
981 |
if ( in_hash_if_exp ) ls = 1 ;
|
|
|
982 |
}
|
|
|
983 |
if ( us == 0 && ( c1 == char_u || c1 == char_U ) ) {
|
|
|
984 |
us = 1 ;
|
|
|
985 |
s++ ;
|
|
|
986 |
c1 = s [0] ;
|
|
|
987 |
}
|
|
|
988 |
|
|
|
989 |
/* Check for end of number */
|
|
|
990 |
if ( c1 || err ) report ( crt_loc, ERR_lex_literal_bad ( str ) ) ;
|
|
|
991 |
|
|
|
992 |
/* Find literal type */
|
|
|
993 |
if ( force ) {
|
|
|
994 |
t = type_ulong ;
|
|
|
995 |
fit = 1 ;
|
|
|
996 |
} else {
|
|
|
997 |
int suff = SUFFIX ( us, ls ) ;
|
|
|
998 |
t = find_literal_type ( lit, form, suff, str, &fit ) ;
|
|
|
999 |
}
|
|
|
1000 |
MAKE_exp_int_lit ( t, lit, exp_int_lit_tag, e ) ;
|
|
|
1001 |
if ( !fit ) {
|
|
|
1002 |
/* Force result to be a calculated value */
|
|
|
1003 |
MAKE_exp_cast ( t, CONV_INT_INT, e, e ) ;
|
|
|
1004 |
MAKE_nat_calc ( e, lit ) ;
|
|
|
1005 |
MAKE_exp_int_lit ( t, lit, exp_int_lit_tag, e ) ;
|
|
|
1006 |
}
|
|
|
1007 |
*ptok = lex_integer_Hexp ;
|
|
|
1008 |
}
|
|
|
1009 |
return ( e ) ;
|
|
|
1010 |
}
|
|
|
1011 |
|
|
|
1012 |
|
|
|
1013 |
/*
|
|
|
1014 |
IS A FLOATING LITERAL ZERO?
|
|
|
1015 |
|
|
|
1016 |
This routine checks whether the floating point literal f is zero.
|
|
|
1017 |
*/
|
|
|
1018 |
|
|
|
1019 |
int is_zero_float
|
|
|
1020 |
PROTO_N ( ( f ) )
|
|
|
1021 |
PROTO_T ( FLOAT f )
|
|
|
1022 |
{
|
|
|
1023 |
string s ;
|
|
|
1024 |
character c ;
|
|
|
1025 |
s = DEREF_string ( flt_simple_int_part ( f ) ) ;
|
|
|
1026 |
while ( c = *( s++ ), c != 0 ) {
|
|
|
1027 |
if ( c != char_zero ) return ( 0 ) ;
|
|
|
1028 |
}
|
|
|
1029 |
s = DEREF_string ( flt_simple_frac_part ( f ) ) ;
|
|
|
1030 |
while ( c = *( s++ ), c != 0 ) {
|
|
|
1031 |
if ( c != char_zero ) return ( 0 ) ;
|
|
|
1032 |
}
|
|
|
1033 |
return ( 1 ) ;
|
|
|
1034 |
}
|
|
|
1035 |
|
|
|
1036 |
|
|
|
1037 |
/*
|
|
|
1038 |
ARE TWO FLOATING LITERALS EQUAL?
|
|
|
1039 |
|
|
|
1040 |
This routine checks whether the floating point literals f and g are
|
|
|
1041 |
equal. Note that this is equality of representation rather than
|
|
|
1042 |
equality of the underlying numbers.
|
|
|
1043 |
*/
|
|
|
1044 |
|
|
|
1045 |
int eq_float_lit
|
|
|
1046 |
PROTO_N ( ( f, g ) )
|
|
|
1047 |
PROTO_T ( FLOAT f X FLOAT g )
|
|
|
1048 |
{
|
|
|
1049 |
NAT ef, eg ;
|
|
|
1050 |
ulong nf, ng ;
|
|
|
1051 |
string af, ag ;
|
|
|
1052 |
string bf, bg ;
|
|
|
1053 |
if ( EQ_flt ( f, g ) ) return ( 1 ) ;
|
|
|
1054 |
DECONS_flt_simple ( nf, af, bf, ef, f ) ;
|
|
|
1055 |
DECONS_flt_simple ( ng, ag, bg, eg, g ) ;
|
|
|
1056 |
if ( !ustreq ( af, ag ) ) return ( 0 ) ;
|
|
|
1057 |
if ( !ustreq ( bf, bg ) ) return ( 0 ) ;
|
|
|
1058 |
if ( compare_nat ( ef, eg ) != 0 ) return ( 0 ) ;
|
|
|
1059 |
if ( nf == LINK_NONE ) COPY_ulong ( flt_tok ( f ), ng ) ;
|
|
|
1060 |
if ( ng == LINK_NONE ) COPY_ulong ( flt_tok ( g ), nf ) ;
|
|
|
1061 |
return ( 1 ) ;
|
|
|
1062 |
}
|
|
|
1063 |
|
|
|
1064 |
|
|
|
1065 |
/*
|
|
|
1066 |
DEFAULT ROUNDING MODE
|
|
|
1067 |
|
|
|
1068 |
This variable gives the default rounding mode used for converting
|
|
|
1069 |
floating point expressions to integers.
|
|
|
1070 |
*/
|
|
|
1071 |
|
|
|
1072 |
RMODE crt_round_mode = rmode_to_zero ;
|
|
|
1073 |
|
|
|
1074 |
|
|
|
1075 |
/*
|
|
|
1076 |
ROUND A FLOATING POINT LITERAL
|
|
|
1077 |
|
|
|
1078 |
This routine rounds the floating point literal f to an integer
|
|
|
1079 |
literal by the rounding mode corresponding to mode. The null integer
|
|
|
1080 |
literal is returned to indicate a target dependent literal. The
|
|
|
1081 |
range of values in which the result is target independent is actually
|
|
|
1082 |
rather small - it is given by FLT_DIG.
|
|
|
1083 |
*/
|
|
|
1084 |
|
|
|
1085 |
NAT round_float_lit
|
|
|
1086 |
PROTO_N ( ( f, mode ) )
|
|
|
1087 |
PROTO_T ( FLOAT f X RMODE mode )
|
|
|
1088 |
{
|
|
|
1089 |
NAT res ;
|
|
|
1090 |
unsigned base = 10 ;
|
|
|
1091 |
unsigned long i, j, n ;
|
|
|
1092 |
unsigned long res_len ;
|
|
|
1093 |
unsigned long pre_len ;
|
|
|
1094 |
unsigned long exp_val ;
|
|
|
1095 |
character result [100] ;
|
|
|
1096 |
|
|
|
1097 |
/* Decompose simple literal */
|
|
|
1098 |
string int_part = DEREF_string ( flt_simple_int_part ( f ) ) ;
|
|
|
1099 |
string frac_part = DEREF_string ( flt_simple_frac_part ( f ) ) ;
|
|
|
1100 |
NAT expon = DEREF_nat ( flt_simple_exponent ( f ) ) ;
|
|
|
1101 |
|
|
|
1102 |
/* Find component lengths */
|
|
|
1103 |
unsigned long int_len = ( unsigned long ) ustrlen ( int_part ) ;
|
|
|
1104 |
unsigned long frac_len = ( unsigned long ) ustrlen ( frac_part ) ;
|
|
|
1105 |
|
|
|
1106 |
/* Allow for initial zeros */
|
|
|
1107 |
while ( int_part [0] == char_zero ) {
|
|
|
1108 |
int_part++ ;
|
|
|
1109 |
int_len-- ;
|
|
|
1110 |
}
|
|
|
1111 |
|
|
|
1112 |
/* Allow for exponent */
|
|
|
1113 |
if ( IS_nat_neg ( expon ) ) {
|
|
|
1114 |
expon = DEREF_nat ( nat_neg_arg ( expon ) ) ;
|
|
|
1115 |
exp_val = get_nat_value ( expon ) ;
|
|
|
1116 |
if ( exp_val > int_len ) {
|
|
|
1117 |
res_len = 0 ;
|
|
|
1118 |
pre_len = exp_val - int_len ;
|
|
|
1119 |
} else {
|
|
|
1120 |
res_len = int_len - exp_val ;
|
|
|
1121 |
pre_len = 0 ;
|
|
|
1122 |
}
|
|
|
1123 |
} else {
|
|
|
1124 |
exp_val = get_nat_value ( expon ) ;
|
|
|
1125 |
res_len = int_len + exp_val ;
|
|
|
1126 |
pre_len = 0 ;
|
|
|
1127 |
}
|
|
|
1128 |
|
|
|
1129 |
/* Allow for initial zeros in fractional part */
|
|
|
1130 |
if ( int_part [0] == 0 ) {
|
|
|
1131 |
while ( frac_part [0] == char_zero ) {
|
|
|
1132 |
frac_part++ ;
|
|
|
1133 |
frac_len-- ;
|
|
|
1134 |
if ( res_len == 0 ) {
|
|
|
1135 |
pre_len++ ;
|
|
|
1136 |
} else {
|
|
|
1137 |
res_len-- ;
|
|
|
1138 |
}
|
|
|
1139 |
}
|
|
|
1140 |
if ( frac_part [0] == 0 ) {
|
|
|
1141 |
/* Zero floating literal */
|
|
|
1142 |
res = small_nat [0] ;
|
|
|
1143 |
return ( res ) ;
|
|
|
1144 |
}
|
|
|
1145 |
}
|
|
|
1146 |
|
|
|
1147 |
/* Extreme values are target dependent */
|
|
|
1148 |
if ( pre_len > 6 ) return ( NULL_nat ) ;
|
|
|
1149 |
if ( res_len > 6 ) return ( NULL_nat ) ;
|
|
|
1150 |
if ( exp_val == EXTENDED_MAX ) return ( NULL_nat ) ;
|
|
|
1151 |
|
|
|
1152 |
/* Construct integer string */
|
|
|
1153 |
j = 0 ;
|
|
|
1154 |
n = res_len ;
|
|
|
1155 |
for ( i = 0 ; i < pre_len ; i++ ) {
|
|
|
1156 |
if ( j < n ) {
|
|
|
1157 |
result [j] = char_zero ;
|
|
|
1158 |
j++ ;
|
|
|
1159 |
}
|
|
|
1160 |
}
|
|
|
1161 |
for ( i = 0 ; i < int_len ; i++ ) {
|
|
|
1162 |
if ( j < n ) {
|
|
|
1163 |
result [j] = int_part [i] ;
|
|
|
1164 |
j++ ;
|
|
|
1165 |
}
|
|
|
1166 |
}
|
|
|
1167 |
for ( i = 0 ; i < frac_len ; i++ ) {
|
|
|
1168 |
if ( j < n ) {
|
|
|
1169 |
result [j] = frac_part [i] ;
|
|
|
1170 |
j++ ;
|
|
|
1171 |
}
|
|
|
1172 |
}
|
|
|
1173 |
for ( ; j < n ; j++ ) result [j] = char_zero ;
|
|
|
1174 |
result [n] = 0 ;
|
|
|
1175 |
|
|
|
1176 |
/* Calculate the result */
|
|
|
1177 |
res = eval_digits ( result, result + res_len, base ) ;
|
|
|
1178 |
UNUSED ( mode ) ;
|
|
|
1179 |
return ( res ) ;
|
|
|
1180 |
}
|
|
|
1181 |
|
|
|
1182 |
|
|
|
1183 |
/*
|
|
|
1184 |
EVALUATE A UNICODE CHARACTER
|
|
|
1185 |
|
|
|
1186 |
This routine evaluates the unicode character with prefix c, consisting
|
|
|
1187 |
of n hex digits, given by ps. ps is advanced to the position following
|
|
|
1188 |
the hex digits.
|
|
|
1189 |
*/
|
|
|
1190 |
|
|
|
1191 |
unsigned long eval_unicode
|
|
|
1192 |
PROTO_N ( ( c, n, pc, ps, err ) )
|
|
|
1193 |
PROTO_T ( int c X unsigned n X int *pc X string *ps X ERROR *err )
|
|
|
1194 |
{
|
|
|
1195 |
string r = *ps ;
|
|
|
1196 |
unsigned long u ;
|
|
|
1197 |
unsigned base = 16 ;
|
|
|
1198 |
string s = check_digits ( r, base ) ;
|
|
|
1199 |
unsigned m = ( unsigned ) ( s - r ) ;
|
|
|
1200 |
if ( m < n ) {
|
|
|
1201 |
add_error ( err, ERR_lex_charset_len ( c, n ) ) ;
|
|
|
1202 |
} else {
|
|
|
1203 |
s = r + n ;
|
|
|
1204 |
}
|
|
|
1205 |
*ps = s ;
|
|
|
1206 |
u = eval_char_digits ( r, s, base ) ;
|
|
|
1207 |
add_error ( err, ERR_lex_charset_replace ( u ) ) ;
|
|
|
1208 |
if ( u < 0x20 || ( u >= 0x7f && u <= 0x9f ) || is_legal_char ( u ) ) {
|
|
|
1209 |
add_error ( err, ERR_lex_charset_bad ( u ) ) ;
|
|
|
1210 |
*pc = CHAR_SIMPLE ;
|
|
|
1211 |
} else {
|
|
|
1212 |
if ( u <= ( unsigned long ) 0xffff ) *pc = CHAR_UNI4 ;
|
|
|
1213 |
}
|
|
|
1214 |
return ( u ) ;
|
|
|
1215 |
}
|
|
|
1216 |
|
|
|
1217 |
|
|
|
1218 |
/*
|
|
|
1219 |
GET A MULTI-BYTE CHARACTER FROM A STRING
|
|
|
1220 |
|
|
|
1221 |
This routine returns the multi-byte character pointed to by the
|
|
|
1222 |
string s. It assigns the character type to pc.
|
|
|
1223 |
*/
|
|
|
1224 |
|
|
|
1225 |
unsigned long get_multi_char
|
|
|
1226 |
PROTO_N ( ( s, pc ) )
|
|
|
1227 |
PROTO_T ( string s X int *pc )
|
|
|
1228 |
{
|
|
|
1229 |
int i ;
|
|
|
1230 |
unsigned long n = 0 ;
|
|
|
1231 |
for ( i = MULTI_WIDTH - 1 ; i >= 1 ; i-- ) {
|
|
|
1232 |
n = ( n << 8 ) + ( unsigned long ) s [i] ;
|
|
|
1233 |
}
|
|
|
1234 |
*pc = ( int ) s [0] ;
|
|
|
1235 |
return ( n ) ;
|
|
|
1236 |
}
|
|
|
1237 |
|
|
|
1238 |
|
|
|
1239 |
/*
|
|
|
1240 |
ADD A MULTI-BYTE CHARACTER TO A STRING
|
|
|
1241 |
|
|
|
1242 |
This routine adds the multi-byte character n of type ch to the
|
|
|
1243 |
string s. A multi-byte character is represented by 5 characters.
|
|
|
1244 |
The first is a key describing how the character was described (a
|
|
|
1245 |
simple character, a hex or octal escape sequence, a unicode
|
|
|
1246 |
character etc.). The next four characters give the character value.
|
|
|
1247 |
*/
|
|
|
1248 |
|
|
|
1249 |
void add_multi_char
|
|
|
1250 |
PROTO_N ( ( s, n, ch ) )
|
|
|
1251 |
PROTO_T ( string s X unsigned long n X int ch )
|
|
|
1252 |
{
|
|
|
1253 |
int i ;
|
|
|
1254 |
s [0] = ( character ) ch ;
|
|
|
1255 |
for ( i = 1 ; i < MULTI_WIDTH ; i++ ) {
|
|
|
1256 |
s [i] = ( character ) ( n & 0xff ) ;
|
|
|
1257 |
n >>= 8 ;
|
|
|
1258 |
}
|
|
|
1259 |
if ( n ) report ( crt_loc, ERR_lex_ccon_large () ) ;
|
|
|
1260 |
return ;
|
|
|
1261 |
}
|
|
|
1262 |
|
|
|
1263 |
|
|
|
1264 |
/*
|
|
|
1265 |
CREATE A MULTI-BYTE STRING
|
|
|
1266 |
|
|
|
1267 |
This routine creates a multi-byte string of length n in s from the
|
|
|
1268 |
string t of kind k.
|
|
|
1269 |
*/
|
|
|
1270 |
|
|
|
1271 |
static void make_multi_string
|
|
|
1272 |
PROTO_N ( ( s, t, n, k ) )
|
|
|
1273 |
PROTO_T ( string s X string t X unsigned long n X unsigned k )
|
|
|
1274 |
{
|
|
|
1275 |
if ( k & STRING_MULTI ) {
|
|
|
1276 |
n *= MULTI_WIDTH ;
|
|
|
1277 |
xumemcpy ( s, t, ( gen_size ) n ) ;
|
|
|
1278 |
} else {
|
|
|
1279 |
unsigned long i ;
|
|
|
1280 |
for ( i = 0 ; i < n ; i++ ) {
|
|
|
1281 |
add_multi_char ( s, ( unsigned long ) *t, CHAR_SIMPLE ) ;
|
|
|
1282 |
s += MULTI_WIDTH ;
|
|
|
1283 |
t++ ;
|
|
|
1284 |
}
|
|
|
1285 |
}
|
|
|
1286 |
return ;
|
|
|
1287 |
}
|
|
|
1288 |
|
|
|
1289 |
|
|
|
1290 |
/*
|
|
|
1291 |
GET A MULTIBYTE CHARACTER FROM A STRING
|
|
|
1292 |
|
|
|
1293 |
This routine reads a multibyte character from the string s (which
|
|
|
1294 |
ends at se). The value (as a wide character) is assigned to pc with
|
|
|
1295 |
the new value of s being returned. Note that this routine is not
|
|
|
1296 |
required in, for example, check_digits because the representation
|
|
|
1297 |
of a simple single byte character as a multibyte character comprises
|
|
|
1298 |
that single byte.
|
|
|
1299 |
*/
|
|
|
1300 |
|
|
|
1301 |
#if FS_MULTIBYTE
|
|
|
1302 |
|
|
|
1303 |
static string get_multibyte
|
|
|
1304 |
PROTO_N ( ( s, se, pc ) )
|
|
|
1305 |
PROTO_T ( string s X string se X unsigned long *pc )
|
|
|
1306 |
{
|
|
|
1307 |
wchar_t c ;
|
|
|
1308 |
int n = mbtowc ( &c, s, ( size_t ) ( se - s ) ) ;
|
|
|
1309 |
if ( n > 0 ) {
|
|
|
1310 |
/* Valid multibyte character */
|
|
|
1311 |
*pc = ( unsigned long ) c ;
|
|
|
1312 |
s += n ;
|
|
|
1313 |
} else if ( n == 0 ) {
|
|
|
1314 |
/* Null character */
|
|
|
1315 |
*pc = 0 ;
|
|
|
1316 |
s++ ;
|
|
|
1317 |
} else {
|
|
|
1318 |
/* Invalid multibyte character */
|
|
|
1319 |
report ( crt_loc, ERR_lex_ccon_multibyte () ) ;
|
|
|
1320 |
*pc = ( unsigned long ) *( s++ ) ;
|
|
|
1321 |
}
|
|
|
1322 |
return ( s ) ;
|
|
|
1323 |
}
|
|
|
1324 |
|
|
|
1325 |
#endif
|
|
|
1326 |
|
|
|
1327 |
|
|
|
1328 |
/*
|
|
|
1329 |
ANALYSE A STRING OR CHARACTER LITERAL
|
|
|
1330 |
|
|
|
1331 |
This routine analyses the string or character literal given by the
|
|
|
1332 |
string s (which ends at se). Only characters in the range [0,0xff]
|
|
|
1333 |
are assumed to be valid. Note that this is the routine which should
|
|
|
1334 |
do the mapping from the source character set to the execution
|
|
|
1335 |
character set (translation phase 5), however this is deferred until
|
|
|
1336 |
the string output routines.
|
|
|
1337 |
*/
|
|
|
1338 |
|
|
|
1339 |
STRING new_string_lit
|
|
|
1340 |
PROTO_N ( ( s, se, lex ) )
|
|
|
1341 |
PROTO_T ( string s X string se X int lex )
|
|
|
1342 |
{
|
|
|
1343 |
STRING res ;
|
|
|
1344 |
STRING prev ;
|
|
|
1345 |
int multi = 0 ;
|
|
|
1346 |
int overflow = 0 ;
|
|
|
1347 |
unsigned long len = 0 ;
|
|
|
1348 |
unsigned kind = STRING_NONE ;
|
|
|
1349 |
#if FS_MULTIBYTE
|
|
|
1350 |
int multibyte = allow_multibyte ;
|
|
|
1351 |
#endif
|
|
|
1352 |
gen_size sz = ( gen_size ) ( se - s ) + 1 ;
|
|
|
1353 |
string str = xustr ( sz ) ;
|
|
|
1354 |
|
|
|
1355 |
/* Find string type */
|
|
|
1356 |
switch ( lex ) {
|
|
|
1357 |
case lex_char_Hlit :
|
|
|
1358 |
case lex_char_Hexp : {
|
|
|
1359 |
kind = STRING_CHAR ;
|
|
|
1360 |
break ;
|
|
|
1361 |
}
|
|
|
1362 |
case lex_wchar_Hlit :
|
|
|
1363 |
case lex_wchar_Hexp : {
|
|
|
1364 |
kind = ( STRING_WIDE | STRING_CHAR ) ;
|
|
|
1365 |
break ;
|
|
|
1366 |
}
|
|
|
1367 |
case lex_string_Hlit :
|
|
|
1368 |
case lex_string_Hexp : {
|
|
|
1369 |
kind = STRING_NONE ;
|
|
|
1370 |
break ;
|
|
|
1371 |
}
|
|
|
1372 |
case lex_wstring_Hlit :
|
|
|
1373 |
case lex_wstring_Hexp : {
|
|
|
1374 |
kind = STRING_WIDE ;
|
|
|
1375 |
break ;
|
|
|
1376 |
}
|
|
|
1377 |
}
|
|
|
1378 |
if ( do_string ) dump_string_lit ( s, se, kind ) ;
|
|
|
1379 |
|
|
|
1380 |
/* Scan string replacing escape sequences */
|
|
|
1381 |
while ( s != se ) {
|
|
|
1382 |
unsigned long c ;
|
|
|
1383 |
int ch = CHAR_SIMPLE ;
|
|
|
1384 |
#if FS_MULTIBYTE
|
|
|
1385 |
if ( multibyte ) {
|
|
|
1386 |
s = get_multibyte ( s, se, &c ) ;
|
|
|
1387 |
} else {
|
|
|
1388 |
c = ( unsigned long ) *( s++ ) ;
|
|
|
1389 |
}
|
|
|
1390 |
#else
|
|
|
1391 |
c = ( unsigned long ) *( s++ ) ;
|
|
|
1392 |
#endif
|
|
|
1393 |
if ( c == char_backslash ) {
|
|
|
1394 |
if ( s != se ) {
|
|
|
1395 |
/* Unterminated string literals already reported */
|
|
|
1396 |
character e = NONE ;
|
|
|
1397 |
#if FS_MULTIBYTE
|
|
|
1398 |
if ( multibyte ) {
|
|
|
1399 |
s = get_multibyte ( s, se, &c ) ;
|
|
|
1400 |
} else {
|
|
|
1401 |
c = ( unsigned long ) *( s++ ) ;
|
|
|
1402 |
}
|
|
|
1403 |
#else
|
|
|
1404 |
c = ( unsigned long ) *( s++ ) ;
|
|
|
1405 |
#endif
|
|
|
1406 |
if ( c < NO_CHAR ) e = escape_sequences [c] ;
|
|
|
1407 |
switch ( e ) {
|
|
|
1408 |
|
|
|
1409 |
case OCTE : {
|
|
|
1410 |
/* Octal escape sequences */
|
|
|
1411 |
unsigned base = 8 ;
|
|
|
1412 |
string r = s - 1 ;
|
|
|
1413 |
s = check_digits ( r, base ) ;
|
|
|
1414 |
if ( s > r + 3 ) s = r + 3 ;
|
|
|
1415 |
c = eval_char_digits ( r, s, base ) ;
|
|
|
1416 |
ch = CHAR_OCTAL ;
|
|
|
1417 |
break ;
|
|
|
1418 |
}
|
|
|
1419 |
|
|
|
1420 |
case HEXE : {
|
|
|
1421 |
/* Hexadecimal escape sequences */
|
|
|
1422 |
unsigned base = 16 ;
|
|
|
1423 |
string r = s ;
|
|
|
1424 |
s = check_digits ( r, base ) ;
|
|
|
1425 |
if ( s == r ) {
|
|
|
1426 |
int i = ( int ) c ;
|
|
|
1427 |
report ( crt_loc, ERR_lex_ccon_hex ( i ) ) ;
|
|
|
1428 |
} else {
|
|
|
1429 |
c = eval_char_digits ( r, s, base ) ;
|
|
|
1430 |
}
|
|
|
1431 |
ch = CHAR_HEX ;
|
|
|
1432 |
break ;
|
|
|
1433 |
}
|
|
|
1434 |
|
|
|
1435 |
case UNI4 : {
|
|
|
1436 |
/* Short unicode escape sequences */
|
|
|
1437 |
if ( allow_unicodes ) {
|
|
|
1438 |
string r = s ;
|
|
|
1439 |
unsigned d = 4 ;
|
|
|
1440 |
ERROR err = NULL_err ;
|
|
|
1441 |
c = eval_unicode ( char_u, d, &ch, &r, &err ) ;
|
|
|
1442 |
if ( !IS_NULL_err ( err ) ) {
|
|
|
1443 |
report ( crt_loc, err ) ;
|
|
|
1444 |
}
|
|
|
1445 |
ch = CHAR_UNI4 ;
|
|
|
1446 |
s = r ;
|
|
|
1447 |
break ;
|
|
|
1448 |
}
|
|
|
1449 |
goto illegal_lab ;
|
|
|
1450 |
}
|
|
|
1451 |
|
|
|
1452 |
case UNI8 : {
|
|
|
1453 |
/* Long unicode escape sequences */
|
|
|
1454 |
if ( allow_unicodes ) {
|
|
|
1455 |
string r = s ;
|
|
|
1456 |
unsigned d = 8 ;
|
|
|
1457 |
ERROR err = NULL_err ;
|
|
|
1458 |
c = eval_unicode ( char_U, d, &ch, &r, &err ) ;
|
|
|
1459 |
if ( !IS_NULL_err ( err ) ) {
|
|
|
1460 |
report ( crt_loc, err ) ;
|
|
|
1461 |
}
|
|
|
1462 |
ch = CHAR_UNI8 ;
|
|
|
1463 |
s = r ;
|
|
|
1464 |
break ;
|
|
|
1465 |
}
|
|
|
1466 |
goto illegal_lab ;
|
|
|
1467 |
}
|
|
|
1468 |
|
|
|
1469 |
case NONE :
|
|
|
1470 |
illegal_lab : {
|
|
|
1471 |
/* Illegal escape sequences */
|
|
|
1472 |
int i = ( int ) c ;
|
|
|
1473 |
report ( crt_loc, ERR_lex_ccon_escape ( i ) ) ;
|
|
|
1474 |
break ;
|
|
|
1475 |
}
|
|
|
1476 |
|
|
|
1477 |
default : {
|
|
|
1478 |
/* Simple escape sequences */
|
|
|
1479 |
c = ( unsigned long ) e ;
|
|
|
1480 |
break ;
|
|
|
1481 |
}
|
|
|
1482 |
}
|
|
|
1483 |
}
|
|
|
1484 |
}
|
|
|
1485 |
if ( ( ch != CHAR_SIMPLE || c >= 256 ) && !multi ) {
|
|
|
1486 |
/* Convert to multi-character format */
|
|
|
1487 |
string a ;
|
|
|
1488 |
sz *= MULTI_WIDTH ;
|
|
|
1489 |
a = xustr ( sz ) ;
|
|
|
1490 |
make_multi_string ( a, str, len, kind ) ;
|
|
|
1491 |
if ( len ) {
|
|
|
1492 |
len *= MULTI_WIDTH ;
|
|
|
1493 |
if ( len == 0 ) overflow = 1 ;
|
|
|
1494 |
}
|
|
|
1495 |
if ( c >= 256 ) {
|
|
|
1496 |
/* Mark fat strings */
|
|
|
1497 |
if ( !( kind & STRING_WIDE ) ) {
|
|
|
1498 |
if ( ch == CHAR_UNI4 || ch == CHAR_UNI8 ) {
|
|
|
1499 |
/* EMPTY */
|
|
|
1500 |
} else {
|
|
|
1501 |
report ( crt_loc, ERR_lex_ccon_large () ) ;
|
|
|
1502 |
}
|
|
|
1503 |
}
|
|
|
1504 |
kind |= STRING_FAT ;
|
|
|
1505 |
}
|
|
|
1506 |
kind |= STRING_MULTI ;
|
|
|
1507 |
multi = 1 ;
|
|
|
1508 |
str = a ;
|
|
|
1509 |
}
|
|
|
1510 |
if ( multi ) {
|
|
|
1511 |
add_multi_char ( str + len, c, ch ) ;
|
|
|
1512 |
len += MULTI_WIDTH ;
|
|
|
1513 |
} else {
|
|
|
1514 |
str [ len++ ] = ( character ) c ;
|
|
|
1515 |
}
|
|
|
1516 |
if ( len == 0 ) overflow = 1 ;
|
|
|
1517 |
}
|
|
|
1518 |
if ( multi ) {
|
|
|
1519 |
add_multi_char ( str + len, ( unsigned long ) 0, CHAR_OCTAL ) ;
|
|
|
1520 |
len /= MULTI_WIDTH ;
|
|
|
1521 |
} else {
|
|
|
1522 |
str [ len ] = 0 ;
|
|
|
1523 |
}
|
|
|
1524 |
if ( overflow ) len = ULONG_MAX ;
|
|
|
1525 |
if ( !check_value ( OPT_VAL_string_length, len ) ) {
|
|
|
1526 |
len = option_value ( OPT_VAL_string_length ) ;
|
|
|
1527 |
if ( multi ) {
|
|
|
1528 |
unsigned long n = MULTI_WIDTH * len ;
|
|
|
1529 |
add_multi_char ( str + n, ( unsigned long ) 0, CHAR_OCTAL ) ;
|
|
|
1530 |
} else {
|
|
|
1531 |
str [ len ] = 0 ;
|
|
|
1532 |
}
|
|
|
1533 |
}
|
|
|
1534 |
MAKE_str_simple ( len, str, kind, res ) ;
|
|
|
1535 |
prev = share_string_lit ( res ) ;
|
|
|
1536 |
if ( !EQ_str ( prev, res ) ) {
|
|
|
1537 |
/* Share string literals */
|
|
|
1538 |
unsigned long v ;
|
|
|
1539 |
DESTROY_str_simple ( destroy, res, len, str, kind, v, res ) ;
|
|
|
1540 |
xufree ( str, sz ) ;
|
|
|
1541 |
UNUSED ( res ) ;
|
|
|
1542 |
UNUSED ( len ) ;
|
|
|
1543 |
UNUSED ( kind ) ;
|
|
|
1544 |
UNUSED ( v ) ;
|
|
|
1545 |
res = prev ;
|
|
|
1546 |
}
|
|
|
1547 |
return ( res ) ;
|
|
|
1548 |
}
|
|
|
1549 |
|
|
|
1550 |
|
|
|
1551 |
/*
|
|
|
1552 |
ARE TWO STRINGS EQUAL?
|
|
|
1553 |
|
|
|
1554 |
This routine checks whether the string literals s and t are equal.
|
|
|
1555 |
*/
|
|
|
1556 |
|
|
|
1557 |
int eq_string_lit
|
|
|
1558 |
PROTO_N ( ( s, t ) )
|
|
|
1559 |
PROTO_T ( STRING s X STRING t )
|
|
|
1560 |
{
|
|
|
1561 |
string as, at ;
|
|
|
1562 |
unsigned ks, kt ;
|
|
|
1563 |
unsigned long ns, nt ;
|
|
|
1564 |
if ( EQ_str ( s, t ) ) return ( 1 ) ;
|
|
|
1565 |
ks = DEREF_unsigned ( str_simple_kind ( s ) ) ;
|
|
|
1566 |
kt = DEREF_unsigned ( str_simple_kind ( t ) ) ;
|
|
|
1567 |
ns = DEREF_ulong ( str_simple_len ( s ) ) ;
|
|
|
1568 |
nt = DEREF_ulong ( str_simple_len ( t ) ) ;
|
|
|
1569 |
if ( ks == kt && ns == nt ) {
|
|
|
1570 |
as = DEREF_string ( str_simple_text ( s ) ) ;
|
|
|
1571 |
at = DEREF_string ( str_simple_text ( t ) ) ;
|
|
|
1572 |
if ( as == at ) return ( 1 ) ;
|
|
|
1573 |
if ( ks & STRING_MULTI ) ns *= MULTI_WIDTH ;
|
|
|
1574 |
if ( xumemcmp ( as, at, ( gen_size ) ns ) == 0 ) return ( 1 ) ;
|
|
|
1575 |
}
|
|
|
1576 |
return ( 0 ) ;
|
|
|
1577 |
}
|
|
|
1578 |
|
|
|
1579 |
|
|
|
1580 |
/*
|
|
|
1581 |
CONCATENATE TWO STRING LITERALS
|
|
|
1582 |
|
|
|
1583 |
This routine concatenates the string literals s and t.
|
|
|
1584 |
*/
|
|
|
1585 |
|
|
|
1586 |
STRING concat_string_lit
|
|
|
1587 |
PROTO_N ( ( s, t ) )
|
|
|
1588 |
PROTO_T ( STRING s X STRING t )
|
|
|
1589 |
{
|
|
|
1590 |
string c ;
|
|
|
1591 |
STRING res ;
|
|
|
1592 |
STRING prev ;
|
|
|
1593 |
unsigned kc ;
|
|
|
1594 |
gen_size sz ;
|
|
|
1595 |
unsigned long nc ;
|
|
|
1596 |
string a = DEREF_string ( str_simple_text ( s ) ) ;
|
|
|
1597 |
string b = DEREF_string ( str_simple_text ( t ) ) ;
|
|
|
1598 |
unsigned ka = DEREF_unsigned ( str_simple_kind ( s ) ) ;
|
|
|
1599 |
unsigned kb = DEREF_unsigned ( str_simple_kind ( t ) ) ;
|
|
|
1600 |
unsigned long na = DEREF_ulong ( str_simple_len ( s ) ) ;
|
|
|
1601 |
unsigned long nb = DEREF_ulong ( str_simple_len ( t ) ) ;
|
|
|
1602 |
|
|
|
1603 |
/* Form the result literal */
|
|
|
1604 |
if ( na == 0 ) return ( t ) ;
|
|
|
1605 |
if ( nb == 0 ) return ( s ) ;
|
|
|
1606 |
nc = na + nb ;
|
|
|
1607 |
if ( nc < na || nc < nb ) nc = ULONG_MAX ;
|
|
|
1608 |
if ( !check_value ( OPT_VAL_string_length, nc ) ) {
|
|
|
1609 |
nc = option_value ( OPT_VAL_string_length ) ;
|
|
|
1610 |
nb = nc - na ;
|
|
|
1611 |
}
|
|
|
1612 |
kc = ( ka | kb ) ;
|
|
|
1613 |
if ( kc & STRING_MULTI ) {
|
|
|
1614 |
/* Multi-byte strings */
|
|
|
1615 |
unsigned long sa = MULTI_WIDTH * na ;
|
|
|
1616 |
unsigned long sc = MULTI_WIDTH * nc ;
|
|
|
1617 |
sz = ( gen_size ) ( sc + MULTI_WIDTH ) ;
|
|
|
1618 |
c = xustr ( sz ) ;
|
|
|
1619 |
make_multi_string ( c, a, na, ka ) ;
|
|
|
1620 |
make_multi_string ( c + sa, b, nb, kb ) ;
|
|
|
1621 |
add_multi_char ( c + sc, ( unsigned long ) 0, CHAR_OCTAL ) ;
|
|
|
1622 |
} else {
|
|
|
1623 |
/* Simple strings */
|
|
|
1624 |
sz = ( gen_size ) ( nc + 1 ) ;
|
|
|
1625 |
c = xustr ( sz ) ;
|
|
|
1626 |
xumemcpy ( c, a, ( gen_size ) na ) ;
|
|
|
1627 |
xumemcpy ( c + na, b, ( gen_size ) nb ) ;
|
|
|
1628 |
c [ nc ] = 0 ;
|
|
|
1629 |
}
|
|
|
1630 |
MAKE_str_simple ( nc, c, kc, res ) ;
|
|
|
1631 |
prev = share_string_lit ( res ) ;
|
|
|
1632 |
if ( !EQ_str ( prev, res ) ) {
|
|
|
1633 |
/* Share string literals */
|
|
|
1634 |
unsigned long v ;
|
|
|
1635 |
DESTROY_str_simple ( destroy, res, nc, c, kc, v, res ) ;
|
|
|
1636 |
xufree ( c, sz ) ;
|
|
|
1637 |
UNUSED ( res ) ;
|
|
|
1638 |
UNUSED ( nc ) ;
|
|
|
1639 |
UNUSED ( kc ) ;
|
|
|
1640 |
UNUSED ( v ) ;
|
|
|
1641 |
res = prev ;
|
|
|
1642 |
}
|
|
|
1643 |
return ( res ) ;
|
|
|
1644 |
}
|
|
|
1645 |
|
|
|
1646 |
|
|
|
1647 |
/*
|
|
|
1648 |
FIND THE SHARED COPY OF A STRING LITERAL
|
|
|
1649 |
|
|
|
1650 |
This routine is used to implement shared string literals. It returns
|
|
|
1651 |
the canonical copy of s (i.e. the first string equal to s for which
|
|
|
1652 |
the routine was called).
|
|
|
1653 |
*/
|
|
|
1654 |
|
|
|
1655 |
STRING share_string_lit
|
|
|
1656 |
PROTO_N ( ( s ) )
|
|
|
1657 |
PROTO_T ( STRING s )
|
|
|
1658 |
{
|
|
|
1659 |
string a = DEREF_string ( str_simple_text ( s ) ) ;
|
|
|
1660 |
unsigned long h = ( hash ( a ) % HASH_STRING_SIZE ) ;
|
|
|
1661 |
STRING p = string_hash_table [h] ;
|
|
|
1662 |
STRING t = p ;
|
|
|
1663 |
while ( !IS_NULL_str ( t ) ) {
|
|
|
1664 |
if ( eq_string_lit ( t, s ) ) return ( t ) ;
|
|
|
1665 |
t = DEREF_str ( str_next ( t ) ) ;
|
|
|
1666 |
}
|
|
|
1667 |
COPY_str ( str_next ( s ), p ) ;
|
|
|
1668 |
string_hash_table [h] = s ;
|
|
|
1669 |
return ( s ) ;
|
|
|
1670 |
}
|
|
|
1671 |
|
|
|
1672 |
|
|
|
1673 |
/*
|
|
|
1674 |
GET THE NEXT CHARACTER FROM A STRING
|
|
|
1675 |
|
|
|
1676 |
This routine returns the next character from the string s, using
|
|
|
1677 |
the tok field as a counter. The character type is assigned to pc,
|
|
|
1678 |
including CHAR_NONE to indicate the end of the string.
|
|
|
1679 |
*/
|
|
|
1680 |
|
|
|
1681 |
unsigned long get_string_char
|
|
|
1682 |
PROTO_N ( ( s, pc ) )
|
|
|
1683 |
PROTO_T ( STRING s X int *pc )
|
|
|
1684 |
{
|
|
|
1685 |
unsigned long c ;
|
|
|
1686 |
unsigned long i = DEREF_ulong ( str_simple_tok ( s ) ) ;
|
|
|
1687 |
unsigned long n = DEREF_ulong ( str_simple_len ( s ) ) ;
|
|
|
1688 |
if ( i < n ) {
|
|
|
1689 |
string text = DEREF_string ( str_simple_text ( s ) ) ;
|
|
|
1690 |
unsigned kind = DEREF_unsigned ( str_simple_kind ( s ) ) ;
|
|
|
1691 |
if ( kind & STRING_MULTI ) {
|
|
|
1692 |
c = get_multi_char ( text + MULTI_WIDTH * i, pc ) ;
|
|
|
1693 |
} else {
|
|
|
1694 |
c = ( unsigned long ) text [i] ;
|
|
|
1695 |
*pc = CHAR_SIMPLE ;
|
|
|
1696 |
}
|
|
|
1697 |
} else {
|
|
|
1698 |
c = 0 ;
|
|
|
1699 |
*pc = CHAR_NONE ;
|
|
|
1700 |
}
|
|
|
1701 |
COPY_ulong ( str_simple_tok ( s ), i + 1 ) ;
|
|
|
1702 |
return ( c ) ;
|
|
|
1703 |
}
|
|
|
1704 |
|
|
|
1705 |
|
|
|
1706 |
/*
|
|
|
1707 |
FIND A CHARACTER LITERAL
|
|
|
1708 |
|
|
|
1709 |
This routine returns the character value corresponding to the character
|
|
|
1710 |
literal expression e.
|
|
|
1711 |
*/
|
|
|
1712 |
|
|
|
1713 |
int get_char_value
|
|
|
1714 |
PROTO_N ( ( e ) )
|
|
|
1715 |
PROTO_T ( EXP e )
|
|
|
1716 |
{
|
|
|
1717 |
int c = char_illegal ;
|
|
|
1718 |
if ( !IS_NULL_exp ( e ) ) {
|
|
|
1719 |
if ( IS_exp_int_lit ( e ) ) {
|
|
|
1720 |
NAT n = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
|
|
|
1721 |
if ( IS_nat_calc ( n ) ) {
|
|
|
1722 |
e = DEREF_exp ( nat_calc_value ( n ) ) ;
|
|
|
1723 |
}
|
|
|
1724 |
}
|
|
|
1725 |
if ( IS_exp_cast ( e ) ) {
|
|
|
1726 |
e = DEREF_exp ( exp_cast_arg ( e ) ) ;
|
|
|
1727 |
if ( IS_exp_int_lit ( e ) ) {
|
|
|
1728 |
NAT n = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
|
|
|
1729 |
if ( IS_nat_calc ( n ) ) {
|
|
|
1730 |
e = DEREF_exp ( nat_calc_value ( n ) ) ;
|
|
|
1731 |
}
|
|
|
1732 |
}
|
|
|
1733 |
}
|
|
|
1734 |
if ( IS_exp_char_lit ( e ) ) {
|
|
|
1735 |
STRING s = DEREF_str ( exp_char_lit_str ( e ) ) ;
|
|
|
1736 |
unsigned kind = DEREF_unsigned ( str_simple_kind ( s ) ) ;
|
|
|
1737 |
if ( !( kind & STRING_MULTI ) ) {
|
|
|
1738 |
unsigned long len = DEREF_ulong ( str_simple_len ( s ) ) ;
|
|
|
1739 |
if ( len == 1 ) {
|
|
|
1740 |
string t = DEREF_string ( str_simple_text ( s ) ) ;
|
|
|
1741 |
c = ( int ) *t ;
|
|
|
1742 |
}
|
|
|
1743 |
}
|
|
|
1744 |
}
|
|
|
1745 |
}
|
|
|
1746 |
return ( c ) ;
|
|
|
1747 |
}
|
|
|
1748 |
|
|
|
1749 |
|
|
|
1750 |
/*
|
|
|
1751 |
EVALUATE A CHARACTER LITERAL
|
|
|
1752 |
|
|
|
1753 |
This routine evaluates the character literal str by mapping it to
|
|
|
1754 |
its ASCII representation. The value is stored in the tok field
|
|
|
1755 |
(the fact that LINK_NONE equals EXTENDED_MAX is convenient, but not
|
|
|
1756 |
essential).
|
|
|
1757 |
*/
|
|
|
1758 |
|
|
|
1759 |
NAT eval_char_lit
|
|
|
1760 |
PROTO_N ( ( str ) )
|
|
|
1761 |
PROTO_T ( STRING str )
|
|
|
1762 |
{
|
|
|
1763 |
NAT n ;
|
|
|
1764 |
unsigned long v = DEREF_ulong ( str_simple_tok ( str ) ) ;
|
|
|
1765 |
if ( v == LINK_NONE ) {
|
|
|
1766 |
unsigned long i ;
|
|
|
1767 |
string s = DEREF_string ( str_simple_text ( str ) ) ;
|
|
|
1768 |
unsigned long len = DEREF_ulong ( str_simple_len ( str ) ) ;
|
|
|
1769 |
unsigned kind = DEREF_unsigned ( str_simple_kind ( str ) ) ;
|
|
|
1770 |
if ( kind & STRING_MULTI ) {
|
|
|
1771 |
NAT b = make_small_nat ( 256 ) ;
|
|
|
1772 |
n = small_nat [0] ;
|
|
|
1773 |
for ( i = 0 ; i < len ; i++ ) {
|
|
|
1774 |
NAT d ;
|
|
|
1775 |
int ch = CHAR_SIMPLE ;
|
|
|
1776 |
unsigned long c = get_multi_char ( s, &ch ) ;
|
|
|
1777 |
if ( ch == CHAR_SIMPLE ) c = to_ascii ( c, &ch ) ;
|
|
|
1778 |
d = make_nat_value ( c ) ;
|
|
|
1779 |
n = binary_nat_op ( exp_mult_tag, n, b ) ;
|
|
|
1780 |
n = binary_nat_op ( exp_plus_tag, n, d ) ;
|
|
|
1781 |
s += MULTI_WIDTH ;
|
|
|
1782 |
}
|
|
|
1783 |
} else {
|
|
|
1784 |
n = small_nat [0] ;
|
|
|
1785 |
for ( i = 0 ; i < len ; i++ ) {
|
|
|
1786 |
int ch = CHAR_SIMPLE ;
|
|
|
1787 |
unsigned long c = ( unsigned long ) *s ;
|
|
|
1788 |
c = to_ascii ( c, &ch ) ;
|
|
|
1789 |
n = make_nat_literal ( n, ( unsigned ) 256, ( unsigned ) c ) ;
|
|
|
1790 |
s++ ;
|
|
|
1791 |
}
|
|
|
1792 |
}
|
|
|
1793 |
v = get_nat_value ( n ) ;
|
|
|
1794 |
if ( v != EXTENDED_MAX ) {
|
|
|
1795 |
/* Store calculated value */
|
|
|
1796 |
COPY_ulong ( str_simple_tok ( str ), v ) ;
|
|
|
1797 |
}
|
|
|
1798 |
} else {
|
|
|
1799 |
/* Use stored value */
|
|
|
1800 |
n = make_nat_value ( v ) ;
|
|
|
1801 |
}
|
|
|
1802 |
return ( n ) ;
|
|
|
1803 |
}
|
|
|
1804 |
|
|
|
1805 |
|
|
|
1806 |
/*
|
|
|
1807 |
FIND A CHARACTER REPRESENTATION TYPE
|
|
|
1808 |
|
|
|
1809 |
In the case where a character literal type doesn't fit into its type
|
|
|
1810 |
then this routine gives a type in which the literal value can be
|
|
|
1811 |
constructed and then converted into its underlying type.
|
|
|
1812 |
*/
|
|
|
1813 |
|
|
|
1814 |
TYPE find_char_type
|
|
|
1815 |
PROTO_N ( ( n ) )
|
|
|
1816 |
PROTO_T ( NAT n )
|
|
|
1817 |
{
|
|
|
1818 |
TYPE t ;
|
|
|
1819 |
int fit = 0 ;
|
|
|
1820 |
string str = NULL_string ;
|
|
|
1821 |
t = find_literal_type ( n, BASE_OCTAL, SUFFIX_NONE, str, &fit ) ;
|
|
|
1822 |
return ( t ) ;
|
|
|
1823 |
}
|
|
|
1824 |
|
|
|
1825 |
|
|
|
1826 |
/*
|
|
|
1827 |
CREATE A STRING OR CHARACTER LITERAL EXPRESSION
|
|
|
1828 |
|
|
|
1829 |
This routine turns a string or character literal into an expression.
|
|
|
1830 |
Note that the type of a normal character literal varies between C
|
|
|
1831 |
(where it is a char cast to an int) and C++ (where it stays as a
|
|
|
1832 |
char), and also that a string, or wide string, literal is an lvalue
|
|
|
1833 |
of array type.
|
|
|
1834 |
*/
|
|
|
1835 |
|
|
|
1836 |
EXP make_string_exp
|
|
|
1837 |
PROTO_N ( ( s ) )
|
|
|
1838 |
PROTO_T ( STRING s )
|
|
|
1839 |
{
|
|
|
1840 |
EXP e ;
|
|
|
1841 |
string text = DEREF_string ( str_simple_text ( s ) ) ;
|
|
|
1842 |
unsigned long len = DEREF_ulong ( str_simple_len ( s ) ) ;
|
|
|
1843 |
unsigned kind = DEREF_unsigned ( str_simple_kind ( s ) ) ;
|
|
|
1844 |
|
|
|
1845 |
if ( kind & STRING_CHAR ) {
|
|
|
1846 |
int fits = 0 ;
|
|
|
1847 |
int digit = -1 ;
|
|
|
1848 |
TYPE t0, t1, t2 ;
|
|
|
1849 |
NAT n = NULL_nat ;
|
|
|
1850 |
ERROR err = NULL_err ;
|
|
|
1851 |
if ( kind & STRING_WIDE ) {
|
|
|
1852 |
t0 = type_wchar_lit ;
|
|
|
1853 |
t1 = t0 ;
|
|
|
1854 |
t2 = t0 ;
|
|
|
1855 |
} else if ( len <= 1 ) {
|
|
|
1856 |
t0 = type_char ;
|
|
|
1857 |
t1 = t0 ;
|
|
|
1858 |
t2 = type_char_lit ;
|
|
|
1859 |
} else {
|
|
|
1860 |
report ( crt_loc, ERR_lex_ccon_multi ( s ) ) ;
|
|
|
1861 |
t0 = type_mchar_lit ;
|
|
|
1862 |
t1 = t0 ;
|
|
|
1863 |
t2 = t0 ;
|
|
|
1864 |
}
|
|
|
1865 |
if ( len == 0 ) {
|
|
|
1866 |
fits = 1 ;
|
|
|
1867 |
n = small_nat [0] ;
|
|
|
1868 |
COPY_ulong ( str_simple_tok ( s ), 0 ) ;
|
|
|
1869 |
} else if ( len == 1 ) {
|
|
|
1870 |
if ( kind & STRING_MULTI ) {
|
|
|
1871 |
if ( !( kind & STRING_FAT ) ) {
|
|
|
1872 |
/* Simple octal or hex escape sequence */
|
|
|
1873 |
unsigned long v = DEREF_ulong ( str_simple_tok ( s ) ) ;
|
|
|
1874 |
if ( v == LINK_NONE ) {
|
|
|
1875 |
int ch = CHAR_SIMPLE ;
|
|
|
1876 |
v = get_multi_char ( text, &ch ) ;
|
|
|
1877 |
if ( ch == CHAR_OCTAL || ch == CHAR_HEX ) {
|
|
|
1878 |
if ( v < 128 ) fits = 1 ;
|
|
|
1879 |
n = make_nat_value ( v ) ;
|
|
|
1880 |
COPY_ulong ( str_simple_tok ( s ), v ) ;
|
|
|
1881 |
}
|
|
|
1882 |
} else {
|
|
|
1883 |
if ( v < 128 ) fits = 1 ;
|
|
|
1884 |
n = make_nat_value ( v ) ;
|
|
|
1885 |
}
|
|
|
1886 |
}
|
|
|
1887 |
} else {
|
|
|
1888 |
/* Single character */
|
|
|
1889 |
character c = text [0] ;
|
|
|
1890 |
if ( in_hash_if_exp ) {
|
|
|
1891 |
/* Evaluate character value immediately */
|
|
|
1892 |
unsigned long v = DEREF_ulong ( str_simple_tok ( s ) ) ;
|
|
|
1893 |
if ( v == LINK_NONE ) {
|
|
|
1894 |
int ch = CHAR_SIMPLE ;
|
|
|
1895 |
v = ( unsigned long ) c ;
|
|
|
1896 |
v = to_ascii ( v, &ch ) ;
|
|
|
1897 |
COPY_ulong ( str_simple_tok ( s ), v ) ;
|
|
|
1898 |
}
|
|
|
1899 |
if ( v < 128 ) fits = 1 ;
|
|
|
1900 |
n = make_nat_value ( v ) ;
|
|
|
1901 |
} else {
|
|
|
1902 |
if ( c >= char_zero && c <= char_nine ) {
|
|
|
1903 |
/* Allow for digits */
|
|
|
1904 |
digit = ( int ) ( c - char_zero ) ;
|
|
|
1905 |
}
|
|
|
1906 |
}
|
|
|
1907 |
}
|
|
|
1908 |
}
|
|
|
1909 |
if ( IS_NULL_nat ( n ) ) {
|
|
|
1910 |
/* Make character literal expression */
|
|
|
1911 |
MAKE_exp_char_lit ( t0, s, digit, e ) ;
|
|
|
1912 |
MAKE_nat_calc ( e, n ) ;
|
|
|
1913 |
} else {
|
|
|
1914 |
if ( !fits && check_nat_range ( t0, n ) != 0 ) {
|
|
|
1915 |
/* Value doesn't fit into t0 */
|
|
|
1916 |
t0 = find_char_type ( n ) ;
|
|
|
1917 |
}
|
|
|
1918 |
}
|
|
|
1919 |
MAKE_exp_int_lit ( t0, n, exp_char_lit_tag, e ) ;
|
|
|
1920 |
if ( !EQ_type ( t0, t1 ) ) {
|
|
|
1921 |
/* Convert from t0 to t1 */
|
|
|
1922 |
e = make_cast_nat ( t1, e, &err, CAST_STATIC ) ;
|
|
|
1923 |
}
|
|
|
1924 |
if ( !EQ_type ( t1, t2 ) ) {
|
|
|
1925 |
/* Convert from t1 to t2 */
|
|
|
1926 |
e = make_cast_nat ( t2, e, &err, CAST_IMPLICIT ) ;
|
|
|
1927 |
}
|
|
|
1928 |
if ( !IS_NULL_err ( err ) ) report ( crt_loc, err ) ;
|
|
|
1929 |
} else {
|
|
|
1930 |
/* String literals */
|
|
|
1931 |
TYPE t ;
|
|
|
1932 |
NAT n = make_nat_value ( len + 1 ) ;
|
|
|
1933 |
if ( kind & STRING_WIDE ) {
|
|
|
1934 |
t = type_wstring_lit ;
|
|
|
1935 |
} else {
|
|
|
1936 |
t = type_string_lit ;
|
|
|
1937 |
}
|
|
|
1938 |
MAKE_type_array ( cv_lvalue, t, n, t ) ;
|
|
|
1939 |
MAKE_exp_string_lit ( t, s, e ) ;
|
|
|
1940 |
}
|
|
|
1941 |
return ( e ) ;
|
|
|
1942 |
}
|
|
|
1943 |
|
|
|
1944 |
|
|
|
1945 |
/*
|
|
|
1946 |
CREATE A BOOLEAN LITERAL EXPRESSION
|
|
|
1947 |
|
|
|
1948 |
This routine creates a boolean literal expression given by the boolean
|
|
|
1949 |
value b (which should be one of the values BOOL_FALSE and BOOL_TRUE
|
|
|
1950 |
defined in literal.h).
|
|
|
1951 |
*/
|
|
|
1952 |
|
|
|
1953 |
EXP make_bool_exp
|
|
|
1954 |
PROTO_N ( ( b, tag ) )
|
|
|
1955 |
PROTO_T ( unsigned b X unsigned tag )
|
|
|
1956 |
{
|
|
|
1957 |
EXP e ;
|
|
|
1958 |
NAT n = small_nat [b] ;
|
|
|
1959 |
MAKE_exp_int_lit ( type_bool, n, tag, e ) ;
|
|
|
1960 |
return ( e ) ;
|
|
|
1961 |
}
|
|
|
1962 |
|
|
|
1963 |
|
|
|
1964 |
/*
|
|
|
1965 |
TEST A BOOLEAN LITERAL EXPRESSION
|
|
|
1966 |
|
|
|
1967 |
This routine is the reverse of the one above. It returns the boolean
|
|
|
1968 |
value (BOOL_FALSE, BOOL_TRUE or BOOL_UNKNOWN) corresponding to the
|
|
|
1969 |
expression e.
|
|
|
1970 |
*/
|
|
|
1971 |
|
|
|
1972 |
unsigned test_bool_exp
|
|
|
1973 |
PROTO_N ( ( e ) )
|
|
|
1974 |
PROTO_T ( EXP e )
|
|
|
1975 |
{
|
|
|
1976 |
NAT n = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
|
|
|
1977 |
if ( IS_nat_small ( n ) ) {
|
|
|
1978 |
unsigned b = DEREF_unsigned ( nat_small_value ( n ) ) ;
|
|
|
1979 |
if ( b == BOOL_FALSE ) return ( BOOL_FALSE ) ;
|
|
|
1980 |
if ( b == BOOL_TRUE ) return ( BOOL_TRUE ) ;
|
|
|
1981 |
}
|
|
|
1982 |
return ( BOOL_UNKNOWN ) ;
|
|
|
1983 |
}
|