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, 59 Temple Place - Suite 330, 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')
842 /* Set new line number. */
843 current_file->line = line;
847 /* No file name given. */
853 while (*c == ' ' || *c == '\t')
863 /* Make filename end at quote. */
865 while (*c && ! (! escaped && *c == '"'))
870 escaped = *c == '\\';
875 /* Preprocessor line has no closing quote. */
884 flag[1] = flag[2] = flag[3] = flag[4] = flag[5] = false;
895 if (1 <= i && i <= 4)
899 /* Interpret flags. */
901 if (flag[1] || flag[3]) /* Starting new file. */
903 f = get_file (filename, LC_RENAME);
904 f->up = current_file;
908 if (flag[2]) /* Ending current file. */
910 current_file = current_file->up;
913 /* The name of the file can be a temporary file produced by
914 cpp. Replace the name if it is different. */
916 if (strcmp (current_file->filename, filename) != 0)
918 gfc_free (current_file->filename);
919 current_file->filename = gfc_getmem (strlen (filename) + 1);
920 strcpy (current_file->filename, filename);
926 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
927 current_file->filename, current_file->line);
928 current_file->line++;
932 static try load_file (char *, bool);
934 /* include_line()-- Checks a line buffer to see if it is an include
935 line. If so, we call load_file() recursively to load the included
936 file. We never return a syntax error because a statement like
937 "include = 5" is perfectly legal. We return false if no include was
938 processed or true if we matched an include. */
941 include_line (char *line)
943 char quote, *c, *begin, *stop;
946 while (*c == ' ' || *c == '\t')
949 if (strncasecmp (c, "include", 7))
953 while (*c == ' ' || *c == '\t')
956 /* Find filename between quotes. */
959 if (quote != '"' && quote != '\'')
964 while (*c != quote && *c != '\0')
972 while (*c == ' ' || *c == '\t')
975 if (*c != '\0' && *c != '!')
978 /* We have an include line at this point. */
980 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
981 read by anything else. */
983 load_file (begin, false);
987 /* Load a file into memory by calling load_line until the file ends. */
990 load_file (char *filename, bool initial)
998 for (f = current_file; f; f = f->up)
999 if (strcmp (filename, f->filename) == 0)
1001 gfc_error_now ("File '%s' is being included recursively", filename);
1007 input = gfc_open_file (filename);
1010 gfc_error_now ("Can't open file '%s'", filename);
1016 input = gfc_open_included_file (filename);
1019 gfc_error_now ("Can't open included file '%s'", filename);
1024 /* Load the file. */
1026 f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
1027 f->up = current_file;
1029 current_file->line = 1;
1034 int trunc = load_line (input, &line);
1036 len = strlen (line);
1037 if (feof (input) && len == 0)
1040 /* There are three things this line can be: a line of Fortran
1041 source, an include line or a C preprocessor directive. */
1045 preprocessor_line (line);
1049 if (include_line (line))
1051 current_file->line++;
1057 b = gfc_getmem (gfc_linebuf_header_size + len + 1);
1059 #ifdef USE_MAPPED_LOCATION
1061 = linemap_line_start (&line_table, current_file->line++, 120);
1063 b->linenum = current_file->line++;
1065 b->file = current_file;
1066 b->truncated = trunc;
1067 strcpy (b->line, line);
1069 if (line_head == NULL)
1072 line_tail->next = b;
1077 /* Release the line buffer allocated in load_line. */
1082 current_file = current_file->up;
1083 #ifdef USE_MAPPED_LOCATION
1084 linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
1090 /* Determine the source form from the filename extension. We assume
1091 case insensitivity. */
1093 static gfc_source_form
1094 form_from_filename (const char *filename)
1099 const char *extension;
1100 gfc_source_form form;
1118 }; /* sentinel value */
1120 gfc_source_form f_form;
1121 const char *fileext;
1124 /* Find end of file name. */
1126 while ((i < PATH_MAX) && (filename[i] != '\0'))
1129 /* Improperly terminated or too-long filename. */
1131 return FORM_UNKNOWN;
1133 /* Find last period. */
1134 while (i >= 0 && (filename[i] != '.'))
1137 /* Did we see a file extension? */
1139 return FORM_UNKNOWN; /* Nope */
1141 /* Get file extension and compare it to others. */
1142 fileext = &(filename[i]);
1145 f_form = FORM_UNKNOWN;
1149 if (strcasecmp (fileext, exttype[i].extension) == 0)
1151 f_form = exttype[i].form;
1155 while (exttype[i].form != FORM_UNKNOWN);
1161 /* Open a new file and start scanning from that file. Returns SUCCESS
1162 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1163 it tries to determine the source form from the filename, defaulting
1167 gfc_new_file (const char *filename, gfc_source_form form)
1171 if (filename != NULL)
1173 gfc_source_file = gfc_getmem (strlen (filename) + 1);
1174 strcpy (gfc_source_file, filename);
1177 gfc_source_file = NULL;
1179 /* Decide which form the file will be read in as. */
1181 if (form != FORM_UNKNOWN)
1182 gfc_current_form = form;
1185 gfc_current_form = form_from_filename (filename);
1187 if (gfc_current_form == FORM_UNKNOWN)
1189 gfc_current_form = FORM_FREE;
1190 gfc_warning_now ("Reading file '%s' as free form.",
1191 (filename[0] == '\0') ? "<stdin>" : filename);
1195 result = load_file (gfc_source_file, true);
1197 gfc_current_locus.lb = line_head;
1198 gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
1200 #if 0 /* Debugging aid. */
1201 for (; line_head; line_head = line_head->next)
1202 gfc_status ("%s:%3d %s\n", line_head->file->filename,
1203 #ifdef USE_MAPPED_LOCATION
1204 LOCATION_LINE (line_head->location),