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