gcc/ch/lex.c

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