gcc/ch/lex.c

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