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 */
467 /* If the next nonblank character is a ! or \n, we've got a
468 continuation line. */
469 old_loc
= gfc_current_locus
;
472 while (gfc_is_whitespace (c
))
475 /* Character constants to be continued cannot have commentary
478 if (in_string
&& c
!= '\n')
480 gfc_current_locus
= old_loc
;
485 if (c
!= '!' && c
!= '\n')
487 gfc_current_locus
= old_loc
;
494 skip_comment_line ();
498 /* We've got a continuation line and need to find where it continues.
499 First eat any comment lines. */
500 gfc_skip_comments ();
502 /* Now that we have a non-comment line, probe ahead for the
503 first non-whitespace character. If it is another '&', then
504 reading starts at the next character, otherwise we must back
505 up to where the whitespace started and resume from there. */
507 old_loc
= gfc_current_locus
;
510 while (gfc_is_whitespace (c
))
514 gfc_current_locus
= old_loc
;
519 /* Fixed form continuation. */
520 if (!in_string
&& c
== '!')
522 /* Skip comment at end of line. */
534 old_loc
= gfc_current_locus
;
537 gfc_skip_comments ();
539 /* See if this line is a continuation line. */
540 for (i
= 0; i
< 5; i
++)
544 goto not_continuation
;
548 if (c
== '0' || c
== ' ')
549 goto not_continuation
;
552 /* Ready to read first character of continuation line, which might
553 be another continuation line! */
558 gfc_current_locus
= old_loc
;
566 /* Get the next character of input, folded to lowercase. In fixed
567 form mode, we also ignore spaces. When matcher subroutines are
568 parsing character literals, they have to call
569 gfc_next_char_literal(). */
578 c
= gfc_next_char_literal (0);
580 while (gfc_current_form
== FORM_FIXED
&& gfc_is_whitespace (c
));
592 old_loc
= gfc_current_locus
;
593 c
= gfc_next_char ();
594 gfc_current_locus
= old_loc
;
600 /* Recover from an error. We try to get past the current statement
601 and get lined up for the next. The next statement follows a '\n'
602 or a ';'. We also assume that we are not within a character
603 constant, and deal with finding a '\'' or '"'. */
606 gfc_error_recovery (void)
615 c
= gfc_next_char ();
616 if (c
== '\n' || c
== ';')
619 if (c
!= '\'' && c
!= '"')
648 /* Read ahead until the next character to be read is not whitespace. */
651 gfc_gobble_whitespace (void)
658 old_loc
= gfc_current_locus
;
659 c
= gfc_next_char_literal (0);
661 while (gfc_is_whitespace (c
));
663 gfc_current_locus
= old_loc
;
667 /* Load a single line into pbuf.
669 If pbuf points to a NULL pointer, it is allocated.
670 We truncate lines that are too long, unless we're dealing with
671 preprocessor lines or if the option -ffixed-line-length-none is set,
672 in which case we reallocate the buffer to fit the entire line, if
674 In fixed mode, we expand a tab that occurs within the statement
675 label region to expand to spaces that leave the next character in
677 load_line returns wether the line was truncated. */
680 load_line (FILE * input
, char **pbuf
)
682 int c
, maxlen
, i
, preprocessor_flag
;
684 static int buflen
= 0;
687 /* Determine the maximum allowed line length. */
688 if (gfc_current_form
== FORM_FREE
)
689 maxlen
= GFC_MAX_LINE
;
691 maxlen
= gfc_option
.fixed_line_length
;
695 /* Allocate the line buffer, storing its length into buflen. */
699 buflen
= GFC_MAX_LINE
;
701 *pbuf
= gfc_getmem (buflen
+ 1);
707 preprocessor_flag
= 0;
710 /* In order to not truncate preprocessor lines, we have to
711 remember that this is one. */
712 preprocessor_flag
= 1;
725 continue; /* Gobble characters. */
731 /* Ctrl-Z ends the file. */
732 while (fgetc (input
) != EOF
);
736 if (gfc_current_form
== FORM_FIXED
&& c
== '\t' && i
<= 6)
737 { /* Tab expansion. */
750 if (i
>= buflen
&& (maxlen
== 0 || preprocessor_flag
))
752 /* Reallocate line buffer to double size to hold the
755 *pbuf
= xrealloc (*pbuf
, buflen
);
758 else if (i
>= buflen
)
760 /* Truncate the rest of the line. */
766 if (c
== '\n' || c
== EOF
)
770 ungetc ('\n', input
);
774 /* Pad lines to the selected line length in fixed form. */
775 if (gfc_current_form
== FORM_FIXED
776 && gfc_option
.fixed_line_length
> 0
777 && !preprocessor_flag
788 /* Get a gfc_file structure, initialize it and add it to
792 get_file (char *name
, enum lc_reason reason ATTRIBUTE_UNUSED
)
796 f
= gfc_getmem (sizeof (gfc_file
));
798 f
->filename
= gfc_getmem (strlen (name
) + 1);
799 strcpy (f
->filename
, name
);
804 f
->included_by
= current_file
;
805 if (current_file
!= NULL
)
806 f
->inclusion_line
= current_file
->line
;
808 #ifdef USE_MAPPED_LOCATION
809 linemap_add (&line_table
, reason
, false, f
->filename
, 1);
815 /* Deal with a line from the C preprocessor. The
816 initial octothorp has already been seen. */
819 preprocessor_line (char *c
)
828 while (*c
== ' ' || *c
== '\t')
831 if (*c
< '0' || *c
> '9')
836 /* Set new line number. */
837 current_file
->line
= line
;
841 /* No file name given. */
847 while (*c
== ' ' || *c
== '\t')
857 /* Make filename end at quote. */
859 while (*c
&& ! (! escaped
&& *c
== '"'))
864 escaped
= *c
== '\\';
869 /* Preprocessor line has no closing quote. */
878 flag
[1] = flag
[2] = flag
[3] = flag
[4] = flag
[5] = false;
889 if (1 <= i
&& i
<= 4)
893 /* Interpret flags. */
895 if (flag
[1] || flag
[3]) /* Starting new file. */
897 f
= get_file (filename
, LC_RENAME
);
898 f
->up
= current_file
;
902 if (flag
[2]) /* Ending current file. */
904 current_file
= current_file
->up
;
907 /* The name of the file can be a temporary file produced by
908 cpp. Replace the name if it is different. */
910 if (strcmp (current_file
->filename
, filename
) != 0)
912 gfc_free (current_file
->filename
);
913 current_file
->filename
= gfc_getmem (strlen (filename
) + 1);
914 strcpy (current_file
->filename
, filename
);
920 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
921 current_file
->filename
, current_file
->line
);
922 current_file
->line
++;
926 static try load_file (char *, bool);
928 /* include_line()-- Checks a line buffer to see if it is an include
929 line. If so, we call load_file() recursively to load the included
930 file. We never return a syntax error because a statement like
931 "include = 5" is perfectly legal. We return false if no include was
932 processed or true if we matched an include. */
935 include_line (char *line
)
937 char quote
, *c
, *begin
, *stop
;
940 while (*c
== ' ' || *c
== '\t')
943 if (strncasecmp (c
, "include", 7))
947 while (*c
== ' ' || *c
== '\t')
950 /* Find filename between quotes. */
953 if (quote
!= '"' && quote
!= '\'')
958 while (*c
!= quote
&& *c
!= '\0')
966 while (*c
== ' ' || *c
== '\t')
969 if (*c
!= '\0' && *c
!= '!')
972 /* We have an include line at this point. */
974 *stop
= '\0'; /* It's ok to trash the buffer, as this line won't be
975 read by anything else. */
977 load_file (begin
, false);
981 /* Load a file into memory by calling load_line until the file ends. */
984 load_file (char *filename
, bool initial
)
992 for (f
= current_file
; f
; f
= f
->up
)
993 if (strcmp (filename
, f
->filename
) == 0)
995 gfc_error_now ("File '%s' is being included recursively", filename
);
1001 input
= gfc_open_file (filename
);
1004 gfc_error_now ("Can't open file '%s'", filename
);
1010 input
= gfc_open_included_file (filename
);
1013 gfc_error_now ("Can't open included file '%s'", filename
);
1018 /* Load the file. */
1020 f
= get_file (filename
, initial
? LC_RENAME
: LC_ENTER
);
1021 f
->up
= current_file
;
1023 current_file
->line
= 1;
1028 int trunc
= load_line (input
, &line
);
1030 len
= strlen (line
);
1031 if (feof (input
) && len
== 0)
1034 /* There are three things this line can be: a line of Fortran
1035 source, an include line or a C preprocessor directive. */
1039 preprocessor_line (line
);
1043 if (include_line (line
))
1045 current_file
->line
++;
1051 b
= gfc_getmem (gfc_linebuf_header_size
+ len
+ 1);
1053 #ifdef USE_MAPPED_LOCATION
1055 = linemap_line_start (&line_table
, current_file
->line
++, 120);
1057 b
->linenum
= current_file
->line
++;
1059 b
->file
= current_file
;
1060 b
->truncated
= trunc
;
1061 strcpy (b
->line
, line
);
1063 if (line_head
== NULL
)
1066 line_tail
->next
= b
;
1071 /* Release the line buffer allocated in load_line. */
1076 current_file
= current_file
->up
;
1077 #ifdef USE_MAPPED_LOCATION
1078 linemap_add (&line_table
, LC_LEAVE
, 0, NULL
, 0);
1084 /* Determine the source form from the filename extension. We assume
1085 case insensitivity. */
1087 static gfc_source_form
1088 form_from_filename (const char *filename
)
1093 const char *extension
;
1094 gfc_source_form form
;
1112 }; /* sentinel value */
1114 gfc_source_form f_form
;
1115 const char *fileext
;
1118 /* Find end of file name. */
1120 while ((i
< PATH_MAX
) && (filename
[i
] != '\0'))
1123 /* Improperly terminated or too-long filename. */
1125 return FORM_UNKNOWN
;
1127 /* Find last period. */
1128 while (i
>= 0 && (filename
[i
] != '.'))
1131 /* Did we see a file extension? */
1133 return FORM_UNKNOWN
; /* Nope */
1135 /* Get file extension and compare it to others. */
1136 fileext
= &(filename
[i
]);
1139 f_form
= FORM_UNKNOWN
;
1143 if (strcasecmp (fileext
, exttype
[i
].extension
) == 0)
1145 f_form
= exttype
[i
].form
;
1149 while (exttype
[i
].form
!= FORM_UNKNOWN
);
1155 /* Open a new file and start scanning from that file. Returns SUCCESS
1156 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1157 it tries to determine the source form from the filename, defaulting
1161 gfc_new_file (const char *filename
, gfc_source_form form
)
1165 if (filename
!= NULL
)
1167 gfc_source_file
= gfc_getmem (strlen (filename
) + 1);
1168 strcpy (gfc_source_file
, filename
);
1171 gfc_source_file
= NULL
;
1173 /* Decide which form the file will be read in as. */
1175 if (form
!= FORM_UNKNOWN
)
1176 gfc_current_form
= form
;
1179 gfc_current_form
= form_from_filename (filename
);
1181 if (gfc_current_form
== FORM_UNKNOWN
)
1183 gfc_current_form
= FORM_FREE
;
1184 gfc_warning_now ("Reading file '%s' as free form.",
1185 (filename
[0] == '\0') ? "<stdin>" : filename
);
1189 result
= load_file (gfc_source_file
, true);
1191 gfc_current_locus
.lb
= line_head
;
1192 gfc_current_locus
.nextc
= (line_head
== NULL
) ? NULL
: line_head
->line
;
1194 #if 0 /* Debugging aid. */
1195 for (; line_head
; line_head
= line_head
->next
)
1196 gfc_status ("%s:%3d %s\n", line_head
->file
->filename
,
1197 #ifdef USE_MAPPED_LOCATION
1198 LOCATION_LINE (line_head
->location
),