gcc/ch/lex.c

   1 /* Lexical analyzer for GNU CHILL. -*- C -*-
   2    Copyright (C) 1992, 93, 94, 98, 99, 2000 Free Software Foundation, Inc.
   3
   4 This file is part of GNU CC.
   5
   6 GNU CC is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU CC is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14          General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU CC; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20 \f
  21 #include "config.h"
  22 #include "system.h"
  23 #include <setjmp.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 DWARF_DEBUGGING_INFO
  38 #include "dwarfout.h"
  39 #endif
  40
  41 #ifdef MULTIBYTE_CHARS
  42 #include <locale.h>
  43 #endif
  44
  45 /* include the keyword recognizers */
  46 #include "hash.h"
  47
  48 FILE* finput;
  49
  50 #if 0
  51 static int      last_token = 0;
  52 /* Sun's C compiler warns about the safer sequence
  53    do { .. } while 0
  54    when there's a 'return' inside the braces, so don't use it */
  55 #define RETURN_TOKEN(X) { last_token = X; return (X); }
  56 #endif
  57
  58 /* This is set non-zero to force incoming tokens to lowercase. */
  59 extern int ignore_case;
  60
  61 extern int module_number;
  62 extern int serious_errors;
  63
  64 /* This is non-zero to recognize only uppercase special words. */
  65 extern int special_UC;
  66
  67 extern struct obstack permanent_obstack;
  68 extern struct obstack temporary_obstack;
  69
  70 /* forward declarations */
  71 static void close_input_file         PARAMS ((const char *));
  72 static tree convert_bitstring        PARAMS ((char *));
  73 static tree convert_integer          PARAMS ((char *));
  74 static void maybe_downcase           PARAMS ((char *));
  75 static int  maybe_number             PARAMS ((const char *));
  76 static tree equal_number             PARAMS ((void));
  77 static void handle_use_seizefile_directive PARAMS ((int));
  78 static int  handle_name              PARAMS ((tree));
  79 static char *readstring              PARAMS ((int, int *));
  80 static void read_directive           PARAMS ((void));
  81 static tree read_identifier          PARAMS ((int));
  82 static tree read_number              PARAMS ((int));
  83 static void skip_c_comment           PARAMS ((void));
  84 static void skip_line_comment        PARAMS ((void));
  85 static int  skip_whitespace          PARAMS ((void));
  86 static tree string_or_char           PARAMS ((int, const char *));
  87 static void ch_lex_init              PARAMS ((void));
  88 static void skip_directive           PARAMS ((void));
  89 static int same_file                 PARAMS ((const char *, const char *));
  90 static int getlc                     PARAMS ((FILE *));
  91
  92 /* next variables are public, because ch-actions uses them */
  93
  94 /* the default grantfile name, set by lang_init */
  95 tree default_grant_file = 0;
  96
  97 /* These tasking-related variables are NULL at the start of each
  98    compiler pass, and are set to an expression tree if and when
  99    a compiler directive is parsed containing an expression.
 100    The NULL state is significant;  it means 'no user-specified
 101    signal_code (or whatever) has been parsed'. */
 102
 103 /* process type, set by <> PROCESS_TYPE = number <> */
 104 tree process_type = NULL_TREE;
 105
 106 /* send buffer default priority,
 107    set by <> SEND_BUFFER_DEFAULT_PRIORITY = number <> */
 108 tree send_buffer_prio = NULL_TREE;
 109
 110 /* send signal default priority,
 111    set by <> SEND_SIGNAL_DEFAULT_PRIORITY = number <> */
 112 tree send_signal_prio = NULL_TREE;
 113
 114 /* signal code, set by <> SIGNAL_CODE = number <> */
 115 tree signal_code = NULL_TREE;
 116
 117 /* flag for range checking */
 118 int range_checking = 1;
 119
 120 /* flag for NULL pointer checking */
 121 int empty_checking = 1;
 122
 123 /* flag to indicate making all procedure local variables
 124    to be STATIC */
 125 int all_static_flag = 0;
 126
 127 /* flag to indicate -fruntime-checking command line option.
 128    Needed for initializing range_checking and empty_checking
 129    before pass 2 */
 130 int runtime_checking_flag = 1;
 131
 132 /* The elements of `ridpointers' are identifier nodes
 133    for the reserved type names and storage classes.
 134    It is indexed by a RID_... value.  */
 135 tree ridpointers[(int) RID_MAX];
 136
 137 /* Nonzero tells yylex to ignore \ in string constants.  */
 138 static int ignore_escape_flag = 0;
 139
 140 static int maxtoken;            /* Current nominal length of token buffer.  */
 141 char *token_buffer;     /* Pointer to token buffer.
 142                            Actual allocated length is maxtoken + 2.
 143                            This is not static because objc-parse.y uses it.  */
 144
 145 /* implement yylineno handling for flex */
 146 #define yylineno lineno
 147
 148 static int inside_c_comment = 0;
 149
 150 static int saw_eol = 0; /* 1 if we've just seen a '\n' */
 151 static int saw_eof = 0; /* 1 if we've just seen an EOF */
 152
 153 typedef struct string_list
 154   {
 155     struct string_list *next;
 156     char               *str;
 157   } STRING_LIST;
 158
 159 /* list of paths specified on the compiler command line by -L options. */
 160 static STRING_LIST *seize_path_list = (STRING_LIST *)0;
 161
 162 /* List of seize file names.  Each TREE_VALUE is an identifier
 163    (file name) from a <>USE_SEIZE_FILE<> directive.
 164    The TREE_PURPOSE is non-NULL if a USE_SEIZE_FILE directive has been
 165    written to the grant file. */
 166 static tree files_to_seize     = NULL_TREE;
 167 /* Last node on files_to_seize list. */
 168 static tree last_file_to_seize = NULL_TREE;
 169 /* Pointer into files_to_seize list:  Next unparsed file to read. */
 170 static tree next_file_to_seize = NULL_TREE;
 171
 172 /* The most recent use_seize_file directive. */
 173 tree use_seizefile_name = NULL_TREE;
 174
 175 /* If non-NULL, the name of the seizefile we're currently processing. */
 176 tree current_seizefile_name = NULL_TREE;
 177 \f
 178 /* called to reset for pass 2 */
 179 static void
 180 ch_lex_init ()
 181 {
 182   current_seizefile_name = NULL_TREE;
 183
 184   lineno = 0;
 185
 186   saw_eol = 0;
 187   saw_eof = 0;
 188   /* Initialize these compiler-directive variables. */
 189   process_type     = NULL_TREE;
 190   send_buffer_prio = NULL_TREE;
 191   send_signal_prio = NULL_TREE;
 192   signal_code      = NULL_TREE;
 193   all_static_flag  = 0;
 194   /* reinitialize rnage checking and empty checking */
 195   range_checking = runtime_checking_flag;
 196   empty_checking = runtime_checking_flag;
 197 }
 198
 199
 200 const char *
 201 init_parse (filename)
 202      const char *filename;
 203 {
 204   int lowercase_standard_names = ignore_case || ! special_UC;
 205
 206   /* Open input file.  */
 207   if (filename == 0 || !strcmp (filename, "-"))
 208     {
 209       finput = stdin;
 210       filename = "stdin";
 211     }
 212   else
 213     finput = fopen (filename, "r");
 214   if (finput == 0)
 215     pfatal_with_name (filename);
 216
 217 #ifdef IO_BUFFER_SIZE
 218   setvbuf (finput, (char *) xmalloc (IO_BUFFER_SIZE), _IOFBF, IO_BUFFER_SIZE);
 219 #endif
 220
 221   /* Make identifier nodes long enough for the language-specific slots.  */
 222   set_identifier_size (sizeof (struct lang_identifier));
 223
 224   /* Start it at 0, because check_newline is called at the very beginning
 225      and will increment it to 1.  */
 226   lineno = 0;
 227
 228   /* Initialize these compiler-directive variables. */
 229   process_type     = NULL_TREE;
 230   send_buffer_prio = NULL_TREE;
 231   send_signal_prio = NULL_TREE;
 232   signal_code      = NULL_TREE;
 233
 234   maxtoken         = 40;
 235   token_buffer     = xmalloc ((unsigned)(maxtoken + 2));
 236
 237   init_chill_expand ();
 238
 239 #define ENTER_STANDARD_NAME(RID, LOWER, UPPER) \
 240   ridpointers[(int) RID] = \
 241     get_identifier (lowercase_standard_names ? LOWER : UPPER)
 242
 243   ENTER_STANDARD_NAME (RID_ALL,         "all",          "ALL");
 244   ENTER_STANDARD_NAME (RID_ASSERTFAIL,  "assertfail",   "ASSERTFAIL");
 245   ENTER_STANDARD_NAME (RID_ASSOCIATION, "association",  "ASSOCIATION");
 246   ENTER_STANDARD_NAME (RID_BIN,         "bin",          "BIN");
 247   ENTER_STANDARD_NAME (RID_BOOL,        "bool",         "BOOL");
 248   ENTER_STANDARD_NAME (RID_BOOLS,       "bools",        "BOOLS");
 249   ENTER_STANDARD_NAME (RID_BYTE,        "byte",         "BYTE");
 250   ENTER_STANDARD_NAME (RID_CHAR,        "char",         "CHAR");
 251   ENTER_STANDARD_NAME (RID_DOUBLE,      "double",       "DOUBLE");
 252   ENTER_STANDARD_NAME (RID_DURATION,    "duration",     "DURATION");
 253   ENTER_STANDARD_NAME (RID_DYNAMIC,     "dynamic",      "DYNAMIC");
 254   ENTER_STANDARD_NAME (RID_ELSE,        "else",         "ELSE");
 255   ENTER_STANDARD_NAME (RID_EMPTY,       "empty",        "EMPTY");
 256   ENTER_STANDARD_NAME (RID_FALSE,       "false",        "FALSE");
 257   ENTER_STANDARD_NAME (RID_FLOAT,       "float",        "FLOAT");
 258   ENTER_STANDARD_NAME (RID_GENERAL,     "general",      "GENERAL");
 259   ENTER_STANDARD_NAME (RID_IN,          "in",           "IN");
 260   ENTER_STANDARD_NAME (RID_INLINE,      "inline",       "INLINE");
 261   ENTER_STANDARD_NAME (RID_INOUT,       "inout",        "INOUT");
 262   ENTER_STANDARD_NAME (RID_INSTANCE,    "instance",     "INSTANCE");
 263   ENTER_STANDARD_NAME (RID_INT,         "int",          "INT");
 264   ENTER_STANDARD_NAME (RID_LOC,         "loc",          "LOC");
 265   ENTER_STANDARD_NAME (RID_LONG,        "long",         "LONG");
 266   ENTER_STANDARD_NAME (RID_LONG_REAL,   "long_real",    "LONG_REAL");
 267   ENTER_STANDARD_NAME (RID_NULL,        "null",         "NULL");
 268   ENTER_STANDARD_NAME (RID_OUT,         "out",          "OUT");
 269   ENTER_STANDARD_NAME (RID_OVERFLOW,    "overflow",     "OVERFLOW");
 270   ENTER_STANDARD_NAME (RID_PTR,         "ptr",          "PTR");
 271   ENTER_STANDARD_NAME (RID_READ,        "read",         "READ");
 272   ENTER_STANDARD_NAME (RID_REAL,        "real",         "REAL");
 273   ENTER_STANDARD_NAME (RID_RANGE,       "range",        "RANGE");
 274   ENTER_STANDARD_NAME (RID_RANGEFAIL,   "rangefail",    "RANGEFAIL");
 275   ENTER_STANDARD_NAME (RID_RECURSIVE,   "recursive",    "RECURSIVE");
 276   ENTER_STANDARD_NAME (RID_SHORT,       "short",        "SHORT");
 277   ENTER_STANDARD_NAME (RID_SIMPLE,      "simple",       "SIMPLE");
 278   ENTER_STANDARD_NAME (RID_TIME,        "time",         "TIME");
 279   ENTER_STANDARD_NAME (RID_TRUE,        "true",         "TRUE");
 280   ENTER_STANDARD_NAME (RID_UBYTE,       "ubyte",        "UBYTE");
 281   ENTER_STANDARD_NAME (RID_UINT,        "uint",         "UINT");
 282   ENTER_STANDARD_NAME (RID_ULONG,       "ulong",        "ULONG");
 283   ENTER_STANDARD_NAME (RID_UNSIGNED,    "unsigned",     "UNSIGNED");
 284   ENTER_STANDARD_NAME (RID_USHORT,      "ushort",       "USHORT");
 285   ENTER_STANDARD_NAME (RID_VOID,        "void",         "VOID");
 286
 287   return filename;
 288 }
 289
 290 void
 291 finish_parse ()
 292 {
 293   if (finput != NULL)
 294     fclose (finput);
 295 }
 296 \f
 297 static int yywrap PARAMS ((void));
 298 static int yy_refill PARAMS ((void));
 299
 300 #define YY_PUTBACK_SIZE 5
 301 #define YY_BUF_SIZE 1000
 302
 303 static char yy_buffer[YY_PUTBACK_SIZE + YY_BUF_SIZE];
 304 static char *yy_cur = yy_buffer + YY_PUTBACK_SIZE;
 305 static char *yy_lim = yy_buffer + YY_PUTBACK_SIZE;
 306
 307 static int
 308 yy_refill ()
 309 {
 310   char *buf = yy_buffer + YY_PUTBACK_SIZE;
 311   int c, result;
 312   bcopy (yy_cur - YY_PUTBACK_SIZE, yy_buffer, YY_PUTBACK_SIZE);
 313   yy_cur = buf;
 314
 315  retry:
 316   if (saw_eof)
 317     {
 318       if (yywrap ())
 319         return EOF;
 320       saw_eof = 0;
 321       goto retry;
 322     }
 323
 324   result = 0;
 325   while (saw_eol)
 326     {
 327       c = check_newline ();
 328       if (c == EOF)
 329         {
 330           saw_eof = 1;
 331           goto retry;
 332         }
 333       else if (c != '\n')
 334         {
 335           saw_eol = 0;
 336           buf[result++] = c;
 337         }
 338     }
 339
 340   while (result < YY_BUF_SIZE)
 341     {
 342       c = getc(finput);
 343       if (c == EOF)
 344         {
 345           saw_eof = 1;
 346           break;
 347         }
 348       buf[result++] = c;
 349
 350       /* Because we might switch input files on a compiler directive
 351          (that end with '>', don't read past a '>', just in case. */
 352       if (c == '>')
 353         break;
 354
 355       if (c == '\n')
 356         {
 357 #ifdef YYDEBUG
 358           extern int yydebug;
 359           if (yydebug)
 360             fprintf (stderr, "-------------------------- finished Line %d\n",
 361                      yylineno);
 362 #endif
 363           saw_eol = 1;
 364           break;
 365         }
 366     }
 367
 368   yy_lim = yy_cur + result;
 369
 370   return yy_lim > yy_cur ? *yy_cur++ : EOF;
 371 }
 372
 373 #define input() (yy_cur < yy_lim ? *yy_cur++ : yy_refill ())
 374
 375 #define unput(c) (*--yy_cur = (c))
 376 \f
 377
 378 int starting_pass_2 = 0;
 379
 380 int
 381 yylex ()
 382 {
 383   int nextc;
 384   int len;
 385   char* tmp;
 386   int base;
 387   int ch;
 388  retry:
 389   ch = input ();
 390   if (starting_pass_2)
 391     {
 392       starting_pass_2 = 0;
 393       unput (ch);
 394       return END_PASS_1;
 395     }
 396   switch (ch)
 397     {
 398     case ' ': case '\t': case '\n': case '\f': case '\b': case '\v': case '\r':
 399       goto retry;
 400     case '[':
 401       return LPC;
 402     case ']':
 403       return RPC;
 404     case '{':
 405       return LC;
 406     case '}':
 407       return RC;
 408     case '(':
 409       nextc = input ();
 410       if (nextc == ':')
 411         return LPC;
 412       unput (nextc);
 413       return LPRN;
 414     case ')':
 415       return RPRN;
 416     case ':':
 417       nextc = input ();
 418       if (nextc == ')')
 419         return RPC;
 420       else if (nextc == '=')
 421         return ASGN;
 422       unput (nextc);
 423       return COLON;
 424     case ',':
 425       return COMMA;
 426     case ';':
 427       return SC;
 428     case '+':
 429       return PLUS;
 430     case '-':
 431       nextc = input ();
 432       if (nextc == '>')
 433         return ARROW;
 434       if (nextc == '-')
 435         {
 436           skip_line_comment ();
 437           goto retry;
 438         }
 439       unput (nextc);
 440       return SUB;
 441     case '*':
 442       return MUL;
 443     case '=':
 444       return EQL;
 445     case '/':
 446       nextc = input ();
 447       if (nextc == '/')
 448         return CONCAT;
 449       else if (nextc == '=')
 450         return NE;
 451       else if (nextc == '*')
 452         {
 453           skip_c_comment ();
 454           goto retry;
 455         }
 456       unput (nextc);
 457       return DIV;
 458     case '<':
 459       nextc = input ();
 460       if (nextc == '=')
 461         return LTE;
 462       if (nextc == '>')
 463         {
 464           read_directive ();
 465           goto retry;
 466         }
 467       unput (nextc);
 468       return LT;
 469     case '>':
 470       nextc = input ();
 471       if (nextc == '=')
 472         return GTE;
 473       unput (nextc);
 474       return GT;
 475
 476     case 'D': case 'd':
 477       base = 10;
 478       goto maybe_digits;
 479     case 'B': case 'b':
 480       base = 2;
 481       goto maybe_digits;
 482     case 'H': case 'h':
 483       base = 16;
 484       goto maybe_digits;
 485     case 'O': case 'o':
 486       base = 8;
 487       goto maybe_digits;
 488     case 'C': case 'c':
 489       nextc = input ();
 490       if (nextc == '\'')
 491         {
 492           int byte_val = 0;
 493           char *start;
 494           int len = 0;  /* Number of hex digits seen. */
 495           for (;;)
 496             {
 497               ch = input ();
 498               if (ch == '\'')
 499                 break;
 500               if (ch == '_')
 501                 continue;
 502               if (!ISXDIGIT (ch))           /* error on non-hex digit */
 503                 {
 504                   if (pass == 1)
 505                     error ("invalid C'xx' ");
 506                   break;
 507                 }
 508               if (ch >= 'a')
 509                 ch -= ' ';
 510               ch -= '0';
 511               if (ch > 9)
 512                 ch -= 7;
 513               byte_val *= 16;
 514               byte_val += (int)ch;
 515
 516               if (len & 1) /* collected two digits, save byte */
 517                 obstack_1grow (&temporary_obstack, (char) byte_val);
 518               len++;
 519             }
 520           start = obstack_finish (&temporary_obstack);
 521           yylval.ttype = string_or_char (len >> 1, start);
 522           obstack_free (&temporary_obstack, start);
 523           return len == 2 ? SINGLECHAR : STRING;
 524         }
 525       unput (nextc);
 526       goto letter;
 527
 528     maybe_digits:
 529       nextc = input ();
 530       if (nextc == '\'')
 531         {
 532           char *start;
 533           obstack_1grow (&temporary_obstack, ch);
 534           obstack_1grow (&temporary_obstack, nextc);
 535           for (;;)
 536             {
 537               ch = input ();
 538               if (ISALNUM (ch))
 539                 obstack_1grow (&temporary_obstack, ch);
 540               else if (ch != '_')
 541                 break;
 542             }
 543           obstack_1grow (&temporary_obstack, '\0');
 544           start = obstack_finish (&temporary_obstack);
 545           if (ch != '\'')
 546             {
 547               unput (ch);
 548               yylval.ttype = convert_integer (start); /* Pass base? */
 549               return NUMBER;
 550             }
 551           else
 552             {
 553               yylval.ttype = convert_bitstring (start);
 554               return BITSTRING;
 555             }
 556         }
 557       unput (nextc);
 558       goto letter;
 559
 560     case 'A':                                   case 'E':
 561     case 'F':  case 'G':             case 'I':  case 'J':
 562     case 'K':  case 'L':  case 'M':  case 'N':
 563     case 'P':  case 'Q':  case 'R':  case 'S':  case 'T':
 564     case 'U':  case 'V':  case 'W':  case 'X':  case 'Y':
 565     case 'Z':
 566     case 'a':                                   case 'e':
 567     case 'f':  case 'g':             case 'i':  case 'j':
 568     case 'k':  case 'l':  case 'm':  case 'n':
 569     case 'p':  case 'q':  case 'r':  case 's':  case 't':
 570     case 'u':  case 'v':  case 'w':  case 'x':  case 'y':
 571     case 'z':
 572     case '_':
 573     letter:
 574       return handle_name (read_identifier (ch));
 575     case '\'':
 576       tmp = readstring ('\'', &len);
 577       yylval.ttype = string_or_char (len, tmp);
 578       free (tmp);
 579       return len == 1 ? SINGLECHAR : STRING;
 580     case '\"':
 581       tmp = readstring ('\"', &len);
 582       yylval.ttype = build_chill_string (len, tmp);
 583       free (tmp);
 584       return STRING;
 585     case '.':
 586       nextc = input ();
 587       unput (nextc);
 588       if (ISDIGIT (nextc)) /* || nextc == '_')  we don't start numbers with '_' */
 589         goto number;
 590       return DOT;
 591     case '0': case '1': case '2': case '3': case '4':
 592     case '5': case '6': case '7': case '8': case '9':
 593     number:
 594       yylval.ttype = read_number (ch);
 595       return TREE_CODE (yylval.ttype) == REAL_CST ? FLOATING : NUMBER;
 596     default:
 597       return ch;
 598     }
 599 }
 600
 601 static void
 602 close_input_file (fn)
 603   const char *fn;
 604 {
 605   if (finput == NULL)
 606     abort ();
 607
 608   if (finput != stdin && fclose (finput) == EOF)
 609     {
 610       error ("can't close %s", fn);
 611       abort ();
 612     }
 613   finput = NULL;
 614 }
 615
 616 /* Return an identifier, starting with FIRST and then reading
 617    more characters using input().  Return an IDENTIFIER_NODE. */
 618
 619 static tree
 620 read_identifier (first)
 621      int first; /* First letter of identifier */
 622 {
 623   tree id;
 624   char *start;
 625   for (;;)
 626     {
 627       obstack_1grow (&temporary_obstack, first);
 628       first = input ();
 629       if (first == EOF)
 630         break;
 631       if (! ISALNUM (first) && first != '_')
 632         {
 633           unput (first);
 634           break;
 635         }
 636     }
 637   obstack_1grow (&temporary_obstack, '\0');
 638   start = obstack_finish (&temporary_obstack);
 639   maybe_downcase (start);
 640   id = get_identifier (start);
 641   obstack_free (&temporary_obstack, start);
 642   return id;
 643 }
 644
 645 /* Given an identifier ID, check to see if it is a reserved name,
 646    and return the appropriate token type. */
 647
 648 static int
 649 handle_name (id)
 650      tree id;
 651 {
 652   struct resword *tp;
 653   tp = in_word_set (IDENTIFIER_POINTER (id), IDENTIFIER_LENGTH (id));
 654   if (tp != NULL
 655       && special_UC == ISUPPER ((unsigned char) tp->name[0])
 656       && (tp->flags == RESERVED || tp->flags == PREDEF))
 657     {
 658       if (tp->rid != NORID)
 659         yylval.ttype = ridpointers[tp->rid];
 660       else if (tp->token == THIS)
 661         yylval.ttype = lookup_name (get_identifier ("__whoami"));
 662       return tp->token;
 663     }
 664   yylval.ttype = id;
 665   return NAME;
 666 }
 667
 668 static tree
 669 read_number (ch)
 670      int ch; /* Initial character */
 671 {
 672   tree num;
 673   char *start;
 674   int is_float = 0;
 675   for (;;)
 676     {
 677       if (ch != '_')
 678         obstack_1grow (&temporary_obstack, ch);
 679       ch = input ();
 680       if (! ISDIGIT (ch) && ch != '_')
 681         break;
 682     }
 683   if (ch == '.')
 684     {
 685       do
 686         {
 687           if (ch != '_')
 688             obstack_1grow (&temporary_obstack, ch);
 689           ch = input ();
 690         } while (ISDIGIT (ch) || ch == '_');
 691       is_float++;
 692     }
 693   if (ch == 'd' || ch == 'D' || ch == 'e' || ch == 'E')
 694     {
 695       /* Convert exponent indication [eEdD] to 'e'. */
 696       obstack_1grow (&temporary_obstack, 'e');
 697       ch = input ();
 698       if (ch == '+' || ch == '-')
 699         {
 700           obstack_1grow (&temporary_obstack, ch);
 701           ch = input ();
 702         }
 703       if (ISDIGIT (ch) || ch == '_')
 704         {
 705           do
 706             {
 707               if (ch != '_')
 708                 obstack_1grow (&temporary_obstack, ch);
 709               ch = input ();
 710             } while (ISDIGIT (ch) || ch == '_');
 711         }
 712       else
 713         {
 714           error ("malformed exponent part of floating-point literal");
 715         }
 716       is_float++;
 717     }
 718   if (ch != EOF)
 719     unput (ch);
 720   obstack_1grow (&temporary_obstack, '\0');
 721   start = obstack_finish (&temporary_obstack);
 722   if (is_float)
 723     {
 724       REAL_VALUE_TYPE value;
 725       tree  type = double_type_node;
 726       errno = 0;
 727       value = REAL_VALUE_ATOF (start, TYPE_MODE (type));
 728       obstack_free (&temporary_obstack, start);
 729       if (TARGET_FLOAT_FORMAT != IEEE_FLOAT_FORMAT
 730           && REAL_VALUE_ISINF (value) && pedantic)
 731         pedwarn ("real number exceeds range of REAL");
 732       num = build_real (type, value);
 733     }
 734   else
 735     num = convert_integer (start);
 736   CH_DERIVED_FLAG (num) = 1;
 737   return num;
 738 }
 739
 740 /* Skip to the end of a compiler directive. */
 741
 742 static void
 743 skip_directive ()
 744 {
 745   int ch = input ();
 746   for (;;)
 747     {
 748       if (ch == EOF)
 749         {
 750           error ("end-of-file in '<>' directive");
 751           break;
 752         }
 753       if (ch == '\n')
 754         break;
 755       if (ch == '<')
 756         {
 757           ch = input ();
 758           if (ch == '>')
 759             break;
 760         }
 761       ch = input ();
 762     }
 763   starting_pass_2 = 0;
 764 }
 765
 766 /* Read a compiler directive.  ("<>{WS}" have already been read. ) */
 767 static void
 768 read_directive ()
 769 {
 770   struct resword *tp;
 771   tree id;
 772   int ch = skip_whitespace();
 773   if (ISALPHA (ch) || ch == '_')
 774     id = read_identifier (ch);
 775   else if (ch == EOF)
 776     {
 777       error ("end-of-file in '<>' directive");
 778       to_global_binding_level ();
 779       return;
 780     }
 781   else
 782     {
 783       warning ("unrecognized compiler directive");
 784       skip_directive ();
 785       return;
 786     }
 787   tp = in_word_set (IDENTIFIER_POINTER (id), IDENTIFIER_LENGTH (id));
 788   if (tp == NULL || special_UC != ISUPPER ((unsigned char) tp->name[0]))
 789     {
 790       if (pass == 1)
 791         warning ("unrecognized compiler directive `%s'",
 792                  IDENTIFIER_POINTER (id));
 793     }
 794   else
 795     switch (tp->token)
 796       {
 797       case ALL_STATIC_OFF:
 798         all_static_flag = 0;
 799         break;
 800       case ALL_STATIC_ON:
 801         all_static_flag = 1;
 802         break;
 803       case EMPTY_OFF:
 804         empty_checking = 0;
 805         break;
 806       case EMPTY_ON:
 807         empty_checking = 1;
 808         break;
 809       case IGNORED_DIRECTIVE:
 810         break;
 811       case PROCESS_TYPE_TOKEN:
 812         process_type = equal_number ();
 813         break;
 814       case RANGE_OFF:
 815         range_checking = 0;
 816         break;
 817       case RANGE_ON:
 818         range_checking = 1;
 819         break;
 820       case SEND_SIGNAL_DEFAULT_PRIORITY:
 821         send_signal_prio = equal_number ();
 822         break;
 823       case SEND_BUFFER_DEFAULT_PRIORITY:
 824         send_buffer_prio = equal_number ();
 825         break;
 826       case SIGNAL_CODE:
 827         signal_code = equal_number ();
 828         break;
 829       case USE_SEIZE_FILE:
 830         handle_use_seizefile_directive (0);
 831         break;
 832       case USE_SEIZE_FILE_RESTRICTED:
 833         handle_use_seizefile_directive (1);
 834         break;
 835       default:
 836         if (pass == 1)
 837           warning ("unrecognized compiler directive `%s'",
 838                    IDENTIFIER_POINTER (id));
 839         break;
 840       }
 841   skip_directive ();
 842 }
 843
 844 \f
 845 tree
 846 build_chill_string (len, str)
 847     int   len;
 848     const char  *str;
 849 {
 850   tree t;
 851
 852   push_obstacks (&permanent_obstack, &permanent_obstack);
 853   t = build_string (len, str);
 854   TREE_TYPE (t) = build_string_type (char_type_node,
 855                                      build_int_2 (len, 0));
 856   CH_DERIVED_FLAG (t) = 1;
 857   pop_obstacks ();
 858   return t;
 859 }
 860
 861
 862 static tree
 863 string_or_char (len, str)
 864      int   len;
 865      const char *str;
 866 {
 867   tree result;
 868
 869   push_obstacks (&permanent_obstack, &permanent_obstack);
 870   if (len == 1)
 871     {
 872       result = build_int_2 ((unsigned char)str[0], 0);
 873       CH_DERIVED_FLAG (result) = 1;
 874       TREE_TYPE (result) = char_type_node;
 875     }
 876   else
 877     result = build_chill_string (len, str);
 878   pop_obstacks ();
 879   return result;
 880 }
 881
 882
 883 static void
 884 maybe_downcase (str)
 885     char        *str;
 886 {
 887   if (! ignore_case)
 888     return;
 889   while (*str)
 890     {
 891       if (ISUPPER ((unsigned char) *str))
 892         *str = TOLOWER (*str);
 893       str++;
 894     }
 895 }
 896
 897
 898 static int
 899 maybe_number (s)
 900   const char *s;
 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':
 932           if (!ISXDIGIT ((unsigned char) *s))
 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 }
 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);
 961   unsigned i = 0;
 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                     {
1095                       if (! ISDIGIT (cc))
1096                         cc = -1;
1097                       else
1098                         cc -= '0';
1099                     }
1100                   else if (base == 16)
1101                     {
1102                       if (!ISXDIGIT (cc))
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:
1197       if (!ISDIGIT (*p))   /* this test is for equal_number () */
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)
1359      const char *filename1;
1360      const char *filename2;
1361 {
1362   struct stat s[2];
1363   const char *fn_input[2];
1364   int         i, stat_status;
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  */
1467 static int
1468 getlc (file)
1469      FILE *file;
1470 {
1471   register int c;
1472
1473   c = getc (file);
1474   if (ignore_case)
1475     c = TOLOWER (c);
1476   return c;
1477 }
1478 \f
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
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         }
1528       while (c != EOF && isascii (c) && ! ISSPACE (c) && c != '\n'
1529              && buff < buffer + 128); /* XXX shared knowledge about size of buffer.  */
1530
1531       ungetc (c, finput);
1532
1533       * -- buff = 0;
1534     }
1535 }
1536 #endif /* HANDLE_GENERIC_PRAGMAS */
1537 \f
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
1581   if (ignore_case)
1582     c = TOLOWER (c);
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'
1593               && (c = getlc (finput), ISSPACE (c)))
1594             {
1595 #ifdef HANDLE_PRAGMA
1596               static char buffer [128];
1597               char * buff = buffer;
1598
1599               /* Read the pragma name into a buffer.  */
1600               while (c = getlc (finput), ISSPACE (c))
1601                 continue;
1602
1603               do
1604                 {
1605                   * buff ++ = c;
1606                   c = getlc (finput);
1607                 }
1608               while (c != EOF && ! ISSPACE (c) && c != '\n'
1609                      && buff < buffer + 128);
1610
1611               pragma_ungetc (c);
1612
1613               * -- buff = 0;
1614
1615               if (HANDLE_PRAGMA (pragma_getc, pragma_ungetc, buffer))
1616                 goto skipline;
1617 #endif /* HANDLE_PRAGMA */
1618
1619 #ifdef HANDLE_GENERIC_PRAGMAS
1620               if (handle_generic_pragma (buffer))
1621                 goto skipline;
1622 #endif /* HANDLE_GENERIC_PRAGMAS */
1623
1624               goto skipline;
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'
1635               && (c = getlc (finput), ISSPACE (c)))
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'
1652               && (c = getlc (finput), ISSPACE (c)))
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             {
1680               /* #ident.  The pedantic warning is now in cpp.  */
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
1733   if (ISDIGIT(c))
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);
1744         } while (ISDIGIT(c));
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
1811       if (ISDIGIT (c))
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     {
2010       if (ISSPACE (c) || c == '<')
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;
2051       if (!ISALPHA (c) && c != '_')
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++)
2059         if (ISALPHA ((unsigned char) *cursor) || *cursor == '_' ||
2060             ISDIGIT (*cursor))
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)
2114      const char *path;
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 {
2152   extern char *chill_real_input_filename;
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;
2161       char *seizefile_name_chars
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 }