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