2 Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
5 This file is part of GNU G95.
7 GNU G95 is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU G95 is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU G95; see the file COPYING. If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Set of subroutines to (ultimately) return the next character to the
23 various matching subroutines. This file's job is to read files and
24 build up lines that are parsed by the parser. This means that we
25 handle continuation lines and "include" lines.
27 The first thing the scanner does is to load an entire file into
28 memory. We load the entire file into memory for a couple reasons.
29 The first is that we want to be able to deal with nonseekable input
30 (pipes, stdin) and there is a lot of backing up involved during
33 The second is that we want to be able to print the locus of errors,
34 and an error on line 999999 could conflict with something on line
35 one. Given nonseekable input, we've got to store the whole thing.
37 One thing that helps are the column truncation limits that give us
38 an upper bound on the size of individual lines. We don't store the
41 From the scanner's viewpoint, the higher level subroutines ask for
42 new characters and do a lot of jumping backwards. */
52 /* Structure for holding module and include file search path. */
53 typedef struct gfc_directorylist
56 struct gfc_directorylist *next;
60 /* List of include file search directories. */
61 static gfc_directorylist *include_dirs;
63 static gfc_file *first_file, *first_duplicated_file;
64 static int continue_flag, end_flag;
66 gfc_file *gfc_current_file;
69 /* Main scanner initialization. */
72 gfc_scanner_init_1 (void)
75 gfc_current_file = NULL;
77 first_duplicated_file = NULL;
82 /* Main scanner destructor. */
85 gfc_scanner_done_1 (void)
91 for (fp = first_file; fp; fp = fp2)
94 if (fp->start != NULL)
96 /* Free linebuf blocks */
97 for (fp2 = fp->next; fp2; fp2 = fp2->next)
98 if (fp->start == fp2->start)
101 for (lp = fp->start; lp; lp = lp2)
112 for (fp = first_duplicated_file; fp; fp = fp2)
120 /* Adds path to the list pointed to by list. */
123 gfc_add_include_path (const char *path)
125 gfc_directorylist *dir;
129 while (*p == ' ' || *p == '\t') /* someone might do 'gfortran "-I include"' */
136 dir = include_dirs = gfc_getmem (sizeof (gfc_directorylist));
143 dir->next = gfc_getmem (sizeof (gfc_directorylist));
148 dir->path = gfc_getmem (strlen (p) + 2);
149 strcpy (dir->path, p);
150 strcat (dir->path, "/"); /* make '/' last character */
154 /* Release resources allocated for options. */
157 gfc_release_include_path (void)
159 gfc_directorylist *p;
161 gfc_free (gfc_option.module_dir);
162 while (include_dirs != NULL)
165 include_dirs = include_dirs->next;
172 /* Opens file for reading, searching through the include directories
173 given if necessary. */
176 gfc_open_included_file (const char *name)
178 char fullname[PATH_MAX];
179 gfc_directorylist *p;
182 f = gfc_open_file (name);
186 for (p = include_dirs; p; p = p->next)
188 if (strlen (p->path) + strlen (name) + 1 > PATH_MAX)
191 strcpy (fullname, p->path);
192 strcat (fullname, name);
194 f = gfc_open_file (fullname);
203 /* Return a pointer to the current locus. */
206 gfc_current_locus (void)
209 if (gfc_current_file == NULL)
211 return &gfc_current_file->loc;
215 /* Let a caller move the current read pointer (backwards). */
218 gfc_set_locus (locus * lp)
221 gfc_current_file->loc = *lp;
225 /* Test to see if we're at the end of the main source file. */
235 /* Test to see if we're at the end of the current file. */
244 if (gfc_current_file->start->lines == 0)
245 return 1; /* Null file */
247 if (gfc_current_file->loc.lp == NULL)
254 /* Test to see if we're at the beginning of a new line. */
264 i = gfc_current_file->loc.line;
266 return gfc_current_file->loc.nextc == gfc_current_file->loc.lp->line[i];
270 /* Test to see if we're at the end of a line. */
279 return *gfc_current_file->loc.nextc == '\0';
283 /* Advance the current line pointer to the next line. */
286 gfc_advance_line (void)
294 locp = &gfc_current_file->loc;
299 if (++locp->line >= lp->lines)
301 locp->lp = lp = lp->next;
303 return; /* End of this file */
308 locp->nextc = lp->line[locp->line];
312 /* Get the next character from the input, advancing gfc_current_file's
313 locus. When we hit the end of the line or the end of the file, we
314 start returning a '\n' in order to complete the current statement.
315 No Fortran line conventions are implemented here.
317 Requiring explicit advances to the next line prevents the parse
318 pointer from being on the wrong line if the current statement ends
327 /* End the current include level, but not if we're in the middle
328 of processing a continuation. */
331 if (continue_flag != 0 || gfc_at_end ())
334 if (gfc_current_file->included_by == NULL)
340 locp = &gfc_current_file->loc;
341 if (locp->nextc == NULL)
347 locp->nextc--; /* Stay stuck on this line */
355 /* Checks the current line buffer to see if it is an include line. If
356 so, we load the new file and prepare to read from it. Include
357 lines happen at a lower level than regular parsing because the
358 string-matching subroutine is far simpler than the normal one.
360 We never return a syntax error because a statement like "include = 5"
361 is perfectly legal. We return zero if no include was processed or
362 nonzero if we matched an include. */
365 gfc_check_include (void)
367 char c, quote, path[PATH_MAX + 1];
374 start = *gfc_current_locus ();
375 gfc_gobble_whitespace ();
377 /* Match the 'include' */
378 while (*include != '\0')
379 if (*include++ != gfc_next_char ())
382 gfc_gobble_whitespace ();
384 quote = next_char ();
385 if (quote != '"' && quote != '\'')
388 /* Copy the filename */
393 goto no_include; /* No close quote */
397 /* This shouldn't happen-- PATH_MAX should be way longer than the
401 gfc_internal_error ("Pathname of include file is too long at %C");
408 goto no_include; /* No filename! */
410 /* At this point, we've got a filename to be included. The rest
411 of the include line is ignored */
413 gfc_new_file (path, gfc_current_file->form);
417 gfc_set_locus (&start);
422 /* Skip a comment. When we come here the parse pointer is positioned
423 immediately after the comment character. If we ever implement
424 compiler directives withing comments, here is where we parse the
428 skip_comment_line (void)
442 /* Comment lines are null lines, lines containing only blanks or lines
443 on which the first nonblank line is a '!'. */
446 skip_free_comments (void)
453 start = *gfc_current_locus ();
461 while (gfc_is_whitespace (c));
471 skip_comment_line ();
478 gfc_set_locus (&start);
482 /* Skip comment lines in fixed source mode. We have the same rules as
483 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
484 in column 1. and a '!' cannot be in* column 6. */
487 skip_fixed_comments (void)
495 start = *gfc_current_locus ();
506 if (c == '!' || c == 'c' || c == 'C' || c == '*')
508 skip_comment_line ();
518 while (gfc_is_whitespace (c));
526 if (col != 6 && c == '!')
528 skip_comment_line ();
535 gfc_set_locus (&start);
539 /* Skips the current line if it is a comment. Assumes that we are at
540 the start of the current line. */
543 gfc_skip_comments (void)
546 if (!gfc_at_bol () || gfc_current_file->form == FORM_FREE)
547 skip_free_comments ();
549 skip_fixed_comments ();
553 /* Get the next character from the input, taking continuation lines
554 and end-of-line comments into account. This implies that comment
555 lines between continued lines must be eaten here. For higher-level
556 subroutines, this flattens continued lines into a single logical
557 line. The in_string flag denotes whether we're inside a character
561 gfc_next_char_literal (int in_string)
573 if (gfc_current_file->form == FORM_FREE)
576 if (!in_string && c == '!')
578 /* This line can't be continued */
591 /* If the next nonblank character is a ! or \n, we've got a
592 continuation line. */
593 old_loc = gfc_current_file->loc;
596 while (gfc_is_whitespace (c))
599 /* Character constants to be continued cannot have commentary
602 if (in_string && c != '\n')
604 gfc_set_locus (&old_loc);
609 if (c != '!' && c != '\n')
611 gfc_set_locus (&old_loc);
618 skip_comment_line ();
622 /* We've got a continuation line and need to find where it continues.
623 First eat any comment lines. */
624 gfc_skip_comments ();
626 /* Now that we have a non-comment line, probe ahead for the
627 first non-whitespace character. If it is another '&', then
628 reading starts at the next character, otherwise we must back
629 up to where the whitespace started and resume from there. */
631 old_loc = *gfc_current_locus ();
634 while (gfc_is_whitespace (c))
638 gfc_set_locus (&old_loc);
643 /* Fixed form continuation. */
644 if (!in_string && c == '!')
646 /* Skip comment at end of line. */
658 old_loc = *gfc_current_locus ();
661 gfc_skip_comments ();
663 /* See if this line is a continuation line. */
664 for (i = 0; i < 5; i++)
668 goto not_continuation;
672 if (c == '0' || c == ' ')
673 goto not_continuation;
676 /* Ready to read first character of continuation line, which might
677 be another continuation line! */
682 gfc_set_locus (&old_loc);
690 /* Get the next character of input, folded to lowercase. In fixed
691 form mode, we also ignore spaces. When matcher subroutines are
692 parsing character literals, they have to call
693 gfc_next_char_literal(). */
702 c = gfc_next_char_literal (0);
704 while (gfc_current_file->form == FORM_FIXED && gfc_is_whitespace (c));
716 old_loc = *gfc_current_locus ();
717 c = gfc_next_char ();
718 gfc_set_locus (&old_loc);
724 /* Recover from an error. We try to get past the current statement
725 and get lined up for the next. The next statement follows a '\n'
726 or a ';'. We also assume that we are not within a character
727 constant, and deal with finding a '\'' or '"'. */
730 gfc_error_recovery (void)
739 c = gfc_next_char ();
740 if (c == '\n' || c == ';')
743 if (c != '\'' && c != '"')
776 /* Read ahead until the next character to be read is not whitespace. */
779 gfc_gobble_whitespace (void)
786 old_loc = *gfc_current_locus ();
787 c = gfc_next_char_literal (0);
789 while (gfc_is_whitespace (c));
791 gfc_set_locus (&old_loc);
795 /* Load a single line into the buffer. We truncate lines that are too
796 long. In fixed mode, we expand a tab that occurs within the
797 statement label region to expand to spaces that leave the next
798 character in the source region. */
801 load_line (FILE * input, gfc_source_form form, char *buffer,
802 char *filename, int linenum)
804 int c, maxlen, i, trunc_flag;
806 maxlen = (form == FORM_FREE) ? 132 : gfc_option.fixed_line_length;
820 continue; /* Gobble characters */
824 if (form == FORM_FIXED && c == '\t' && i <= 6)
825 { /* Tab expandsion */
839 { /* Truncate the rest of the line */
845 if (c == '\n' || c == EOF)
848 if (gfc_option.warn_line_truncation
850 && !gfc_is_whitespace (c))
852 gfc_warning_now ("Line %d of %s is being truncated",
858 ungetc ('\n', input);
866 /* Load a file into memory by calling load_line until the file ends. */
869 load_file (FILE * input, gfc_file * fp)
871 char *linep, line[GFC_MAX_LINE + 1];
875 fp->start = lp = gfc_getmem (sizeof (linebuf));
882 linep = (char *) (lp + 1);
887 load_line (input, fp->form, line, fp->filename, linenum);
892 if (feof (input) && len == 0)
895 /* See if we need another linebuf. */
896 if (((char *) &lp->line[lp->lines + 2]) > linep - len - 1)
898 lp->next = gfc_getmem (sizeof (linebuf));
900 lp->next->start_line = lp->start_line + lp->lines;
904 linep = (char *) (lp + 1);
907 linep = linep - len - 1;
908 lp->line[lp->lines++] = linep;
909 strcpy (linep, line);
914 /* Determine the source form from the filename extension. We assume
915 case insensitivity. */
917 static gfc_source_form
918 form_from_filename (const char *filename)
923 const char *extension;
924 gfc_source_form form;
942 }; /* sentinel value */
944 gfc_source_form f_form;
948 /* Find end of file name. */
950 while ((i < PATH_MAX) && (filename[i] != '\0'))
953 /* Improperly terminated or too-long filename. */
957 /* Find last period. */
958 while (i >= 0 && (filename[i] != '.'))
961 /* Did we see a file extension? */
963 return FORM_UNKNOWN; /* Nope */
965 /* Get file extension and compare it to others. */
966 fileext = &(filename[i]);
969 f_form = FORM_UNKNOWN;
973 if (strcasecmp (fileext, exttype[i].extension) == 0)
975 f_form = exttype[i].form;
979 while (exttype[i].form != FORM_UNKNOWN);
985 /* Open a new file and start scanning from that file. Every new file
986 gets a gfc_file node, even if it is a duplicate file. Returns SUCCESS
987 if everything went OK, FAILURE otherwise. */
990 gfc_new_file (const char *filename, gfc_source_form form)
996 len = strlen (filename);
999 gfc_error_now ("Filename '%s' is too long- ignoring it", filename);
1003 fp = gfc_getmem (sizeof (gfc_file));
1005 /* Make sure this file isn't being included recursively. */
1006 for (fp2 = gfc_current_file; fp2; fp2 = fp2->included_by)
1007 if (strcmp (filename, fp2->filename) == 0)
1009 gfc_error_now ("Recursive inclusion of file '%s' at %C- ignoring it",
1015 /* See if the file has already been included. */
1016 for (fp2 = first_file; fp2; fp2 = fp2->next)
1017 if (strcmp (filename, fp2->filename) == 0)
1020 fp->next = first_duplicated_file;
1021 first_duplicated_file = fp;
1025 strcpy (fp->filename, filename);
1027 if (gfc_current_file == NULL)
1028 input = gfc_open_file (filename);
1030 input = gfc_open_included_file (filename);
1034 if (gfc_current_file == NULL)
1035 gfc_error_now ("Can't open file '%s'", filename);
1037 gfc_error_now ("Can't open file '%s' included at %C", filename);
1043 /* Decide which form the file will be read in as. */
1044 if (form != FORM_UNKNOWN)
1048 fp->form = form_from_filename (filename);
1050 if (fp->form == FORM_UNKNOWN)
1052 fp->form = FORM_FREE;
1053 gfc_warning_now ("Reading file %s as free form", filename);
1057 fp->next = first_file;
1060 load_file (input, fp);
1064 fp->included_by = gfc_current_file;
1065 gfc_current_file = fp;
1068 fp->loc.lp = fp->start;
1069 fp->loc.nextc = fp->start->line[0];