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. */
49 /* Structure for holding module and include file search path. */
50 typedef struct gfc_directorylist
53 struct gfc_directorylist *next;
57 /* List of include file search directories. */
58 static gfc_directorylist *include_dirs;
60 static gfc_file *file_head, *current_file;
62 static int continue_flag, end_flag;
64 gfc_source_form gfc_current_form;
65 static gfc_linebuf *line_head, *line_tail;
67 locus gfc_current_locus;
68 char *gfc_source_file;
71 /* Main scanner initialization. */
74 gfc_scanner_init_1 (void)
84 /* Main scanner destructor. */
87 gfc_scanner_done_1 (void)
92 while(line_head != NULL)
99 while(file_head != NULL)
102 gfc_free(file_head->filename);
110 /* Adds path to the list pointed to by list. */
113 gfc_add_include_path (const char *path)
115 gfc_directorylist *dir;
119 while (*p == ' ' || *p == '\t') /* someone might do 'gfortran "-I include"' */
126 dir = include_dirs = gfc_getmem (sizeof (gfc_directorylist));
133 dir->next = gfc_getmem (sizeof (gfc_directorylist));
138 dir->path = gfc_getmem (strlen (p) + 2);
139 strcpy (dir->path, p);
140 strcat (dir->path, "/"); /* make '/' last character */
144 /* Release resources allocated for options. */
147 gfc_release_include_path (void)
149 gfc_directorylist *p;
151 gfc_free (gfc_option.module_dir);
152 while (include_dirs != NULL)
155 include_dirs = include_dirs->next;
161 /* Opens file for reading, searching through the include directories
162 given if necessary. */
165 gfc_open_included_file (const char *name)
167 char fullname[PATH_MAX];
168 gfc_directorylist *p;
171 f = gfc_open_file (name);
175 for (p = include_dirs; p; p = p->next)
177 if (strlen (p->path) + strlen (name) + 1 > PATH_MAX)
180 strcpy (fullname, p->path);
181 strcat (fullname, name);
183 f = gfc_open_file (fullname);
191 /* Test to see if we're at the end of the main source file. */
201 /* Test to see if we're at the end of the current file. */
210 if (line_head == NULL)
211 return 1; /* Null file */
213 if (gfc_current_locus.lb == NULL)
220 /* Test to see if we're at the beginning of a new line. */
228 return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
232 /* Test to see if we're at the end of a line. */
241 return (*gfc_current_locus.nextc == '\0');
245 /* Advance the current line pointer to the next line. */
248 gfc_advance_line (void)
253 if (gfc_current_locus.lb == NULL)
259 gfc_current_locus.lb = gfc_current_locus.lb->next;
261 if (gfc_current_locus.lb != NULL)
262 gfc_current_locus.nextc = gfc_current_locus.lb->line;
265 gfc_current_locus.nextc = NULL;
271 /* Get the next character from the input, advancing gfc_current_file's
272 locus. When we hit the end of the line or the end of the file, we
273 start returning a '\n' in order to complete the current statement.
274 No Fortran line conventions are implemented here.
276 Requiring explicit advances to the next line prevents the parse
277 pointer from being on the wrong line if the current statement ends
285 if (gfc_current_locus.nextc == NULL)
288 c = *gfc_current_locus.nextc++;
291 gfc_current_locus.nextc--; /* Remain on this line. */
298 /* Skip a comment. When we come here the parse pointer is positioned
299 immediately after the comment character. If we ever implement
300 compiler directives withing comments, here is where we parse the
304 skip_comment_line (void)
318 /* Comment lines are null lines, lines containing only blanks or lines
319 on which the first nonblank line is a '!'. */
322 skip_free_comments (void)
329 start = gfc_current_locus;
337 while (gfc_is_whitespace (c));
347 skip_comment_line ();
354 gfc_current_locus = start;
358 /* Skip comment lines in fixed source mode. We have the same rules as
359 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
360 in column 1, and a '!' cannot be in column 6. */
363 skip_fixed_comments (void)
371 start = gfc_current_locus;
382 if (c == '!' || c == 'c' || c == 'C' || c == '*')
384 skip_comment_line ();
394 while (gfc_is_whitespace (c));
402 if (col != 6 && c == '!')
404 skip_comment_line ();
411 gfc_current_locus = start;
415 /* Skips the current line if it is a comment. Assumes that we are at
416 the start of the current line. */
419 gfc_skip_comments (void)
422 if (!gfc_at_bol () || gfc_current_form == FORM_FREE)
423 skip_free_comments ();
425 skip_fixed_comments ();
429 /* Get the next character from the input, taking continuation lines
430 and end-of-line comments into account. This implies that comment
431 lines between continued lines must be eaten here. For higher-level
432 subroutines, this flattens continued lines into a single logical
433 line. The in_string flag denotes whether we're inside a character
437 gfc_next_char_literal (int in_string)
449 if (gfc_current_form == FORM_FREE)
452 if (!in_string && c == '!')
454 /* This line can't be continued */
461 /* Avoid truncation warnings for comment ending lines. */
462 gfc_current_locus.lb->truncated = 0;
470 /* If the next nonblank character is a ! or \n, we've got a
471 continuation line. */
472 old_loc = gfc_current_locus;
475 while (gfc_is_whitespace (c))
478 /* Character constants to be continued cannot have commentary
481 if (in_string && c != '\n')
483 gfc_current_locus = old_loc;
488 if (c != '!' && c != '\n')
490 gfc_current_locus = old_loc;
497 skip_comment_line ();
501 /* We've got a continuation line and need to find where it continues.
502 First eat any comment lines. */
503 gfc_skip_comments ();
505 /* Now that we have a non-comment line, probe ahead for the
506 first non-whitespace character. If it is another '&', then
507 reading starts at the next character, otherwise we must back
508 up to where the whitespace started and resume from there. */
510 old_loc = gfc_current_locus;
513 while (gfc_is_whitespace (c))
517 gfc_current_locus = old_loc;
522 /* Fixed form continuation. */
523 if (!in_string && c == '!')
525 /* Skip comment at end of line. */
532 /* Avoid truncation warnings for comment ending lines. */
533 gfc_current_locus.lb->truncated = 0;
540 old_loc = gfc_current_locus;
543 gfc_skip_comments ();
545 /* See if this line is a continuation line. */
546 for (i = 0; i < 5; i++)
550 goto not_continuation;
554 if (c == '0' || c == ' ')
555 goto not_continuation;
558 /* Ready to read first character of continuation line, which might
559 be another continuation line! */
564 gfc_current_locus = old_loc;
572 /* Get the next character of input, folded to lowercase. In fixed
573 form mode, we also ignore spaces. When matcher subroutines are
574 parsing character literals, they have to call
575 gfc_next_char_literal(). */
584 c = gfc_next_char_literal (0);
586 while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
598 old_loc = gfc_current_locus;
599 c = gfc_next_char ();
600 gfc_current_locus = old_loc;
606 /* Recover from an error. We try to get past the current statement
607 and get lined up for the next. The next statement follows a '\n'
608 or a ';'. We also assume that we are not within a character
609 constant, and deal with finding a '\'' or '"'. */
612 gfc_error_recovery (void)
621 c = gfc_next_char ();
622 if (c == '\n' || c == ';')
625 if (c != '\'' && c != '"')
654 /* Read ahead until the next character to be read is not whitespace. */
657 gfc_gobble_whitespace (void)
664 old_loc = gfc_current_locus;
665 c = gfc_next_char_literal (0);
667 while (gfc_is_whitespace (c));
669 gfc_current_locus = old_loc;
673 /* Load a single line into pbuf.
675 If pbuf points to a NULL pointer, it is allocated.
676 We truncate lines that are too long, unless we're dealing with
677 preprocessor lines or if the option -ffixed-line-length-none is set,
678 in which case we reallocate the buffer to fit the entire line, if
680 In fixed mode, we expand a tab that occurs within the statement
681 label region to expand to spaces that leave the next character in
683 load_line returns wether the line was truncated. */
686 load_line (FILE * input, char **pbuf)
688 int c, maxlen, i, preprocessor_flag;
690 static int buflen = 0;
693 /* Determine the maximum allowed line length. */
694 if (gfc_current_form == FORM_FREE)
695 maxlen = GFC_MAX_LINE;
697 maxlen = gfc_option.fixed_line_length;
701 /* Allocate the line buffer, storing its length into buflen. */
705 buflen = GFC_MAX_LINE;
707 *pbuf = gfc_getmem (buflen + 1);
713 preprocessor_flag = 0;
716 /* In order to not truncate preprocessor lines, we have to
717 remember that this is one. */
718 preprocessor_flag = 1;
731 continue; /* Gobble characters. */
737 /* Ctrl-Z ends the file. */
738 while (fgetc (input) != EOF);
742 if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
743 { /* Tab expansion. */
756 if (i >= buflen && (maxlen == 0 || preprocessor_flag))
758 /* Reallocate line buffer to double size to hold the
761 *pbuf = xrealloc (*pbuf, buflen);
764 else if (i >= buflen)
766 /* Truncate the rest of the line. */
770 if (c == '\n' || c == EOF)
776 ungetc ('\n', input);
780 /* Pad lines to the selected line length in fixed form. */
781 if (gfc_current_form == FORM_FIXED
782 && gfc_option.fixed_line_length > 0
783 && !preprocessor_flag
794 /* Get a gfc_file structure, initialize it and add it to
798 get_file (char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
802 f = gfc_getmem (sizeof (gfc_file));
804 f->filename = gfc_getmem (strlen (name) + 1);
805 strcpy (f->filename, name);
810 f->included_by = current_file;
811 if (current_file != NULL)
812 f->inclusion_line = current_file->line;
814 #ifdef USE_MAPPED_LOCATION
815 linemap_add (&line_table, reason, false, f->filename, 1);
821 /* Deal with a line from the C preprocessor. The
822 initial octothorp has already been seen. */
825 preprocessor_line (char *c)
834 while (*c == ' ' || *c == '\t')
837 if (*c < '0' || *c > '9')
845 /* No file name given. Set new line number. */
846 current_file->line = line;
851 while (*c == ' ' || *c == '\t')
861 /* Make filename end at quote. */
863 while (*c && ! (! escaped && *c == '"'))
868 escaped = *c == '\\';
873 /* Preprocessor line has no closing quote. */
882 flag[1] = flag[2] = flag[3] = flag[4] = flag[5] = false;
893 if (1 <= i && i <= 4)
897 /* Interpret flags. */
899 if (flag[1] || flag[3]) /* Starting new file. */
901 f = get_file (filename, LC_RENAME);
902 f->up = current_file;
906 if (flag[2]) /* Ending current file. */
908 if (strcmp (current_file->filename, filename) != 0)
910 gfc_warning_now ("%s:%d: file %s left but not entered",
911 current_file->filename, current_file->line,
915 if (current_file->up)
916 current_file = current_file->up;
919 /* The name of the file can be a temporary file produced by
920 cpp. Replace the name if it is different. */
922 if (strcmp (current_file->filename, filename) != 0)
924 gfc_free (current_file->filename);
925 current_file->filename = gfc_getmem (strlen (filename) + 1);
926 strcpy (current_file->filename, filename);
929 /* Set new line number. */
930 current_file->line = line;
934 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
935 current_file->filename, current_file->line);
936 current_file->line++;
940 static try load_file (char *, bool);
942 /* include_line()-- Checks a line buffer to see if it is an include
943 line. If so, we call load_file() recursively to load the included
944 file. We never return a syntax error because a statement like
945 "include = 5" is perfectly legal. We return false if no include was
946 processed or true if we matched an include. */
949 include_line (char *line)
951 char quote, *c, *begin, *stop;
954 while (*c == ' ' || *c == '\t')
957 if (strncasecmp (c, "include", 7))
961 while (*c == ' ' || *c == '\t')
964 /* Find filename between quotes. */
967 if (quote != '"' && quote != '\'')
972 while (*c != quote && *c != '\0')
980 while (*c == ' ' || *c == '\t')
983 if (*c != '\0' && *c != '!')
986 /* We have an include line at this point. */
988 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
989 read by anything else. */
991 load_file (begin, false);
995 /* Load a file into memory by calling load_line until the file ends. */
998 load_file (char *filename, bool initial)
1006 for (f = current_file; f; f = f->up)
1007 if (strcmp (filename, f->filename) == 0)
1009 gfc_error_now ("File '%s' is being included recursively", filename);
1015 input = gfc_open_file (filename);
1018 gfc_error_now ("Can't open file '%s'", filename);
1024 input = gfc_open_included_file (filename);
1027 gfc_error_now ("Can't open included file '%s'", filename);
1032 /* Load the file. */
1034 f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
1035 f->up = current_file;
1037 current_file->line = 1;
1042 int trunc = load_line (input, &line);
1044 len = strlen (line);
1045 if (feof (input) && len == 0)
1048 /* There are three things this line can be: a line of Fortran
1049 source, an include line or a C preprocessor directive. */
1053 preprocessor_line (line);
1057 if (include_line (line))
1059 current_file->line++;
1065 b = gfc_getmem (gfc_linebuf_header_size + len + 1);
1067 #ifdef USE_MAPPED_LOCATION
1069 = linemap_line_start (&line_table, current_file->line++, 120);
1071 b->linenum = current_file->line++;
1073 b->file = current_file;
1074 b->truncated = trunc;
1075 strcpy (b->line, line);
1077 if (line_head == NULL)
1080 line_tail->next = b;
1085 /* Release the line buffer allocated in load_line. */
1090 current_file = current_file->up;
1091 #ifdef USE_MAPPED_LOCATION
1092 linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
1098 /* Determine the source form from the filename extension. We assume
1099 case insensitivity. */
1101 static gfc_source_form
1102 form_from_filename (const char *filename)
1107 const char *extension;
1108 gfc_source_form form;
1126 }; /* sentinel value */
1128 gfc_source_form f_form;
1129 const char *fileext;
1132 /* Find end of file name. */
1134 while ((i < PATH_MAX) && (filename[i] != '\0'))
1137 /* Improperly terminated or too-long filename. */
1139 return FORM_UNKNOWN;
1141 /* Find last period. */
1142 while (i >= 0 && (filename[i] != '.'))
1145 /* Did we see a file extension? */
1147 return FORM_UNKNOWN; /* Nope */
1149 /* Get file extension and compare it to others. */
1150 fileext = &(filename[i]);
1153 f_form = FORM_UNKNOWN;
1157 if (strcasecmp (fileext, exttype[i].extension) == 0)
1159 f_form = exttype[i].form;
1163 while (exttype[i].form != FORM_UNKNOWN);
1169 /* Open a new file and start scanning from that file. Returns SUCCESS
1170 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1171 it tries to determine the source form from the filename, defaulting
1175 gfc_new_file (const char *filename, gfc_source_form form)
1179 if (filename != NULL)
1181 gfc_source_file = gfc_getmem (strlen (filename) + 1);
1182 strcpy (gfc_source_file, filename);
1185 gfc_source_file = NULL;
1187 /* Decide which form the file will be read in as. */
1189 if (form != FORM_UNKNOWN)
1190 gfc_current_form = form;
1193 gfc_current_form = form_from_filename (filename);
1195 if (gfc_current_form == FORM_UNKNOWN)
1197 gfc_current_form = FORM_FREE;
1198 gfc_warning_now ("Reading file '%s' as free form.",
1199 (filename[0] == '\0') ? "<stdin>" : filename);
1203 result = load_file (gfc_source_file, true);
1205 gfc_current_locus.lb = line_head;
1206 gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
1208 #if 0 /* Debugging aid. */
1209 for (; line_head; line_head = line_head->next)
1210 gfc_status ("%s:%3d %s\n", line_head->file->filename,
1211 #ifdef USE_MAPPED_LOCATION
1212 LOCATION_LINE (line_head->location),