2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
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. */
50 /* Structure for holding module and include file search path. */
51 typedef struct gfc_directorylist
54 struct gfc_directorylist
*next
;
58 /* List of include file search directories. */
59 static gfc_directorylist
*include_dirs
;
61 static gfc_file
*file_head
, *current_file
;
63 static int continue_flag
, end_flag
, openmp_flag
;
64 static int continue_count
, continue_line
;
65 static locus openmp_locus
;
67 gfc_source_form gfc_current_form
;
68 static gfc_linebuf
*line_head
, *line_tail
;
70 locus gfc_current_locus
;
71 const char *gfc_source_file
;
72 static FILE *gfc_src_file
;
73 static char *gfc_src_preprocessor_lines
[2];
77 /* Main scanner initialization. */
80 gfc_scanner_init_1 (void)
93 /* Main scanner destructor. */
96 gfc_scanner_done_1 (void)
101 while(line_head
!= NULL
)
103 lb
= line_head
->next
;
108 while(file_head
!= NULL
)
111 gfc_free(file_head
->filename
);
119 /* Adds path to the list pointed to by list. */
122 gfc_add_include_path (const char *path
)
124 gfc_directorylist
*dir
;
128 while (*p
== ' ' || *p
== '\t') /* someone might do 'gfortran "-I include"' */
135 dir
= include_dirs
= gfc_getmem (sizeof (gfc_directorylist
));
142 dir
->next
= gfc_getmem (sizeof (gfc_directorylist
));
147 dir
->path
= gfc_getmem (strlen (p
) + 2);
148 strcpy (dir
->path
, p
);
149 strcat (dir
->path
, "/"); /* make '/' last character */
153 /* Release resources allocated for options. */
156 gfc_release_include_path (void)
158 gfc_directorylist
*p
;
160 gfc_free (gfc_option
.module_dir
);
161 while (include_dirs
!= NULL
)
164 include_dirs
= include_dirs
->next
;
170 /* Opens file for reading, searching through the include directories
171 given if necessary. If the include_cwd argument is true, we try
172 to open the file in the current directory first. */
175 gfc_open_included_file (const char *name
, const bool include_cwd
)
178 gfc_directorylist
*p
;
183 f
= gfc_open_file (name
);
188 for (p
= include_dirs
; p
; p
= p
->next
)
190 fullname
= (char *) alloca(strlen (p
->path
) + strlen (name
) + 1);
191 strcpy (fullname
, p
->path
);
192 strcat (fullname
, name
);
194 f
= gfc_open_file (fullname
);
202 /* Test to see if we're at the end of the main source file. */
212 /* Test to see if we're at the end of the current file. */
221 if (line_head
== NULL
)
222 return 1; /* Null file */
224 if (gfc_current_locus
.lb
== NULL
)
231 /* Test to see if we're at the beginning of a new line. */
239 return (gfc_current_locus
.nextc
== gfc_current_locus
.lb
->line
);
243 /* Test to see if we're at the end of a line. */
252 return (*gfc_current_locus
.nextc
== '\0');
256 /* Advance the current line pointer to the next line. */
259 gfc_advance_line (void)
264 if (gfc_current_locus
.lb
== NULL
)
270 gfc_current_locus
.lb
= gfc_current_locus
.lb
->next
;
272 if (gfc_current_locus
.lb
!= NULL
)
273 gfc_current_locus
.nextc
= gfc_current_locus
.lb
->line
;
276 gfc_current_locus
.nextc
= NULL
;
282 /* Get the next character from the input, advancing gfc_current_file's
283 locus. When we hit the end of the line or the end of the file, we
284 start returning a '\n' in order to complete the current statement.
285 No Fortran line conventions are implemented here.
287 Requiring explicit advances to the next line prevents the parse
288 pointer from being on the wrong line if the current statement ends
296 if (gfc_current_locus
.nextc
== NULL
)
299 c
= *gfc_current_locus
.nextc
++;
302 gfc_current_locus
.nextc
--; /* Remain on this line. */
309 /* Skip a comment. When we come here the parse pointer is positioned
310 immediately after the comment character. If we ever implement
311 compiler directives withing comments, here is where we parse the
315 skip_comment_line (void)
329 /* Comment lines are null lines, lines containing only blanks or lines
330 on which the first nonblank line is a '!'.
331 Return true if !$ openmp conditional compilation sentinel was
335 skip_free_comments (void)
343 at_bol
= gfc_at_bol ();
344 start
= gfc_current_locus
;
350 while (gfc_is_whitespace (c
));
360 /* If -fopenmp, we need to handle here 2 things:
361 1) don't treat !$omp as comments, but directives
362 2) handle OpenMP conditional compilation, where
363 !$ should be treated as 2 spaces (for initial lines
364 only if followed by space). */
365 if (gfc_option
.flag_openmp
&& at_bol
)
367 locus old_loc
= gfc_current_locus
;
368 if (next_char () == '$')
371 if (c
== 'o' || c
== 'O')
373 if (((c
= next_char ()) == 'm' || c
== 'M')
374 && ((c
= next_char ()) == 'p' || c
== 'P')
375 && ((c
= next_char ()) == ' ' || continue_flag
))
377 while (gfc_is_whitespace (c
))
379 if (c
!= '\n' && c
!= '!')
382 openmp_locus
= old_loc
;
383 gfc_current_locus
= start
;
387 gfc_current_locus
= old_loc
;
391 if (continue_flag
|| c
== ' ')
393 gfc_current_locus
= old_loc
;
398 gfc_current_locus
= old_loc
;
400 skip_comment_line ();
407 if (openmp_flag
&& at_bol
)
409 gfc_current_locus
= start
;
414 /* Skip comment lines in fixed source mode. We have the same rules as
415 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
416 in column 1, and a '!' cannot be in column 6. Also, we deal with
417 lines with 'd' or 'D' in column 1, if the user requested this. */
420 skip_fixed_comments (void)
428 start
= gfc_current_locus
;
433 while (gfc_is_whitespace (c
));
438 skip_comment_line ();
443 gfc_current_locus
= start
;
450 start
= gfc_current_locus
;
461 if (c
== '!' || c
== 'c' || c
== 'C' || c
== '*')
463 /* If -fopenmp, we need to handle here 2 things:
464 1) don't treat !$omp|c$omp|*$omp as comments, but directives
465 2) handle OpenMP conditional compilation, where
466 !$|c$|*$ should be treated as 2 spaces if the characters
467 in columns 3 to 6 are valid fixed form label columns
469 if (gfc_option
.flag_openmp
)
471 if (next_char () == '$')
474 if (c
== 'o' || c
== 'O')
476 if (((c
= next_char ()) == 'm' || c
== 'M')
477 && ((c
= next_char ()) == 'p' || c
== 'P'))
481 && ((openmp_flag
&& continue_flag
)
482 || c
== ' ' || c
== '0'))
485 while (gfc_is_whitespace (c
))
487 if (c
!= '\n' && c
!= '!')
489 /* Canonicalize to *$omp. */
492 gfc_current_locus
= start
;
502 for (col
= 3; col
< 6; col
++, c
= next_char ())
505 else if (c
< '0' || c
> '9')
510 if (col
== 6 && c
!= '\n'
511 && ((continue_flag
&& !digit_seen
)
512 || c
== ' ' || c
== '0'))
514 gfc_current_locus
= start
;
515 start
.nextc
[0] = ' ';
516 start
.nextc
[1] = ' ';
521 gfc_current_locus
= start
;
523 skip_comment_line ();
527 if (gfc_option
.flag_d_lines
!= -1 && (c
== 'd' || c
== 'D'))
529 if (gfc_option
.flag_d_lines
== 0)
531 skip_comment_line ();
535 *start
.nextc
= c
= ' ';
540 while (gfc_is_whitespace (c
))
552 if (col
!= 6 && c
== '!')
554 skip_comment_line ();
562 gfc_current_locus
= start
;
566 /* Skips the current line if it is a comment. */
569 gfc_skip_comments (void)
571 if (gfc_current_form
== FORM_FREE
)
572 skip_free_comments ();
574 skip_fixed_comments ();
578 /* Get the next character from the input, taking continuation lines
579 and end-of-line comments into account. This implies that comment
580 lines between continued lines must be eaten here. For higher-level
581 subroutines, this flattens continued lines into a single logical
582 line. The in_string flag denotes whether we're inside a character
586 gfc_next_char_literal (int in_string
)
589 int i
, c
, prev_openmp_flag
;
601 if (gfc_current_form
== FORM_FREE
)
603 bool openmp_cond_flag
;
605 if (!in_string
&& c
== '!')
608 && memcmp (&gfc_current_locus
, &openmp_locus
,
609 sizeof (gfc_current_locus
)) == 0)
612 /* This line can't be continued */
619 /* Avoid truncation warnings for comment ending lines. */
620 gfc_current_locus
.lb
->truncated
= 0;
628 /* If the next nonblank character is a ! or \n, we've got a
629 continuation line. */
630 old_loc
= gfc_current_locus
;
633 while (gfc_is_whitespace (c
))
636 /* Character constants to be continued cannot have commentary
639 if (in_string
&& c
!= '\n')
641 gfc_current_locus
= old_loc
;
646 if (c
!= '!' && c
!= '\n')
648 gfc_current_locus
= old_loc
;
653 prev_openmp_flag
= openmp_flag
;
656 skip_comment_line ();
660 /* We've got a continuation line. If we are on the very next line after
661 the last continuation, increment the continuation line count and
662 check whether the limit has been exceeded. */
663 if (gfc_current_locus
.lb
->linenum
== continue_line
+ 1)
665 if (++continue_count
== gfc_option
.max_continue_free
)
667 if (gfc_notification_std (GFC_STD_GNU
)
669 gfc_warning ("Limit of %d continuations exceeded in statement at %C",
670 gfc_option
.max_continue_free
);
673 continue_line
= gfc_current_locus
.lb
->linenum
;
675 /* Now find where it continues. First eat any comment lines. */
676 openmp_cond_flag
= skip_free_comments ();
678 if (prev_openmp_flag
!= openmp_flag
)
680 gfc_current_locus
= old_loc
;
681 openmp_flag
= prev_openmp_flag
;
686 /* Now that we have a non-comment line, probe ahead for the
687 first non-whitespace character. If it is another '&', then
688 reading starts at the next character, otherwise we must back
689 up to where the whitespace started and resume from there. */
691 old_loc
= gfc_current_locus
;
694 while (gfc_is_whitespace (c
))
699 for (i
= 0; i
< 5; i
++, c
= next_char ())
701 gcc_assert (TOLOWER (c
) == "!$omp"[i
]);
703 old_loc
= gfc_current_locus
;
705 while (gfc_is_whitespace (c
))
713 if (gfc_option
.warn_ampersand
)
714 gfc_warning_now ("Missing '&' in continued character constant at %C");
715 gfc_current_locus
.nextc
--;
717 /* Both !$omp and !$ -fopenmp continuation lines have & on the
718 continuation line only optionally. */
719 else if (openmp_flag
|| openmp_cond_flag
)
720 gfc_current_locus
.nextc
--;
724 gfc_current_locus
= old_loc
;
731 /* Fixed form continuation. */
732 if (!in_string
&& c
== '!')
734 /* Skip comment at end of line. */
741 /* Avoid truncation warnings for comment ending lines. */
742 gfc_current_locus
.lb
->truncated
= 0;
748 prev_openmp_flag
= openmp_flag
;
750 old_loc
= gfc_current_locus
;
753 skip_fixed_comments ();
755 /* See if this line is a continuation line. */
756 if (openmp_flag
!= prev_openmp_flag
)
758 openmp_flag
= prev_openmp_flag
;
759 goto not_continuation
;
763 for (i
= 0; i
< 5; i
++)
767 goto not_continuation
;
770 for (i
= 0; i
< 5; i
++)
773 if (TOLOWER (c
) != "*$omp"[i
])
774 goto not_continuation
;
778 if (c
== '0' || c
== ' ' || c
== '\n')
779 goto not_continuation
;
781 /* We've got a continuation line. If we are on the very next line after
782 the last continuation, increment the continuation line count and
783 check whether the limit has been exceeded. */
784 if (gfc_current_locus
.lb
->linenum
== continue_line
+ 1)
786 if (++continue_count
== gfc_option
.max_continue_fixed
)
788 if (gfc_notification_std (GFC_STD_GNU
)
790 gfc_warning ("Limit of %d continuations exceeded in statement at %C",
791 gfc_option
.max_continue_fixed
);
795 if (continue_line
< gfc_current_locus
.lb
->linenum
)
796 continue_line
= gfc_current_locus
.lb
->linenum
;
799 /* Ready to read first character of continuation line, which might
800 be another continuation line! */
805 gfc_current_locus
= old_loc
;
815 /* Get the next character of input, folded to lowercase. In fixed
816 form mode, we also ignore spaces. When matcher subroutines are
817 parsing character literals, they have to call
818 gfc_next_char_literal(). */
827 c
= gfc_next_char_literal (0);
829 while (gfc_current_form
== FORM_FIXED
&& gfc_is_whitespace (c
));
841 old_loc
= gfc_current_locus
;
842 c
= gfc_next_char ();
843 gfc_current_locus
= old_loc
;
849 /* Recover from an error. We try to get past the current statement
850 and get lined up for the next. The next statement follows a '\n'
851 or a ';'. We also assume that we are not within a character
852 constant, and deal with finding a '\'' or '"'. */
855 gfc_error_recovery (void)
864 c
= gfc_next_char ();
865 if (c
== '\n' || c
== ';')
868 if (c
!= '\'' && c
!= '"')
897 /* Read ahead until the next character to be read is not whitespace. */
900 gfc_gobble_whitespace (void)
902 static int linenum
= 0;
908 old_loc
= gfc_current_locus
;
909 c
= gfc_next_char_literal (0);
910 /* Issue a warning for nonconforming tabs. We keep track of the line
911 number because the Fortran matchers will often back up and the same
912 line will be scanned multiple times. */
913 if (!gfc_option
.warn_tabs
&& c
== '\t')
915 #ifdef USE_MAPPED_LOCATION
916 int cur_linenum
= LOCATION_LINE (gfc_current_locus
.lb
->location
);
918 int cur_linenum
= gfc_current_locus
.lb
->linenum
;
920 if (cur_linenum
!= linenum
)
922 linenum
= cur_linenum
;
923 gfc_warning_now ("Nonconforming tab character at %C");
927 while (gfc_is_whitespace (c
));
929 gfc_current_locus
= old_loc
;
933 /* Load a single line into pbuf.
935 If pbuf points to a NULL pointer, it is allocated.
936 We truncate lines that are too long, unless we're dealing with
937 preprocessor lines or if the option -ffixed-line-length-none is set,
938 in which case we reallocate the buffer to fit the entire line, if
940 In fixed mode, we expand a tab that occurs within the statement
941 label region to expand to spaces that leave the next character in
943 load_line returns whether the line was truncated.
945 NOTE: The error machinery isn't available at this point, so we can't
946 easily report line and column numbers consistent with other
947 parts of gfortran. */
950 load_line (FILE * input
, char **pbuf
, int *pbuflen
)
952 static int linenum
= 0, current_line
= 1;
953 int c
, maxlen
, i
, preprocessor_flag
, buflen
= *pbuflen
;
954 int trunc_flag
= 0, seen_comment
= 0;
955 int seen_printable
= 0, seen_ampersand
= 0;
958 /* Determine the maximum allowed line length.
959 The default for free-form is GFC_MAX_LINE, for fixed-form or for
960 unknown form it is 72. Refer to the documentation in gfc_option_t. */
961 if (gfc_current_form
== FORM_FREE
)
963 if (gfc_option
.free_line_length
== -1)
964 maxlen
= GFC_MAX_LINE
;
966 maxlen
= gfc_option
.free_line_length
;
968 else if (gfc_current_form
== FORM_FIXED
)
970 if (gfc_option
.fixed_line_length
== -1)
973 maxlen
= gfc_option
.fixed_line_length
;
980 /* Allocate the line buffer, storing its length into buflen. */
984 buflen
= GFC_MAX_LINE
;
986 *pbuf
= gfc_getmem (buflen
+ 1);
992 preprocessor_flag
= 0;
995 /* In order to not truncate preprocessor lines, we have to
996 remember that this is one. */
997 preprocessor_flag
= 1;
1008 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1009 if (gfc_current_form
== FORM_FREE
1010 && !seen_printable
&& seen_ampersand
)
1014 ("'&' not allowed by itself in line %d", current_line
);
1017 ("'&' not allowed by itself in line %d", current_line
);
1023 continue; /* Gobble characters. */
1029 /* Ctrl-Z ends the file. */
1030 while (fgetc (input
) != EOF
);
1034 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1038 if ((c
!= ' ' && c
!= '&' && c
!= '!') || (c
== '!' && !seen_ampersand
))
1041 if (gfc_current_form
== FORM_FREE
1042 && c
== '!' && !seen_printable
&& seen_ampersand
)
1046 "'&' not allowed by itself with comment in line %d", current_line
);
1049 "'&' not allowed by itself with comment in line %d", current_line
);
1053 /* Is this a fixed-form comment? */
1054 if (gfc_current_form
== FORM_FIXED
&& i
== 0
1055 && (c
== '*' || c
== 'c' || c
== 'd'))
1058 if (gfc_current_form
== FORM_FIXED
&& c
== '\t' && i
<= 6)
1060 if (!gfc_option
.warn_tabs
&& seen_comment
== 0
1061 && current_line
!= linenum
)
1063 linenum
= current_line
;
1065 "Nonconforming tab character in column 1 of line %d", linenum
);
1080 if (maxlen
== 0 || preprocessor_flag
)
1084 /* Reallocate line buffer to double size to hold the
1086 buflen
= buflen
* 2;
1087 *pbuf
= xrealloc (*pbuf
, buflen
+ 1);
1091 else if (i
>= maxlen
)
1093 /* Truncate the rest of the line. */
1097 if (c
== '\n' || c
== EOF
)
1103 ungetc ('\n', input
);
1107 /* Pad lines to the selected line length in fixed form. */
1108 if (gfc_current_form
== FORM_FIXED
1109 && gfc_option
.fixed_line_length
!= 0
1110 && !preprocessor_flag
1113 while (i
++ < maxlen
)
1125 /* Get a gfc_file structure, initialize it and add it to
1129 get_file (const char *name
, enum lc_reason reason ATTRIBUTE_UNUSED
)
1133 f
= gfc_getmem (sizeof (gfc_file
));
1135 f
->filename
= gfc_getmem (strlen (name
) + 1);
1136 strcpy (f
->filename
, name
);
1138 f
->next
= file_head
;
1141 f
->included_by
= current_file
;
1142 if (current_file
!= NULL
)
1143 f
->inclusion_line
= current_file
->line
;
1145 #ifdef USE_MAPPED_LOCATION
1146 linemap_add (&line_table
, reason
, false, f
->filename
, 1);
1152 /* Deal with a line from the C preprocessor. The
1153 initial octothorp has already been seen. */
1156 preprocessor_line (char *c
)
1162 int escaped
, unescape
;
1165 while (*c
== ' ' || *c
== '\t')
1168 if (*c
< '0' || *c
> '9')
1173 c
= strchr (c
, ' ');
1176 /* No file name given. Set new line number. */
1177 current_file
->line
= line
;
1182 while (*c
== ' ' || *c
== '\t')
1192 /* Make filename end at quote. */
1195 while (*c
&& ! (! escaped
&& *c
== '"'))
1199 else if (*c
== '\\')
1208 /* Preprocessor line has no closing quote. */
1213 /* Undo effects of cpp_quote_string. */
1217 char *d
= gfc_getmem (c
- filename
- unescape
);
1233 flag
[1] = flag
[2] = flag
[3] = flag
[4] = false;
1237 c
= strchr (c
, ' ');
1244 if (1 <= i
&& i
<= 4)
1248 /* Interpret flags. */
1250 if (flag
[1]) /* Starting new file. */
1252 f
= get_file (filename
, LC_RENAME
);
1253 f
->up
= current_file
;
1257 if (flag
[2]) /* Ending current file. */
1259 if (!current_file
->up
1260 || strcmp (current_file
->up
->filename
, filename
) != 0)
1262 gfc_warning_now ("%s:%d: file %s left but not entered",
1263 current_file
->filename
, current_file
->line
,
1266 gfc_free (filename
);
1269 current_file
= current_file
->up
;
1272 /* The name of the file can be a temporary file produced by
1273 cpp. Replace the name if it is different. */
1275 if (strcmp (current_file
->filename
, filename
) != 0)
1277 gfc_free (current_file
->filename
);
1278 current_file
->filename
= gfc_getmem (strlen (filename
) + 1);
1279 strcpy (current_file
->filename
, filename
);
1282 /* Set new line number. */
1283 current_file
->line
= line
;
1285 gfc_free (filename
);
1289 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
1290 current_file
->filename
, current_file
->line
);
1291 current_file
->line
++;
1295 static try load_file (const char *, bool);
1297 /* include_line()-- Checks a line buffer to see if it is an include
1298 line. If so, we call load_file() recursively to load the included
1299 file. We never return a syntax error because a statement like
1300 "include = 5" is perfectly legal. We return false if no include was
1301 processed or true if we matched an include. */
1304 include_line (char *line
)
1306 char quote
, *c
, *begin
, *stop
;
1310 if (gfc_option
.flag_openmp
)
1312 if (gfc_current_form
== FORM_FREE
)
1314 while (*c
== ' ' || *c
== '\t')
1316 if (*c
== '!' && c
[1] == '$' && (c
[2] == ' ' || c
[2] == '\t'))
1321 if ((*c
== '!' || *c
== 'c' || *c
== 'C' || *c
== '*')
1322 && c
[1] == '$' && (c
[2] == ' ' || c
[2] == '\t'))
1327 while (*c
== ' ' || *c
== '\t')
1330 if (strncasecmp (c
, "include", 7))
1334 while (*c
== ' ' || *c
== '\t')
1337 /* Find filename between quotes. */
1340 if (quote
!= '"' && quote
!= '\'')
1345 while (*c
!= quote
&& *c
!= '\0')
1353 while (*c
== ' ' || *c
== '\t')
1356 if (*c
!= '\0' && *c
!= '!')
1359 /* We have an include line at this point. */
1361 *stop
= '\0'; /* It's ok to trash the buffer, as this line won't be
1362 read by anything else. */
1364 load_file (begin
, false);
1368 /* Load a file into memory by calling load_line until the file ends. */
1371 load_file (const char *filename
, bool initial
)
1379 for (f
= current_file
; f
; f
= f
->up
)
1380 if (strcmp (filename
, f
->filename
) == 0)
1382 gfc_error_now ("File '%s' is being included recursively", filename
);
1390 input
= gfc_src_file
;
1391 gfc_src_file
= NULL
;
1394 input
= gfc_open_file (filename
);
1397 gfc_error_now ("Can't open file '%s'", filename
);
1403 input
= gfc_open_included_file (filename
, false);
1406 gfc_error_now ("Can't open included file '%s'", filename
);
1411 /* Load the file. */
1413 f
= get_file (filename
, initial
? LC_RENAME
: LC_ENTER
);
1414 f
->up
= current_file
;
1416 current_file
->line
= 1;
1420 if (initial
&& gfc_src_preprocessor_lines
[0])
1422 preprocessor_line (gfc_src_preprocessor_lines
[0]);
1423 gfc_free (gfc_src_preprocessor_lines
[0]);
1424 gfc_src_preprocessor_lines
[0] = NULL
;
1425 if (gfc_src_preprocessor_lines
[1])
1427 preprocessor_line (gfc_src_preprocessor_lines
[1]);
1428 gfc_free (gfc_src_preprocessor_lines
[1]);
1429 gfc_src_preprocessor_lines
[1] = NULL
;
1435 int trunc
= load_line (input
, &line
, &line_len
);
1437 len
= strlen (line
);
1438 if (feof (input
) && len
== 0)
1441 /* There are three things this line can be: a line of Fortran
1442 source, an include line or a C preprocessor directive. */
1446 preprocessor_line (line
);
1450 if (include_line (line
))
1452 current_file
->line
++;
1458 b
= gfc_getmem (gfc_linebuf_header_size
+ len
+ 1);
1460 #ifdef USE_MAPPED_LOCATION
1462 = linemap_line_start (&line_table
, current_file
->line
++, 120);
1464 b
->linenum
= current_file
->line
++;
1466 b
->file
= current_file
;
1467 b
->truncated
= trunc
;
1468 strcpy (b
->line
, line
);
1470 if (line_head
== NULL
)
1473 line_tail
->next
= b
;
1478 /* Release the line buffer allocated in load_line. */
1483 current_file
= current_file
->up
;
1484 #ifdef USE_MAPPED_LOCATION
1485 linemap_add (&line_table
, LC_LEAVE
, 0, NULL
, 0);
1491 /* Open a new file and start scanning from that file. Returns SUCCESS
1492 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1493 it tries to determine the source form from the filename, defaulting
1501 result
= load_file (gfc_source_file
, true);
1503 gfc_current_locus
.lb
= line_head
;
1504 gfc_current_locus
.nextc
= (line_head
== NULL
) ? NULL
: line_head
->line
;
1506 #if 0 /* Debugging aid. */
1507 for (; line_head
; line_head
= line_head
->next
)
1508 gfc_status ("%s:%3d %s\n", line_head
->file
->filename
,
1509 #ifdef USE_MAPPED_LOCATION
1510 LOCATION_LINE (line_head
->location
),
1523 unescape_filename (const char *ptr
)
1525 const char *p
= ptr
, *s
;
1527 int escaped
, unescape
= 0;
1529 /* Make filename end at quote. */
1531 while (*p
&& ! (! escaped
&& *p
== '"'))
1535 else if (*p
== '\\')
1546 /* Undo effects of cpp_quote_string. */
1548 d
= gfc_getmem (p
+ 1 - ptr
- unescape
);
1563 /* For preprocessed files, if the first tokens are of the form # NUM.
1564 handle the directives so we know the original file name. */
1567 gfc_read_orig_filename (const char *filename
, const char **canon_source_file
)
1572 gfc_src_file
= gfc_open_file (filename
);
1573 if (gfc_src_file
== NULL
)
1576 c
= fgetc (gfc_src_file
);
1577 ungetc (c
, gfc_src_file
);
1583 load_line (gfc_src_file
, &gfc_src_preprocessor_lines
[0], &len
);
1585 if (strncmp (gfc_src_preprocessor_lines
[0], "# 1 \"", 5) != 0)
1588 filename
= unescape_filename (gfc_src_preprocessor_lines
[0] + 5);
1589 if (filename
== NULL
)
1592 c
= fgetc (gfc_src_file
);
1593 ungetc (c
, gfc_src_file
);
1599 load_line (gfc_src_file
, &gfc_src_preprocessor_lines
[1], &len
);
1601 if (strncmp (gfc_src_preprocessor_lines
[1], "# 1 \"", 5) != 0)
1604 dirname
= unescape_filename (gfc_src_preprocessor_lines
[1] + 5);
1605 if (dirname
== NULL
)
1608 len
= strlen (dirname
);
1609 if (len
< 3 || dirname
[len
- 1] != '/' || dirname
[len
- 2] != '/')
1614 dirname
[len
- 2] = '\0';
1615 set_src_pwd (dirname
);
1617 if (! IS_ABSOLUTE_PATH (filename
))
1619 char *p
= gfc_getmem (len
+ strlen (filename
));
1621 memcpy (p
, dirname
, len
- 2);
1623 strcpy (p
+ len
- 1, filename
);
1624 *canon_source_file
= p
;