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 const 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. If the include_cwd argument is true, we try
163 to open the file in the current directory first. */
166 gfc_open_included_file (const char *name, const bool include_cwd)
169 gfc_directorylist *p;
174 f = gfc_open_file (name);
179 for (p = include_dirs; p; p = p->next)
181 fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
182 strcpy (fullname, p->path);
183 strcat (fullname, name);
185 f = gfc_open_file (fullname);
193 /* Test to see if we're at the end of the main source file. */
203 /* Test to see if we're at the end of the current file. */
212 if (line_head == NULL)
213 return 1; /* Null file */
215 if (gfc_current_locus.lb == NULL)
222 /* Test to see if we're at the beginning of a new line. */
230 return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
234 /* Test to see if we're at the end of a line. */
243 return (*gfc_current_locus.nextc == '\0');
247 /* Advance the current line pointer to the next line. */
250 gfc_advance_line (void)
255 if (gfc_current_locus.lb == NULL)
261 gfc_current_locus.lb = gfc_current_locus.lb->next;
263 if (gfc_current_locus.lb != NULL)
264 gfc_current_locus.nextc = gfc_current_locus.lb->line;
267 gfc_current_locus.nextc = NULL;
273 /* Get the next character from the input, advancing gfc_current_file's
274 locus. When we hit the end of the line or the end of the file, we
275 start returning a '\n' in order to complete the current statement.
276 No Fortran line conventions are implemented here.
278 Requiring explicit advances to the next line prevents the parse
279 pointer from being on the wrong line if the current statement ends
287 if (gfc_current_locus.nextc == NULL)
290 c = *gfc_current_locus.nextc++;
293 gfc_current_locus.nextc--; /* Remain on this line. */
300 /* Skip a comment. When we come here the parse pointer is positioned
301 immediately after the comment character. If we ever implement
302 compiler directives withing comments, here is where we parse the
306 skip_comment_line (void)
320 /* Comment lines are null lines, lines containing only blanks or lines
321 on which the first nonblank line is a '!'. */
324 skip_free_comments (void)
331 start = gfc_current_locus;
339 while (gfc_is_whitespace (c));
349 skip_comment_line ();
356 gfc_current_locus = start;
360 /* Skip comment lines in fixed source mode. We have the same rules as
361 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
362 in column 1, and a '!' cannot be in column 6. Also, we deal with
363 lines with 'd' or 'D' in column 1, if the user requested this. */
366 skip_fixed_comments (void)
374 start = gfc_current_locus;
385 if (c == '!' || c == 'c' || c == 'C' || c == '*')
387 skip_comment_line ();
391 if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
393 if (gfc_option.flag_d_lines == 0)
395 skip_comment_line ();
399 *start.nextc = c = ' ';
404 while (gfc_is_whitespace (c))
416 if (col != 6 && c == '!')
418 skip_comment_line ();
425 gfc_current_locus = start;
429 /* Skips the current line if it is a comment. Assumes that we are at
430 the start of the current line. */
433 gfc_skip_comments (void)
436 if (!gfc_at_bol () || gfc_current_form == FORM_FREE)
437 skip_free_comments ();
439 skip_fixed_comments ();
443 /* Get the next character from the input, taking continuation lines
444 and end-of-line comments into account. This implies that comment
445 lines between continued lines must be eaten here. For higher-level
446 subroutines, this flattens continued lines into a single logical
447 line. The in_string flag denotes whether we're inside a character
451 gfc_next_char_literal (int in_string)
463 if (gfc_current_form == FORM_FREE)
466 if (!in_string && c == '!')
468 /* This line can't be continued */
475 /* Avoid truncation warnings for comment ending lines. */
476 gfc_current_locus.lb->truncated = 0;
484 /* If the next nonblank character is a ! or \n, we've got a
485 continuation line. */
486 old_loc = gfc_current_locus;
489 while (gfc_is_whitespace (c))
492 /* Character constants to be continued cannot have commentary
495 if (in_string && c != '\n')
497 gfc_current_locus = old_loc;
502 if (c != '!' && c != '\n')
504 gfc_current_locus = old_loc;
511 skip_comment_line ();
515 /* We've got a continuation line and need to find where it continues.
516 First eat any comment lines. */
517 gfc_skip_comments ();
519 /* Now that we have a non-comment line, probe ahead for the
520 first non-whitespace character. If it is another '&', then
521 reading starts at the next character, otherwise we must back
522 up to where the whitespace started and resume from there. */
524 old_loc = gfc_current_locus;
527 while (gfc_is_whitespace (c))
531 gfc_current_locus = old_loc;
536 /* Fixed form continuation. */
537 if (!in_string && c == '!')
539 /* Skip comment at end of line. */
546 /* Avoid truncation warnings for comment ending lines. */
547 gfc_current_locus.lb->truncated = 0;
554 old_loc = gfc_current_locus;
557 gfc_skip_comments ();
559 /* See if this line is a continuation line. */
560 for (i = 0; i < 5; i++)
564 goto not_continuation;
568 if (c == '0' || c == ' ')
569 goto not_continuation;
572 /* Ready to read first character of continuation line, which might
573 be another continuation line! */
578 gfc_current_locus = old_loc;
586 /* Get the next character of input, folded to lowercase. In fixed
587 form mode, we also ignore spaces. When matcher subroutines are
588 parsing character literals, they have to call
589 gfc_next_char_literal(). */
598 c = gfc_next_char_literal (0);
600 while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
612 old_loc = gfc_current_locus;
613 c = gfc_next_char ();
614 gfc_current_locus = old_loc;
620 /* Recover from an error. We try to get past the current statement
621 and get lined up for the next. The next statement follows a '\n'
622 or a ';'. We also assume that we are not within a character
623 constant, and deal with finding a '\'' or '"'. */
626 gfc_error_recovery (void)
635 c = gfc_next_char ();
636 if (c == '\n' || c == ';')
639 if (c != '\'' && c != '"')
668 /* Read ahead until the next character to be read is not whitespace. */
671 gfc_gobble_whitespace (void)
678 old_loc = gfc_current_locus;
679 c = gfc_next_char_literal (0);
681 while (gfc_is_whitespace (c));
683 gfc_current_locus = old_loc;
687 /* Load a single line into pbuf.
689 If pbuf points to a NULL pointer, it is allocated.
690 We truncate lines that are too long, unless we're dealing with
691 preprocessor lines or if the option -ffixed-line-length-none is set,
692 in which case we reallocate the buffer to fit the entire line, if
694 In fixed mode, we expand a tab that occurs within the statement
695 label region to expand to spaces that leave the next character in
697 load_line returns whether the line was truncated. */
700 load_line (FILE * input, char **pbuf, int *pbuflen)
702 int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
706 /* Determine the maximum allowed line length.
707 The default for free-form is GFC_MAX_LINE, for fixed-form or for
708 unknown form it is 72. Refer to the documentation in gfc_option_t. */
709 if (gfc_current_form == FORM_FREE)
711 if (gfc_option.free_line_length == -1)
712 maxlen = GFC_MAX_LINE;
714 maxlen = gfc_option.free_line_length;
716 else if (gfc_current_form == FORM_FIXED)
718 if (gfc_option.fixed_line_length == -1)
721 maxlen = gfc_option.fixed_line_length;
728 /* Allocate the line buffer, storing its length into buflen. */
732 buflen = GFC_MAX_LINE;
734 *pbuf = gfc_getmem (buflen + 1);
740 preprocessor_flag = 0;
743 /* In order to not truncate preprocessor lines, we have to
744 remember that this is one. */
745 preprocessor_flag = 1;
758 continue; /* Gobble characters. */
764 /* Ctrl-Z ends the file. */
765 while (fgetc (input) != EOF);
769 if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
770 { /* Tab expansion. */
783 if (maxlen == 0 || preprocessor_flag)
787 /* Reallocate line buffer to double size to hold the
790 *pbuf = xrealloc (*pbuf, buflen + 1);
794 else if (i >= maxlen)
796 /* Truncate the rest of the line. */
800 if (c == '\n' || c == EOF)
806 ungetc ('\n', input);
810 /* Pad lines to the selected line length in fixed form. */
811 if (gfc_current_form == FORM_FIXED
812 && gfc_option.fixed_line_length != 0
813 && !preprocessor_flag
827 /* Get a gfc_file structure, initialize it and add it to
831 get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
835 f = gfc_getmem (sizeof (gfc_file));
837 f->filename = gfc_getmem (strlen (name) + 1);
838 strcpy (f->filename, name);
843 f->included_by = current_file;
844 if (current_file != NULL)
845 f->inclusion_line = current_file->line;
847 #ifdef USE_MAPPED_LOCATION
848 linemap_add (&line_table, reason, false, f->filename, 1);
854 /* Deal with a line from the C preprocessor. The
855 initial octothorp has already been seen. */
858 preprocessor_line (char *c)
867 while (*c == ' ' || *c == '\t')
870 if (*c < '0' || *c > '9')
878 /* No file name given. Set new line number. */
879 current_file->line = line;
884 while (*c == ' ' || *c == '\t')
894 /* Make filename end at quote. */
896 while (*c && ! (! escaped && *c == '"'))
901 escaped = *c == '\\';
906 /* Preprocessor line has no closing quote. */
915 flag[1] = flag[2] = flag[3] = flag[4] = false;
926 if (1 <= i && i <= 4)
930 /* Interpret flags. */
932 if (flag[1]) /* Starting new file. */
934 f = get_file (filename, LC_RENAME);
935 f->up = current_file;
939 if (flag[2]) /* Ending current file. */
941 if (!current_file->up
942 || strcmp (current_file->up->filename, filename) != 0)
944 gfc_warning_now ("%s:%d: file %s left but not entered",
945 current_file->filename, current_file->line,
949 current_file = current_file->up;
952 /* The name of the file can be a temporary file produced by
953 cpp. Replace the name if it is different. */
955 if (strcmp (current_file->filename, filename) != 0)
957 gfc_free (current_file->filename);
958 current_file->filename = gfc_getmem (strlen (filename) + 1);
959 strcpy (current_file->filename, filename);
962 /* Set new line number. */
963 current_file->line = line;
967 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
968 current_file->filename, current_file->line);
969 current_file->line++;
973 static try load_file (const char *, bool);
975 /* include_line()-- Checks a line buffer to see if it is an include
976 line. If so, we call load_file() recursively to load the included
977 file. We never return a syntax error because a statement like
978 "include = 5" is perfectly legal. We return false if no include was
979 processed or true if we matched an include. */
982 include_line (char *line)
984 char quote, *c, *begin, *stop;
987 while (*c == ' ' || *c == '\t')
990 if (strncasecmp (c, "include", 7))
994 while (*c == ' ' || *c == '\t')
997 /* Find filename between quotes. */
1000 if (quote != '"' && quote != '\'')
1005 while (*c != quote && *c != '\0')
1013 while (*c == ' ' || *c == '\t')
1016 if (*c != '\0' && *c != '!')
1019 /* We have an include line at this point. */
1021 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
1022 read by anything else. */
1024 load_file (begin, false);
1028 /* Load a file into memory by calling load_line until the file ends. */
1031 load_file (const char *filename, bool initial)
1039 for (f = current_file; f; f = f->up)
1040 if (strcmp (filename, f->filename) == 0)
1042 gfc_error_now ("File '%s' is being included recursively", filename);
1048 input = gfc_open_file (filename);
1051 gfc_error_now ("Can't open file '%s'", filename);
1057 input = gfc_open_included_file (filename, false);
1060 gfc_error_now ("Can't open included file '%s'", filename);
1065 /* Load the file. */
1067 f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
1068 f->up = current_file;
1070 current_file->line = 1;
1076 int trunc = load_line (input, &line, &line_len);
1078 len = strlen (line);
1079 if (feof (input) && len == 0)
1082 /* There are three things this line can be: a line of Fortran
1083 source, an include line or a C preprocessor directive. */
1087 preprocessor_line (line);
1091 if (include_line (line))
1093 current_file->line++;
1099 b = gfc_getmem (gfc_linebuf_header_size + len + 1);
1101 #ifdef USE_MAPPED_LOCATION
1103 = linemap_line_start (&line_table, current_file->line++, 120);
1105 b->linenum = current_file->line++;
1107 b->file = current_file;
1108 b->truncated = trunc;
1109 strcpy (b->line, line);
1111 if (line_head == NULL)
1114 line_tail->next = b;
1119 /* Release the line buffer allocated in load_line. */
1124 current_file = current_file->up;
1125 #ifdef USE_MAPPED_LOCATION
1126 linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
1132 /* Open a new file and start scanning from that file. Returns SUCCESS
1133 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1134 it tries to determine the source form from the filename, defaulting
1142 result = load_file (gfc_source_file, true);
1144 gfc_current_locus.lb = line_head;
1145 gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
1147 #if 0 /* Debugging aid. */
1148 for (; line_head; line_head = line_head->next)
1149 gfc_status ("%s:%3d %s\n", line_head->file->filename,
1150 #ifdef USE_MAPPED_LOCATION
1151 LOCATION_LINE (line_head->location),