gcc/ch/lex.c

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