2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
3 Free Software Foundation, Inc.
4 Contributed by Andy Vaught
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 2, or (at your option) any later
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING. If not, write to the Free
20 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
23 /* Set of subroutines to (ultimately) return the next character to the
24 various matching subroutines. This file's job is to read files and
25 build up lines that are parsed by the parser. This means that we
26 handle continuation lines and "include" lines.
28 The first thing the scanner does is to load an entire file into
29 memory. We load the entire file into memory for a couple reasons.
30 The first is that we want to be able to deal with nonseekable input
31 (pipes, stdin) and there is a lot of backing up involved during
34 The second is that we want to be able to print the locus of errors,
35 and an error on line 999999 could conflict with something on line
36 one. Given nonseekable input, we've got to store the whole thing.
38 One thing that helps are the column truncation limits that give us
39 an upper bound on the size of individual lines. We don't store the
42 From the scanner's viewpoint, the higher level subroutines ask for
43 new characters and do a lot of jumping backwards. */
50 /* Structure for holding module and include file search path. */
51 typedef struct gfc_directorylist
54 struct gfc_directorylist *next;
58 /* List of include file search directories. */
59 static gfc_directorylist *include_dirs;
61 static gfc_file *file_head, *current_file;
63 static int continue_flag, end_flag;
65 gfc_source_form gfc_current_form;
66 static gfc_linebuf *line_head, *line_tail;
68 locus gfc_current_locus;
69 const char *gfc_source_file;
70 static FILE *gfc_src_file;
71 static char *gfc_src_preprocessor_lines[2];
74 /* Main scanner initialization. */
77 gfc_scanner_init_1 (void)
87 /* Main scanner destructor. */
90 gfc_scanner_done_1 (void)
95 while(line_head != NULL)
102 while(file_head != NULL)
105 gfc_free(file_head->filename);
113 /* Adds path to the list pointed to by list. */
116 gfc_add_include_path (const char *path)
118 gfc_directorylist *dir;
122 while (*p == ' ' || *p == '\t') /* someone might do 'gfortran "-I include"' */
129 dir = include_dirs = gfc_getmem (sizeof (gfc_directorylist));
136 dir->next = gfc_getmem (sizeof (gfc_directorylist));
141 dir->path = gfc_getmem (strlen (p) + 2);
142 strcpy (dir->path, p);
143 strcat (dir->path, "/"); /* make '/' last character */
147 /* Release resources allocated for options. */
150 gfc_release_include_path (void)
152 gfc_directorylist *p;
154 gfc_free (gfc_option.module_dir);
155 while (include_dirs != NULL)
158 include_dirs = include_dirs->next;
164 /* Opens file for reading, searching through the include directories
165 given if necessary. If the include_cwd argument is true, we try
166 to open the file in the current directory first. */
169 gfc_open_included_file (const char *name, const bool include_cwd)
172 gfc_directorylist *p;
177 f = gfc_open_file (name);
182 for (p = include_dirs; p; p = p->next)
184 fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
185 strcpy (fullname, p->path);
186 strcat (fullname, name);
188 f = gfc_open_file (fullname);
196 /* Test to see if we're at the end of the main source file. */
206 /* Test to see if we're at the end of the current file. */
215 if (line_head == NULL)
216 return 1; /* Null file */
218 if (gfc_current_locus.lb == NULL)
225 /* Test to see if we're at the beginning of a new line. */
233 return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
237 /* Test to see if we're at the end of a line. */
246 return (*gfc_current_locus.nextc == '\0');
250 /* Advance the current line pointer to the next line. */
253 gfc_advance_line (void)
258 if (gfc_current_locus.lb == NULL)
264 gfc_current_locus.lb = gfc_current_locus.lb->next;
266 if (gfc_current_locus.lb != NULL)
267 gfc_current_locus.nextc = gfc_current_locus.lb->line;
270 gfc_current_locus.nextc = NULL;
276 /* Get the next character from the input, advancing gfc_current_file's
277 locus. When we hit the end of the line or the end of the file, we
278 start returning a '\n' in order to complete the current statement.
279 No Fortran line conventions are implemented here.
281 Requiring explicit advances to the next line prevents the parse
282 pointer from being on the wrong line if the current statement ends
290 if (gfc_current_locus.nextc == NULL)
293 c = *gfc_current_locus.nextc++;
296 gfc_current_locus.nextc--; /* Remain on this line. */
303 /* Skip a comment. When we come here the parse pointer is positioned
304 immediately after the comment character. If we ever implement
305 compiler directives withing comments, here is where we parse the
309 skip_comment_line (void)
323 /* Comment lines are null lines, lines containing only blanks or lines
324 on which the first nonblank line is a '!'. */
327 skip_free_comments (void)
334 start = gfc_current_locus;
342 while (gfc_is_whitespace (c));
352 skip_comment_line ();
359 gfc_current_locus = start;
363 /* Skip comment lines in fixed source mode. We have the same rules as
364 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
365 in column 1, and a '!' cannot be in column 6. Also, we deal with
366 lines with 'd' or 'D' in column 1, if the user requested this. */
369 skip_fixed_comments (void)
377 start = gfc_current_locus;
388 if (c == '!' || c == 'c' || c == 'C' || c == '*')
390 skip_comment_line ();
394 if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
396 if (gfc_option.flag_d_lines == 0)
398 skip_comment_line ();
402 *start.nextc = c = ' ';
407 while (gfc_is_whitespace (c))
419 if (col != 6 && c == '!')
421 skip_comment_line ();
428 gfc_current_locus = start;
432 /* Skips the current line if it is a comment. Assumes that we are at
433 the start of the current line. */
436 gfc_skip_comments (void)
439 if (!gfc_at_bol () || gfc_current_form == FORM_FREE)
440 skip_free_comments ();
442 skip_fixed_comments ();
446 /* Get the next character from the input, taking continuation lines
447 and end-of-line comments into account. This implies that comment
448 lines between continued lines must be eaten here. For higher-level
449 subroutines, this flattens continued lines into a single logical
450 line. The in_string flag denotes whether we're inside a character
454 gfc_next_char_literal (int in_string)
466 if (gfc_current_form == FORM_FREE)
469 if (!in_string && c == '!')
471 /* This line can't be continued */
478 /* Avoid truncation warnings for comment ending lines. */
479 gfc_current_locus.lb->truncated = 0;
487 /* If the next nonblank character is a ! or \n, we've got a
488 continuation line. */
489 old_loc = gfc_current_locus;
492 while (gfc_is_whitespace (c))
495 /* Character constants to be continued cannot have commentary
498 if (in_string && c != '\n')
500 gfc_current_locus = old_loc;
505 if (c != '!' && c != '\n')
507 gfc_current_locus = old_loc;
514 skip_comment_line ();
518 /* We've got a continuation line and need to find where it continues.
519 First eat any comment lines. */
520 gfc_skip_comments ();
522 /* Now that we have a non-comment line, probe ahead for the
523 first non-whitespace character. If it is another '&', then
524 reading starts at the next character, otherwise we must back
525 up to where the whitespace started and resume from there. */
527 old_loc = gfc_current_locus;
530 while (gfc_is_whitespace (c))
534 gfc_current_locus = old_loc;
539 /* Fixed form continuation. */
540 if (!in_string && c == '!')
542 /* Skip comment at end of line. */
549 /* Avoid truncation warnings for comment ending lines. */
550 gfc_current_locus.lb->truncated = 0;
557 old_loc = gfc_current_locus;
560 gfc_skip_comments ();
562 /* See if this line is a continuation line. */
563 for (i = 0; i < 5; i++)
567 goto not_continuation;
571 if (c == '0' || c == ' ')
572 goto not_continuation;
575 /* Ready to read first character of continuation line, which might
576 be another continuation line! */
581 gfc_current_locus = old_loc;
589 /* Get the next character of input, folded to lowercase. In fixed
590 form mode, we also ignore spaces. When matcher subroutines are
591 parsing character literals, they have to call
592 gfc_next_char_literal(). */
601 c = gfc_next_char_literal (0);
603 while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
615 old_loc = gfc_current_locus;
616 c = gfc_next_char ();
617 gfc_current_locus = old_loc;
623 /* Recover from an error. We try to get past the current statement
624 and get lined up for the next. The next statement follows a '\n'
625 or a ';'. We also assume that we are not within a character
626 constant, and deal with finding a '\'' or '"'. */
629 gfc_error_recovery (void)
638 c = gfc_next_char ();
639 if (c == '\n' || c == ';')
642 if (c != '\'' && c != '"')
671 /* Read ahead until the next character to be read is not whitespace. */
674 gfc_gobble_whitespace (void)
681 old_loc = gfc_current_locus;
682 c = gfc_next_char_literal (0);
684 while (gfc_is_whitespace (c));
686 gfc_current_locus = old_loc;
690 /* Load a single line into pbuf.
692 If pbuf points to a NULL pointer, it is allocated.
693 We truncate lines that are too long, unless we're dealing with
694 preprocessor lines or if the option -ffixed-line-length-none is set,
695 in which case we reallocate the buffer to fit the entire line, if
697 In fixed mode, we expand a tab that occurs within the statement
698 label region to expand to spaces that leave the next character in
700 load_line returns whether the line was truncated. */
703 load_line (FILE * input, char **pbuf, int *pbuflen)
705 int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
709 /* Determine the maximum allowed line length.
710 The default for free-form is GFC_MAX_LINE, for fixed-form or for
711 unknown form it is 72. Refer to the documentation in gfc_option_t. */
712 if (gfc_current_form == FORM_FREE)
714 if (gfc_option.free_line_length == -1)
715 maxlen = GFC_MAX_LINE;
717 maxlen = gfc_option.free_line_length;
719 else if (gfc_current_form == FORM_FIXED)
721 if (gfc_option.fixed_line_length == -1)
724 maxlen = gfc_option.fixed_line_length;
731 /* Allocate the line buffer, storing its length into buflen. */
735 buflen = GFC_MAX_LINE;
737 *pbuf = gfc_getmem (buflen + 1);
743 preprocessor_flag = 0;
746 /* In order to not truncate preprocessor lines, we have to
747 remember that this is one. */
748 preprocessor_flag = 1;
761 continue; /* Gobble characters. */
767 /* Ctrl-Z ends the file. */
768 while (fgetc (input) != EOF);
772 if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
773 { /* Tab expansion. */
786 if (maxlen == 0 || preprocessor_flag)
790 /* Reallocate line buffer to double size to hold the
793 *pbuf = xrealloc (*pbuf, buflen + 1);
797 else if (i >= maxlen)
799 /* Truncate the rest of the line. */
803 if (c == '\n' || c == EOF)
809 ungetc ('\n', input);
813 /* Pad lines to the selected line length in fixed form. */
814 if (gfc_current_form == FORM_FIXED
815 && gfc_option.fixed_line_length != 0
816 && !preprocessor_flag
830 /* Get a gfc_file structure, initialize it and add it to
834 get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
838 f = gfc_getmem (sizeof (gfc_file));
840 f->filename = gfc_getmem (strlen (name) + 1);
841 strcpy (f->filename, name);
846 f->included_by = current_file;
847 if (current_file != NULL)
848 f->inclusion_line = current_file->line;
850 #ifdef USE_MAPPED_LOCATION
851 linemap_add (&line_table, reason, false, f->filename, 1);
857 /* Deal with a line from the C preprocessor. The
858 initial octothorp has already been seen. */
861 preprocessor_line (char *c)
867 int escaped, unescape;
870 while (*c == ' ' || *c == '\t')
873 if (*c < '0' || *c > '9')
881 /* No file name given. Set new line number. */
882 current_file->line = line;
887 while (*c == ' ' || *c == '\t')
897 /* Make filename end at quote. */
900 while (*c && ! (! escaped && *c == '"'))
913 /* Preprocessor line has no closing quote. */
918 /* Undo effects of cpp_quote_string. */
922 char *d = gfc_getmem (c - filename - unescape);
938 flag[1] = flag[2] = flag[3] = flag[4] = false;
949 if (1 <= i && i <= 4)
953 /* Interpret flags. */
955 if (flag[1]) /* Starting new file. */
957 f = get_file (filename, LC_RENAME);
958 f->up = current_file;
962 if (flag[2]) /* Ending current file. */
964 if (!current_file->up
965 || strcmp (current_file->up->filename, filename) != 0)
967 gfc_warning_now ("%s:%d: file %s left but not entered",
968 current_file->filename, current_file->line,
974 current_file = current_file->up;
977 /* The name of the file can be a temporary file produced by
978 cpp. Replace the name if it is different. */
980 if (strcmp (current_file->filename, filename) != 0)
982 gfc_free (current_file->filename);
983 current_file->filename = gfc_getmem (strlen (filename) + 1);
984 strcpy (current_file->filename, filename);
987 /* Set new line number. */
988 current_file->line = line;
994 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
995 current_file->filename, current_file->line);
996 current_file->line++;
1000 static try load_file (const char *, bool);
1002 /* include_line()-- Checks a line buffer to see if it is an include
1003 line. If so, we call load_file() recursively to load the included
1004 file. We never return a syntax error because a statement like
1005 "include = 5" is perfectly legal. We return false if no include was
1006 processed or true if we matched an include. */
1009 include_line (char *line)
1011 char quote, *c, *begin, *stop;
1014 while (*c == ' ' || *c == '\t')
1017 if (strncasecmp (c, "include", 7))
1021 while (*c == ' ' || *c == '\t')
1024 /* Find filename between quotes. */
1027 if (quote != '"' && quote != '\'')
1032 while (*c != quote && *c != '\0')
1040 while (*c == ' ' || *c == '\t')
1043 if (*c != '\0' && *c != '!')
1046 /* We have an include line at this point. */
1048 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
1049 read by anything else. */
1051 load_file (begin, false);
1055 /* Load a file into memory by calling load_line until the file ends. */
1058 load_file (const char *filename, bool initial)
1066 for (f = current_file; f; f = f->up)
1067 if (strcmp (filename, f->filename) == 0)
1069 gfc_error_now ("File '%s' is being included recursively", filename);
1077 input = gfc_src_file;
1078 gfc_src_file = NULL;
1081 input = gfc_open_file (filename);
1084 gfc_error_now ("Can't open file '%s'", filename);
1090 input = gfc_open_included_file (filename, false);
1093 gfc_error_now ("Can't open included file '%s'", filename);
1098 /* Load the file. */
1100 f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
1101 f->up = current_file;
1103 current_file->line = 1;
1107 if (initial && gfc_src_preprocessor_lines[0])
1109 preprocessor_line (gfc_src_preprocessor_lines[0]);
1110 gfc_free (gfc_src_preprocessor_lines[0]);
1111 gfc_src_preprocessor_lines[0] = NULL;
1112 if (gfc_src_preprocessor_lines[1])
1114 preprocessor_line (gfc_src_preprocessor_lines[1]);
1115 gfc_free (gfc_src_preprocessor_lines[1]);
1116 gfc_src_preprocessor_lines[1] = NULL;
1122 int trunc = load_line (input, &line, &line_len);
1124 len = strlen (line);
1125 if (feof (input) && len == 0)
1128 /* There are three things this line can be: a line of Fortran
1129 source, an include line or a C preprocessor directive. */
1133 preprocessor_line (line);
1137 if (include_line (line))
1139 current_file->line++;
1145 b = gfc_getmem (gfc_linebuf_header_size + len + 1);
1147 #ifdef USE_MAPPED_LOCATION
1149 = linemap_line_start (&line_table, current_file->line++, 120);
1151 b->linenum = current_file->line++;
1153 b->file = current_file;
1154 b->truncated = trunc;
1155 strcpy (b->line, line);
1157 if (line_head == NULL)
1160 line_tail->next = b;
1165 /* Release the line buffer allocated in load_line. */
1170 current_file = current_file->up;
1171 #ifdef USE_MAPPED_LOCATION
1172 linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
1178 /* Open a new file and start scanning from that file. Returns SUCCESS
1179 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1180 it tries to determine the source form from the filename, defaulting
1188 result = load_file (gfc_source_file, true);
1190 gfc_current_locus.lb = line_head;
1191 gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
1193 #if 0 /* Debugging aid. */
1194 for (; line_head; line_head = line_head->next)
1195 gfc_status ("%s:%3d %s\n", line_head->file->filename,
1196 #ifdef USE_MAPPED_LOCATION
1197 LOCATION_LINE (line_head->location),
1210 unescape_filename (const char *ptr)
1212 const char *p = ptr, *s;
1214 int escaped, unescape = 0;
1216 /* Make filename end at quote. */
1218 while (*p && ! (! escaped && *p == '"'))
1222 else if (*p == '\\')
1233 /* Undo effects of cpp_quote_string. */
1235 d = gfc_getmem (p + 1 - ptr - unescape);
1250 /* For preprocessed files, if the first tokens are of the form # NUM.
1251 handle the directives so we know the original file name. */
1254 gfc_read_orig_filename (const char *filename, const char **canon_source_file)
1259 gfc_src_file = gfc_open_file (filename);
1260 if (gfc_src_file == NULL)
1263 c = fgetc (gfc_src_file);
1264 ungetc (c, gfc_src_file);
1270 load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
1272 if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
1275 filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
1276 if (filename == NULL)
1279 c = fgetc (gfc_src_file);
1280 ungetc (c, gfc_src_file);
1286 load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
1288 if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
1291 dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
1292 if (dirname == NULL)
1295 len = strlen (dirname);
1296 if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
1301 dirname[len - 2] = '\0';
1302 set_src_pwd (dirname);
1304 if (! IS_ABSOLUTE_PATH (filename))
1306 char *p = gfc_getmem (len + strlen (filename));
1308 memcpy (p, dirname, len - 2);
1310 strcpy (p + len - 1, filename);
1311 *canon_source_file = p;