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, int *pbuflen)
688 int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
692 /* Determine the maximum allowed line length. */
693 if (gfc_current_form == FORM_FREE)
694 maxlen = GFC_MAX_LINE;
696 maxlen = gfc_option.fixed_line_length;
700 /* Allocate the line buffer, storing its length into buflen. */
704 buflen = GFC_MAX_LINE;
706 *pbuf = gfc_getmem (buflen + 1);
712 preprocessor_flag = 0;
715 /* In order to not truncate preprocessor lines, we have to
716 remember that this is one. */
717 preprocessor_flag = 1;
730 continue; /* Gobble characters. */
736 /* Ctrl-Z ends the file. */
737 while (fgetc (input) != EOF);
741 if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
742 { /* Tab expansion. */
755 if (maxlen == 0 || preprocessor_flag)
759 /* Reallocate line buffer to double size to hold the
762 *pbuf = xrealloc (*pbuf, buflen + 1);
766 else if (i >= maxlen)
768 /* Truncate the rest of the line. */
772 if (c == '\n' || c == EOF)
778 ungetc ('\n', input);
782 /* Pad lines to the selected line length in fixed form. */
783 if (gfc_current_form == FORM_FIXED
784 && gfc_option.fixed_line_length > 0
785 && !preprocessor_flag
787 while (i++ < gfc_option.fixed_line_length)
797 /* Get a gfc_file structure, initialize it and add it to
801 get_file (char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
805 f = gfc_getmem (sizeof (gfc_file));
807 f->filename = gfc_getmem (strlen (name) + 1);
808 strcpy (f->filename, name);
813 f->included_by = current_file;
814 if (current_file != NULL)
815 f->inclusion_line = current_file->line;
817 #ifdef USE_MAPPED_LOCATION
818 linemap_add (&line_table, reason, false, f->filename, 1);
824 /* Deal with a line from the C preprocessor. The
825 initial octothorp has already been seen. */
828 preprocessor_line (char *c)
837 while (*c == ' ' || *c == '\t')
840 if (*c < '0' || *c > '9')
848 /* No file name given. Set new line number. */
849 current_file->line = line;
854 while (*c == ' ' || *c == '\t')
864 /* Make filename end at quote. */
866 while (*c && ! (! escaped && *c == '"'))
871 escaped = *c == '\\';
876 /* Preprocessor line has no closing quote. */
885 flag[1] = flag[2] = flag[3] = flag[4] = flag[5] = false;
896 if (1 <= i && i <= 4)
900 /* Interpret flags. */
902 if (flag[1]) /* Starting new file. */
904 f = get_file (filename, LC_RENAME);
905 f->up = current_file;
909 if (flag[2]) /* Ending current file. */
911 if (!current_file->up
912 || strcmp (current_file->up->filename, filename) != 0)
914 gfc_warning_now ("%s:%d: file %s left but not entered",
915 current_file->filename, current_file->line,
919 current_file = current_file->up;
922 /* The name of the file can be a temporary file produced by
923 cpp. Replace the name if it is different. */
925 if (strcmp (current_file->filename, filename) != 0)
927 gfc_free (current_file->filename);
928 current_file->filename = gfc_getmem (strlen (filename) + 1);
929 strcpy (current_file->filename, filename);
932 /* Set new line number. */
933 current_file->line = line;
937 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
938 current_file->filename, current_file->line);
939 current_file->line++;
943 static try load_file (char *, bool);
945 /* include_line()-- Checks a line buffer to see if it is an include
946 line. If so, we call load_file() recursively to load the included
947 file. We never return a syntax error because a statement like
948 "include = 5" is perfectly legal. We return false if no include was
949 processed or true if we matched an include. */
952 include_line (char *line)
954 char quote, *c, *begin, *stop;
957 while (*c == ' ' || *c == '\t')
960 if (strncasecmp (c, "include", 7))
964 while (*c == ' ' || *c == '\t')
967 /* Find filename between quotes. */
970 if (quote != '"' && quote != '\'')
975 while (*c != quote && *c != '\0')
983 while (*c == ' ' || *c == '\t')
986 if (*c != '\0' && *c != '!')
989 /* We have an include line at this point. */
991 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
992 read by anything else. */
994 load_file (begin, false);
998 /* Load a file into memory by calling load_line until the file ends. */
1001 load_file (char *filename, bool initial)
1009 for (f = current_file; f; f = f->up)
1010 if (strcmp (filename, f->filename) == 0)
1012 gfc_error_now ("File '%s' is being included recursively", filename);
1018 input = gfc_open_file (filename);
1021 gfc_error_now ("Can't open file '%s'", filename);
1027 input = gfc_open_included_file (filename);
1030 gfc_error_now ("Can't open included file '%s'", filename);
1035 /* Load the file. */
1037 f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
1038 f->up = current_file;
1040 current_file->line = 1;
1046 int trunc = load_line (input, &line, &line_len);
1048 len = strlen (line);
1049 if (feof (input) && len == 0)
1052 /* There are three things this line can be: a line of Fortran
1053 source, an include line or a C preprocessor directive. */
1057 preprocessor_line (line);
1061 if (include_line (line))
1063 current_file->line++;
1069 b = gfc_getmem (gfc_linebuf_header_size + len + 1);
1071 #ifdef USE_MAPPED_LOCATION
1073 = linemap_line_start (&line_table, current_file->line++, 120);
1075 b->linenum = current_file->line++;
1077 b->file = current_file;
1078 b->truncated = trunc;
1079 strcpy (b->line, line);
1081 if (line_head == NULL)
1084 line_tail->next = b;
1089 /* Release the line buffer allocated in load_line. */
1094 current_file = current_file->up;
1095 #ifdef USE_MAPPED_LOCATION
1096 linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
1102 /* Determine the source form from the filename extension. We assume
1103 case insensitivity. */
1105 static gfc_source_form
1106 form_from_filename (const char *filename)
1111 const char *extension;
1112 gfc_source_form form;
1130 }; /* sentinel value */
1132 gfc_source_form f_form;
1133 const char *fileext;
1136 /* Find end of file name. */
1138 while ((i < PATH_MAX) && (filename[i] != '\0'))
1141 /* Improperly terminated or too-long filename. */
1143 return FORM_UNKNOWN;
1145 /* Find last period. */
1146 while (i >= 0 && (filename[i] != '.'))
1149 /* Did we see a file extension? */
1151 return FORM_UNKNOWN; /* Nope */
1153 /* Get file extension and compare it to others. */
1154 fileext = &(filename[i]);
1157 f_form = FORM_UNKNOWN;
1161 if (strcasecmp (fileext, exttype[i].extension) == 0)
1163 f_form = exttype[i].form;
1167 while (exttype[i].form != FORM_UNKNOWN);
1173 /* Open a new file and start scanning from that file. Returns SUCCESS
1174 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1175 it tries to determine the source form from the filename, defaulting
1179 gfc_new_file (const char *filename, gfc_source_form form)
1183 if (filename != NULL)
1185 gfc_source_file = gfc_getmem (strlen (filename) + 1);
1186 strcpy (gfc_source_file, filename);
1189 gfc_source_file = NULL;
1191 /* Decide which form the file will be read in as. */
1193 if (form != FORM_UNKNOWN)
1194 gfc_current_form = form;
1197 gfc_current_form = form_from_filename (filename);
1199 if (gfc_current_form == FORM_UNKNOWN)
1201 gfc_current_form = FORM_FREE;
1202 gfc_warning_now ("Reading file '%s' as free form.",
1203 (filename[0] == '\0') ? "<stdin>" : filename);
1207 result = load_file (gfc_source_file, true);
1209 gfc_current_locus.lb = line_head;
1210 gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
1212 #if 0 /* Debugging aid. */
1213 for (; line_head; line_head = line_head->next)
1214 gfc_status ("%s:%3d %s\n", line_head->file->filename,
1215 #ifdef USE_MAPPED_LOCATION
1216 LOCATION_LINE (line_head->location),