OSDN Git Service

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