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. */
165 gfc_open_included_file (const char *name
)
168 gfc_directorylist
*p
;
171 f
= gfc_open_file (name
);
175 for (p
= include_dirs
; p
; p
= p
->next
)
177 fullname
= (char *) alloca(strlen (p
->path
) + strlen (name
) + 1);
178 strcpy (fullname
, p
->path
);
179 strcat (fullname
, name
);
181 f
= gfc_open_file (fullname
);
189 /* Test to see if we're at the end of the main source file. */
199 /* Test to see if we're at the end of the current file. */
208 if (line_head
== NULL
)
209 return 1; /* Null file */
211 if (gfc_current_locus
.lb
== NULL
)
218 /* Test to see if we're at the beginning of a new line. */
226 return (gfc_current_locus
.nextc
== gfc_current_locus
.lb
->line
);
230 /* Test to see if we're at the end of a line. */
239 return (*gfc_current_locus
.nextc
== '\0');
243 /* Advance the current line pointer to the next line. */
246 gfc_advance_line (void)
251 if (gfc_current_locus
.lb
== NULL
)
257 gfc_current_locus
.lb
= gfc_current_locus
.lb
->next
;
259 if (gfc_current_locus
.lb
!= NULL
)
260 gfc_current_locus
.nextc
= gfc_current_locus
.lb
->line
;
263 gfc_current_locus
.nextc
= NULL
;
269 /* Get the next character from the input, advancing gfc_current_file's
270 locus. When we hit the end of the line or the end of the file, we
271 start returning a '\n' in order to complete the current statement.
272 No Fortran line conventions are implemented here.
274 Requiring explicit advances to the next line prevents the parse
275 pointer from being on the wrong line if the current statement ends
283 if (gfc_current_locus
.nextc
== NULL
)
286 c
= *gfc_current_locus
.nextc
++;
289 gfc_current_locus
.nextc
--; /* Remain on this line. */
296 /* Skip a comment. When we come here the parse pointer is positioned
297 immediately after the comment character. If we ever implement
298 compiler directives withing comments, here is where we parse the
302 skip_comment_line (void)
316 /* Comment lines are null lines, lines containing only blanks or lines
317 on which the first nonblank line is a '!'. */
320 skip_free_comments (void)
327 start
= gfc_current_locus
;
335 while (gfc_is_whitespace (c
));
345 skip_comment_line ();
352 gfc_current_locus
= start
;
356 /* Skip comment lines in fixed source mode. We have the same rules as
357 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
358 in column 1, and a '!' cannot be in column 6. Also, we deal with
359 lines with 'd' or 'D' in column 1, if the user requested this. */
362 skip_fixed_comments (void)
370 start
= gfc_current_locus
;
381 if (c
== '!' || c
== 'c' || c
== 'C' || c
== '*')
383 skip_comment_line ();
387 if (gfc_option
.flag_d_lines
!= -1 && (c
== 'd' || c
== 'D'))
389 if (gfc_option
.flag_d_lines
== 0)
391 skip_comment_line ();
395 *start
.nextc
= c
= ' ';
400 while (gfc_is_whitespace (c
))
412 if (col
!= 6 && c
== '!')
414 skip_comment_line ();
421 gfc_current_locus
= start
;
425 /* Skips the current line if it is a comment. Assumes that we are at
426 the start of the current line. */
429 gfc_skip_comments (void)
432 if (!gfc_at_bol () || gfc_current_form
== FORM_FREE
)
433 skip_free_comments ();
435 skip_fixed_comments ();
439 /* Get the next character from the input, taking continuation lines
440 and end-of-line comments into account. This implies that comment
441 lines between continued lines must be eaten here. For higher-level
442 subroutines, this flattens continued lines into a single logical
443 line. The in_string flag denotes whether we're inside a character
447 gfc_next_char_literal (int in_string
)
459 if (gfc_current_form
== FORM_FREE
)
462 if (!in_string
&& c
== '!')
464 /* This line can't be continued */
471 /* Avoid truncation warnings for comment ending lines. */
472 gfc_current_locus
.lb
->truncated
= 0;
480 /* If the next nonblank character is a ! or \n, we've got a
481 continuation line. */
482 old_loc
= gfc_current_locus
;
485 while (gfc_is_whitespace (c
))
488 /* Character constants to be continued cannot have commentary
491 if (in_string
&& c
!= '\n')
493 gfc_current_locus
= old_loc
;
498 if (c
!= '!' && c
!= '\n')
500 gfc_current_locus
= old_loc
;
507 skip_comment_line ();
511 /* We've got a continuation line and need to find where it continues.
512 First eat any comment lines. */
513 gfc_skip_comments ();
515 /* Now that we have a non-comment line, probe ahead for the
516 first non-whitespace character. If it is another '&', then
517 reading starts at the next character, otherwise we must back
518 up to where the whitespace started and resume from there. */
520 old_loc
= gfc_current_locus
;
523 while (gfc_is_whitespace (c
))
527 gfc_current_locus
= old_loc
;
532 /* Fixed form continuation. */
533 if (!in_string
&& c
== '!')
535 /* Skip comment at end of line. */
542 /* Avoid truncation warnings for comment ending lines. */
543 gfc_current_locus
.lb
->truncated
= 0;
550 old_loc
= gfc_current_locus
;
553 gfc_skip_comments ();
555 /* See if this line is a continuation line. */
556 for (i
= 0; i
< 5; i
++)
560 goto not_continuation
;
564 if (c
== '0' || c
== ' ')
565 goto not_continuation
;
568 /* Ready to read first character of continuation line, which might
569 be another continuation line! */
574 gfc_current_locus
= old_loc
;
582 /* Get the next character of input, folded to lowercase. In fixed
583 form mode, we also ignore spaces. When matcher subroutines are
584 parsing character literals, they have to call
585 gfc_next_char_literal(). */
594 c
= gfc_next_char_literal (0);
596 while (gfc_current_form
== FORM_FIXED
&& gfc_is_whitespace (c
));
608 old_loc
= gfc_current_locus
;
609 c
= gfc_next_char ();
610 gfc_current_locus
= old_loc
;
616 /* Recover from an error. We try to get past the current statement
617 and get lined up for the next. The next statement follows a '\n'
618 or a ';'. We also assume that we are not within a character
619 constant, and deal with finding a '\'' or '"'. */
622 gfc_error_recovery (void)
631 c
= gfc_next_char ();
632 if (c
== '\n' || c
== ';')
635 if (c
!= '\'' && c
!= '"')
664 /* Read ahead until the next character to be read is not whitespace. */
667 gfc_gobble_whitespace (void)
674 old_loc
= gfc_current_locus
;
675 c
= gfc_next_char_literal (0);
677 while (gfc_is_whitespace (c
));
679 gfc_current_locus
= old_loc
;
683 /* Load a single line into pbuf.
685 If pbuf points to a NULL pointer, it is allocated.
686 We truncate lines that are too long, unless we're dealing with
687 preprocessor lines or if the option -ffixed-line-length-none is set,
688 in which case we reallocate the buffer to fit the entire line, if
690 In fixed mode, we expand a tab that occurs within the statement
691 label region to expand to spaces that leave the next character in
693 load_line returns wether the line was truncated. */
696 load_line (FILE * input
, char **pbuf
, int *pbuflen
)
698 int c
, maxlen
, i
, preprocessor_flag
, buflen
= *pbuflen
;
702 /* Determine the maximum allowed line length. */
703 if (gfc_current_form
== FORM_FREE
)
704 maxlen
= GFC_MAX_LINE
;
706 maxlen
= gfc_option
.fixed_line_length
;
710 /* Allocate the line buffer, storing its length into buflen. */
714 buflen
= GFC_MAX_LINE
;
716 *pbuf
= gfc_getmem (buflen
+ 1);
722 preprocessor_flag
= 0;
725 /* In order to not truncate preprocessor lines, we have to
726 remember that this is one. */
727 preprocessor_flag
= 1;
740 continue; /* Gobble characters. */
746 /* Ctrl-Z ends the file. */
747 while (fgetc (input
) != EOF
);
751 if (gfc_current_form
== FORM_FIXED
&& c
== '\t' && i
<= 6)
752 { /* Tab expansion. */
765 if (maxlen
== 0 || preprocessor_flag
)
769 /* Reallocate line buffer to double size to hold the
772 *pbuf
= xrealloc (*pbuf
, buflen
+ 1);
776 else if (i
>= maxlen
)
778 /* Truncate the rest of the line. */
782 if (c
== '\n' || c
== EOF
)
788 ungetc ('\n', input
);
792 /* Pad lines to the selected line length in fixed form. */
793 if (gfc_current_form
== FORM_FIXED
794 && gfc_option
.fixed_line_length
> 0
795 && !preprocessor_flag
797 while (i
++ < gfc_option
.fixed_line_length
)
807 /* Get a gfc_file structure, initialize it and add it to
811 get_file (const char *name
, enum lc_reason reason ATTRIBUTE_UNUSED
)
815 f
= gfc_getmem (sizeof (gfc_file
));
817 f
->filename
= gfc_getmem (strlen (name
) + 1);
818 strcpy (f
->filename
, name
);
823 f
->included_by
= current_file
;
824 if (current_file
!= NULL
)
825 f
->inclusion_line
= current_file
->line
;
827 #ifdef USE_MAPPED_LOCATION
828 linemap_add (&line_table
, reason
, false, f
->filename
, 1);
834 /* Deal with a line from the C preprocessor. The
835 initial octothorp has already been seen. */
838 preprocessor_line (char *c
)
847 while (*c
== ' ' || *c
== '\t')
850 if (*c
< '0' || *c
> '9')
858 /* No file name given. Set new line number. */
859 current_file
->line
= line
;
864 while (*c
== ' ' || *c
== '\t')
874 /* Make filename end at quote. */
876 while (*c
&& ! (! escaped
&& *c
== '"'))
881 escaped
= *c
== '\\';
886 /* Preprocessor line has no closing quote. */
895 flag
[1] = flag
[2] = flag
[3] = flag
[4] = false;
906 if (1 <= i
&& i
<= 4)
910 /* Interpret flags. */
912 if (flag
[1]) /* Starting new file. */
914 f
= get_file (filename
, LC_RENAME
);
915 f
->up
= current_file
;
919 if (flag
[2]) /* Ending current file. */
921 if (!current_file
->up
922 || strcmp (current_file
->up
->filename
, filename
) != 0)
924 gfc_warning_now ("%s:%d: file %s left but not entered",
925 current_file
->filename
, current_file
->line
,
929 current_file
= current_file
->up
;
932 /* The name of the file can be a temporary file produced by
933 cpp. Replace the name if it is different. */
935 if (strcmp (current_file
->filename
, filename
) != 0)
937 gfc_free (current_file
->filename
);
938 current_file
->filename
= gfc_getmem (strlen (filename
) + 1);
939 strcpy (current_file
->filename
, filename
);
942 /* Set new line number. */
943 current_file
->line
= line
;
947 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
948 current_file
->filename
, current_file
->line
);
949 current_file
->line
++;
953 static try load_file (const char *, bool);
955 /* include_line()-- Checks a line buffer to see if it is an include
956 line. If so, we call load_file() recursively to load the included
957 file. We never return a syntax error because a statement like
958 "include = 5" is perfectly legal. We return false if no include was
959 processed or true if we matched an include. */
962 include_line (char *line
)
964 char quote
, *c
, *begin
, *stop
;
967 while (*c
== ' ' || *c
== '\t')
970 if (strncasecmp (c
, "include", 7))
974 while (*c
== ' ' || *c
== '\t')
977 /* Find filename between quotes. */
980 if (quote
!= '"' && quote
!= '\'')
985 while (*c
!= quote
&& *c
!= '\0')
993 while (*c
== ' ' || *c
== '\t')
996 if (*c
!= '\0' && *c
!= '!')
999 /* We have an include line at this point. */
1001 *stop
= '\0'; /* It's ok to trash the buffer, as this line won't be
1002 read by anything else. */
1004 load_file (begin
, false);
1008 /* Load a file into memory by calling load_line until the file ends. */
1011 load_file (const char *filename
, bool initial
)
1019 for (f
= current_file
; f
; f
= f
->up
)
1020 if (strcmp (filename
, f
->filename
) == 0)
1022 gfc_error_now ("File '%s' is being included recursively", filename
);
1028 input
= gfc_open_file (filename
);
1031 gfc_error_now ("Can't open file '%s'", filename
);
1037 input
= gfc_open_included_file (filename
);
1040 gfc_error_now ("Can't open included file '%s'", filename
);
1045 /* Load the file. */
1047 f
= get_file (filename
, initial
? LC_RENAME
: LC_ENTER
);
1048 f
->up
= current_file
;
1050 current_file
->line
= 1;
1056 int trunc
= load_line (input
, &line
, &line_len
);
1058 len
= strlen (line
);
1059 if (feof (input
) && len
== 0)
1062 /* There are three things this line can be: a line of Fortran
1063 source, an include line or a C preprocessor directive. */
1067 preprocessor_line (line
);
1071 if (include_line (line
))
1073 current_file
->line
++;
1079 b
= gfc_getmem (gfc_linebuf_header_size
+ len
+ 1);
1081 #ifdef USE_MAPPED_LOCATION
1083 = linemap_line_start (&line_table
, current_file
->line
++, 120);
1085 b
->linenum
= current_file
->line
++;
1087 b
->file
= current_file
;
1088 b
->truncated
= trunc
;
1089 strcpy (b
->line
, line
);
1091 if (line_head
== NULL
)
1094 line_tail
->next
= b
;
1099 /* Release the line buffer allocated in load_line. */
1104 current_file
= current_file
->up
;
1105 #ifdef USE_MAPPED_LOCATION
1106 linemap_add (&line_table
, LC_LEAVE
, 0, NULL
, 0);
1112 /* Open a new file and start scanning from that file. Returns SUCCESS
1113 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1114 it tries to determine the source form from the filename, defaulting
1122 result
= load_file (gfc_source_file
, true);
1124 gfc_current_locus
.lb
= line_head
;
1125 gfc_current_locus
.nextc
= (line_head
== NULL
) ? NULL
: line_head
->line
;
1127 #if 0 /* Debugging aid. */
1128 for (; line_head
; line_head
= line_head
->next
)
1129 gfc_status ("%s:%3d %s\n", line_head
->file
->filename
,
1130 #ifdef USE_MAPPED_LOCATION
1131 LOCATION_LINE (line_head
->location
),