]>
Commit | Line | Data |
---|---|---|
80a093b2 | 1 | /* Lexical analyzer for GNU CHILL. -*- C -*- |
48e1571a RB |
2 | Copyright (C) 1992, 1993, 1994, 1998, 1999, 2000 |
3 | Free Software Foundation, Inc. | |
80a093b2 PB |
4 | |
5 | This file is part of GNU CC. | |
6 | ||
7 | GNU CC is free software; you can redistribute it and/or modify | |
8 | it under the terms of the GNU General Public License as published by | |
9 | the Free Software Foundation; either version 2, or (at your option) | |
10 | any later version. | |
11 | ||
12 | GNU CC is distributed in the hope that it will be useful, | |
13 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | General Public License for more details. | |
16 | ||
17 | You should have received a copy of the GNU General Public License | |
18 | along with GNU CC; see the file COPYING. If not, write to | |
6f48294d JL |
19 | the Free Software Foundation, 59 Temple Place - Suite 330, |
20 | Boston, MA 02111-1307, USA. */ | |
80a093b2 | 21 | \f |
75111422 KG |
22 | #include "config.h" |
23 | #include "system.h" | |
80a093b2 | 24 | #include <setjmp.h> |
80a093b2 PB |
25 | #include <sys/stat.h> |
26 | ||
80a093b2 PB |
27 | #include "tree.h" |
28 | #include "input.h" | |
29 | ||
30 | #include "lex.h" | |
31 | #include "ch-tree.h" | |
32 | #include "flags.h" | |
33 | #include "parse.h" | |
34 | #include "obstack.h" | |
75111422 | 35 | #include "toplev.h" |
7bdb32b9 | 36 | #include "tm_p.h" |
80a093b2 | 37 | |
6fbe9901 KG |
38 | #ifdef DWARF_DEBUGGING_INFO |
39 | #include "dwarfout.h" | |
40 | #endif | |
41 | ||
80a093b2 | 42 | #ifdef MULTIBYTE_CHARS |
80a093b2 PB |
43 | #include <locale.h> |
44 | #endif | |
45 | ||
46 | /* include the keyword recognizers */ | |
47 | #include "hash.h" | |
48 | ||
80a093b2 PB |
49 | FILE* finput; |
50 | ||
75111422 | 51 | #if 0 |
80a093b2 PB |
52 | static int last_token = 0; |
53 | /* Sun's C compiler warns about the safer sequence | |
54 | do { .. } while 0 | |
55 | when there's a 'return' inside the braces, so don't use it */ | |
56 | #define RETURN_TOKEN(X) { last_token = X; return (X); } | |
75111422 | 57 | #endif |
80a093b2 PB |
58 | |
59 | /* This is set non-zero to force incoming tokens to lowercase. */ | |
60 | extern int ignore_case; | |
61 | ||
62 | extern int module_number; | |
63 | extern int serious_errors; | |
64 | ||
65 | /* This is non-zero to recognize only uppercase special words. */ | |
66 | extern int special_UC; | |
67 | ||
68 | extern struct obstack permanent_obstack; | |
69 | extern struct obstack temporary_obstack; | |
70 | ||
80a093b2 | 71 | /* forward declarations */ |
3b0d91ff KG |
72 | static void close_input_file PARAMS ((const char *)); |
73 | static tree convert_bitstring PARAMS ((char *)); | |
74 | static tree convert_integer PARAMS ((char *)); | |
75 | static void maybe_downcase PARAMS ((char *)); | |
76 | static int maybe_number PARAMS ((const char *)); | |
77 | static tree equal_number PARAMS ((void)); | |
78 | static void handle_use_seizefile_directive PARAMS ((int)); | |
79 | static int handle_name PARAMS ((tree)); | |
80 | static char *readstring PARAMS ((int, int *)); | |
81 | static void read_directive PARAMS ((void)); | |
82 | static tree read_identifier PARAMS ((int)); | |
83 | static tree read_number PARAMS ((int)); | |
84 | static void skip_c_comment PARAMS ((void)); | |
85 | static void skip_line_comment PARAMS ((void)); | |
86 | static int skip_whitespace PARAMS ((void)); | |
87 | static tree string_or_char PARAMS ((int, const char *)); | |
88 | static void ch_lex_init PARAMS ((void)); | |
89 | static void skip_directive PARAMS ((void)); | |
90 | static int same_file PARAMS ((const char *, const char *)); | |
91 | static int getlc PARAMS ((FILE *)); | |
80a093b2 PB |
92 | |
93 | /* next variables are public, because ch-actions uses them */ | |
94 | ||
95 | /* the default grantfile name, set by lang_init */ | |
96 | tree default_grant_file = 0; | |
97 | ||
98 | /* These tasking-related variables are NULL at the start of each | |
99 | compiler pass, and are set to an expression tree if and when | |
100 | a compiler directive is parsed containing an expression. | |
101 | The NULL state is significant; it means 'no user-specified | |
102 | signal_code (or whatever) has been parsed'. */ | |
103 | ||
104 | /* process type, set by <> PROCESS_TYPE = number <> */ | |
105 | tree process_type = NULL_TREE; | |
106 | ||
107 | /* send buffer default priority, | |
108 | set by <> SEND_BUFFER_DEFAULT_PRIORITY = number <> */ | |
109 | tree send_buffer_prio = NULL_TREE; | |
110 | ||
111 | /* send signal default priority, | |
112 | set by <> SEND_SIGNAL_DEFAULT_PRIORITY = number <> */ | |
113 | tree send_signal_prio = NULL_TREE; | |
114 | ||
115 | /* signal code, set by <> SIGNAL_CODE = number <> */ | |
116 | tree signal_code = NULL_TREE; | |
117 | ||
118 | /* flag for range checking */ | |
119 | int range_checking = 1; | |
120 | ||
121 | /* flag for NULL pointer checking */ | |
122 | int empty_checking = 1; | |
123 | ||
124 | /* flag to indicate making all procedure local variables | |
125 | to be STATIC */ | |
126 | int all_static_flag = 0; | |
127 | ||
128 | /* flag to indicate -fruntime-checking command line option. | |
129 | Needed for initializing range_checking and empty_checking | |
130 | before pass 2 */ | |
131 | int runtime_checking_flag = 1; | |
132 | ||
133 | /* The elements of `ridpointers' are identifier nodes | |
134 | for the reserved type names and storage classes. | |
135 | It is indexed by a RID_... value. */ | |
136 | tree ridpointers[(int) RID_MAX]; | |
137 | ||
138 | /* Nonzero tells yylex to ignore \ in string constants. */ | |
139 | static int ignore_escape_flag = 0; | |
140 | ||
141 | static int maxtoken; /* Current nominal length of token buffer. */ | |
142 | char *token_buffer; /* Pointer to token buffer. | |
143 | Actual allocated length is maxtoken + 2. | |
144 | This is not static because objc-parse.y uses it. */ | |
145 | ||
146 | /* implement yylineno handling for flex */ | |
147 | #define yylineno lineno | |
148 | ||
149 | static int inside_c_comment = 0; | |
150 | ||
151 | static int saw_eol = 0; /* 1 if we've just seen a '\n' */ | |
152 | static int saw_eof = 0; /* 1 if we've just seen an EOF */ | |
153 | ||
154 | typedef struct string_list | |
155 | { | |
156 | struct string_list *next; | |
157 | char *str; | |
158 | } STRING_LIST; | |
159 | ||
160 | /* list of paths specified on the compiler command line by -L options. */ | |
161 | static STRING_LIST *seize_path_list = (STRING_LIST *)0; | |
162 | ||
163 | /* List of seize file names. Each TREE_VALUE is an identifier | |
164 | (file name) from a <>USE_SEIZE_FILE<> directive. | |
165 | The TREE_PURPOSE is non-NULL if a USE_SEIZE_FILE directive has been | |
166 | written to the grant file. */ | |
167 | static tree files_to_seize = NULL_TREE; | |
168 | /* Last node on files_to_seize list. */ | |
169 | static tree last_file_to_seize = NULL_TREE; | |
170 | /* Pointer into files_to_seize list: Next unparsed file to read. */ | |
171 | static tree next_file_to_seize = NULL_TREE; | |
172 | ||
173 | /* The most recent use_seize_file directive. */ | |
174 | tree use_seizefile_name = NULL_TREE; | |
175 | ||
176 | /* If non-NULL, the name of the seizefile we're currently processing. */ | |
177 | tree current_seizefile_name = NULL_TREE; | |
178 | \f | |
179 | /* called to reset for pass 2 */ | |
180 | static void | |
181 | ch_lex_init () | |
182 | { | |
183 | current_seizefile_name = NULL_TREE; | |
184 | ||
185 | lineno = 0; | |
186 | ||
187 | saw_eol = 0; | |
188 | saw_eof = 0; | |
189 | /* Initialize these compiler-directive variables. */ | |
190 | process_type = NULL_TREE; | |
191 | send_buffer_prio = NULL_TREE; | |
192 | send_signal_prio = NULL_TREE; | |
193 | signal_code = NULL_TREE; | |
194 | all_static_flag = 0; | |
195 | /* reinitialize rnage checking and empty checking */ | |
196 | range_checking = runtime_checking_flag; | |
197 | empty_checking = runtime_checking_flag; | |
198 | } | |
199 | ||
200 | ||
3b304f5b | 201 | const char * |
80a093b2 | 202 | init_parse (filename) |
3b304f5b | 203 | const char *filename; |
80a093b2 PB |
204 | { |
205 | int lowercase_standard_names = ignore_case || ! special_UC; | |
206 | ||
207 | /* Open input file. */ | |
208 | if (filename == 0 || !strcmp (filename, "-")) | |
209 | { | |
210 | finput = stdin; | |
211 | filename = "stdin"; | |
212 | } | |
213 | else | |
214 | finput = fopen (filename, "r"); | |
215 | if (finput == 0) | |
216 | pfatal_with_name (filename); | |
217 | ||
218 | #ifdef IO_BUFFER_SIZE | |
219 | setvbuf (finput, (char *) xmalloc (IO_BUFFER_SIZE), _IOFBF, IO_BUFFER_SIZE); | |
220 | #endif | |
221 | ||
222 | /* Make identifier nodes long enough for the language-specific slots. */ | |
223 | set_identifier_size (sizeof (struct lang_identifier)); | |
224 | ||
225 | /* Start it at 0, because check_newline is called at the very beginning | |
226 | and will increment it to 1. */ | |
227 | lineno = 0; | |
228 | ||
229 | /* Initialize these compiler-directive variables. */ | |
230 | process_type = NULL_TREE; | |
231 | send_buffer_prio = NULL_TREE; | |
232 | send_signal_prio = NULL_TREE; | |
233 | signal_code = NULL_TREE; | |
234 | ||
235 | maxtoken = 40; | |
236 | token_buffer = xmalloc ((unsigned)(maxtoken + 2)); | |
237 | ||
238 | init_chill_expand (); | |
239 | ||
240 | #define ENTER_STANDARD_NAME(RID, LOWER, UPPER) \ | |
241 | ridpointers[(int) RID] = \ | |
242 | get_identifier (lowercase_standard_names ? LOWER : UPPER) | |
243 | ||
244 | ENTER_STANDARD_NAME (RID_ALL, "all", "ALL"); | |
245 | ENTER_STANDARD_NAME (RID_ASSERTFAIL, "assertfail", "ASSERTFAIL"); | |
246 | ENTER_STANDARD_NAME (RID_ASSOCIATION, "association", "ASSOCIATION"); | |
247 | ENTER_STANDARD_NAME (RID_BIN, "bin", "BIN"); | |
248 | ENTER_STANDARD_NAME (RID_BOOL, "bool", "BOOL"); | |
249 | ENTER_STANDARD_NAME (RID_BOOLS, "bools", "BOOLS"); | |
250 | ENTER_STANDARD_NAME (RID_BYTE, "byte", "BYTE"); | |
251 | ENTER_STANDARD_NAME (RID_CHAR, "char", "CHAR"); | |
252 | ENTER_STANDARD_NAME (RID_DOUBLE, "double", "DOUBLE"); | |
253 | ENTER_STANDARD_NAME (RID_DURATION, "duration", "DURATION"); | |
254 | ENTER_STANDARD_NAME (RID_DYNAMIC, "dynamic", "DYNAMIC"); | |
255 | ENTER_STANDARD_NAME (RID_ELSE, "else", "ELSE"); | |
256 | ENTER_STANDARD_NAME (RID_EMPTY, "empty", "EMPTY"); | |
257 | ENTER_STANDARD_NAME (RID_FALSE, "false", "FALSE"); | |
258 | ENTER_STANDARD_NAME (RID_FLOAT, "float", "FLOAT"); | |
259 | ENTER_STANDARD_NAME (RID_GENERAL, "general", "GENERAL"); | |
260 | ENTER_STANDARD_NAME (RID_IN, "in", "IN"); | |
261 | ENTER_STANDARD_NAME (RID_INLINE, "inline", "INLINE"); | |
262 | ENTER_STANDARD_NAME (RID_INOUT, "inout", "INOUT"); | |
263 | ENTER_STANDARD_NAME (RID_INSTANCE, "instance", "INSTANCE"); | |
264 | ENTER_STANDARD_NAME (RID_INT, "int", "INT"); | |
265 | ENTER_STANDARD_NAME (RID_LOC, "loc", "LOC"); | |
266 | ENTER_STANDARD_NAME (RID_LONG, "long", "LONG"); | |
267 | ENTER_STANDARD_NAME (RID_LONG_REAL, "long_real", "LONG_REAL"); | |
268 | ENTER_STANDARD_NAME (RID_NULL, "null", "NULL"); | |
269 | ENTER_STANDARD_NAME (RID_OUT, "out", "OUT"); | |
270 | ENTER_STANDARD_NAME (RID_OVERFLOW, "overflow", "OVERFLOW"); | |
271 | ENTER_STANDARD_NAME (RID_PTR, "ptr", "PTR"); | |
272 | ENTER_STANDARD_NAME (RID_READ, "read", "READ"); | |
273 | ENTER_STANDARD_NAME (RID_REAL, "real", "REAL"); | |
274 | ENTER_STANDARD_NAME (RID_RANGE, "range", "RANGE"); | |
275 | ENTER_STANDARD_NAME (RID_RANGEFAIL, "rangefail", "RANGEFAIL"); | |
276 | ENTER_STANDARD_NAME (RID_RECURSIVE, "recursive", "RECURSIVE"); | |
277 | ENTER_STANDARD_NAME (RID_SHORT, "short", "SHORT"); | |
278 | ENTER_STANDARD_NAME (RID_SIMPLE, "simple", "SIMPLE"); | |
279 | ENTER_STANDARD_NAME (RID_TIME, "time", "TIME"); | |
280 | ENTER_STANDARD_NAME (RID_TRUE, "true", "TRUE"); | |
281 | ENTER_STANDARD_NAME (RID_UBYTE, "ubyte", "UBYTE"); | |
282 | ENTER_STANDARD_NAME (RID_UINT, "uint", "UINT"); | |
283 | ENTER_STANDARD_NAME (RID_ULONG, "ulong", "ULONG"); | |
284 | ENTER_STANDARD_NAME (RID_UNSIGNED, "unsigned", "UNSIGNED"); | |
285 | ENTER_STANDARD_NAME (RID_USHORT, "ushort", "USHORT"); | |
286 | ENTER_STANDARD_NAME (RID_VOID, "void", "VOID"); | |
287 | ||
288 | return filename; | |
289 | } | |
290 | ||
291 | void | |
292 | finish_parse () | |
293 | { | |
294 | if (finput != NULL) | |
295 | fclose (finput); | |
296 | } | |
297 | \f | |
3b0d91ff KG |
298 | static int yywrap PARAMS ((void)); |
299 | static int yy_refill PARAMS ((void)); | |
80a093b2 PB |
300 | |
301 | #define YY_PUTBACK_SIZE 5 | |
302 | #define YY_BUF_SIZE 1000 | |
303 | ||
304 | static char yy_buffer[YY_PUTBACK_SIZE + YY_BUF_SIZE]; | |
305 | static char *yy_cur = yy_buffer + YY_PUTBACK_SIZE; | |
306 | static char *yy_lim = yy_buffer + YY_PUTBACK_SIZE; | |
307 | ||
31029ad7 KG |
308 | static int |
309 | yy_refill () | |
80a093b2 PB |
310 | { |
311 | char *buf = yy_buffer + YY_PUTBACK_SIZE; | |
312 | int c, result; | |
313 | bcopy (yy_cur - YY_PUTBACK_SIZE, yy_buffer, YY_PUTBACK_SIZE); | |
314 | yy_cur = buf; | |
315 | ||
316 | retry: | |
317 | if (saw_eof) | |
318 | { | |
319 | if (yywrap ()) | |
320 | return EOF; | |
321 | saw_eof = 0; | |
322 | goto retry; | |
323 | } | |
324 | ||
325 | result = 0; | |
326 | while (saw_eol) | |
327 | { | |
328 | c = check_newline (); | |
329 | if (c == EOF) | |
330 | { | |
331 | saw_eof = 1; | |
332 | goto retry; | |
333 | } | |
334 | else if (c != '\n') | |
335 | { | |
336 | saw_eol = 0; | |
337 | buf[result++] = c; | |
338 | } | |
339 | } | |
340 | ||
341 | while (result < YY_BUF_SIZE) | |
342 | { | |
343 | c = getc(finput); | |
344 | if (c == EOF) | |
345 | { | |
346 | saw_eof = 1; | |
347 | break; | |
348 | } | |
349 | buf[result++] = c; | |
350 | ||
351 | /* Because we might switch input files on a compiler directive | |
352 | (that end with '>', don't read past a '>', just in case. */ | |
353 | if (c == '>') | |
354 | break; | |
355 | ||
356 | if (c == '\n') | |
357 | { | |
358 | #ifdef YYDEBUG | |
359 | extern int yydebug; | |
360 | if (yydebug) | |
361 | fprintf (stderr, "-------------------------- finished Line %d\n", | |
362 | yylineno); | |
363 | #endif | |
364 | saw_eol = 1; | |
365 | break; | |
366 | } | |
367 | } | |
368 | ||
369 | yy_lim = yy_cur + result; | |
370 | ||
371 | return yy_lim > yy_cur ? *yy_cur++ : EOF; | |
372 | } | |
373 | ||
374 | #define input() (yy_cur < yy_lim ? *yy_cur++ : yy_refill ()) | |
375 | ||
376 | #define unput(c) (*--yy_cur = (c)) | |
377 | \f | |
378 | ||
379 | int starting_pass_2 = 0; | |
380 | ||
381 | int | |
382 | yylex () | |
383 | { | |
384 | int nextc; | |
385 | int len; | |
386 | char* tmp; | |
387 | int base; | |
388 | int ch; | |
389 | retry: | |
390 | ch = input (); | |
391 | if (starting_pass_2) | |
392 | { | |
393 | starting_pass_2 = 0; | |
394 | unput (ch); | |
395 | return END_PASS_1; | |
396 | } | |
397 | switch (ch) | |
398 | { | |
399 | case ' ': case '\t': case '\n': case '\f': case '\b': case '\v': case '\r': | |
400 | goto retry; | |
401 | case '[': | |
402 | return LPC; | |
403 | case ']': | |
404 | return RPC; | |
405 | case '{': | |
406 | return LC; | |
407 | case '}': | |
408 | return RC; | |
409 | case '(': | |
410 | nextc = input (); | |
411 | if (nextc == ':') | |
412 | return LPC; | |
413 | unput (nextc); | |
414 | return LPRN; | |
415 | case ')': | |
416 | return RPRN; | |
417 | case ':': | |
418 | nextc = input (); | |
419 | if (nextc == ')') | |
420 | return RPC; | |
421 | else if (nextc == '=') | |
422 | return ASGN; | |
423 | unput (nextc); | |
424 | return COLON; | |
425 | case ',': | |
426 | return COMMA; | |
427 | case ';': | |
428 | return SC; | |
429 | case '+': | |
430 | return PLUS; | |
431 | case '-': | |
432 | nextc = input (); | |
433 | if (nextc == '>') | |
434 | return ARROW; | |
435 | if (nextc == '-') | |
436 | { | |
437 | skip_line_comment (); | |
438 | goto retry; | |
439 | } | |
440 | unput (nextc); | |
441 | return SUB; | |
442 | case '*': | |
443 | return MUL; | |
444 | case '=': | |
445 | return EQL; | |
446 | case '/': | |
447 | nextc = input (); | |
448 | if (nextc == '/') | |
449 | return CONCAT; | |
450 | else if (nextc == '=') | |
451 | return NE; | |
452 | else if (nextc == '*') | |
453 | { | |
454 | skip_c_comment (); | |
455 | goto retry; | |
456 | } | |
457 | unput (nextc); | |
458 | return DIV; | |
459 | case '<': | |
460 | nextc = input (); | |
461 | if (nextc == '=') | |
462 | return LTE; | |
463 | if (nextc == '>') | |
464 | { | |
465 | read_directive (); | |
466 | goto retry; | |
467 | } | |
468 | unput (nextc); | |
469 | return LT; | |
470 | case '>': | |
471 | nextc = input (); | |
472 | if (nextc == '=') | |
473 | return GTE; | |
474 | unput (nextc); | |
475 | return GT; | |
476 | ||
477 | case 'D': case 'd': | |
478 | base = 10; | |
479 | goto maybe_digits; | |
480 | case 'B': case 'b': | |
481 | base = 2; | |
482 | goto maybe_digits; | |
483 | case 'H': case 'h': | |
484 | base = 16; | |
485 | goto maybe_digits; | |
486 | case 'O': case 'o': | |
487 | base = 8; | |
488 | goto maybe_digits; | |
489 | case 'C': case 'c': | |
490 | nextc = input (); | |
491 | if (nextc == '\'') | |
492 | { | |
493 | int byte_val = 0; | |
494 | char *start; | |
495 | int len = 0; /* Number of hex digits seen. */ | |
496 | for (;;) | |
497 | { | |
498 | ch = input (); | |
499 | if (ch == '\'') | |
500 | break; | |
501 | if (ch == '_') | |
502 | continue; | |
75111422 | 503 | if (!ISXDIGIT (ch)) /* error on non-hex digit */ |
80a093b2 PB |
504 | { |
505 | if (pass == 1) | |
506 | error ("invalid C'xx' "); | |
507 | break; | |
508 | } | |
509 | if (ch >= 'a') | |
510 | ch -= ' '; | |
511 | ch -= '0'; | |
512 | if (ch > 9) | |
513 | ch -= 7; | |
514 | byte_val *= 16; | |
515 | byte_val += (int)ch; | |
516 | ||
517 | if (len & 1) /* collected two digits, save byte */ | |
518 | obstack_1grow (&temporary_obstack, (char) byte_val); | |
519 | len++; | |
520 | } | |
521 | start = obstack_finish (&temporary_obstack); | |
522 | yylval.ttype = string_or_char (len >> 1, start); | |
523 | obstack_free (&temporary_obstack, start); | |
524 | return len == 2 ? SINGLECHAR : STRING; | |
525 | } | |
526 | unput (nextc); | |
527 | goto letter; | |
528 | ||
529 | maybe_digits: | |
530 | nextc = input (); | |
531 | if (nextc == '\'') | |
532 | { | |
533 | char *start; | |
534 | obstack_1grow (&temporary_obstack, ch); | |
535 | obstack_1grow (&temporary_obstack, nextc); | |
536 | for (;;) | |
537 | { | |
538 | ch = input (); | |
75111422 | 539 | if (ISALNUM (ch)) |
80a093b2 PB |
540 | obstack_1grow (&temporary_obstack, ch); |
541 | else if (ch != '_') | |
542 | break; | |
543 | } | |
544 | obstack_1grow (&temporary_obstack, '\0'); | |
545 | start = obstack_finish (&temporary_obstack); | |
546 | if (ch != '\'') | |
547 | { | |
548 | unput (ch); | |
549 | yylval.ttype = convert_integer (start); /* Pass base? */ | |
550 | return NUMBER; | |
551 | } | |
552 | else | |
553 | { | |
554 | yylval.ttype = convert_bitstring (start); | |
555 | return BITSTRING; | |
556 | } | |
557 | } | |
558 | unput (nextc); | |
559 | goto letter; | |
560 | ||
561 | case 'A': case 'E': | |
562 | case 'F': case 'G': case 'I': case 'J': | |
563 | case 'K': case 'L': case 'M': case 'N': | |
564 | case 'P': case 'Q': case 'R': case 'S': case 'T': | |
565 | case 'U': case 'V': case 'W': case 'X': case 'Y': | |
566 | case 'Z': | |
567 | case 'a': case 'e': | |
568 | case 'f': case 'g': case 'i': case 'j': | |
569 | case 'k': case 'l': case 'm': case 'n': | |
570 | case 'p': case 'q': case 'r': case 's': case 't': | |
571 | case 'u': case 'v': case 'w': case 'x': case 'y': | |
572 | case 'z': | |
573 | case '_': | |
574 | letter: | |
575 | return handle_name (read_identifier (ch)); | |
576 | case '\'': | |
577 | tmp = readstring ('\'', &len); | |
578 | yylval.ttype = string_or_char (len, tmp); | |
579 | free (tmp); | |
580 | return len == 1 ? SINGLECHAR : STRING; | |
581 | case '\"': | |
582 | tmp = readstring ('\"', &len); | |
583 | yylval.ttype = build_chill_string (len, tmp); | |
584 | free (tmp); | |
585 | return STRING; | |
586 | case '.': | |
587 | nextc = input (); | |
588 | unput (nextc); | |
75111422 | 589 | if (ISDIGIT (nextc)) /* || nextc == '_') we don't start numbers with '_' */ |
80a093b2 PB |
590 | goto number; |
591 | return DOT; | |
592 | case '0': case '1': case '2': case '3': case '4': | |
593 | case '5': case '6': case '7': case '8': case '9': | |
594 | number: | |
595 | yylval.ttype = read_number (ch); | |
596 | return TREE_CODE (yylval.ttype) == REAL_CST ? FLOATING : NUMBER; | |
597 | default: | |
598 | return ch; | |
599 | } | |
600 | } | |
601 | ||
602 | static void | |
603 | close_input_file (fn) | |
31029ad7 | 604 | const char *fn; |
80a093b2 PB |
605 | { |
606 | if (finput == NULL) | |
607 | abort (); | |
608 | ||
609 | if (finput != stdin && fclose (finput) == EOF) | |
610 | { | |
611 | error ("can't close %s", fn); | |
612 | abort (); | |
613 | } | |
614 | finput = NULL; | |
615 | } | |
616 | ||
617 | /* Return an identifier, starting with FIRST and then reading | |
618 | more characters using input(). Return an IDENTIFIER_NODE. */ | |
619 | ||
620 | static tree | |
621 | read_identifier (first) | |
622 | int first; /* First letter of identifier */ | |
623 | { | |
624 | tree id; | |
625 | char *start; | |
626 | for (;;) | |
627 | { | |
628 | obstack_1grow (&temporary_obstack, first); | |
629 | first = input (); | |
630 | if (first == EOF) | |
631 | break; | |
75111422 | 632 | if (! ISALNUM (first) && first != '_') |
80a093b2 PB |
633 | { |
634 | unput (first); | |
635 | break; | |
636 | } | |
637 | } | |
638 | obstack_1grow (&temporary_obstack, '\0'); | |
639 | start = obstack_finish (&temporary_obstack); | |
640 | maybe_downcase (start); | |
641 | id = get_identifier (start); | |
642 | obstack_free (&temporary_obstack, start); | |
643 | return id; | |
644 | } | |
645 | ||
646 | /* Given an identifier ID, check to see if it is a reserved name, | |
647 | and return the appropriate token type. */ | |
648 | ||
649 | static int | |
650 | handle_name (id) | |
651 | tree id; | |
652 | { | |
653 | struct resword *tp; | |
654 | tp = in_word_set (IDENTIFIER_POINTER (id), IDENTIFIER_LENGTH (id)); | |
655 | if (tp != NULL | |
75111422 | 656 | && special_UC == ISUPPER ((unsigned char) tp->name[0]) |
80a093b2 PB |
657 | && (tp->flags == RESERVED || tp->flags == PREDEF)) |
658 | { | |
659 | if (tp->rid != NORID) | |
660 | yylval.ttype = ridpointers[tp->rid]; | |
661 | else if (tp->token == THIS) | |
662 | yylval.ttype = lookup_name (get_identifier ("__whoami")); | |
663 | return tp->token; | |
664 | } | |
665 | yylval.ttype = id; | |
666 | return NAME; | |
667 | } | |
668 | ||
669 | static tree | |
670 | read_number (ch) | |
671 | int ch; /* Initial character */ | |
672 | { | |
673 | tree num; | |
674 | char *start; | |
675 | int is_float = 0; | |
676 | for (;;) | |
677 | { | |
678 | if (ch != '_') | |
679 | obstack_1grow (&temporary_obstack, ch); | |
680 | ch = input (); | |
75111422 | 681 | if (! ISDIGIT (ch) && ch != '_') |
80a093b2 PB |
682 | break; |
683 | } | |
684 | if (ch == '.') | |
685 | { | |
686 | do | |
687 | { | |
688 | if (ch != '_') | |
689 | obstack_1grow (&temporary_obstack, ch); | |
690 | ch = input (); | |
75111422 | 691 | } while (ISDIGIT (ch) || ch == '_'); |
80a093b2 PB |
692 | is_float++; |
693 | } | |
694 | if (ch == 'd' || ch == 'D' || ch == 'e' || ch == 'E') | |
695 | { | |
696 | /* Convert exponent indication [eEdD] to 'e'. */ | |
697 | obstack_1grow (&temporary_obstack, 'e'); | |
698 | ch = input (); | |
699 | if (ch == '+' || ch == '-') | |
700 | { | |
701 | obstack_1grow (&temporary_obstack, ch); | |
702 | ch = input (); | |
703 | } | |
75111422 | 704 | if (ISDIGIT (ch) || ch == '_') |
80a093b2 PB |
705 | { |
706 | do | |
707 | { | |
708 | if (ch != '_') | |
709 | obstack_1grow (&temporary_obstack, ch); | |
710 | ch = input (); | |
75111422 | 711 | } while (ISDIGIT (ch) || ch == '_'); |
80a093b2 PB |
712 | } |
713 | else | |
714 | { | |
715 | error ("malformed exponent part of floating-point literal"); | |
716 | } | |
717 | is_float++; | |
718 | } | |
719 | if (ch != EOF) | |
720 | unput (ch); | |
721 | obstack_1grow (&temporary_obstack, '\0'); | |
722 | start = obstack_finish (&temporary_obstack); | |
723 | if (is_float) | |
724 | { | |
725 | REAL_VALUE_TYPE value; | |
726 | tree type = double_type_node; | |
727 | errno = 0; | |
728 | value = REAL_VALUE_ATOF (start, TYPE_MODE (type)); | |
729 | obstack_free (&temporary_obstack, start); | |
730 | if (TARGET_FLOAT_FORMAT != IEEE_FLOAT_FORMAT | |
731 | && REAL_VALUE_ISINF (value) && pedantic) | |
732 | pedwarn ("real number exceeds range of REAL"); | |
733 | num = build_real (type, value); | |
734 | } | |
735 | else | |
736 | num = convert_integer (start); | |
737 | CH_DERIVED_FLAG (num) = 1; | |
738 | return num; | |
739 | } | |
740 | ||
741 | /* Skip to the end of a compiler directive. */ | |
742 | ||
743 | static void | |
744 | skip_directive () | |
745 | { | |
746 | int ch = input (); | |
747 | for (;;) | |
748 | { | |
749 | if (ch == EOF) | |
750 | { | |
751 | error ("end-of-file in '<>' directive"); | |
752 | break; | |
753 | } | |
754 | if (ch == '\n') | |
755 | break; | |
756 | if (ch == '<') | |
757 | { | |
758 | ch = input (); | |
759 | if (ch == '>') | |
760 | break; | |
761 | } | |
762 | ch = input (); | |
763 | } | |
764 | starting_pass_2 = 0; | |
765 | } | |
766 | ||
767 | /* Read a compiler directive. ("<>{WS}" have already been read. ) */ | |
768 | static void | |
769 | read_directive () | |
770 | { | |
771 | struct resword *tp; | |
772 | tree id; | |
773 | int ch = skip_whitespace(); | |
75111422 | 774 | if (ISALPHA (ch) || ch == '_') |
80a093b2 PB |
775 | id = read_identifier (ch); |
776 | else if (ch == EOF) | |
777 | { | |
778 | error ("end-of-file in '<>' directive"); | |
779 | to_global_binding_level (); | |
780 | return; | |
781 | } | |
782 | else | |
783 | { | |
784 | warning ("unrecognized compiler directive"); | |
785 | skip_directive (); | |
786 | return; | |
787 | } | |
788 | tp = in_word_set (IDENTIFIER_POINTER (id), IDENTIFIER_LENGTH (id)); | |
75111422 | 789 | if (tp == NULL || special_UC != ISUPPER ((unsigned char) tp->name[0])) |
80a093b2 PB |
790 | { |
791 | if (pass == 1) | |
792 | warning ("unrecognized compiler directive `%s'", | |
793 | IDENTIFIER_POINTER (id)); | |
794 | } | |
795 | else | |
796 | switch (tp->token) | |
797 | { | |
798 | case ALL_STATIC_OFF: | |
799 | all_static_flag = 0; | |
800 | break; | |
801 | case ALL_STATIC_ON: | |
802 | all_static_flag = 1; | |
803 | break; | |
804 | case EMPTY_OFF: | |
805 | empty_checking = 0; | |
806 | break; | |
807 | case EMPTY_ON: | |
808 | empty_checking = 1; | |
809 | break; | |
810 | case IGNORED_DIRECTIVE: | |
811 | break; | |
812 | case PROCESS_TYPE_TOKEN: | |
813 | process_type = equal_number (); | |
814 | break; | |
815 | case RANGE_OFF: | |
816 | range_checking = 0; | |
817 | break; | |
818 | case RANGE_ON: | |
819 | range_checking = 1; | |
820 | break; | |
821 | case SEND_SIGNAL_DEFAULT_PRIORITY: | |
822 | send_signal_prio = equal_number (); | |
823 | break; | |
824 | case SEND_BUFFER_DEFAULT_PRIORITY: | |
825 | send_buffer_prio = equal_number (); | |
826 | break; | |
827 | case SIGNAL_CODE: | |
828 | signal_code = equal_number (); | |
829 | break; | |
830 | case USE_SEIZE_FILE: | |
831 | handle_use_seizefile_directive (0); | |
832 | break; | |
833 | case USE_SEIZE_FILE_RESTRICTED: | |
834 | handle_use_seizefile_directive (1); | |
835 | break; | |
836 | default: | |
837 | if (pass == 1) | |
838 | warning ("unrecognized compiler directive `%s'", | |
839 | IDENTIFIER_POINTER (id)); | |
840 | break; | |
841 | } | |
842 | skip_directive (); | |
843 | } | |
844 | ||
845 | \f | |
846 | tree | |
847 | build_chill_string (len, str) | |
848 | int len; | |
31029ad7 | 849 | const char *str; |
80a093b2 PB |
850 | { |
851 | tree t; | |
852 | ||
853 | push_obstacks (&permanent_obstack, &permanent_obstack); | |
854 | t = build_string (len, str); | |
855 | TREE_TYPE (t) = build_string_type (char_type_node, | |
856 | build_int_2 (len, 0)); | |
857 | CH_DERIVED_FLAG (t) = 1; | |
858 | pop_obstacks (); | |
859 | return t; | |
860 | } | |
861 | ||
862 | ||
863 | static tree | |
864 | string_or_char (len, str) | |
865 | int len; | |
31029ad7 | 866 | const char *str; |
80a093b2 PB |
867 | { |
868 | tree result; | |
869 | ||
870 | push_obstacks (&permanent_obstack, &permanent_obstack); | |
871 | if (len == 1) | |
872 | { | |
873 | result = build_int_2 ((unsigned char)str[0], 0); | |
874 | CH_DERIVED_FLAG (result) = 1; | |
875 | TREE_TYPE (result) = char_type_node; | |
876 | } | |
877 | else | |
878 | result = build_chill_string (len, str); | |
879 | pop_obstacks (); | |
880 | return result; | |
881 | } | |
882 | ||
883 | ||
884 | static void | |
885 | maybe_downcase (str) | |
886 | char *str; | |
887 | { | |
888 | if (! ignore_case) | |
889 | return; | |
890 | while (*str) | |
891 | { | |
f6bbde28 | 892 | *str = TOLOWER (*str); |
80a093b2 PB |
893 | str++; |
894 | } | |
895 | } | |
896 | ||
897 | ||
898 | static int | |
899 | maybe_number (s) | |
31029ad7 | 900 | const char *s; |
80a093b2 PB |
901 | { |
902 | char fc; | |
903 | ||
904 | /* check for decimal number */ | |
905 | if (*s >= '0' && *s <= '9') | |
906 | { | |
907 | while (*s) | |
908 | { | |
909 | if (*s >= '0' && *s <= '9') | |
910 | s++; | |
911 | else | |
912 | return 0; | |
913 | } | |
914 | return 1; | |
915 | } | |
916 | ||
917 | fc = *s; | |
918 | if (s[1] != '\'') | |
919 | return 0; | |
920 | s += 2; | |
921 | while (*s) | |
922 | { | |
923 | switch (fc) | |
924 | { | |
925 | case 'd': | |
926 | case 'D': | |
927 | if (*s < '0' || *s > '9') | |
928 | return 0; | |
929 | break; | |
930 | case 'h': | |
931 | case 'H': | |
75111422 | 932 | if (!ISXDIGIT ((unsigned char) *s)) |
80a093b2 PB |
933 | return 0; |
934 | break; | |
935 | case 'b': | |
936 | case 'B': | |
937 | if (*s < '0' || *s > '1') | |
938 | return 0; | |
939 | break; | |
940 | case 'o': | |
941 | case 'O': | |
942 | if (*s < '0' || *s > '7') | |
943 | return 0; | |
944 | break; | |
945 | default: | |
946 | return 0; | |
947 | } | |
948 | s++; | |
949 | } | |
950 | return 1; | |
951 | } | |
80a093b2 PB |
952 | \f |
953 | static char * | |
954 | readstring (terminator, len) | |
955 | char terminator; | |
956 | int *len; | |
957 | { | |
958 | int c; | |
959 | unsigned allocated = 1024; | |
960 | char *tmp = xmalloc (allocated); | |
75111422 | 961 | unsigned i = 0; |
80a093b2 PB |
962 | |
963 | for (;;) | |
964 | { | |
965 | c = input (); | |
966 | if (c == terminator) | |
967 | { | |
968 | if ((c = input ()) != terminator) | |
969 | { | |
970 | unput (c); | |
971 | break; | |
972 | } | |
973 | else | |
974 | c = terminator; | |
975 | } | |
976 | if (c == '\n' || c == EOF) | |
977 | goto unterminated; | |
978 | if (c == '^') | |
979 | { | |
980 | c = input(); | |
981 | if (c == EOF || c == '\n') | |
982 | goto unterminated; | |
983 | if (c == '^') | |
984 | goto storeit; | |
985 | if (c == '(') | |
986 | { | |
987 | int cc, count = 0; | |
988 | int base = 10; | |
989 | int next_apos = 0; | |
990 | int check_base = 1; | |
991 | c = 0; | |
992 | while (1) | |
993 | { | |
994 | cc = input (); | |
995 | if (cc == terminator) | |
996 | { | |
997 | if (!(terminator == '\'' && next_apos)) | |
998 | { | |
999 | error ("unterminated control sequence"); | |
1000 | serious_errors++; | |
1001 | goto done; | |
1002 | } | |
1003 | } | |
1004 | if (cc == EOF || cc == '\n') | |
1005 | { | |
1006 | c = cc; | |
1007 | goto unterminated; | |
1008 | } | |
1009 | if (next_apos) | |
1010 | { | |
1011 | next_apos = 0; | |
1012 | if (cc != '\'') | |
1013 | { | |
1014 | error ("invalid integer literal in control sequence"); | |
1015 | serious_errors++; | |
1016 | goto done; | |
1017 | } | |
1018 | continue; | |
1019 | } | |
1020 | if (cc == ' ' || cc == '\t') | |
1021 | continue; | |
1022 | if (cc == ')') | |
1023 | { | |
1024 | if ((c < 0 || c > 255) && (pass == 1)) | |
1025 | error ("control sequence overflow"); | |
1026 | if (! count && pass == 1) | |
1027 | error ("invalid control sequence"); | |
1028 | break; | |
1029 | } | |
1030 | else if (cc == ',') | |
1031 | { | |
1032 | if ((c < 0 || c > 255) && (pass == 1)) | |
1033 | error ("control sequence overflow"); | |
1034 | if (! count && pass == 1) | |
1035 | error ("invalid control sequence"); | |
1036 | tmp[i++] = c; | |
1037 | if (i == allocated) | |
1038 | { | |
1039 | allocated += 1024; | |
1040 | tmp = xrealloc (tmp, allocated); | |
1041 | } | |
1042 | c = count = 0; | |
1043 | base = 10; | |
1044 | check_base = 1; | |
1045 | continue; | |
1046 | } | |
1047 | else if (cc == '_') | |
1048 | { | |
1049 | if (! count && pass == 1) | |
1050 | error ("invalid integer literal in control sequence"); | |
1051 | continue; | |
1052 | } | |
1053 | if (check_base) | |
1054 | { | |
1055 | if (cc == 'D' || cc == 'd') | |
1056 | { | |
1057 | base = 10; | |
1058 | next_apos = 1; | |
1059 | } | |
1060 | else if (cc == 'H' || cc == 'h') | |
1061 | { | |
1062 | base = 16; | |
1063 | next_apos = 1; | |
1064 | } | |
1065 | else if (cc == 'O' || cc == 'o') | |
1066 | { | |
1067 | base = 8; | |
1068 | next_apos = 1; | |
1069 | } | |
1070 | else if (cc == 'B' || cc == 'b') | |
1071 | { | |
1072 | base = 2; | |
1073 | next_apos = 1; | |
1074 | } | |
1075 | check_base = 0; | |
1076 | if (next_apos) | |
1077 | continue; | |
1078 | } | |
1079 | if (base == 2) | |
1080 | { | |
1081 | if (cc < '0' || cc > '1') | |
1082 | cc = -1; | |
1083 | else | |
1084 | cc -= '0'; | |
1085 | } | |
1086 | else if (base == 8) | |
1087 | { | |
1088 | if (cc < '0' || cc > '8') | |
1089 | cc = -1; | |
1090 | else | |
1091 | cc -= '0'; | |
1092 | } | |
1093 | else if (base == 10) | |
1094 | { | |
75111422 | 1095 | if (! ISDIGIT (cc)) |
80a093b2 PB |
1096 | cc = -1; |
1097 | else | |
1098 | cc -= '0'; | |
1099 | } | |
1100 | else if (base == 16) | |
1101 | { | |
75111422 | 1102 | if (!ISXDIGIT (cc)) |
80a093b2 PB |
1103 | cc = -1; |
1104 | else | |
1105 | { | |
1106 | if (cc >= 'a') | |
1107 | cc -= ' '; | |
1108 | cc -= '0'; | |
1109 | if (cc > 9) | |
1110 | cc -= 7; | |
1111 | } | |
1112 | } | |
1113 | else | |
1114 | { | |
1115 | error ("invalid base in read control sequence"); | |
1116 | abort (); | |
1117 | } | |
1118 | if (cc == -1) | |
1119 | { | |
1120 | /* error in control sequence */ | |
1121 | if (pass == 1) | |
1122 | error ("invalid digit in control sequence"); | |
1123 | cc = 0; | |
1124 | } | |
1125 | c = (c * base) + cc; | |
1126 | count++; | |
1127 | } | |
1128 | } | |
1129 | else | |
1130 | c ^= 64; | |
1131 | } | |
1132 | storeit: | |
1133 | tmp[i++] = c; | |
1134 | if (i == allocated) | |
1135 | { | |
1136 | allocated += 1024; | |
1137 | tmp = xrealloc (tmp, allocated); | |
1138 | } | |
1139 | } | |
1140 | done: | |
1141 | tmp [*len = i] = '\0'; | |
1142 | return tmp; | |
1143 | ||
1144 | unterminated: | |
1145 | if (c == '\n') | |
1146 | unput ('\n'); | |
1147 | *len = 1; | |
1148 | if (pass == 1) | |
1149 | error ("unterminated string literal"); | |
1150 | to_global_binding_level (); | |
1151 | tmp[0] = '\0'; | |
1152 | return tmp; | |
1153 | } | |
1154 | \f | |
1155 | /* Convert an integer INTCHARS into an INTEGER_CST. | |
1156 | INTCHARS is on the temporary_obstack, and is popped by this function. */ | |
1157 | ||
1158 | static tree | |
1159 | convert_integer (intchars) | |
1160 | char *intchars; | |
1161 | { | |
1162 | #ifdef YYDEBUG | |
1163 | extern int yydebug; | |
1164 | #endif | |
1165 | char *p = intchars; | |
1166 | char *oldp = p; | |
1167 | int base = 10, tmp; | |
1168 | int valid_chars = 0; | |
1169 | int overflow = 0; | |
1170 | tree type; | |
1171 | HOST_WIDE_INT val_lo = 0, val_hi = 0; | |
1172 | tree val; | |
1173 | ||
1174 | /* determine the base */ | |
1175 | switch (*p) | |
1176 | { | |
1177 | case 'd': | |
1178 | case 'D': | |
1179 | p += 2; | |
1180 | break; | |
1181 | case 'o': | |
1182 | case 'O': | |
1183 | p += 2; | |
1184 | base = 8; | |
1185 | break; | |
1186 | case 'h': | |
1187 | case 'H': | |
1188 | p += 2; | |
1189 | base = 16; | |
1190 | break; | |
1191 | case 'b': | |
1192 | case 'B': | |
1193 | p += 2; | |
1194 | base = 2; | |
1195 | break; | |
1196 | default: | |
75111422 | 1197 | if (!ISDIGIT (*p)) /* this test is for equal_number () */ |
80a093b2 PB |
1198 | { |
1199 | obstack_free (&temporary_obstack, intchars); | |
1200 | return 0; | |
1201 | } | |
1202 | break; | |
1203 | } | |
1204 | ||
1205 | while (*p) | |
1206 | { | |
1207 | tmp = *p++; | |
1208 | if ((tmp == '\'') || (tmp == '_')) | |
1209 | continue; | |
1210 | if (tmp < '0') | |
1211 | goto bad_char; | |
1212 | if (tmp >= 'a') /* uppercase the char */ | |
1213 | tmp -= ' '; | |
1214 | switch (base) /* validate the characters */ | |
1215 | { | |
1216 | case 2: | |
1217 | if (tmp > '1') | |
1218 | goto bad_char; | |
1219 | break; | |
1220 | case 8: | |
1221 | if (tmp > '7') | |
1222 | goto bad_char; | |
1223 | break; | |
1224 | case 10: | |
1225 | if (tmp > '9') | |
1226 | goto bad_char; | |
1227 | break; | |
1228 | case 16: | |
1229 | if (tmp > 'F') | |
1230 | goto bad_char; | |
1231 | if (tmp > '9' && tmp < 'A') | |
1232 | goto bad_char; | |
1233 | break; | |
1234 | default: | |
1235 | abort (); | |
1236 | } | |
1237 | tmp -= '0'; | |
1238 | if (tmp > 9) | |
1239 | tmp -= 7; | |
1240 | if (mul_double (val_lo, val_hi, base, 0, &val_lo, &val_hi)) | |
1241 | overflow++; | |
1242 | add_double (val_lo, val_hi, tmp, 0, &val_lo, &val_hi); | |
1243 | if (val_hi < 0) | |
1244 | overflow++; | |
1245 | valid_chars++; | |
1246 | } | |
1247 | bad_char: | |
1248 | obstack_free (&temporary_obstack, intchars); | |
1249 | if (!valid_chars) | |
1250 | { | |
1251 | if (pass == 2) | |
1252 | error ("invalid number format `%s'", oldp); | |
1253 | return 0; | |
1254 | } | |
1255 | val = build_int_2 (val_lo, val_hi); | |
1256 | /* We set the type to long long (or long long unsigned) so that | |
1257 | constant fold of literals is less likely to overflow. */ | |
1258 | if (int_fits_type_p (val, long_long_integer_type_node)) | |
1259 | type = long_long_integer_type_node; | |
1260 | else | |
1261 | { | |
1262 | if (! int_fits_type_p (val, long_long_unsigned_type_node)) | |
1263 | overflow++; | |
1264 | type = long_long_unsigned_type_node; | |
1265 | } | |
1266 | TREE_TYPE (val) = type; | |
1267 | CH_DERIVED_FLAG (val) = 1; | |
1268 | ||
1269 | if (overflow) | |
1270 | error ("integer literal too big"); | |
1271 | ||
1272 | return val; | |
1273 | } | |
1274 | \f | |
1275 | /* Convert a bitstring literal on the temporary_obstack to | |
1276 | a bitstring CONSTRUCTOR. Free the literal from the obstack. */ | |
1277 | ||
1278 | static tree | |
1279 | convert_bitstring (p) | |
1280 | char *p; | |
1281 | { | |
1282 | #ifdef YYDEBUG | |
1283 | extern int yydebug; | |
1284 | #endif | |
1285 | int bl = 0, valid_chars = 0, bits_per_char = 0, c, k; | |
1286 | tree initlist = NULL_TREE; | |
1287 | tree val; | |
1288 | ||
1289 | /* Move p to stack so we can re-use temporary_obstack for result. */ | |
1290 | char *oldp = (char*) alloca (strlen (p) + 1); | |
1291 | if (oldp == 0) fatal ("stack space exhausted"); | |
1292 | strcpy (oldp, p); | |
1293 | obstack_free (&temporary_obstack, p); | |
1294 | p = oldp; | |
1295 | ||
1296 | switch (*p) | |
1297 | { | |
1298 | case 'h': | |
1299 | case 'H': | |
1300 | bits_per_char = 4; | |
1301 | break; | |
1302 | case 'o': | |
1303 | case 'O': | |
1304 | bits_per_char = 3; | |
1305 | break; | |
1306 | case 'b': | |
1307 | case 'B': | |
1308 | bits_per_char = 1; | |
1309 | break; | |
1310 | } | |
1311 | p += 2; | |
1312 | ||
1313 | while (*p) | |
1314 | { | |
1315 | c = *p++; | |
1316 | if (c == '_' || c == '\'') | |
1317 | continue; | |
1318 | if (c >= 'a') | |
1319 | c -= ' '; | |
1320 | c -= '0'; | |
1321 | if (c > 9) | |
1322 | c -= 7; | |
1323 | valid_chars++; | |
1324 | ||
1325 | for (k = BYTES_BIG_ENDIAN ? bits_per_char - 1 : 0; | |
1326 | BYTES_BIG_ENDIAN ? k >= 0 : k < bits_per_char; | |
1327 | bl++, BYTES_BIG_ENDIAN ? k-- : k++) | |
1328 | { | |
1329 | if (c & (1 << k)) | |
1330 | initlist = tree_cons (NULL_TREE, build_int_2 (bl, 0), initlist); | |
1331 | } | |
1332 | } | |
1333 | #if 0 | |
1334 | /* as long as BOOLS(0) is valid it must tbe possible to | |
1335 | specify an empty bitstring */ | |
1336 | if (!valid_chars) | |
1337 | { | |
1338 | if (pass == 2) | |
1339 | error ("invalid number format `%s'", oldp); | |
1340 | return 0; | |
1341 | } | |
1342 | #endif | |
1343 | val = build (CONSTRUCTOR, | |
1344 | build_bitstring_type (size_int (bl)), | |
1345 | NULL_TREE, nreverse (initlist)); | |
1346 | TREE_CONSTANT (val) = 1; | |
1347 | CH_DERIVED_FLAG (val) = 1; | |
1348 | return val; | |
1349 | } | |
1350 | \f | |
1351 | /* Check if two filenames name the same file. | |
1352 | This is done by stat'ing both files and comparing their inodes. | |
1353 | ||
1354 | Note: we have to take care of seize_path_list. Therefore do it the same | |
1355 | way as in yywrap. FIXME: This probably can be done better. */ | |
1356 | ||
1357 | static int | |
1358 | same_file (filename1, filename2) | |
31029ad7 KG |
1359 | const char *filename1; |
1360 | const char *filename2; | |
80a093b2 PB |
1361 | { |
1362 | struct stat s[2]; | |
31029ad7 | 1363 | const char *fn_input[2]; |
80a093b2 | 1364 | int i, stat_status; |
80a093b2 PB |
1365 | |
1366 | if (grant_only_flag) | |
1367 | /* do nothing in this case */ | |
1368 | return 0; | |
1369 | ||
1370 | /* if filenames are equal -- return 1, cause there is no need | |
1371 | to search in the include list in this case */ | |
1372 | if (strcmp (filename1, filename2) == 0) | |
1373 | return 1; | |
1374 | ||
1375 | fn_input[0] = filename1; | |
1376 | fn_input[1] = filename2; | |
1377 | ||
1378 | for (i = 0; i < 2; i++) | |
1379 | { | |
1380 | stat_status = stat (fn_input[i], &s[i]); | |
1381 | if (stat_status < 0 && | |
1382 | strchr (fn_input[i], '/') == 0) | |
1383 | { | |
1384 | STRING_LIST *plp; | |
1385 | char *path; | |
1386 | ||
1387 | for (plp = seize_path_list; plp != 0; plp = plp->next) | |
1388 | { | |
1389 | path = (char *)xmalloc (strlen (fn_input[i]) + | |
1390 | strlen (plp->str) + 2); | |
1391 | sprintf (path, "%s/%s", plp->str, fn_input[i]); | |
1392 | stat_status = stat (path, &s[i]); | |
1393 | free (path); | |
1394 | if (stat_status >= 0) | |
1395 | break; | |
1396 | } | |
1397 | } | |
1398 | if (stat_status < 0) | |
1399 | pfatal_with_name (fn_input[i]); | |
1400 | } | |
1401 | return s[0].st_ino == s[1].st_ino && s[0].st_dev == s[1].st_dev; | |
1402 | } | |
1403 | ||
1404 | /* | |
1405 | * Note that simply appending included file names to a list in this | |
1406 | * way completely eliminates the need for nested files, and the | |
1407 | * associated book-keeping, since the EOF processing in the lexer | |
1408 | * will simply process the files one at a time, in the order that the | |
1409 | * USE_SEIZE_FILE directives were scanned. | |
1410 | */ | |
1411 | static void | |
1412 | handle_use_seizefile_directive (restricted) | |
1413 | int restricted; | |
1414 | { | |
1415 | tree seen; | |
1416 | int len; | |
1417 | int c = skip_whitespace (); | |
1418 | char *use_seizefile_str = readstring (c, &len); | |
1419 | ||
1420 | if (pass > 1) | |
1421 | return; | |
1422 | ||
1423 | if (c != '\'' && c != '\"') | |
1424 | { | |
1425 | error ("USE_SEIZE_FILE directive must be followed by string"); | |
1426 | return; | |
1427 | } | |
1428 | ||
1429 | use_seizefile_name = get_identifier (use_seizefile_str); | |
1430 | CH_USE_SEIZEFILE_RESTRICTED (use_seizefile_name) = restricted; | |
1431 | ||
1432 | if (!grant_only_flag) | |
1433 | { | |
1434 | /* If file foo.ch contains a <> use_seize_file "bar.grt" <>, | |
1435 | and file bar.ch contains a <> use_seize_file "foo.grt" <>, | |
1436 | then if we're compiling foo.ch, we will indirectly be | |
1437 | asked to seize foo.grt. Don't. */ | |
1438 | extern char *grant_file_name; | |
1439 | if (strcmp (use_seizefile_str, grant_file_name) == 0) | |
1440 | return; | |
1441 | ||
1442 | /* Check if the file is already on the list. */ | |
1443 | for (seen = files_to_seize; seen != NULL_TREE; seen = TREE_CHAIN (seen)) | |
1444 | if (same_file (IDENTIFIER_POINTER (TREE_VALUE (seen)), | |
1445 | use_seizefile_str)) | |
1446 | return; /* Previously seen; nothing to do. */ | |
1447 | } | |
1448 | ||
1449 | /* Haven't been asked to seize this file yet, so add | |
1450 | its name to the list. */ | |
1451 | { | |
1452 | tree pl = perm_tree_cons (0, use_seizefile_name, NULL_TREE); | |
1453 | if (files_to_seize == NULL_TREE) | |
1454 | files_to_seize = pl; | |
1455 | else | |
1456 | TREE_CHAIN (last_file_to_seize) = pl; | |
1457 | if (next_file_to_seize == NULL_TREE) | |
1458 | next_file_to_seize = pl; | |
1459 | last_file_to_seize = pl; | |
1460 | } | |
1461 | } | |
1462 | ||
1463 | ||
1464 | /* | |
1465 | * get input, convert to lower case for comparison | |
1466 | */ | |
31029ad7 | 1467 | static int |
80a093b2 PB |
1468 | getlc (file) |
1469 | FILE *file; | |
1470 | { | |
1471 | register int c; | |
1472 | ||
1473 | c = getc (file); | |
92a438d1 KG |
1474 | if (ignore_case) |
1475 | c = TOLOWER (c); | |
80a093b2 PB |
1476 | return c; |
1477 | } | |
1478 | \f | |
c5168e64 NC |
1479 | #if defined HANDLE_PRAGMA |
1480 | /* Local versions of these macros, that can be passed as function pointers. */ | |
1481 | static int | |
1482 | pragma_getc () | |
1483 | { | |
1484 | return getc (finput); | |
1485 | } | |
1486 | ||
1487 | static void | |
1488 | pragma_ungetc (arg) | |
1489 | int arg; | |
1490 | { | |
1491 | ungetc (arg, finput); | |
1492 | } | |
1493 | #endif /* HANDLE_PRAGMA */ | |
1494 | ||
43cab252 NC |
1495 | #ifdef HANDLE_GENERIC_PRAGMAS |
1496 | /* Handle a generic #pragma directive. | |
1497 | BUFFER contains the text we read after `#pragma'. Processes the entire input | |
1498 | line and return non-zero iff the pragma was successfully processed. */ | |
1499 | ||
1500 | static int | |
1501 | handle_generic_pragma (buffer) | |
1502 | char * buffer; | |
1503 | { | |
1504 | register int c; | |
1505 | ||
1506 | for (;;) | |
1507 | { | |
1508 | char * buff; | |
1509 | ||
1510 | handle_pragma_token (buffer, NULL); | |
1511 | ||
1512 | c = getc (finput); | |
1513 | ||
1514 | while (c == ' ' || c == '\t') | |
1515 | c = getc (finput); | |
1516 | ungetc (c, finput); | |
1517 | ||
1518 | if (c == '\n' || c == EOF) | |
1519 | return handle_pragma_token (NULL, NULL); | |
1520 | ||
1521 | /* Read the next word of the pragma into the buffer. */ | |
1522 | buff = buffer; | |
1523 | do | |
1524 | { | |
1525 | * buff ++ = c; | |
1526 | c = getc (finput); | |
1527 | } | |
f6bbde28 ZW |
1528 | while (c != EOF && ! ISSPACE (c) && buff < buffer + 128); |
1529 | /* XXX shared knowledge about size of buffer. */ | |
1530 | ||
43cab252 NC |
1531 | ungetc (c, finput); |
1532 | ||
1533 | * -- buff = 0; | |
1534 | } | |
1535 | } | |
1536 | #endif /* HANDLE_GENERIC_PRAGMAS */ | |
1537 | \f | |
80a093b2 PB |
1538 | /* At the beginning of a line, increment the line number and process |
1539 | any #-directive on this line. If the line is a #-directive, read | |
1540 | the entire line and return a newline. Otherwise, return the line's | |
1541 | first non-whitespace character. | |
1542 | ||
1543 | (Each language front end has a check_newline() function that is called | |
1544 | from lang_init() for that language. One of the things this function | |
1545 | must do is read the first line of the input file, and if it is a #line | |
1546 | directive, extract the filename from it and use it to initialize | |
1547 | main_input_filename. Proper generation of debugging information in | |
1548 | the normal "front end calls cpp then calls cc1XXXX environment" depends | |
1549 | upon this being done.) */ | |
1550 | ||
1551 | int | |
1552 | check_newline () | |
1553 | { | |
1554 | register int c; | |
1555 | ||
1556 | lineno++; | |
1557 | ||
1558 | /* Read first nonwhite char on the line. */ | |
1559 | ||
1560 | c = getc (finput); | |
1561 | ||
1562 | while (c == ' ' || c == '\t') | |
1563 | c = getc (finput); | |
1564 | ||
1565 | if (c != '#' || inside_c_comment) | |
1566 | { | |
1567 | /* If not #, return it so caller will use it. */ | |
1568 | return c; | |
1569 | } | |
1570 | ||
1571 | /* Read first nonwhite char after the `#'. */ | |
1572 | ||
1573 | c = getc (finput); | |
1574 | while (c == ' ' || c == '\t') | |
1575 | c = getc (finput); | |
1576 | ||
1577 | /* If a letter follows, then if the word here is `line', skip | |
1578 | it and ignore it; otherwise, ignore the line, with an error | |
1579 | if the word isn't `pragma', `ident', `define', or `undef'. */ | |
1580 | ||
92a438d1 KG |
1581 | if (ignore_case) |
1582 | c = TOLOWER (c); | |
80a093b2 PB |
1583 | |
1584 | if (c >= 'a' && c <= 'z') | |
1585 | { | |
1586 | if (c == 'p') | |
1587 | { | |
1588 | if (getlc (finput) == 'r' | |
1589 | && getlc (finput) == 'a' | |
1590 | && getlc (finput) == 'g' | |
1591 | && getlc (finput) == 'm' | |
1592 | && getlc (finput) == 'a' | |
75111422 | 1593 | && (c = getlc (finput), ISSPACE (c))) |
80a093b2 PB |
1594 | { |
1595 | #ifdef HANDLE_PRAGMA | |
c5168e64 NC |
1596 | static char buffer [128]; |
1597 | char * buff = buffer; | |
1598 | ||
1599 | /* Read the pragma name into a buffer. */ | |
75111422 | 1600 | while (c = getlc (finput), ISSPACE (c)) |
c5168e64 NC |
1601 | continue; |
1602 | ||
1603 | do | |
1604 | { | |
1605 | * buff ++ = c; | |
1606 | c = getlc (finput); | |
1607 | } | |
75111422 | 1608 | while (c != EOF && ! ISSPACE (c) && c != '\n' |
c5168e64 NC |
1609 | && buff < buffer + 128); |
1610 | ||
1611 | pragma_ungetc (c); | |
1612 | ||
1613 | * -- buff = 0; | |
1614 | ||
43cab252 NC |
1615 | if (HANDLE_PRAGMA (pragma_getc, pragma_ungetc, buffer)) |
1616 | goto skipline; | |
80a093b2 | 1617 | #endif /* HANDLE_PRAGMA */ |
43cab252 NC |
1618 | |
1619 | #ifdef HANDLE_GENERIC_PRAGMAS | |
1620 | if (handle_generic_pragma (buffer)) | |
1621 | goto skipline; | |
1622 | #endif /* HANDLE_GENERIC_PRAGMAS */ | |
1623 | ||
c5168e64 | 1624 | goto skipline; |
80a093b2 PB |
1625 | } |
1626 | } | |
1627 | ||
1628 | else if (c == 'd') | |
1629 | { | |
1630 | if (getlc (finput) == 'e' | |
1631 | && getlc (finput) == 'f' | |
1632 | && getlc (finput) == 'i' | |
1633 | && getlc (finput) == 'n' | |
1634 | && getlc (finput) == 'e' | |
75111422 | 1635 | && (c = getlc (finput), ISSPACE (c))) |
80a093b2 PB |
1636 | { |
1637 | #if 0 /*def DWARF_DEBUGGING_INFO*/ | |
1638 | if (c != '\n' | |
1639 | && (debug_info_level == DINFO_LEVEL_VERBOSE) | |
1640 | && (write_symbols == DWARF_DEBUG)) | |
1641 | dwarfout_define (lineno, get_directive_line (finput)); | |
1642 | #endif /* DWARF_DEBUGGING_INFO */ | |
1643 | goto skipline; | |
1644 | } | |
1645 | } | |
1646 | else if (c == 'u') | |
1647 | { | |
1648 | if (getlc (finput) == 'n' | |
1649 | && getlc (finput) == 'd' | |
1650 | && getlc (finput) == 'e' | |
1651 | && getlc (finput) == 'f' | |
75111422 | 1652 | && (c = getlc (finput), ISSPACE (c))) |
80a093b2 PB |
1653 | { |
1654 | #if 0 /*def DWARF_DEBUGGING_INFO*/ | |
1655 | if (c != '\n' | |
1656 | && (debug_info_level == DINFO_LEVEL_VERBOSE) | |
1657 | && (write_symbols == DWARF_DEBUG)) | |
1658 | dwarfout_undef (lineno, get_directive_line (finput)); | |
1659 | #endif /* DWARF_DEBUGGING_INFO */ | |
1660 | goto skipline; | |
1661 | } | |
1662 | } | |
1663 | else if (c == 'l') | |
1664 | { | |
1665 | if (getlc (finput) == 'i' | |
1666 | && getlc (finput) == 'n' | |
1667 | && getlc (finput) == 'e' | |
1668 | && ((c = getlc (finput)) == ' ' || c == '\t')) | |
1669 | goto linenum; | |
1670 | } | |
1671 | #if 0 | |
1672 | else if (c == 'i') | |
1673 | { | |
1674 | if (getlc (finput) == 'd' | |
1675 | && getlc (finput) == 'e' | |
1676 | && getlc (finput) == 'n' | |
1677 | && getlc (finput) == 't' | |
1678 | && ((c = getlc (finput)) == ' ' || c == '\t')) | |
1679 | { | |
86702e31 | 1680 | /* #ident. The pedantic warning is now in cpp. */ |
80a093b2 PB |
1681 | |
1682 | /* Here we have just seen `#ident '. | |
1683 | A string constant should follow. */ | |
1684 | ||
1685 | while (c == ' ' || c == '\t') | |
1686 | c = getlc (finput); | |
1687 | ||
1688 | /* If no argument, ignore the line. */ | |
1689 | if (c == '\n') | |
1690 | return c; | |
1691 | ||
1692 | ungetc (c, finput); | |
1693 | token = yylex (); | |
1694 | if (token != STRING | |
1695 | || TREE_CODE (yylval.ttype) != STRING_CST) | |
1696 | { | |
1697 | error ("invalid #ident"); | |
1698 | goto skipline; | |
1699 | } | |
1700 | ||
1701 | if (!flag_no_ident) | |
1702 | { | |
1703 | #ifdef ASM_OUTPUT_IDENT | |
1704 | extern FILE *asm_out_file; | |
1705 | ASM_OUTPUT_IDENT (asm_out_file, TREE_STRING_POINTER (yylval.ttype)); | |
1706 | #endif | |
1707 | } | |
1708 | ||
1709 | /* Skip the rest of this line. */ | |
1710 | goto skipline; | |
1711 | } | |
1712 | } | |
1713 | #endif | |
1714 | ||
1715 | error ("undefined or invalid # directive"); | |
1716 | goto skipline; | |
1717 | } | |
1718 | ||
1719 | linenum: | |
1720 | /* Here we have either `#line' or `# <nonletter>'. | |
1721 | In either case, it should be a line number; a digit should follow. */ | |
1722 | ||
1723 | while (c == ' ' || c == '\t') | |
1724 | c = getlc (finput); | |
1725 | ||
1726 | /* If the # is the only nonwhite char on the line, | |
1727 | just ignore it. Check the new newline. */ | |
1728 | if (c == '\n') | |
1729 | return c; | |
1730 | ||
1731 | /* Something follows the #; read a token. */ | |
1732 | ||
75111422 | 1733 | if (ISDIGIT(c)) |
80a093b2 PB |
1734 | { |
1735 | int old_lineno = lineno; | |
1736 | int used_up = 0; | |
1737 | int l = 0; | |
1738 | extern struct obstack permanent_obstack; | |
1739 | ||
1740 | do | |
1741 | { | |
1742 | l = l * 10 + (c - '0'); /* FIXME Not portable */ | |
1743 | c = getlc(finput); | |
75111422 | 1744 | } while (ISDIGIT(c)); |
80a093b2 PB |
1745 | /* subtract one, because it is the following line that |
1746 | gets the specified number */ | |
1747 | ||
1748 | l--; | |
1749 | ||
1750 | /* Is this the last nonwhite stuff on the line? */ | |
1751 | c = getlc (finput); | |
1752 | while (c == ' ' || c == '\t') | |
1753 | c = getlc (finput); | |
1754 | if (c == '\n') | |
1755 | { | |
1756 | /* No more: store the line number and check following line. */ | |
1757 | lineno = l; | |
1758 | return c; | |
1759 | } | |
1760 | ||
1761 | /* More follows: it must be a string constant (filename). */ | |
1762 | ||
1763 | /* Read the string constant, but don't treat \ as special. */ | |
1764 | ignore_escape_flag = 1; | |
1765 | ignore_escape_flag = 0; | |
1766 | ||
1767 | if (c != '\"') | |
1768 | { | |
1769 | error ("invalid #line"); | |
1770 | goto skipline; | |
1771 | } | |
1772 | ||
1773 | for (;;) | |
1774 | { | |
1775 | c = getc (finput); | |
1776 | if (c == EOF || c == '\n') | |
1777 | { | |
1778 | error ("invalid #line"); | |
1779 | return c; | |
1780 | } | |
1781 | if (c == '\"') | |
1782 | { | |
1783 | obstack_1grow(&permanent_obstack, 0); | |
1784 | input_filename = obstack_finish (&permanent_obstack); | |
1785 | break; | |
1786 | } | |
1787 | obstack_1grow(&permanent_obstack, c); | |
1788 | } | |
1789 | ||
1790 | lineno = l; | |
1791 | ||
1792 | /* Each change of file name | |
1793 | reinitializes whether we are now in a system header. */ | |
1794 | in_system_header = 0; | |
1795 | ||
1796 | if (main_input_filename == 0) | |
1797 | main_input_filename = input_filename; | |
1798 | ||
1799 | /* Is this the last nonwhite stuff on the line? */ | |
1800 | c = getlc (finput); | |
1801 | while (c == ' ' || c == '\t') | |
1802 | c = getlc (finput); | |
1803 | if (c == '\n') | |
1804 | return c; | |
1805 | ||
1806 | used_up = 0; | |
1807 | ||
1808 | /* `1' after file name means entering new file. | |
1809 | `2' after file name means just left a file. */ | |
1810 | ||
75111422 | 1811 | if (ISDIGIT (c)) |
80a093b2 PB |
1812 | { |
1813 | if (c == '1') | |
1814 | { | |
1815 | /* Pushing to a new file. */ | |
1816 | struct file_stack *p | |
1817 | = (struct file_stack *) xmalloc (sizeof (struct file_stack)); | |
1818 | input_file_stack->line = old_lineno; | |
1819 | p->next = input_file_stack; | |
1820 | p->name = input_filename; | |
1821 | input_file_stack = p; | |
1822 | input_file_stack_tick++; | |
1823 | #ifdef DWARF_DEBUGGING_INFO | |
1824 | if (debug_info_level == DINFO_LEVEL_VERBOSE | |
1825 | && write_symbols == DWARF_DEBUG) | |
1826 | dwarfout_start_new_source_file (input_filename); | |
1827 | #endif /* DWARF_DEBUGGING_INFO */ | |
1828 | ||
1829 | used_up = 1; | |
1830 | } | |
1831 | else if (c == '2') | |
1832 | { | |
1833 | /* Popping out of a file. */ | |
1834 | if (input_file_stack->next) | |
1835 | { | |
1836 | struct file_stack *p = input_file_stack; | |
1837 | input_file_stack = p->next; | |
1838 | free (p); | |
1839 | input_file_stack_tick++; | |
1840 | #ifdef DWARF_DEBUGGING_INFO | |
1841 | if (debug_info_level == DINFO_LEVEL_VERBOSE | |
1842 | && write_symbols == DWARF_DEBUG) | |
1843 | dwarfout_resume_previous_source_file (input_file_stack->line); | |
1844 | #endif /* DWARF_DEBUGGING_INFO */ | |
1845 | } | |
1846 | else | |
1847 | error ("#-lines for entering and leaving files don't match"); | |
1848 | ||
1849 | used_up = 1; | |
1850 | } | |
1851 | } | |
1852 | ||
1853 | /* If we have handled a `1' or a `2', | |
1854 | see if there is another number to read. */ | |
1855 | if (used_up) | |
1856 | { | |
1857 | /* Is this the last nonwhite stuff on the line? */ | |
1858 | c = getlc (finput); | |
1859 | while (c == ' ' || c == '\t') | |
1860 | c = getlc (finput); | |
1861 | if (c == '\n') | |
1862 | return c; | |
1863 | used_up = 0; | |
1864 | } | |
1865 | ||
1866 | /* `3' after file name means this is a system header file. */ | |
1867 | ||
1868 | if (c == '3') | |
1869 | in_system_header = 1; | |
1870 | } | |
1871 | else | |
1872 | error ("invalid #-line"); | |
1873 | ||
1874 | /* skip the rest of this line. */ | |
1875 | skipline: | |
1876 | while (c != '\n' && c != EOF) | |
1877 | c = getc (finput); | |
1878 | return c; | |
1879 | } | |
1880 | ||
1881 | ||
1882 | tree | |
1883 | get_chill_filename () | |
1884 | { | |
1885 | return (build_chill_string ( | |
1886 | strlen (input_filename) + 1, /* +1 to get a zero terminated string */ | |
1887 | input_filename)); | |
1888 | } | |
1889 | ||
1890 | tree | |
1891 | get_chill_linenumber () | |
1892 | { | |
1893 | return build_int_2 ((HOST_WIDE_INT)lineno, 0); | |
1894 | } | |
1895 | ||
1896 | ||
1897 | /* Assuming '/' and '*' have been read, skip until we've | |
1898 | read the terminating '*' and '/'. */ | |
1899 | ||
1900 | static void | |
1901 | skip_c_comment () | |
1902 | { | |
1903 | int c = input(); | |
1904 | int start_line = lineno; | |
1905 | ||
1906 | inside_c_comment++; | |
1907 | for (;;) | |
1908 | if (c == EOF) | |
1909 | { | |
1910 | error_with_file_and_line (input_filename, start_line, | |
1911 | "unterminated comment"); | |
1912 | break; | |
1913 | } | |
1914 | else if (c != '*') | |
1915 | c = input(); | |
1916 | else if ((c = input ()) == '/') | |
1917 | break; | |
1918 | inside_c_comment--; | |
1919 | } | |
1920 | ||
1921 | ||
1922 | /* Assuming "--" has been read, skip until '\n'. */ | |
1923 | ||
1924 | static void | |
1925 | skip_line_comment () | |
1926 | { | |
1927 | for (;;) | |
1928 | { | |
1929 | int c = input (); | |
1930 | ||
1931 | if (c == EOF) | |
1932 | return; | |
1933 | if (c == '\n') | |
1934 | break; | |
1935 | } | |
1936 | unput ('\n'); | |
1937 | } | |
1938 | ||
1939 | ||
1940 | static int | |
1941 | skip_whitespace () | |
1942 | { | |
1943 | for (;;) | |
1944 | { | |
1945 | int c = input (); | |
1946 | ||
1947 | if (c == EOF) | |
1948 | return c; | |
1949 | if (c == ' ' || c == '\t' || c == '\r' || c == '\n' || c == '\v') | |
1950 | continue; | |
1951 | if (c == '/') | |
1952 | { | |
1953 | c = input (); | |
1954 | if (c == '*') | |
1955 | { | |
1956 | skip_c_comment (); | |
1957 | continue; | |
1958 | } | |
1959 | else | |
1960 | { | |
1961 | unput (c); | |
1962 | return '/'; | |
1963 | } | |
1964 | } | |
1965 | if (c == '-') | |
1966 | { | |
1967 | c = input (); | |
1968 | if (c == '-') | |
1969 | { | |
1970 | skip_line_comment (); | |
1971 | continue; | |
1972 | } | |
1973 | else | |
1974 | { | |
1975 | unput (c); | |
1976 | return '-'; | |
1977 | } | |
1978 | } | |
1979 | return c; | |
1980 | } | |
1981 | } | |
1982 | \f | |
1983 | /* | |
1984 | * avoid recursive calls to yylex to parse the ' = digits' or | |
1985 | * ' = SYNvalue' which are supposed to follow certain compiler | |
1986 | * directives. Read the input stream, and return the value parsed. | |
1987 | */ | |
1988 | /* FIXME: overflow check in here */ | |
1989 | /* FIXME: check for EOF around here */ | |
1990 | static tree | |
1991 | equal_number () | |
1992 | { | |
1993 | int c, result; | |
1994 | char *tokenbuf; | |
1995 | char *cursor; | |
1996 | tree retval = integer_zero_node; | |
1997 | ||
1998 | c = skip_whitespace(); | |
1999 | if ((char)c != '=') | |
2000 | { | |
2001 | if (pass == 2) | |
2002 | error ("missing `=' in compiler directive"); | |
2003 | return integer_zero_node; | |
2004 | } | |
2005 | c = skip_whitespace(); | |
2006 | ||
2007 | /* collect token into tokenbuf for later analysis */ | |
2008 | while (TRUE) | |
2009 | { | |
75111422 | 2010 | if (ISSPACE (c) || c == '<') |
80a093b2 PB |
2011 | break; |
2012 | obstack_1grow (&temporary_obstack, c); | |
2013 | c = input (); | |
2014 | } | |
2015 | unput (c); /* put uninteresting char back */ | |
2016 | obstack_1grow (&temporary_obstack, '\0'); /* terminate token */ | |
2017 | tokenbuf = obstack_finish (&temporary_obstack); | |
2018 | maybe_downcase (tokenbuf); | |
2019 | ||
2020 | if (*tokenbuf == '-') | |
2021 | /* will fail in the next test */ | |
2022 | result = BITSTRING; | |
2023 | else if (maybe_number (tokenbuf)) | |
2024 | { | |
2025 | if (pass == 1) | |
2026 | return integer_zero_node; | |
2027 | push_obstacks_nochange (); | |
2028 | end_temporary_allocation (); | |
2029 | yylval.ttype = convert_integer (tokenbuf); | |
2030 | tokenbuf = 0; /* Was freed by convert_integer. */ | |
2031 | result = yylval.ttype ? NUMBER : 0; | |
2032 | pop_obstacks (); | |
2033 | } | |
2034 | else | |
2035 | result = 0; | |
2036 | ||
2037 | if (result == NUMBER) | |
2038 | { | |
2039 | retval = yylval.ttype; | |
2040 | } | |
2041 | else if (result == BITSTRING) | |
2042 | { | |
2043 | if (pass == 1) | |
2044 | error ("invalid value follows `=' in compiler directive"); | |
2045 | goto finish; | |
2046 | } | |
2047 | else /* not a number */ | |
2048 | { | |
2049 | cursor = tokenbuf; | |
2050 | c = *cursor; | |
75111422 | 2051 | if (!ISALPHA (c) && c != '_') |
80a093b2 PB |
2052 | { |
2053 | if (pass == 1) | |
2054 | error ("invalid value follows `=' in compiler directive"); | |
2055 | goto finish; | |
2056 | } | |
2057 | ||
2058 | for (cursor = &tokenbuf[1]; *cursor != '\0'; cursor++) | |
75111422 KG |
2059 | if (ISALPHA ((unsigned char) *cursor) || *cursor == '_' || |
2060 | ISDIGIT (*cursor)) | |
80a093b2 PB |
2061 | continue; |
2062 | else | |
2063 | { | |
2064 | if (pass == 1) | |
2065 | error ("invalid `%c' character in name", *cursor); | |
2066 | goto finish; | |
2067 | } | |
2068 | if (pass == 1) | |
2069 | goto finish; | |
2070 | else | |
2071 | { | |
2072 | tree value = lookup_name (get_identifier (tokenbuf)); | |
2073 | if (value == NULL_TREE | |
2074 | || TREE_CODE (value) != CONST_DECL | |
2075 | || TREE_CODE (DECL_INITIAL (value)) != INTEGER_CST) | |
2076 | { | |
2077 | if (pass == 2) | |
2078 | error ("`%s' not integer constant synonym ", | |
2079 | tokenbuf); | |
2080 | goto finish; | |
2081 | } | |
2082 | obstack_free (&temporary_obstack, tokenbuf); | |
2083 | tokenbuf = 0; | |
2084 | push_obstacks_nochange (); | |
2085 | end_temporary_allocation (); | |
2086 | retval = convert (chill_taskingcode_type_node, DECL_INITIAL (value)); | |
2087 | pop_obstacks (); | |
2088 | } | |
2089 | } | |
2090 | ||
2091 | /* check the value */ | |
2092 | if (TREE_CODE (retval) != INTEGER_CST) | |
2093 | { | |
2094 | if (pass == 2) | |
2095 | error ("invalid value follows `=' in compiler directive"); | |
2096 | } | |
2097 | else if (TREE_INT_CST_HIGH (retval) != 0 || | |
2098 | TREE_INT_CST_LOW (retval) > TREE_INT_CST_LOW (TYPE_MAX_VALUE (chill_unsigned_type_node))) | |
2099 | { | |
2100 | if (pass == 2) | |
2101 | error ("value out of range in compiler directive"); | |
2102 | } | |
2103 | finish: | |
2104 | if (tokenbuf) | |
2105 | obstack_free (&temporary_obstack, tokenbuf); | |
2106 | return retval; | |
2107 | } | |
2108 | \f | |
2109 | /* | |
2110 | * add a possible grant-file path to the list | |
2111 | */ | |
2112 | void | |
2113 | register_seize_path (path) | |
31029ad7 | 2114 | const char *path; |
80a093b2 PB |
2115 | { |
2116 | int pathlen = strlen (path); | |
2117 | char *new_path = (char *)xmalloc (pathlen + 1); | |
2118 | STRING_LIST *pl = (STRING_LIST *)xmalloc (sizeof (STRING_LIST)); | |
2119 | ||
2120 | /* strip off trailing slash if any */ | |
2121 | if (path[pathlen - 1] == '/') | |
2122 | pathlen--; | |
2123 | ||
2124 | memcpy (new_path, path, pathlen); | |
2125 | pl->str = new_path; | |
2126 | pl->next = seize_path_list; | |
2127 | seize_path_list = pl; | |
2128 | } | |
2129 | ||
2130 | ||
2131 | /* Used by decode_decl to indicate that a <> use_seize_file NAME <> | |
2132 | directive has been written to the grantfile. */ | |
2133 | ||
2134 | void | |
2135 | mark_use_seizefile_written (name) | |
2136 | tree name; | |
2137 | { | |
2138 | tree node; | |
2139 | ||
2140 | for (node = files_to_seize; node != NULL_TREE; node = TREE_CHAIN (node)) | |
2141 | if (TREE_VALUE (node) == name) | |
2142 | { | |
2143 | TREE_PURPOSE (node) = integer_one_node; | |
2144 | break; | |
2145 | } | |
2146 | } | |
2147 | ||
2148 | ||
2149 | static int | |
2150 | yywrap () | |
2151 | { | |
80a093b2 | 2152 | extern char *chill_real_input_filename; |
80a093b2 PB |
2153 | |
2154 | close_input_file (input_filename); | |
2155 | ||
2156 | use_seizefile_name = NULL_TREE; | |
2157 | ||
2158 | if (next_file_to_seize && !grant_only_flag) | |
2159 | { | |
2160 | FILE *grt_in = NULL; | |
63ad61ed | 2161 | const char *seizefile_name_chars |
80a093b2 PB |
2162 | = IDENTIFIER_POINTER (TREE_VALUE (next_file_to_seize)); |
2163 | ||
2164 | /* find a seize file, open it. If it's not at the path the | |
2165 | * user gave us, and that path contains no slashes, look on | |
2166 | * the seize_file paths, specified by the '-I' options. | |
2167 | */ | |
2168 | grt_in = fopen (seizefile_name_chars, "r"); | |
2169 | if (grt_in == NULL | |
2170 | && strchr (seizefile_name_chars, '/') == NULL) | |
2171 | { | |
2172 | STRING_LIST *plp; | |
2173 | char *path; | |
2174 | ||
2175 | for (plp = seize_path_list; plp != NULL; plp = plp->next) | |
2176 | { | |
2177 | path = (char *)xmalloc (strlen (seizefile_name_chars) | |
2178 | + strlen (plp->str) + 2); | |
2179 | ||
2180 | sprintf (path, "%s/%s", plp->str, seizefile_name_chars); | |
2181 | grt_in = fopen (path, "r"); | |
2182 | if (grt_in == NULL) | |
2183 | free (path); | |
2184 | else | |
2185 | { | |
2186 | seizefile_name_chars = path; | |
2187 | break; | |
2188 | } | |
2189 | } | |
2190 | } | |
2191 | ||
2192 | if (grt_in == NULL) | |
2193 | pfatal_with_name (seizefile_name_chars); | |
2194 | ||
2195 | finput = grt_in; | |
2196 | input_filename = seizefile_name_chars; | |
2197 | ||
2198 | lineno = 0; | |
2199 | current_seizefile_name = TREE_VALUE (next_file_to_seize); | |
2200 | ||
2201 | next_file_to_seize = TREE_CHAIN (next_file_to_seize); | |
2202 | ||
2203 | saw_eof = 0; | |
2204 | return 0; | |
2205 | } | |
2206 | ||
2207 | if (pass == 1) | |
2208 | { | |
2209 | next_file_to_seize = files_to_seize; | |
2210 | current_seizefile_name = NULL_TREE; | |
2211 | ||
2212 | if (strcmp (main_input_filename, "stdin")) | |
2213 | finput = fopen (chill_real_input_filename, "r"); | |
2214 | else | |
2215 | finput = stdin; | |
2216 | if (finput == NULL) | |
2217 | { | |
2218 | error ("can't reopen %s", chill_real_input_filename); | |
2219 | return 1; | |
2220 | } | |
2221 | input_filename = main_input_filename; | |
2222 | ch_lex_init (); | |
2223 | lineno = 0; | |
2224 | /* Read a line directive if there is one. */ | |
2225 | ungetc (check_newline (), finput); | |
2226 | starting_pass_2 = 1; | |
2227 | saw_eof = 0; | |
2228 | if (module_number == 0) | |
2229 | warning ("no modules seen"); | |
2230 | return 0; | |
2231 | } | |
2232 | return 1; | |
2233 | } |