gcc/ch/lex.c

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