2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
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 3, 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 COPYING3. If not see
20 <http://www.gnu.org/licenses/>. */
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. */
51 /* Structure for holding module and include file search path. */
52 typedef struct gfc_directorylist
56 struct gfc_directorylist *next;
60 /* List of include file search directories. */
61 static gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
63 static gfc_file *file_head, *current_file;
65 static int continue_flag, end_flag, openmp_flag;
66 static int continue_count, continue_line;
67 static locus openmp_locus;
69 gfc_source_form gfc_current_form;
70 static gfc_linebuf *line_head, *line_tail;
72 locus gfc_current_locus;
73 const char *gfc_source_file;
74 static FILE *gfc_src_file;
75 static char *gfc_src_preprocessor_lines[2];
79 /* Main scanner initialization. */
82 gfc_scanner_init_1 (void)
95 /* Main scanner destructor. */
98 gfc_scanner_done_1 (void)
103 while(line_head != NULL)
105 lb = line_head->next;
110 while(file_head != NULL)
113 gfc_free(file_head->filename);
120 /* Adds path to the list pointed to by list. */
123 add_path_to_list (gfc_directorylist **list, const char *path,
124 bool use_for_modules)
126 gfc_directorylist *dir;
130 while (*p == ' ' || *p == '\t') /* someone might do "-I include" */
136 dir = *list = gfc_getmem (sizeof (gfc_directorylist));
142 dir->next = gfc_getmem (sizeof (gfc_directorylist));
147 dir->use_for_modules = use_for_modules;
148 dir->path = gfc_getmem (strlen (p) + 2);
149 strcpy (dir->path, p);
150 strcat (dir->path, "/"); /* make '/' last character */
155 gfc_add_include_path (const char *path, bool use_for_modules)
157 add_path_to_list (&include_dirs, path, use_for_modules);
162 gfc_add_intrinsic_modules_path (const char *path)
164 add_path_to_list (&intrinsic_modules_dirs, path, true);
168 /* Release resources allocated for options. */
171 gfc_release_include_path (void)
173 gfc_directorylist *p;
175 while (include_dirs != NULL)
178 include_dirs = include_dirs->next;
183 while (intrinsic_modules_dirs != NULL)
185 p = intrinsic_modules_dirs;
186 intrinsic_modules_dirs = intrinsic_modules_dirs->next;
191 gfc_free (gfc_option.module_dir);
196 open_included_file (const char *name, gfc_directorylist *list, bool module)
199 gfc_directorylist *p;
202 for (p = list; p; p = p->next)
204 if (module && !p->use_for_modules)
207 fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
208 strcpy (fullname, p->path);
209 strcat (fullname, name);
211 f = gfc_open_file (fullname);
220 /* Opens file for reading, searching through the include directories
221 given if necessary. If the include_cwd argument is true, we try
222 to open the file in the current directory first. */
225 gfc_open_included_file (const char *name, bool include_cwd, bool module)
229 if (IS_ABSOLUTE_PATH (name))
230 return gfc_open_file (name);
234 f = gfc_open_file (name);
239 return open_included_file (name, include_dirs, module);
243 gfc_open_intrinsic_module (const char *name)
245 if (IS_ABSOLUTE_PATH (name))
246 return gfc_open_file (name);
248 return open_included_file (name, intrinsic_modules_dirs, true);
252 /* Test to see if we're at the end of the main source file. */
261 /* Test to see if we're at the end of the current file. */
269 if (line_head == NULL)
270 return 1; /* Null file */
272 if (gfc_current_locus.lb == NULL)
279 /* Test to see if we're at the beginning of a new line. */
287 return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
291 /* Test to see if we're at the end of a line. */
299 return (*gfc_current_locus.nextc == '\0');
303 /* Advance the current line pointer to the next line. */
306 gfc_advance_line (void)
311 if (gfc_current_locus.lb == NULL)
317 if (gfc_current_locus.lb->next)
319 if (gfc_current_locus.lb->file->next
320 && gfc_current_locus.lb->file->up == gfc_current_locus.lb->file->next)
321 /* We exit from an included file. */
322 (*debug_hooks->end_source_file)
323 (gfc_linebuf_linenum (gfc_current_locus.lb->next));
324 else if (gfc_current_locus.lb->next->file != gfc_current_locus.lb->file)
325 /* We enter into a new file. */
326 (*debug_hooks->start_source_file)
327 (gfc_linebuf_linenum (gfc_current_locus.lb),
328 gfc_current_locus.lb->next->file->filename);
331 gfc_current_locus.lb = gfc_current_locus.lb->next;
333 if (gfc_current_locus.lb != NULL)
334 gfc_current_locus.nextc = gfc_current_locus.lb->line;
337 gfc_current_locus.nextc = NULL;
343 /* Get the next character from the input, advancing gfc_current_file's
344 locus. When we hit the end of the line or the end of the file, we
345 start returning a '\n' in order to complete the current statement.
346 No Fortran line conventions are implemented here.
348 Requiring explicit advances to the next line prevents the parse
349 pointer from being on the wrong line if the current statement ends
357 if (gfc_current_locus.nextc == NULL)
360 c = (unsigned char) *gfc_current_locus.nextc++;
363 gfc_current_locus.nextc--; /* Remain on this line. */
371 /* Skip a comment. When we come here the parse pointer is positioned
372 immediately after the comment character. If we ever implement
373 compiler directives withing comments, here is where we parse the
377 skip_comment_line (void)
392 gfc_define_undef_line (void)
394 /* All lines beginning with '#' are either #define or #undef. */
395 if (! (debug_info_level == DINFO_LEVEL_VERBOSE
396 && (write_symbols == DWARF2_DEBUG
397 || write_symbols == VMS_AND_DWARF2_DEBUG))
398 || gfc_peek_char () != '#')
401 if (strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
402 (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb),
403 &(gfc_current_locus.nextc[8]));
405 if (strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
406 (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb),
407 &(gfc_current_locus.nextc[7]));
409 /* Skip the rest of the line. */
410 skip_comment_line ();
416 /* Comment lines are null lines, lines containing only blanks or lines
417 on which the first nonblank line is a '!'.
418 Return true if !$ openmp conditional compilation sentinel was
422 skip_free_comments (void)
430 at_bol = gfc_at_bol ();
431 start = gfc_current_locus;
437 while (gfc_is_whitespace (c));
447 /* If -fopenmp, we need to handle here 2 things:
448 1) don't treat !$omp as comments, but directives
449 2) handle OpenMP conditional compilation, where
450 !$ should be treated as 2 spaces (for initial lines
451 only if followed by space). */
452 if (gfc_option.flag_openmp && at_bol)
454 locus old_loc = gfc_current_locus;
455 if (next_char () == '$')
458 if (c == 'o' || c == 'O')
460 if (((c = next_char ()) == 'm' || c == 'M')
461 && ((c = next_char ()) == 'p' || c == 'P'))
463 if ((c = next_char ()) == ' ' || continue_flag)
465 while (gfc_is_whitespace (c))
467 if (c != '\n' && c != '!')
470 openmp_locus = old_loc;
471 gfc_current_locus = start;
476 gfc_warning_now ("!$OMP at %C starts a commented "
477 "line as it neither is followed "
478 "by a space nor is a "
479 "continuation line");
481 gfc_current_locus = old_loc;
485 if (continue_flag || c == ' ')
487 gfc_current_locus = old_loc;
493 gfc_current_locus = old_loc;
495 skip_comment_line ();
502 if (openmp_flag && at_bol)
504 gfc_current_locus = start;
509 /* Skip comment lines in fixed source mode. We have the same rules as
510 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
511 in column 1, and a '!' cannot be in column 6. Also, we deal with
512 lines with 'd' or 'D' in column 1, if the user requested this. */
515 skip_fixed_comments (void)
523 start = gfc_current_locus;
528 while (gfc_is_whitespace (c));
533 skip_comment_line ();
538 gfc_current_locus = start;
545 start = gfc_current_locus;
556 if (c == '!' || c == 'c' || c == 'C' || c == '*')
558 /* If -fopenmp, we need to handle here 2 things:
559 1) don't treat !$omp|c$omp|*$omp as comments, but directives
560 2) handle OpenMP conditional compilation, where
561 !$|c$|*$ should be treated as 2 spaces if the characters
562 in columns 3 to 6 are valid fixed form label columns
564 if (gfc_option.flag_openmp)
566 if (next_char () == '$')
569 if (c == 'o' || c == 'O')
571 if (((c = next_char ()) == 'm' || c == 'M')
572 && ((c = next_char ()) == 'p' || c == 'P'))
576 && ((openmp_flag && continue_flag)
577 || c == ' ' || c == '0'))
580 while (gfc_is_whitespace (c))
582 if (c != '\n' && c != '!')
584 /* Canonicalize to *$omp. */
587 gfc_current_locus = start;
597 for (col = 3; col < 6; col++, c = next_char ())
600 else if (c < '0' || c > '9')
605 if (col == 6 && c != '\n'
606 && ((continue_flag && !digit_seen)
607 || c == ' ' || c == '0'))
609 gfc_current_locus = start;
610 start.nextc[0] = ' ';
611 start.nextc[1] = ' ';
616 gfc_current_locus = start;
618 skip_comment_line ();
622 if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
624 if (gfc_option.flag_d_lines == 0)
626 skip_comment_line ();
630 *start.nextc = c = ' ';
635 while (gfc_is_whitespace (c))
647 if (col != 6 && c == '!')
649 skip_comment_line ();
657 gfc_current_locus = start;
661 /* Skips the current line if it is a comment. */
664 gfc_skip_comments (void)
666 if (gfc_current_form == FORM_FREE)
667 skip_free_comments ();
669 skip_fixed_comments ();
673 /* Get the next character from the input, taking continuation lines
674 and end-of-line comments into account. This implies that comment
675 lines between continued lines must be eaten here. For higher-level
676 subroutines, this flattens continued lines into a single logical
677 line. The in_string flag denotes whether we're inside a character
681 gfc_next_char_literal (int in_string)
684 int i, c, prev_openmp_flag;
696 if (gfc_current_form == FORM_FREE)
698 bool openmp_cond_flag;
700 if (!in_string && c == '!')
703 && memcmp (&gfc_current_locus, &openmp_locus,
704 sizeof (gfc_current_locus)) == 0)
707 /* This line can't be continued */
714 /* Avoid truncation warnings for comment ending lines. */
715 gfc_current_locus.lb->truncated = 0;
723 /* If the next nonblank character is a ! or \n, we've got a
724 continuation line. */
725 old_loc = gfc_current_locus;
728 while (gfc_is_whitespace (c))
731 /* Character constants to be continued cannot have commentary
734 if (in_string && c != '\n')
736 gfc_current_locus = old_loc;
741 if (c != '!' && c != '\n')
743 gfc_current_locus = old_loc;
748 prev_openmp_flag = openmp_flag;
751 skip_comment_line ();
756 goto not_continuation;
758 /* We've got a continuation line. If we are on the very next line after
759 the last continuation, increment the continuation line count and
760 check whether the limit has been exceeded. */
761 if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
763 if (++continue_count == gfc_option.max_continue_free)
765 if (gfc_notification_std (GFC_STD_GNU) || pedantic)
766 gfc_warning ("Limit of %d continuations exceeded in "
767 "statement at %C", gfc_option.max_continue_free);
770 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
772 /* Now find where it continues. First eat any comment lines. */
773 openmp_cond_flag = skip_free_comments ();
775 if (prev_openmp_flag != openmp_flag)
777 gfc_current_locus = old_loc;
778 openmp_flag = prev_openmp_flag;
783 /* Now that we have a non-comment line, probe ahead for the
784 first non-whitespace character. If it is another '&', then
785 reading starts at the next character, otherwise we must back
786 up to where the whitespace started and resume from there. */
788 old_loc = gfc_current_locus;
791 while (gfc_is_whitespace (c))
796 for (i = 0; i < 5; i++, c = next_char ())
798 gcc_assert (TOLOWER (c) == "!$omp"[i]);
800 old_loc = gfc_current_locus;
802 while (gfc_is_whitespace (c))
810 if (gfc_option.warn_ampersand)
811 gfc_warning_now ("Missing '&' in continued character "
813 gfc_current_locus.nextc--;
815 /* Both !$omp and !$ -fopenmp continuation lines have & on the
816 continuation line only optionally. */
817 else if (openmp_flag || openmp_cond_flag)
818 gfc_current_locus.nextc--;
822 gfc_current_locus = old_loc;
829 /* Fixed form continuation. */
830 if (!in_string && c == '!')
832 /* Skip comment at end of line. */
839 /* Avoid truncation warnings for comment ending lines. */
840 gfc_current_locus.lb->truncated = 0;
846 prev_openmp_flag = openmp_flag;
848 old_loc = gfc_current_locus;
851 skip_fixed_comments ();
853 /* See if this line is a continuation line. */
854 if (openmp_flag != prev_openmp_flag)
856 openmp_flag = prev_openmp_flag;
857 goto not_continuation;
861 for (i = 0; i < 5; i++)
865 goto not_continuation;
868 for (i = 0; i < 5; i++)
871 if (TOLOWER (c) != "*$omp"[i])
872 goto not_continuation;
876 if (c == '0' || c == ' ' || c == '\n')
877 goto not_continuation;
879 /* We've got a continuation line. If we are on the very next line after
880 the last continuation, increment the continuation line count and
881 check whether the limit has been exceeded. */
882 if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
884 if (++continue_count == gfc_option.max_continue_fixed)
886 if (gfc_notification_std (GFC_STD_GNU) || pedantic)
887 gfc_warning ("Limit of %d continuations exceeded in "
889 gfc_option.max_continue_fixed);
893 if (continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
894 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
897 /* Ready to read first character of continuation line, which might
898 be another continuation line! */
903 gfc_current_locus = old_loc;
913 /* Get the next character of input, folded to lowercase. In fixed
914 form mode, we also ignore spaces. When matcher subroutines are
915 parsing character literals, they have to call
916 gfc_next_char_literal(). */
925 c = gfc_next_char_literal (0);
927 while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
939 old_loc = gfc_current_locus;
940 c = gfc_next_char ();
941 gfc_current_locus = old_loc;
947 /* Recover from an error. We try to get past the current statement
948 and get lined up for the next. The next statement follows a '\n'
949 or a ';'. We also assume that we are not within a character
950 constant, and deal with finding a '\'' or '"'. */
953 gfc_error_recovery (void)
962 c = gfc_next_char ();
963 if (c == '\n' || c == ';')
966 if (c != '\'' && c != '"')
995 /* Read ahead until the next character to be read is not whitespace. */
998 gfc_gobble_whitespace (void)
1000 static int linenum = 0;
1006 old_loc = gfc_current_locus;
1007 c = gfc_next_char_literal (0);
1008 /* Issue a warning for nonconforming tabs. We keep track of the line
1009 number because the Fortran matchers will often back up and the same
1010 line will be scanned multiple times. */
1011 if (!gfc_option.warn_tabs && c == '\t')
1013 #ifdef USE_MAPPED_LOCATION
1014 int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
1016 int cur_linenum = gfc_current_locus.lb->linenum;
1018 if (cur_linenum != linenum)
1020 linenum = cur_linenum;
1021 gfc_warning_now ("Nonconforming tab character at %C");
1025 while (gfc_is_whitespace (c));
1027 gfc_current_locus = old_loc;
1031 /* Load a single line into pbuf.
1033 If pbuf points to a NULL pointer, it is allocated.
1034 We truncate lines that are too long, unless we're dealing with
1035 preprocessor lines or if the option -ffixed-line-length-none is set,
1036 in which case we reallocate the buffer to fit the entire line, if
1038 In fixed mode, we expand a tab that occurs within the statement
1039 label region to expand to spaces that leave the next character in
1041 load_line returns whether the line was truncated.
1043 NOTE: The error machinery isn't available at this point, so we can't
1044 easily report line and column numbers consistent with other
1045 parts of gfortran. */
1048 load_line (FILE *input, char **pbuf, int *pbuflen)
1050 static int linenum = 0, current_line = 1;
1051 int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
1052 int trunc_flag = 0, seen_comment = 0;
1053 int seen_printable = 0, seen_ampersand = 0;
1056 /* Determine the maximum allowed line length. */
1057 if (gfc_current_form == FORM_FREE)
1058 maxlen = gfc_option.free_line_length;
1059 else if (gfc_current_form == FORM_FIXED)
1060 maxlen = gfc_option.fixed_line_length;
1066 /* Allocate the line buffer, storing its length into buflen.
1067 Note that if maxlen==0, indicating that arbitrary-length lines
1068 are allowed, the buffer will be reallocated if this length is
1069 insufficient; since 132 characters is the length of a standard
1070 free-form line, we use that as a starting guess. */
1076 *pbuf = gfc_getmem (buflen + 1);
1082 preprocessor_flag = 0;
1085 /* In order to not truncate preprocessor lines, we have to
1086 remember that this is one. */
1087 preprocessor_flag = 1;
1098 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1099 if (gfc_current_form == FORM_FREE
1100 && !seen_printable && seen_ampersand)
1103 gfc_error_now ("'&' not allowed by itself in line %d",
1106 gfc_warning_now ("'&' not allowed by itself in line %d",
1113 continue; /* Gobble characters. */
1125 if ((c != '&' && c != '!') || (c == '!' && !seen_ampersand))
1128 /* Is this a fixed-form comment? */
1129 if (gfc_current_form == FORM_FIXED && i == 0
1130 && (c == '*' || c == 'c' || c == 'd'))
1133 if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
1135 if (!gfc_option.warn_tabs && seen_comment == 0
1136 && current_line != linenum)
1138 linenum = current_line;
1139 gfc_warning_now ("Nonconforming tab character in column 1 "
1140 "of line %d", linenum);
1155 if (maxlen == 0 || preprocessor_flag)
1159 /* Reallocate line buffer to double size to hold the
1161 buflen = buflen * 2;
1162 *pbuf = xrealloc (*pbuf, buflen + 1);
1163 buffer = (*pbuf) + i;
1166 else if (i >= maxlen)
1168 /* Truncate the rest of the line. */
1172 if (c == '\n' || c == EOF)
1178 ungetc ('\n', input);
1182 /* Pad lines to the selected line length in fixed form. */
1183 if (gfc_current_form == FORM_FIXED
1184 && gfc_option.fixed_line_length != 0
1185 && !preprocessor_flag
1188 while (i++ < maxlen)
1200 /* Get a gfc_file structure, initialize it and add it to
1204 get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
1208 f = gfc_getmem (sizeof (gfc_file));
1210 f->filename = gfc_getmem (strlen (name) + 1);
1211 strcpy (f->filename, name);
1213 f->next = file_head;
1216 f->included_by = current_file;
1217 if (current_file != NULL)
1218 f->inclusion_line = current_file->line;
1220 #ifdef USE_MAPPED_LOCATION
1221 linemap_add (line_table, reason, false, f->filename, 1);
1227 /* Deal with a line from the C preprocessor. The
1228 initial octothorp has already been seen. */
1231 preprocessor_line (char *c)
1237 int escaped, unescape;
1240 while (*c == ' ' || *c == '\t')
1243 if (*c < '0' || *c > '9')
1248 c = strchr (c, ' ');
1251 /* No file name given. Set new line number. */
1252 current_file->line = line;
1257 while (*c == ' ' || *c == '\t')
1267 /* Make filename end at quote. */
1270 while (*c && ! (!escaped && *c == '"'))
1274 else if (*c == '\\')
1283 /* Preprocessor line has no closing quote. */
1288 /* Undo effects of cpp_quote_string. */
1292 char *d = gfc_getmem (c - filename - unescape);
1308 flag[1] = flag[2] = flag[3] = flag[4] = false;
1312 c = strchr (c, ' ');
1319 if (1 <= i && i <= 4)
1323 /* Interpret flags. */
1325 if (flag[1]) /* Starting new file. */
1327 f = get_file (filename, LC_RENAME);
1328 f->up = current_file;
1332 if (flag[2]) /* Ending current file. */
1334 if (!current_file->up
1335 || strcmp (current_file->up->filename, filename) != 0)
1337 gfc_warning_now ("%s:%d: file %s left but not entered",
1338 current_file->filename, current_file->line,
1341 gfc_free (filename);
1345 current_file = current_file->up;
1346 #ifdef USE_MAPPED_LOCATION
1347 linemap_add (line_table, LC_RENAME, false, current_file->filename,
1348 current_file->line);
1352 /* The name of the file can be a temporary file produced by
1353 cpp. Replace the name if it is different. */
1355 if (strcmp (current_file->filename, filename) != 0)
1357 gfc_free (current_file->filename);
1358 current_file->filename = gfc_getmem (strlen (filename) + 1);
1359 strcpy (current_file->filename, filename);
1362 /* Set new line number. */
1363 current_file->line = line;
1365 gfc_free (filename);
1369 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
1370 current_file->filename, current_file->line);
1371 current_file->line++;
1375 static try load_file (const char *, bool);
1377 /* include_line()-- Checks a line buffer to see if it is an include
1378 line. If so, we call load_file() recursively to load the included
1379 file. We never return a syntax error because a statement like
1380 "include = 5" is perfectly legal. We return false if no include was
1381 processed or true if we matched an include. */
1384 include_line (char *line)
1386 char quote, *c, *begin, *stop;
1390 if (gfc_option.flag_openmp)
1392 if (gfc_current_form == FORM_FREE)
1394 while (*c == ' ' || *c == '\t')
1396 if (*c == '!' && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1401 if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
1402 && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1407 while (*c == ' ' || *c == '\t')
1410 if (strncasecmp (c, "include", 7))
1414 while (*c == ' ' || *c == '\t')
1417 /* Find filename between quotes. */
1420 if (quote != '"' && quote != '\'')
1425 while (*c != quote && *c != '\0')
1433 while (*c == ' ' || *c == '\t')
1436 if (*c != '\0' && *c != '!')
1439 /* We have an include line at this point. */
1441 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
1442 read by anything else. */
1444 load_file (begin, false);
1449 /* Load a file into memory by calling load_line until the file ends. */
1452 load_file (const char *filename, bool initial)
1461 for (f = current_file; f; f = f->up)
1462 if (strcmp (filename, f->filename) == 0)
1464 gfc_error_now ("File '%s' is being included recursively", filename);
1472 input = gfc_src_file;
1473 gfc_src_file = NULL;
1476 input = gfc_open_file (filename);
1479 gfc_error_now ("Can't open file '%s'", filename);
1485 input = gfc_open_included_file (filename, false, false);
1488 gfc_error_now ("Can't open included file '%s'", filename);
1493 /* Load the file. */
1495 f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
1496 f->up = current_file;
1498 current_file->line = 1;
1503 if (initial && gfc_src_preprocessor_lines[0])
1505 preprocessor_line (gfc_src_preprocessor_lines[0]);
1506 gfc_free (gfc_src_preprocessor_lines[0]);
1507 gfc_src_preprocessor_lines[0] = NULL;
1508 if (gfc_src_preprocessor_lines[1])
1510 preprocessor_line (gfc_src_preprocessor_lines[1]);
1511 gfc_free (gfc_src_preprocessor_lines[1]);
1512 gfc_src_preprocessor_lines[1] = NULL;
1518 int trunc = load_line (input, &line, &line_len);
1520 len = strlen (line);
1521 if (feof (input) && len == 0)
1524 /* If this is the first line of the file, it can contain a byte
1525 order mark (BOM), which we will ignore:
1526 FF FE is UTF-16 little endian,
1527 FE FF is UTF-16 big endian,
1528 EF BB BF is UTF-8. */
1530 && ((line_len >= 2 && line[0] == '\xFF' && line[1] == '\xFE')
1531 || (line_len >= 2 && line[0] == '\xFE' && line[1] == '\xFF')
1532 || (line_len >= 3 && line[0] == '\xEF' && line[1] == '\xBB'
1533 && line[2] == '\xBF')))
1535 int n = line[1] == '\xBB' ? 3 : 2;
1536 char * new = gfc_getmem (line_len);
1538 strcpy (new, line + n);
1544 /* There are three things this line can be: a line of Fortran
1545 source, an include line or a C preprocessor directive. */
1549 /* When -g3 is specified, it's possible that we emit #define
1550 and #undef lines, which we need to pass to the middle-end
1551 so that it can emit correct debug info. */
1552 if (debug_info_level == DINFO_LEVEL_VERBOSE
1553 && (write_symbols == DWARF2_DEBUG
1554 || write_symbols == VMS_AND_DWARF2_DEBUG)
1555 && (strncmp (line, "#define ", 8) == 0
1556 || strncmp (line, "#undef ", 7) == 0))
1560 preprocessor_line (line);
1565 /* Preprocessed files have preprocessor lines added before the byte
1566 order mark, so first_line is not about the first line of the file
1567 but the first line that's not a preprocessor line. */
1570 if (include_line (line))
1572 current_file->line++;
1578 b = gfc_getmem (gfc_linebuf_header_size + len + 1);
1580 #ifdef USE_MAPPED_LOCATION
1582 = linemap_line_start (line_table, current_file->line++, 120);
1584 b->linenum = current_file->line++;
1586 b->file = current_file;
1587 b->truncated = trunc;
1588 strcpy (b->line, line);
1590 if (line_head == NULL)
1593 line_tail->next = b;
1598 /* Release the line buffer allocated in load_line. */
1603 current_file = current_file->up;
1604 #ifdef USE_MAPPED_LOCATION
1605 linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
1611 /* Open a new file and start scanning from that file. Returns SUCCESS
1612 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1613 it tries to determine the source form from the filename, defaulting
1621 result = load_file (gfc_source_file, true);
1623 gfc_current_locus.lb = line_head;
1624 gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
1626 #if 0 /* Debugging aid. */
1627 for (; line_head; line_head = line_head->next)
1628 gfc_status ("%s:%3d %s\n",
1629 #ifdef USE_MAPPED_LOCATION
1630 LOCATION_FILE (line_head->location),
1631 LOCATION_LINE (line_head->location),
1633 line_head->file->filename,
1645 unescape_filename (const char *ptr)
1647 const char *p = ptr, *s;
1649 int escaped, unescape = 0;
1651 /* Make filename end at quote. */
1653 while (*p && ! (! escaped && *p == '"'))
1657 else if (*p == '\\')
1668 /* Undo effects of cpp_quote_string. */
1670 d = gfc_getmem (p + 1 - ptr - unescape);
1685 /* For preprocessed files, if the first tokens are of the form # NUM.
1686 handle the directives so we know the original file name. */
1689 gfc_read_orig_filename (const char *filename, const char **canon_source_file)
1694 gfc_src_file = gfc_open_file (filename);
1695 if (gfc_src_file == NULL)
1698 c = getc (gfc_src_file);
1699 ungetc (c, gfc_src_file);
1705 load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
1707 if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
1710 filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
1711 if (filename == NULL)
1714 c = getc (gfc_src_file);
1715 ungetc (c, gfc_src_file);
1721 load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
1723 if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
1726 dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
1727 if (dirname == NULL)
1730 len = strlen (dirname);
1731 if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
1736 dirname[len - 2] = '\0';
1737 set_src_pwd (dirname);
1739 if (! IS_ABSOLUTE_PATH (filename))
1741 char *p = gfc_getmem (len + strlen (filename));
1743 memcpy (p, dirname, len - 2);
1745 strcpy (p + len - 1, filename);
1746 *canon_source_file = p;