1 /* Lexical analyzer for GNU CHILL. -*- C -*-
2 Copyright (C) 1992, 93, 1994, 1998 Free Software Foundation, Inc.
4 This file is part of GNU CC.
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)
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.
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. */
35 #ifdef DWARF_DEBUGGING_INFO
39 #ifdef MULTIBYTE_CHARS
43 /* include the keyword recognizers */
49 static int last_token
= 0;
50 /* Sun's C compiler warns about the safer sequence
52 when there's a 'return' inside the braces, so don't use it */
53 #define RETURN_TOKEN(X) { last_token = X; return (X); }
56 /* This is set non-zero to force incoming tokens to lowercase. */
57 extern int ignore_case
;
59 extern int module_number
;
60 extern int serious_errors
;
62 /* This is non-zero to recognize only uppercase special words. */
63 extern int special_UC
;
65 extern struct obstack permanent_obstack
;
66 extern struct obstack temporary_obstack
;
68 /* forward declarations */
69 static void close_input_file
PROTO((char *));
70 static tree convert_bitstring
PROTO((char *));
71 static tree convert_integer
PROTO((char *));
72 static void maybe_downcase
PROTO((char *));
73 static int maybe_number
PROTO((char *));
74 static tree equal_number
PROTO((void));
75 static void handle_use_seizefile_directive
PROTO((int));
76 static int handle_name
PROTO((tree
));
77 static char *readstring
PROTO((int, int *));
78 static void read_directive
PROTO((void));
79 static tree read_identifier
PROTO((int));
80 static tree read_number
PROTO((int));
81 static void skip_c_comment
PROTO((void));
82 static void skip_line_comment
PROTO((void));
83 static int skip_whitespace
PROTO((void));
84 static tree string_or_char
PROTO((int, char *));
86 /* next variables are public, because ch-actions uses them */
88 /* the default grantfile name, set by lang_init */
89 tree default_grant_file
= 0;
91 /* These tasking-related variables are NULL at the start of each
92 compiler pass, and are set to an expression tree if and when
93 a compiler directive is parsed containing an expression.
94 The NULL state is significant; it means 'no user-specified
95 signal_code (or whatever) has been parsed'. */
97 /* process type, set by <> PROCESS_TYPE = number <> */
98 tree process_type
= NULL_TREE
;
100 /* send buffer default priority,
101 set by <> SEND_BUFFER_DEFAULT_PRIORITY = number <> */
102 tree send_buffer_prio
= NULL_TREE
;
104 /* send signal default priority,
105 set by <> SEND_SIGNAL_DEFAULT_PRIORITY = number <> */
106 tree send_signal_prio
= NULL_TREE
;
108 /* signal code, set by <> SIGNAL_CODE = number <> */
109 tree signal_code
= NULL_TREE
;
111 /* flag for range checking */
112 int range_checking
= 1;
114 /* flag for NULL pointer checking */
115 int empty_checking
= 1;
117 /* flag to indicate making all procedure local variables
119 int all_static_flag
= 0;
121 /* flag to indicate -fruntime-checking command line option.
122 Needed for initializing range_checking and empty_checking
124 int runtime_checking_flag
= 1;
126 /* The elements of `ridpointers' are identifier nodes
127 for the reserved type names and storage classes.
128 It is indexed by a RID_... value. */
129 tree ridpointers
[(int) RID_MAX
];
131 /* Nonzero tells yylex to ignore \ in string constants. */
132 static int ignore_escape_flag
= 0;
134 static int maxtoken
; /* Current nominal length of token buffer. */
135 char *token_buffer
; /* Pointer to token buffer.
136 Actual allocated length is maxtoken + 2.
137 This is not static because objc-parse.y uses it. */
139 /* implement yylineno handling for flex */
140 #define yylineno lineno
142 static int inside_c_comment
= 0;
144 static int saw_eol
= 0; /* 1 if we've just seen a '\n' */
145 static int saw_eof
= 0; /* 1 if we've just seen an EOF */
147 typedef struct string_list
149 struct string_list
*next
;
153 /* list of paths specified on the compiler command line by -L options. */
154 static STRING_LIST
*seize_path_list
= (STRING_LIST
*)0;
156 /* List of seize file names. Each TREE_VALUE is an identifier
157 (file name) from a <>USE_SEIZE_FILE<> directive.
158 The TREE_PURPOSE is non-NULL if a USE_SEIZE_FILE directive has been
159 written to the grant file. */
160 static tree files_to_seize
= NULL_TREE
;
161 /* Last node on files_to_seize list. */
162 static tree last_file_to_seize
= NULL_TREE
;
163 /* Pointer into files_to_seize list: Next unparsed file to read. */
164 static tree next_file_to_seize
= NULL_TREE
;
166 /* The most recent use_seize_file directive. */
167 tree use_seizefile_name
= NULL_TREE
;
169 /* If non-NULL, the name of the seizefile we're currently processing. */
170 tree current_seizefile_name
= NULL_TREE
;
172 /* called to reset for pass 2 */
176 current_seizefile_name
= NULL_TREE
;
182 /* Initialize these compiler-directive variables. */
183 process_type
= NULL_TREE
;
184 send_buffer_prio
= NULL_TREE
;
185 send_signal_prio
= NULL_TREE
;
186 signal_code
= NULL_TREE
;
188 /* reinitialize rnage checking and empty checking */
189 range_checking
= runtime_checking_flag
;
190 empty_checking
= runtime_checking_flag
;
195 init_parse (filename
)
198 int lowercase_standard_names
= ignore_case
|| ! special_UC
;
200 /* Open input file. */
201 if (filename
== 0 || !strcmp (filename
, "-"))
207 finput
= fopen (filename
, "r");
209 pfatal_with_name (filename
);
211 #ifdef IO_BUFFER_SIZE
212 setvbuf (finput
, (char *) xmalloc (IO_BUFFER_SIZE
), _IOFBF
, IO_BUFFER_SIZE
);
215 /* Make identifier nodes long enough for the language-specific slots. */
216 set_identifier_size (sizeof (struct lang_identifier
));
218 /* Start it at 0, because check_newline is called at the very beginning
219 and will increment it to 1. */
222 /* Initialize these compiler-directive variables. */
223 process_type
= NULL_TREE
;
224 send_buffer_prio
= NULL_TREE
;
225 send_signal_prio
= NULL_TREE
;
226 signal_code
= NULL_TREE
;
229 token_buffer
= xmalloc ((unsigned)(maxtoken
+ 2));
231 init_chill_expand ();
233 #define ENTER_STANDARD_NAME(RID, LOWER, UPPER) \
234 ridpointers[(int) RID] = \
235 get_identifier (lowercase_standard_names ? LOWER : UPPER)
237 ENTER_STANDARD_NAME (RID_ALL
, "all", "ALL");
238 ENTER_STANDARD_NAME (RID_ASSERTFAIL
, "assertfail", "ASSERTFAIL");
239 ENTER_STANDARD_NAME (RID_ASSOCIATION
, "association", "ASSOCIATION");
240 ENTER_STANDARD_NAME (RID_BIN
, "bin", "BIN");
241 ENTER_STANDARD_NAME (RID_BOOL
, "bool", "BOOL");
242 ENTER_STANDARD_NAME (RID_BOOLS
, "bools", "BOOLS");
243 ENTER_STANDARD_NAME (RID_BYTE
, "byte", "BYTE");
244 ENTER_STANDARD_NAME (RID_CHAR
, "char", "CHAR");
245 ENTER_STANDARD_NAME (RID_DOUBLE
, "double", "DOUBLE");
246 ENTER_STANDARD_NAME (RID_DURATION
, "duration", "DURATION");
247 ENTER_STANDARD_NAME (RID_DYNAMIC
, "dynamic", "DYNAMIC");
248 ENTER_STANDARD_NAME (RID_ELSE
, "else", "ELSE");
249 ENTER_STANDARD_NAME (RID_EMPTY
, "empty", "EMPTY");
250 ENTER_STANDARD_NAME (RID_FALSE
, "false", "FALSE");
251 ENTER_STANDARD_NAME (RID_FLOAT
, "float", "FLOAT");
252 ENTER_STANDARD_NAME (RID_GENERAL
, "general", "GENERAL");
253 ENTER_STANDARD_NAME (RID_IN
, "in", "IN");
254 ENTER_STANDARD_NAME (RID_INLINE
, "inline", "INLINE");
255 ENTER_STANDARD_NAME (RID_INOUT
, "inout", "INOUT");
256 ENTER_STANDARD_NAME (RID_INSTANCE
, "instance", "INSTANCE");
257 ENTER_STANDARD_NAME (RID_INT
, "int", "INT");
258 ENTER_STANDARD_NAME (RID_LOC
, "loc", "LOC");
259 ENTER_STANDARD_NAME (RID_LONG
, "long", "LONG");
260 ENTER_STANDARD_NAME (RID_LONG_REAL
, "long_real", "LONG_REAL");
261 ENTER_STANDARD_NAME (RID_NULL
, "null", "NULL");
262 ENTER_STANDARD_NAME (RID_OUT
, "out", "OUT");
263 ENTER_STANDARD_NAME (RID_OVERFLOW
, "overflow", "OVERFLOW");
264 ENTER_STANDARD_NAME (RID_PTR
, "ptr", "PTR");
265 ENTER_STANDARD_NAME (RID_READ
, "read", "READ");
266 ENTER_STANDARD_NAME (RID_REAL
, "real", "REAL");
267 ENTER_STANDARD_NAME (RID_RANGE
, "range", "RANGE");
268 ENTER_STANDARD_NAME (RID_RANGEFAIL
, "rangefail", "RANGEFAIL");
269 ENTER_STANDARD_NAME (RID_RECURSIVE
, "recursive", "RECURSIVE");
270 ENTER_STANDARD_NAME (RID_SHORT
, "short", "SHORT");
271 ENTER_STANDARD_NAME (RID_SIMPLE
, "simple", "SIMPLE");
272 ENTER_STANDARD_NAME (RID_TIME
, "time", "TIME");
273 ENTER_STANDARD_NAME (RID_TRUE
, "true", "TRUE");
274 ENTER_STANDARD_NAME (RID_UBYTE
, "ubyte", "UBYTE");
275 ENTER_STANDARD_NAME (RID_UINT
, "uint", "UINT");
276 ENTER_STANDARD_NAME (RID_ULONG
, "ulong", "ULONG");
277 ENTER_STANDARD_NAME (RID_UNSIGNED
, "unsigned", "UNSIGNED");
278 ENTER_STANDARD_NAME (RID_USHORT
, "ushort", "USHORT");
279 ENTER_STANDARD_NAME (RID_VOID
, "void", "VOID");
291 static int yywrap ();
293 #define YY_PUTBACK_SIZE 5
294 #define YY_BUF_SIZE 1000
296 static char yy_buffer
[YY_PUTBACK_SIZE
+ YY_BUF_SIZE
];
297 static char *yy_cur
= yy_buffer
+ YY_PUTBACK_SIZE
;
298 static char *yy_lim
= yy_buffer
+ YY_PUTBACK_SIZE
;
302 char *buf
= yy_buffer
+ YY_PUTBACK_SIZE
;
304 bcopy (yy_cur
- YY_PUTBACK_SIZE
, yy_buffer
, YY_PUTBACK_SIZE
);
319 c
= check_newline ();
332 while (result
< YY_BUF_SIZE
)
342 /* Because we might switch input files on a compiler directive
343 (that end with '>', don't read past a '>', just in case. */
352 fprintf (stderr
, "-------------------------- finished Line %d\n",
360 yy_lim
= yy_cur
+ result
;
362 return yy_lim
> yy_cur
? *yy_cur
++ : EOF
;
365 #define input() (yy_cur < yy_lim ? *yy_cur++ : yy_refill ())
367 #define unput(c) (*--yy_cur = (c))
370 int starting_pass_2
= 0;
390 case ' ': case '\t': case '\n': case '\f': case '\b': case '\v': case '\r':
412 else if (nextc
== '=')
428 skip_line_comment ();
441 else if (nextc
== '=')
443 else if (nextc
== '*')
486 int len
= 0; /* Number of hex digits seen. */
494 if (!ISXDIGIT (ch
)) /* error on non-hex digit */
497 error ("invalid C'xx' ");
508 if (len
& 1) /* collected two digits, save byte */
509 obstack_1grow (&temporary_obstack
, (char) byte_val
);
512 start
= obstack_finish (&temporary_obstack
);
513 yylval
.ttype
= string_or_char (len
>> 1, start
);
514 obstack_free (&temporary_obstack
, start
);
515 return len
== 2 ? SINGLECHAR
: STRING
;
525 obstack_1grow (&temporary_obstack
, ch
);
526 obstack_1grow (&temporary_obstack
, nextc
);
531 obstack_1grow (&temporary_obstack
, ch
);
535 obstack_1grow (&temporary_obstack
, '\0');
536 start
= obstack_finish (&temporary_obstack
);
540 yylval
.ttype
= convert_integer (start
); /* Pass base? */
545 yylval
.ttype
= convert_bitstring (start
);
553 case 'F': case 'G': case 'I': case 'J':
554 case 'K': case 'L': case 'M': case 'N':
555 case 'P': case 'Q': case 'R': case 'S': case 'T':
556 case 'U': case 'V': case 'W': case 'X': case 'Y':
559 case 'f': case 'g': case 'i': case 'j':
560 case 'k': case 'l': case 'm': case 'n':
561 case 'p': case 'q': case 'r': case 's': case 't':
562 case 'u': case 'v': case 'w': case 'x': case 'y':
566 return handle_name (read_identifier (ch
));
568 tmp
= readstring ('\'', &len
);
569 yylval
.ttype
= string_or_char (len
, tmp
);
571 return len
== 1 ? SINGLECHAR
: STRING
;
573 tmp
= readstring ('\"', &len
);
574 yylval
.ttype
= build_chill_string (len
, tmp
);
580 if (ISDIGIT (nextc
)) /* || nextc == '_') we don't start numbers with '_' */
583 case '0': case '1': case '2': case '3': case '4':
584 case '5': case '6': case '7': case '8': case '9':
586 yylval
.ttype
= read_number (ch
);
587 return TREE_CODE (yylval
.ttype
) == REAL_CST
? FLOATING
: NUMBER
;
594 close_input_file (fn
)
600 if (finput
!= stdin
&& fclose (finput
) == EOF
)
602 error ("can't close %s", fn
);
608 /* Return an identifier, starting with FIRST and then reading
609 more characters using input(). Return an IDENTIFIER_NODE. */
612 read_identifier (first
)
613 int first
; /* First letter of identifier */
619 obstack_1grow (&temporary_obstack
, first
);
623 if (! ISALNUM (first
) && first
!= '_')
629 obstack_1grow (&temporary_obstack
, '\0');
630 start
= obstack_finish (&temporary_obstack
);
631 maybe_downcase (start
);
632 id
= get_identifier (start
);
633 obstack_free (&temporary_obstack
, start
);
637 /* Given an identifier ID, check to see if it is a reserved name,
638 and return the appropriate token type. */
645 tp
= in_word_set (IDENTIFIER_POINTER (id
), IDENTIFIER_LENGTH (id
));
647 && special_UC
== ISUPPER ((unsigned char) tp
->name
[0])
648 && (tp
->flags
== RESERVED
|| tp
->flags
== PREDEF
))
650 if (tp
->rid
!= NORID
)
651 yylval
.ttype
= ridpointers
[tp
->rid
];
652 else if (tp
->token
== THIS
)
653 yylval
.ttype
= lookup_name (get_identifier ("__whoami"));
662 int ch
; /* Initial character */
670 obstack_1grow (&temporary_obstack
, ch
);
672 if (! ISDIGIT (ch
) && ch
!= '_')
680 obstack_1grow (&temporary_obstack
, ch
);
682 } while (ISDIGIT (ch
) || ch
== '_');
685 if (ch
== 'd' || ch
== 'D' || ch
== 'e' || ch
== 'E')
687 /* Convert exponent indication [eEdD] to 'e'. */
688 obstack_1grow (&temporary_obstack
, 'e');
690 if (ch
== '+' || ch
== '-')
692 obstack_1grow (&temporary_obstack
, ch
);
695 if (ISDIGIT (ch
) || ch
== '_')
700 obstack_1grow (&temporary_obstack
, ch
);
702 } while (ISDIGIT (ch
) || ch
== '_');
706 error ("malformed exponent part of floating-point literal");
712 obstack_1grow (&temporary_obstack
, '\0');
713 start
= obstack_finish (&temporary_obstack
);
716 REAL_VALUE_TYPE value
;
717 tree type
= double_type_node
;
719 value
= REAL_VALUE_ATOF (start
, TYPE_MODE (type
));
720 obstack_free (&temporary_obstack
, start
);
721 if (TARGET_FLOAT_FORMAT
!= IEEE_FLOAT_FORMAT
722 && REAL_VALUE_ISINF (value
) && pedantic
)
723 pedwarn ("real number exceeds range of REAL");
724 num
= build_real (type
, value
);
727 num
= convert_integer (start
);
728 CH_DERIVED_FLAG (num
) = 1;
732 /* Skip to the end of a compiler directive. */
742 error ("end-of-file in '<>' directive");
758 /* Read a compiler directive. ("<>{WS}" have already been read. ) */
764 int ch
= skip_whitespace();
765 if (ISALPHA (ch
) || ch
== '_')
766 id
= read_identifier (ch
);
769 error ("end-of-file in '<>' directive");
770 to_global_binding_level ();
775 warning ("unrecognized compiler directive");
779 tp
= in_word_set (IDENTIFIER_POINTER (id
), IDENTIFIER_LENGTH (id
));
780 if (tp
== NULL
|| special_UC
!= ISUPPER ((unsigned char) tp
->name
[0]))
783 warning ("unrecognized compiler directive `%s'",
784 IDENTIFIER_POINTER (id
));
801 case IGNORED_DIRECTIVE
:
803 case PROCESS_TYPE_TOKEN
:
804 process_type
= equal_number ();
812 case SEND_SIGNAL_DEFAULT_PRIORITY
:
813 send_signal_prio
= equal_number ();
815 case SEND_BUFFER_DEFAULT_PRIORITY
:
816 send_buffer_prio
= equal_number ();
819 signal_code
= equal_number ();
822 handle_use_seizefile_directive (0);
824 case USE_SEIZE_FILE_RESTRICTED
:
825 handle_use_seizefile_directive (1);
829 warning ("unrecognized compiler directive `%s'",
830 IDENTIFIER_POINTER (id
));
838 build_chill_string (len
, str
)
844 push_obstacks (&permanent_obstack
, &permanent_obstack
);
845 t
= build_string (len
, str
);
846 TREE_TYPE (t
) = build_string_type (char_type_node
,
847 build_int_2 (len
, 0));
848 CH_DERIVED_FLAG (t
) = 1;
855 string_or_char (len
, str
)
861 push_obstacks (&permanent_obstack
, &permanent_obstack
);
864 result
= build_int_2 ((unsigned char)str
[0], 0);
865 CH_DERIVED_FLAG (result
) = 1;
866 TREE_TYPE (result
) = char_type_node
;
869 result
= build_chill_string (len
, str
);
883 if (ISUPPER ((unsigned char) *str
))
884 *str
= tolower ((unsigned char)*str
);
896 /* check for decimal number */
897 if (*s
>= '0' && *s
<= '9')
901 if (*s
>= '0' && *s
<= '9')
919 if (*s
< '0' || *s
> '9')
924 if (!ISXDIGIT ((unsigned char) *s
))
929 if (*s
< '0' || *s
> '1')
934 if (*s
< '0' || *s
> '7')
946 readstring (terminator
, len
)
951 unsigned allocated
= 1024;
952 char *tmp
= xmalloc (allocated
);
960 if ((c
= input ()) != terminator
)
968 if (c
== '\n' || c
== EOF
)
973 if (c
== EOF
|| c
== '\n')
987 if (cc
== terminator
)
989 if (!(terminator
== '\'' && next_apos
))
991 error ("unterminated control sequence");
996 if (cc
== EOF
|| cc
== '\n')
1006 error ("invalid integer literal in control sequence");
1012 if (cc
== ' ' || cc
== '\t')
1016 if ((c
< 0 || c
> 255) && (pass
== 1))
1017 error ("control sequence overflow");
1018 if (! count
&& pass
== 1)
1019 error ("invalid control sequence");
1024 if ((c
< 0 || c
> 255) && (pass
== 1))
1025 error ("control sequence overflow");
1026 if (! count
&& pass
== 1)
1027 error ("invalid control sequence");
1032 tmp
= xrealloc (tmp
, allocated
);
1041 if (! count
&& pass
== 1)
1042 error ("invalid integer literal in control sequence");
1047 if (cc
== 'D' || cc
== 'd')
1052 else if (cc
== 'H' || cc
== 'h')
1057 else if (cc
== 'O' || cc
== 'o')
1062 else if (cc
== 'B' || cc
== 'b')
1073 if (cc
< '0' || cc
> '1')
1080 if (cc
< '0' || cc
> '8')
1085 else if (base
== 10)
1092 else if (base
== 16)
1107 error ("invalid base in read control sequence");
1112 /* error in control sequence */
1114 error ("invalid digit in control sequence");
1117 c
= (c
* base
) + cc
;
1129 tmp
= xrealloc (tmp
, allocated
);
1133 tmp
[*len
= i
] = '\0';
1141 error ("unterminated string literal");
1142 to_global_binding_level ();
1147 /* Convert an integer INTCHARS into an INTEGER_CST.
1148 INTCHARS is on the temporary_obstack, and is popped by this function. */
1151 convert_integer (intchars
)
1160 int valid_chars
= 0;
1163 HOST_WIDE_INT val_lo
= 0, val_hi
= 0;
1166 /* determine the base */
1189 if (!ISDIGIT (*p
)) /* this test is for equal_number () */
1191 obstack_free (&temporary_obstack
, intchars
);
1200 if ((tmp
== '\'') || (tmp
== '_'))
1204 if (tmp
>= 'a') /* uppercase the char */
1206 switch (base
) /* validate the characters */
1223 if (tmp
> '9' && tmp
< 'A')
1232 if (mul_double (val_lo
, val_hi
, base
, 0, &val_lo
, &val_hi
))
1234 add_double (val_lo
, val_hi
, tmp
, 0, &val_lo
, &val_hi
);
1240 obstack_free (&temporary_obstack
, intchars
);
1244 error ("invalid number format `%s'", oldp
);
1247 val
= build_int_2 (val_lo
, val_hi
);
1248 /* We set the type to long long (or long long unsigned) so that
1249 constant fold of literals is less likely to overflow. */
1250 if (int_fits_type_p (val
, long_long_integer_type_node
))
1251 type
= long_long_integer_type_node
;
1254 if (! int_fits_type_p (val
, long_long_unsigned_type_node
))
1256 type
= long_long_unsigned_type_node
;
1258 TREE_TYPE (val
) = type
;
1259 CH_DERIVED_FLAG (val
) = 1;
1262 error ("integer literal too big");
1267 /* Convert a bitstring literal on the temporary_obstack to
1268 a bitstring CONSTRUCTOR. Free the literal from the obstack. */
1271 convert_bitstring (p
)
1277 int bl
= 0, valid_chars
= 0, bits_per_char
= 0, c
, k
;
1278 tree initlist
= NULL_TREE
;
1281 /* Move p to stack so we can re-use temporary_obstack for result. */
1282 char *oldp
= (char*) alloca (strlen (p
) + 1);
1283 if (oldp
== 0) fatal ("stack space exhausted");
1285 obstack_free (&temporary_obstack
, p
);
1308 if (c
== '_' || c
== '\'')
1317 for (k
= BYTES_BIG_ENDIAN
? bits_per_char
- 1 : 0;
1318 BYTES_BIG_ENDIAN
? k
>= 0 : k
< bits_per_char
;
1319 bl
++, BYTES_BIG_ENDIAN
? k
-- : k
++)
1322 initlist
= tree_cons (NULL_TREE
, build_int_2 (bl
, 0), initlist
);
1326 /* as long as BOOLS(0) is valid it must tbe possible to
1327 specify an empty bitstring */
1331 error ("invalid number format `%s'", oldp
);
1335 val
= build (CONSTRUCTOR
,
1336 build_bitstring_type (size_int (bl
)),
1337 NULL_TREE
, nreverse (initlist
));
1338 TREE_CONSTANT (val
) = 1;
1339 CH_DERIVED_FLAG (val
) = 1;
1343 /* Check if two filenames name the same file.
1344 This is done by stat'ing both files and comparing their inodes.
1346 Note: we have to take care of seize_path_list. Therefore do it the same
1347 way as in yywrap. FIXME: This probably can be done better. */
1350 same_file (filename1
, filename2
)
1358 if (grant_only_flag
)
1359 /* do nothing in this case */
1362 /* if filenames are equal -- return 1, cause there is no need
1363 to search in the include list in this case */
1364 if (strcmp (filename1
, filename2
) == 0)
1367 fn_input
[0] = filename1
;
1368 fn_input
[1] = filename2
;
1370 for (i
= 0; i
< 2; i
++)
1372 stat_status
= stat (fn_input
[i
], &s
[i
]);
1373 if (stat_status
< 0 &&
1374 strchr (fn_input
[i
], '/') == 0)
1379 for (plp
= seize_path_list
; plp
!= 0; plp
= plp
->next
)
1381 path
= (char *)xmalloc (strlen (fn_input
[i
]) +
1382 strlen (plp
->str
) + 2);
1383 sprintf (path
, "%s/%s", plp
->str
, fn_input
[i
]);
1384 stat_status
= stat (path
, &s
[i
]);
1386 if (stat_status
>= 0)
1390 if (stat_status
< 0)
1391 pfatal_with_name (fn_input
[i
]);
1393 return s
[0].st_ino
== s
[1].st_ino
&& s
[0].st_dev
== s
[1].st_dev
;
1397 * Note that simply appending included file names to a list in this
1398 * way completely eliminates the need for nested files, and the
1399 * associated book-keeping, since the EOF processing in the lexer
1400 * will simply process the files one at a time, in the order that the
1401 * USE_SEIZE_FILE directives were scanned.
1404 handle_use_seizefile_directive (restricted
)
1409 int c
= skip_whitespace ();
1410 char *use_seizefile_str
= readstring (c
, &len
);
1415 if (c
!= '\'' && c
!= '\"')
1417 error ("USE_SEIZE_FILE directive must be followed by string");
1421 use_seizefile_name
= get_identifier (use_seizefile_str
);
1422 CH_USE_SEIZEFILE_RESTRICTED (use_seizefile_name
) = restricted
;
1424 if (!grant_only_flag
)
1426 /* If file foo.ch contains a <> use_seize_file "bar.grt" <>,
1427 and file bar.ch contains a <> use_seize_file "foo.grt" <>,
1428 then if we're compiling foo.ch, we will indirectly be
1429 asked to seize foo.grt. Don't. */
1430 extern char *grant_file_name
;
1431 if (strcmp (use_seizefile_str
, grant_file_name
) == 0)
1434 /* Check if the file is already on the list. */
1435 for (seen
= files_to_seize
; seen
!= NULL_TREE
; seen
= TREE_CHAIN (seen
))
1436 if (same_file (IDENTIFIER_POINTER (TREE_VALUE (seen
)),
1438 return; /* Previously seen; nothing to do. */
1441 /* Haven't been asked to seize this file yet, so add
1442 its name to the list. */
1444 tree pl
= perm_tree_cons (0, use_seizefile_name
, NULL_TREE
);
1445 if (files_to_seize
== NULL_TREE
)
1446 files_to_seize
= pl
;
1448 TREE_CHAIN (last_file_to_seize
) = pl
;
1449 if (next_file_to_seize
== NULL_TREE
)
1450 next_file_to_seize
= pl
;
1451 last_file_to_seize
= pl
;
1457 * get input, convert to lower case for comparison
1466 if (ISUPPER (c
) && ignore_case
)
1471 #if defined HANDLE_PRAGMA
1472 /* Local versions of these macros, that can be passed as function pointers. */
1476 return getc (finput
);
1483 ungetc (arg
, finput
);
1485 #endif /* HANDLE_PRAGMA */
1487 #ifdef HANDLE_GENERIC_PRAGMAS
1488 /* Handle a generic #pragma directive.
1489 BUFFER contains the text we read after `#pragma'. Processes the entire input
1490 line and return non-zero iff the pragma was successfully processed. */
1493 handle_generic_pragma (buffer
)
1502 handle_pragma_token (buffer
, NULL
);
1506 while (c
== ' ' || c
== '\t')
1510 if (c
== '\n' || c
== EOF
)
1511 return handle_pragma_token (NULL
, NULL
);
1513 /* Read the next word of the pragma into the buffer. */
1520 while (c
!= EOF
&& isascii (c
) && ! isspace (c
) && c
!= '\n'
1521 && buff
< buffer
+ 128); /* XXX shared knowledge about size of buffer. */
1528 #endif /* HANDLE_GENERIC_PRAGMAS */
1530 /* At the beginning of a line, increment the line number and process
1531 any #-directive on this line. If the line is a #-directive, read
1532 the entire line and return a newline. Otherwise, return the line's
1533 first non-whitespace character.
1535 (Each language front end has a check_newline() function that is called
1536 from lang_init() for that language. One of the things this function
1537 must do is read the first line of the input file, and if it is a #line
1538 directive, extract the filename from it and use it to initialize
1539 main_input_filename. Proper generation of debugging information in
1540 the normal "front end calls cpp then calls cc1XXXX environment" depends
1541 upon this being done.) */
1550 /* Read first nonwhite char on the line. */
1554 while (c
== ' ' || c
== '\t')
1557 if (c
!= '#' || inside_c_comment
)
1559 /* If not #, return it so caller will use it. */
1563 /* Read first nonwhite char after the `#'. */
1566 while (c
== ' ' || c
== '\t')
1569 /* If a letter follows, then if the word here is `line', skip
1570 it and ignore it; otherwise, ignore the line, with an error
1571 if the word isn't `pragma', `ident', `define', or `undef'. */
1573 if (ISUPPER (c
) && ignore_case
)
1576 if (c
>= 'a' && c
<= 'z')
1580 if (getlc (finput
) == 'r'
1581 && getlc (finput
) == 'a'
1582 && getlc (finput
) == 'g'
1583 && getlc (finput
) == 'm'
1584 && getlc (finput
) == 'a'
1585 && (c
= getlc (finput
), ISSPACE (c
)))
1587 #ifdef HANDLE_PRAGMA
1588 static char buffer
[128];
1589 char * buff
= buffer
;
1591 /* Read the pragma name into a buffer. */
1592 while (c
= getlc (finput
), ISSPACE (c
))
1600 while (c
!= EOF
&& ! ISSPACE (c
) && c
!= '\n'
1601 && buff
< buffer
+ 128);
1607 if (HANDLE_PRAGMA (pragma_getc
, pragma_ungetc
, buffer
))
1609 #endif /* HANDLE_PRAGMA */
1611 #ifdef HANDLE_GENERIC_PRAGMAS
1612 if (handle_generic_pragma (buffer
))
1614 #endif /* HANDLE_GENERIC_PRAGMAS */
1622 if (getlc (finput
) == 'e'
1623 && getlc (finput
) == 'f'
1624 && getlc (finput
) == 'i'
1625 && getlc (finput
) == 'n'
1626 && getlc (finput
) == 'e'
1627 && (c
= getlc (finput
), ISSPACE (c
)))
1629 #if 0 /*def DWARF_DEBUGGING_INFO*/
1631 && (debug_info_level
== DINFO_LEVEL_VERBOSE
)
1632 && (write_symbols
== DWARF_DEBUG
))
1633 dwarfout_define (lineno
, get_directive_line (finput
));
1634 #endif /* DWARF_DEBUGGING_INFO */
1640 if (getlc (finput
) == 'n'
1641 && getlc (finput
) == 'd'
1642 && getlc (finput
) == 'e'
1643 && getlc (finput
) == 'f'
1644 && (c
= getlc (finput
), ISSPACE (c
)))
1646 #if 0 /*def DWARF_DEBUGGING_INFO*/
1648 && (debug_info_level
== DINFO_LEVEL_VERBOSE
)
1649 && (write_symbols
== DWARF_DEBUG
))
1650 dwarfout_undef (lineno
, get_directive_line (finput
));
1651 #endif /* DWARF_DEBUGGING_INFO */
1657 if (getlc (finput
) == 'i'
1658 && getlc (finput
) == 'n'
1659 && getlc (finput
) == 'e'
1660 && ((c
= getlc (finput
)) == ' ' || c
== '\t'))
1666 if (getlc (finput
) == 'd'
1667 && getlc (finput
) == 'e'
1668 && getlc (finput
) == 'n'
1669 && getlc (finput
) == 't'
1670 && ((c
= getlc (finput
)) == ' ' || c
== '\t'))
1672 /* #ident. The pedantic warning is now in cccp.c. */
1674 /* Here we have just seen `#ident '.
1675 A string constant should follow. */
1677 while (c
== ' ' || c
== '\t')
1680 /* If no argument, ignore the line. */
1687 || TREE_CODE (yylval
.ttype
) != STRING_CST
)
1689 error ("invalid #ident");
1695 #ifdef ASM_OUTPUT_IDENT
1696 extern FILE *asm_out_file
;
1697 ASM_OUTPUT_IDENT (asm_out_file
, TREE_STRING_POINTER (yylval
.ttype
));
1701 /* Skip the rest of this line. */
1707 error ("undefined or invalid # directive");
1712 /* Here we have either `#line' or `# <nonletter>'.
1713 In either case, it should be a line number; a digit should follow. */
1715 while (c
== ' ' || c
== '\t')
1718 /* If the # is the only nonwhite char on the line,
1719 just ignore it. Check the new newline. */
1723 /* Something follows the #; read a token. */
1727 int old_lineno
= lineno
;
1730 extern struct obstack permanent_obstack
;
1734 l
= l
* 10 + (c
- '0'); /* FIXME Not portable */
1736 } while (ISDIGIT(c
));
1737 /* subtract one, because it is the following line that
1738 gets the specified number */
1742 /* Is this the last nonwhite stuff on the line? */
1744 while (c
== ' ' || c
== '\t')
1748 /* No more: store the line number and check following line. */
1753 /* More follows: it must be a string constant (filename). */
1755 /* Read the string constant, but don't treat \ as special. */
1756 ignore_escape_flag
= 1;
1757 ignore_escape_flag
= 0;
1761 error ("invalid #line");
1768 if (c
== EOF
|| c
== '\n')
1770 error ("invalid #line");
1775 obstack_1grow(&permanent_obstack
, 0);
1776 input_filename
= obstack_finish (&permanent_obstack
);
1779 obstack_1grow(&permanent_obstack
, c
);
1784 /* Each change of file name
1785 reinitializes whether we are now in a system header. */
1786 in_system_header
= 0;
1788 if (main_input_filename
== 0)
1789 main_input_filename
= input_filename
;
1791 /* Is this the last nonwhite stuff on the line? */
1793 while (c
== ' ' || c
== '\t')
1800 /* `1' after file name means entering new file.
1801 `2' after file name means just left a file. */
1807 /* Pushing to a new file. */
1808 struct file_stack
*p
1809 = (struct file_stack
*) xmalloc (sizeof (struct file_stack
));
1810 input_file_stack
->line
= old_lineno
;
1811 p
->next
= input_file_stack
;
1812 p
->name
= input_filename
;
1813 input_file_stack
= p
;
1814 input_file_stack_tick
++;
1815 #ifdef DWARF_DEBUGGING_INFO
1816 if (debug_info_level
== DINFO_LEVEL_VERBOSE
1817 && write_symbols
== DWARF_DEBUG
)
1818 dwarfout_start_new_source_file (input_filename
);
1819 #endif /* DWARF_DEBUGGING_INFO */
1825 /* Popping out of a file. */
1826 if (input_file_stack
->next
)
1828 struct file_stack
*p
= input_file_stack
;
1829 input_file_stack
= p
->next
;
1831 input_file_stack_tick
++;
1832 #ifdef DWARF_DEBUGGING_INFO
1833 if (debug_info_level
== DINFO_LEVEL_VERBOSE
1834 && write_symbols
== DWARF_DEBUG
)
1835 dwarfout_resume_previous_source_file (input_file_stack
->line
);
1836 #endif /* DWARF_DEBUGGING_INFO */
1839 error ("#-lines for entering and leaving files don't match");
1845 /* If we have handled a `1' or a `2',
1846 see if there is another number to read. */
1849 /* Is this the last nonwhite stuff on the line? */
1851 while (c
== ' ' || c
== '\t')
1858 /* `3' after file name means this is a system header file. */
1861 in_system_header
= 1;
1864 error ("invalid #-line");
1866 /* skip the rest of this line. */
1868 while (c
!= '\n' && c
!= EOF
)
1875 get_chill_filename ()
1877 return (build_chill_string (
1878 strlen (input_filename
) + 1, /* +1 to get a zero terminated string */
1883 get_chill_linenumber ()
1885 return build_int_2 ((HOST_WIDE_INT
)lineno
, 0);
1889 /* Assuming '/' and '*' have been read, skip until we've
1890 read the terminating '*' and '/'. */
1896 int start_line
= lineno
;
1902 error_with_file_and_line (input_filename
, start_line
,
1903 "unterminated comment");
1908 else if ((c
= input ()) == '/')
1914 /* Assuming "--" has been read, skip until '\n'. */
1917 skip_line_comment ()
1941 if (c
== ' ' || c
== '\t' || c
== '\r' || c
== '\n' || c
== '\v')
1962 skip_line_comment ();
1976 * avoid recursive calls to yylex to parse the ' = digits' or
1977 * ' = SYNvalue' which are supposed to follow certain compiler
1978 * directives. Read the input stream, and return the value parsed.
1980 /* FIXME: overflow check in here */
1981 /* FIXME: check for EOF around here */
1988 tree retval
= integer_zero_node
;
1990 c
= skip_whitespace();
1994 error ("missing `=' in compiler directive");
1995 return integer_zero_node
;
1997 c
= skip_whitespace();
1999 /* collect token into tokenbuf for later analysis */
2002 if (ISSPACE (c
) || c
== '<')
2004 obstack_1grow (&temporary_obstack
, c
);
2007 unput (c
); /* put uninteresting char back */
2008 obstack_1grow (&temporary_obstack
, '\0'); /* terminate token */
2009 tokenbuf
= obstack_finish (&temporary_obstack
);
2010 maybe_downcase (tokenbuf
);
2012 if (*tokenbuf
== '-')
2013 /* will fail in the next test */
2015 else if (maybe_number (tokenbuf
))
2018 return integer_zero_node
;
2019 push_obstacks_nochange ();
2020 end_temporary_allocation ();
2021 yylval
.ttype
= convert_integer (tokenbuf
);
2022 tokenbuf
= 0; /* Was freed by convert_integer. */
2023 result
= yylval
.ttype
? NUMBER
: 0;
2029 if (result
== NUMBER
)
2031 retval
= yylval
.ttype
;
2033 else if (result
== BITSTRING
)
2036 error ("invalid value follows `=' in compiler directive");
2039 else /* not a number */
2043 if (!ISALPHA (c
) && c
!= '_')
2046 error ("invalid value follows `=' in compiler directive");
2050 for (cursor
= &tokenbuf
[1]; *cursor
!= '\0'; cursor
++)
2051 if (ISALPHA ((unsigned char) *cursor
) || *cursor
== '_' ||
2057 error ("invalid `%c' character in name", *cursor
);
2064 tree value
= lookup_name (get_identifier (tokenbuf
));
2065 if (value
== NULL_TREE
2066 || TREE_CODE (value
) != CONST_DECL
2067 || TREE_CODE (DECL_INITIAL (value
)) != INTEGER_CST
)
2070 error ("`%s' not integer constant synonym ",
2074 obstack_free (&temporary_obstack
, tokenbuf
);
2076 push_obstacks_nochange ();
2077 end_temporary_allocation ();
2078 retval
= convert (chill_taskingcode_type_node
, DECL_INITIAL (value
));
2083 /* check the value */
2084 if (TREE_CODE (retval
) != INTEGER_CST
)
2087 error ("invalid value follows `=' in compiler directive");
2089 else if (TREE_INT_CST_HIGH (retval
) != 0 ||
2090 TREE_INT_CST_LOW (retval
) > TREE_INT_CST_LOW (TYPE_MAX_VALUE (chill_unsigned_type_node
)))
2093 error ("value out of range in compiler directive");
2097 obstack_free (&temporary_obstack
, tokenbuf
);
2102 * add a possible grant-file path to the list
2105 register_seize_path (path
)
2108 int pathlen
= strlen (path
);
2109 char *new_path
= (char *)xmalloc (pathlen
+ 1);
2110 STRING_LIST
*pl
= (STRING_LIST
*)xmalloc (sizeof (STRING_LIST
));
2112 /* strip off trailing slash if any */
2113 if (path
[pathlen
- 1] == '/')
2116 memcpy (new_path
, path
, pathlen
);
2118 pl
->next
= seize_path_list
;
2119 seize_path_list
= pl
;
2123 /* Used by decode_decl to indicate that a <> use_seize_file NAME <>
2124 directive has been written to the grantfile. */
2127 mark_use_seizefile_written (name
)
2132 for (node
= files_to_seize
; node
!= NULL_TREE
; node
= TREE_CHAIN (node
))
2133 if (TREE_VALUE (node
) == name
)
2135 TREE_PURPOSE (node
) = integer_one_node
;
2144 extern char *chill_real_input_filename
;
2146 close_input_file (input_filename
);
2148 use_seizefile_name
= NULL_TREE
;
2150 if (next_file_to_seize
&& !grant_only_flag
)
2152 FILE *grt_in
= NULL
;
2153 char *seizefile_name_chars
2154 = IDENTIFIER_POINTER (TREE_VALUE (next_file_to_seize
));
2156 /* find a seize file, open it. If it's not at the path the
2157 * user gave us, and that path contains no slashes, look on
2158 * the seize_file paths, specified by the '-I' options.
2160 grt_in
= fopen (seizefile_name_chars
, "r");
2162 && strchr (seizefile_name_chars
, '/') == NULL
)
2167 for (plp
= seize_path_list
; plp
!= NULL
; plp
= plp
->next
)
2169 path
= (char *)xmalloc (strlen (seizefile_name_chars
)
2170 + strlen (plp
->str
) + 2);
2172 sprintf (path
, "%s/%s", plp
->str
, seizefile_name_chars
);
2173 grt_in
= fopen (path
, "r");
2178 seizefile_name_chars
= path
;
2185 pfatal_with_name (seizefile_name_chars
);
2188 input_filename
= seizefile_name_chars
;
2191 current_seizefile_name
= TREE_VALUE (next_file_to_seize
);
2193 next_file_to_seize
= TREE_CHAIN (next_file_to_seize
);
2201 next_file_to_seize
= files_to_seize
;
2202 current_seizefile_name
= NULL_TREE
;
2204 if (strcmp (main_input_filename
, "stdin"))
2205 finput
= fopen (chill_real_input_filename
, "r");
2210 error ("can't reopen %s", chill_real_input_filename
);
2213 input_filename
= main_input_filename
;
2216 /* Read a line directive if there is one. */
2217 ungetc (check_newline (), finput
);
2218 starting_pass_2
= 1;
2220 if (module_number
== 0)
2221 warning ("no modules seen");